Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/local/bin/perl -w # # Version 1.00.00 - 2001/11/25 - Initial incarnation # # Home Node Picture Rotator # # Is your homenode boring, dull, and lifeless because you refuse to t +ake the # time to update your homenode picture? Now, with the new miracle ho +menode # image rotator (HNIR), you can be one of the l337 p30pl3 with a new +home node # image every time (well, nearly...) someone accesses your homenode! + # # !!! SEE THE SECURITY SECTION OF THE POD BEFORE RUNNING THIS PROGRAM + !!! # # This script has two pieces. The first is a "bug" that lives in the + text of # your homenode that makes a request to a server for a 1x1 clear pixe +l image. # Along with getting this remarkable 1x1 clear pixel image, it increm +ents a # counter file (which also tells you how many people have accessed yo +ur home- # node). The second piece is this script, whic is a daemon that runs + some- # where you have access to the aforementioned counter file. After a +preset # number of accesses to your homenode, a new image is uploaded, from +a list # of images you provide. # # Of course, if you're so unc00l and non-l337 that no one accesses yo +ur home # node, well, you're stuck with that same boring image. You'll just +have to # get new friends. # # There is no warrantly, express or implied with this software. It # *shouldn't* mess up your homenode contents, but because it does do +a fetch # of the page, change some fields, and re-submit the form, the possib +ility # exists. You might consider backing up the text on your homenode to + a # file somewhere. # # A production of Twitching Monk Software # Copyright (c) 2001 J.C.Wren. All rights reserved. # This is free software. You can redistribute it and/or modify it un +der the # same terms as Perl itself. # # (P.S, That Linux flag has gotten stale, [tilly]. You need to use t +his.) # use strict; use LWP::UserAgent; use URI::Escape; use HTTP::Cookies; use HTML::Form; use Getopt::Std; use Proc::Daemon; # # Change this to suit your taste. # my %config = (username => undef, # or 'myusername' password => undef, # or 'mypassword', homenode => undef, # or 939, sigUpdate => 0, imgListFile => "$ENV{HOME}/.hnirotate.piclist", counterFile => "/tmp/hncounter.dat", lastPicFile => "$ENV{HOME}/.hnirotate.lastpic", updateEvery => 50, checkInterval => 10, baseurl => "http://www.perlmonks.org", pmsite => "http://www.perlmonks.org/index.pl?", oneshot => 0, daemon => 0, verbose => 0, randomize => 0, ); sub UNSAFE_CHARS {"^A-Za-z0-9\-_.!~*'()"} # # Ye olde main # { my %args = (); getopts ('u:p:n:I:C:L:e:c:rsDvPoh?', \%args); if ($args {'?'} || $args {h}) { usage (); exit; } if ($args {P}) { local $| = 1; print "Password: "; $args {p} = <STDIN>; chomp ($args {p}); } $config {username} = $args {u} || $config {username} || d +ie "No username. Program terminated.\n"; $config {password} = $args {p} || $config {password} || d +ie "No password. Program terminated.\n"; $config {homenode} = $args {n} || $config {homenode} || d +ie "No homenode ID. Program terminated.\n"; $config {imgListFile} = $args {I} || $config {imgListFile} || d +ie "No image list file. Program terminated.\n"; $config {counterFile} = $args {C} || $config {counterFile} || d +ie "No counter file. Program terminated.\n"; $config {lastPicFile} = $args {L} || $config {lastPicFile} || d +ie "No last pic file. Program terminated.\n"; $config {updateEvery} = $args {e} || $config {updateEvery} || d +ie "No update every counter. Program terminated.\n"; $config {checkInverval} = $args {c} || $config {checkInterval} || d +ie "No check interval. Program terminated.\n"; $config {randomize} = $args {r} || $config {randomize}; $config {sigUpdate} = $args {s} || $config {sigUpdate}; $config {oneshot} = $args {o} || $config {oneshot}; $config {daemon} = $args {D} || $config {daemon}; $config {daemon} = 0 if ($config {oneshot}); $config {verbose} = $args {v} || $config {verbose}; $config {verbose} = 0 if ($config {daemon}); $config {baseurl} || d +ie "\$config {baseurl} not defined. Program terminated.\n"; $config {pmsite} || d +ie "\$config {pmsite} not defined. Program terminated.\n"; die "\"", $config {lastPicFile}, "\" isn't writeable.\n" unless ((! + -e $config {lastPicFile}) || (-w $config {lastPicFile})); open PICLIST, $config {imgListFile} or die "Error opening image lis +t file \"", $config {imgListFile}, "\": $!"; chomp (@{$config {picList}} = <PICLIST>); close PICLIST; die "Must have at least 2 images for rotation.\n" if (scalar @{$con +fig {picList}} < 2); my $stop = 0; -s $_ or $stop = 1, warn "Image $_ doesn't exist or 0 length: $!\n" + foreach (@{$config {picList}}); $stop and exit; die "Configuration looks good.\n" if ($args {V}); print scalar localtime, ": ", scalar @{$config {picList}}, " images + for rotation\n" if ($config {verbose}); if ($config {oneshot}) { uploadNewPic (randomPicture (), $config {sigUpdate}) } else { foreverLoop (); } } # # # sub foreverLoop { my $thisCount; my $nextCount; my $lastCount; my $thisStamp = (stat ($config {counterFile}))[9] || die "Eeek! Fil +e \"", $config {counterFile}, "\" doesn't exist!\n"; my $lastStamp = $thisStamp; # # This is *so* lame, but I couldn't see a cleaner way to do it. # sub readfile { open IFILE, $config {counterFile} || die "Eeek! Can't open \"", +$config {counterFile}, "\": $!\n"; chomp (my $fileVal = <IFILE>); close IFILE; return $fileVal; } $lastCount = $thisCount = readfile (); $nextCount = $thisCount - ($thisCount % $config {updateEvery}) + $c +onfig {updateEvery}; print scalar localtime, ": counter=$thisCount, ", $nextCount - $thi +sCount, " hits to next upload.\n" if ($config {verbose}); # # Recommended only after testing. Since STDOUT and STDERR are clo +sed, any error message # are going to the great bit bucket in the sky. Of course, if we +were really cool, we'd # write then via syslog()... We're not that cool. # Proc::Daemon::Init if ($config {daemon}); while (1) { while (($thisCount = readfile ()) == $lastCount) { while ($thisStamp == $lastStamp) { sleep ($config {checkInterval}); $thisStamp = (stat ($config {counterFile}))[9] || die "Eee +k! File \"", $config {counterFile}, "\" disappeared!\n"; } $lastStamp = $thisStamp; } if ($thisCount >= $nextCount) { uploadNewPic (randomPicture (), $config {sigUpdate}); $nextCount += $config {updateEvery}; } print scalar localtime, ": counter=$thisCount, ", $nextCount - $ +thisCount, " hits to next upload.\n" if ($config {verbose}); $lastCount = $thisCount; } } # # A little tricknology to get a decent random number. In a test of 1 +00,000 # iterations, the distribution was very close to uniform. # sub randomPicture { my $newimg; my $lastimg = ""; if ((-s $config {lastPicFile}) && open LASTPIC, $config {lastPicFil +e}) { chomp ($lastimg = <LASTPIC>); close LASTPIC; } if ($config {randomize}) { while (1) { my $rnd = sprintf ("%d", rand (scalar @{$config {picList}} + +2)); next if ($rnd == 0 || $rnd == scalar @{$config {picList}} + 1 +); last if (($newimg = $config {picList}[$rnd - 2]) ne $lastimg) +; } } else { my $i = 0; grep {$i++; $newimg = $config {picList} [$i % scalar @{$config { +picList}}] if /$lastimg/} @{$config {picList}}; $lastimg = $config {picList}[0] if (!defined $newimg); } open NEWPIC, ">" . $config {lastPicFile} or die "Eeek! Can't write + to \"", $config {lastPicFile}, "\": $!"; print NEWPIC $newimg, "\n"; close NEWPIC; return $newimg; } # # # sub uploadNewPic { @_ >= 2 || die "At least 1 argument required"; my ($picture, $significantUpdate) = @_; my $err; my $useragent = new LWP::UserAgent; print scalar localtime, ": starting upload\n" if ($config {verbose} +); die "Eeek! Image \"$picture\" doesn't exist\n" unless -s $picture; $useragent->agent ("Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 4 +.0)"); $useragent->cookie_jar (HTTP::Cookies->new (ignore_discard => 1)); my $res = doPerlmonksLogin ($useragent, $config {username}, $config + {password}, $config {homenode}); print scalar localtime, ": login completed\n" if ($config {verbose} +); my @forms = HTML::Form->parse ($res->content (), $config {baseurl}) +; foreach my $form (@forms) { if ($form->find_input ("imgsrc_file")) { $form->value ("imgsrc_file", [$picture]); $form->value ("significantupdate", "on") if ($significantUpda +te); $res = $useragent->request ($form->click ('sexisgood')); $res->is_error && die "Can't post changes"; print scalar localtime, ": uploaded $picture\n" if ($config { +verbose}); return; } } die "Eeek! Can't find the imgsrc_file field in any of the forms!"; } # # # sub doPerlmonksLogin { @_ >= 4 || die "At least 4 arguments required"; my ($useragent, $username, $password, $homenode) = @_; my %pairs = (); my $req = new HTTP::Request ('POST' => $config {pmsite}, HTTP::Head +ers->new ('Content-Type' => 'application/x-www-form-urlencoded')); @pairs {qw(user passwd op ticker displaytype node_id)} = ($username +, $password, 'login', 'yes', 'edit', $homenode); $req->content (join '&', map {$_ . "=" . uri_escape ($pairs {$_}, U +NSAFE_CHARS)} keys %pairs); my $res = $useragent->request ($req); if ($res->is_success) { $useragent->cookie_jar->extract_cookies ($res); return $res if ($useragent->cookie_jar->as_string () =~ m/userpa +ss/i); die "Eeek! Log in failed. Bad username or password?\n"; } die "Eeek! Request to ", $config {pmsite}, " failed!\n"; } # # # sub usage { print <<ENDOFHELP; usage: hnirotate.pl [-h | -?] [-u username] [-p password] [-P] [-n hom +enode] [-I imageListFile] [-C counterFile] [-L lastPictur +eFile] [-e updateEvery] [-c checkInterval] [-r] [-s] [-o] + [-D] [-v] [-V] Rotate images into homenode -h this help list -? this help list -u username user name on Perlmonks.org -p password password for username -n homenode numeric ID of homenode for username -I filename file containing list of images for rotation, 1 per l +ine -C filename counter filename used in "bug" script -L filename file to store name of last picture uploaded -e every upload new image after this many hits on homenode -c interval how often in seconds to check the counter file for c +hanges -r randomize images from names in -I option -s set 'Significant Update' on homenode when new image +uploaded -o one shot upload of random picture -D run as daemon, detach from console -v verbose, be chatty about what program is doing -V validate filenames and arguments, then exit Specifying -o (oneshot) overrides -D (daemon) option. Specifying -D (daemon) overrides -v (verbose) option. ENDOFHELP } __END__ =head1 NAME hnirotate - Home Node Image Rotator =head1 SYNOPSIS usage: hnirotate.pl [B<-h> | B<-?>] [B<-u> username] [B<-p> password] +[B<-P>] [B<-n> homenode] [B<-I> imageListFile] [B<-C> counterFile] [B<-L> lastPictureFile] [B<-e> updateEvery] [B<-c> checkInterval] [B<- +r>] [B<-s>] [B<-o>] [B<-D>] [B<-v>] [B<-V>] Rotate images into homenode -h this help list -? this help list -u username user name on Perlmonks.org -p password password for username -P prompt for password interactively -n homenode numeric ID of homenode for username -I filename file containing list of images for rotation, 1 per l +ine -C filename counter filename used in "bug" script -L filename file to store name of last picture uploaded -e every upload new image after this many hits on homenode -c interval how often in seconds to check the counter file for c +hanges -r randomize images from names in -I option -s set 'Significant Update' on homenode when new image +uploaded -o one shot upload of random picture -D run as daemon, detach from console -v verbose, be chatty about what program is doing -V validate filenames and arguments, then exit Specifying -o (oneshot) overrides -D (daemon) option. Specifying -D (daemon) overrides -v (verbose) option. =head1 DESCRIPTION hnirotate takes care of the majority of the task of keeping a fresh picture on your homenode. Since stale pictures are the root of most homenode dullness, it's important that you change it periodically to k +eep your public coming back to you. Rather than having to actually think about doing this every so often, this script does that automatically, after a certain number of hits on your homenode. All you have to do is periodically add/delete/edit a few lines in a configuration file that point to images suitable for homenode publicat +ion (remember, Lord vroom doesn't want your pr0n collection in your homeno +de!), and after so many accesses, *poof*, a new picture from your list of im +ages gets uploaded. =head1 OPTIONS =over 4 =item B<-h> or B<-?> help Prints out a brief help message. =item B<-u> username The username of the perlmonks.org account that the image is to be uplo +aded to. =item B<-p> password The password for the username. Be sure to READ THE SECURITY SECTION, +below. There is important information about keeping your password private. =item B<-P> Enter password interactively. The password is prompted for as soon as + the script starts. While impractical if the script is started from a cron +job, it is the most secure method. See B<SECURITY>. =item B<-n> homenode This is the numeric ID of the homenode of the user that the image is t +o be uploaded to. While unlikely, it's possible that a node might have bee +n created with the same name as a user, and the script wouldn't be able +to make the determination as to which is correct. To avoid this risk, the hom +e node ID is provided, so no abiguity is possible. =item B<-I> filename This option specifies a file that contains a list of images to be uplo +aded to the home node. The file should contain the complete path to each f +ile, 1 per line. Currently, the monastery only supports .JPG and .GIF file +s. While the script checks that the specified files exist, it does not ch +eck the format of the files. The default filename is $ENV{HOME}/.hnirotat +e.piclist. A sample B<-I> file might look like: =over 4 =item /home/someuser/images/measadog.jpg /home/someuser/images/cartoon.jpg /home/someuser/images/vroomsbuttuglycar.gif /home/someuser/images/gecko.jpg /home/someuser/images/annisagoddess.jpg =back =item B<-C> filename This option specifies the name of the file that the "bug" script (see B<BUG SCRIPT>, below) uses for it's counter file. This is the mechani +sm that is used to communicate home node hits to this script. Because th +e "bug" script typically runs as user ''nobody'', it is necessary to put + it in a place that ''nobody'' has write access to. The /tmp directory is + as good as a location as anywhere to use. The default filename is /tmp/hncounter.dat. =item B<-L> filename This option specifies the filename to use for storing the last image uploaded. This is used to prevent the same image from being uploaded twice in a row, even if the script is cancelled and restarted. It mus +t be a directory that the UID of the script has write permission to. Th +e default filename is $ENV{HOME}/.hnirotate.lastpic. =item B<-e> every Number of hits before between uploads. This is the number of hits the homenode must receive before uploading a new image. B<USE THIS WITH CARE>. If you have a busy homenode, this should be a high value. If you're not part of the Perl Illuminati and have a homenode that's the equivalent of a trailer in the backwoods of West Virginia, you can set this lower. Remember that every image upload uses a little bit of irreplacable bandwidth, that someone is paying for. If you use it too much, our Fearless Leader may become angered and impose a limit on how many times in some given interval that a new home node picture can be uploaded. So use some common sense with this, OK? Default is 50 hits +. =item B<-c> interval Number of seconds between pollings of the B<-C> counter file. This controls the response time between the homenode hit, and this script noticing the hit. There's not much point in setting this to a really low value. If your homenode updates in 1 second or 100 seconds, no one is really going to notice. 10 seconds is a reasonable trade off, since the check for the counter file being updated uses a microscopic amount of resouces. The default is 10 seconds. =item B<-r> Randomize the image list from the B<-I> file. Without this option, th +e images will be sequentially stepped through. With this, a reasonably random image will be selected. The B<-L> filename is in part responsi +ble for making sure the same image isn't uploaded twice in a row. =item B<-s> Set the 'Significant Update' flag on the home node when updating the i +mage. Some people like to indicate that a new image is a major event in thei +r lives, and for those people with that condition, this meets their need +s. =item B<-o> One shot mode. Upload a new random picture immediately, and exit. Us +eful for a manual freshening of the home node picture. This option overrid +es the B<-D> (daemon) option. =item B<-D> Run script as a daemon. Uses B<Proc::Daemon>, and detaches itself fro +m the controlling terminal. This is a useful flag if you put scripts like t +his in your system startup files. It is a B<bad> flag to use if you use init +tab to spawn jobs, since inittab will think the script finished after it d +etaches. Note that if the B<-v> (verbose) flag was specified, it will be overri +dden, since detaching from the controlling terminal closes B<STDOUT> and B<S +TDERR>. This option is override if the B<-o> flag is specified. =item B<-v> Be verbose. Useful for debugging, or just watching how often someone +hits your homenode. Prints out how many image files are available for rota +tion at startup, along with the time each time the homenode is hit, how man +y hits until the next image upload, and the image upload progress (starting, +login complete, upload complete). Also good for control freaks. =item B<-V> Verify configuration. Useful for first time setup. Checks that all n +ecessary arguments are present, that the B<-I> filename exists, and that the im +ages specified in the file all exist (and are greater than 0 bytes in size) +. If it passes this option, odds are the script can be run as a daemon (see B< +-D>) safely. =head1 SECURITY Remember that if you provide usernames and passwords on the command li +ne, someone else can see those with ''ps'' on most systems. Since your perlmonks.org account should be more sacred than your mothers maiden n +ame, your Visa card number, and the phone number for that really hot chick +in Amsterdam (OK, maybe not as important as that last one), you don't wan +t it where it can be seen. There are two ways you can protect your passwor +d. You can either edit the script and set it as a default, then make sure you make the script owner readable only (chmod 700), or you can use th +e B<-P> option, and require the script to interactively prompt you for y +our password each time it's run. Obviously, on a single user system, this isn't much concern. However, + if you're running from an account on perlmonk.org, where there are over 1 +00 users at last count, your want to be careful about compromising inform +ation. =head1 BUG SCRIPT This is the script that you'll want to install on your Apache server somewhere. It does nothing more than satisfy a request for an image, +in the form of a 1x1 clear pixel. As it does that, it increments a count +er in the file, which is specified at the top. This needs to be the same as the B<-C> filename for this script. I deliberately did not pass the homenode ID on the command line, since that would have added additional requirements for taint checking, and allowed someone to change the home node ID before submitting. Instead +, if there are multiple users with this on the same server, they need to either name them uniquely, and set their homenode ID as part of the co +unter filename at the top, or use private cgi-bin directories for each user. That kind of detail will be left to the user. The following line is what should be added to the "User's Bio" section of your homenode. I usually put it near the bottom, or anywhere else you don't really need a 1x1 clear pixel. C<<img src="http://myserver.com/cgi-bin/rotate.pl" alt="">> =item B<The 'bug' Script> #!/usr/local/bin/perl -w use strict; use CGI; my $file = '/tmp/hncounter.dat'; { # # That's a hex-encoded 1 pixel by 1 pixel transparent gif...ugly, +huh? # my $trans = '47494638396101000100f7000000000000003300006600009900' + . '00cc0000ff0033000033330033660033990033cc0033ff006600006633006' + . '6660066990066cc0066ff0099000099330099660099990099cc0099ff00cc' + . '0000cc3300cc6600cc9900cccc00ccff00ff0000ff3300ff6600ff9900ffcc +'. '00ffff3300003300333300663300993300cc3300ff33330033333333336633 +'. '33993333cc3333ff3366003366333366663366993366cc3366ff3399003399 +'. '333399663399993399cc3399ff33cc0033cc3333cc6633cc9933cccc33ccff +'. '33ff0033ff3333ff6633ff9933ffcc33ffff66000066003366006666009966 +'. '00cc6600ff6633006633336633666633996633cc6633ff6666006666336666 +'. '666666996666cc6666ff6699006699336699666699996699cc6699ff66cc00 +'. '66cc3366cc6666cc9966cccc66ccff66ff0066ff3366ff6666ff9966ffcc66 +'. 'ffff9900009900339900669900999900cc9900ff9933009933339933669933 +'. '999933cc9933ff9966009966339966669966999966cc9966ff999900999933 +'. '9999669999999999cc9999ff99cc0099cc3399cc6699cc9999cccc99ccff99 +'. 'ff0099ff3399ff6699ff9999ffcc99ffffcc0000cc0033cc0066cc0099cc00 +'. 'cccc00ffcc3300cc3333cc3366cc3399cc33cccc33ffcc6600cc6633cc6666 +'. 'cc6699cc66cccc66ffcc9900cc9933cc9966cc9999cc99cccc99ffcccc00cc +'. 'cc33cccc66cccc99ccccccccccffccff00ccff33ccff66ccff99ccffccccff +'. 'ffff0000ff0033ff0066ff0099ff00ccff00ffff3300ff3333ff3366ff3399 +'. 'ff33ccff33ffff6600ff6633ff6666ff6699ff66ccff66ffff9900ff9933ff +'. '9966ff9999ff99ccff99ffffcc00ffcc33ffcc66ffcc99ffccccffccffffff +'. '00ffff33ffff66ffff99ffffccffffff000000000000000000000000000000 +'. '00000000000000000000000000000000000000000000000000000000000000 +'. '00000000000000000000000000000000000000000000000000000000000000 +'. '00000000000000000000000000000000000000000000000000000000000000 +'. '00000000000000000000000021f904010000d8002c00000000010001000008 +'. '0400b10504003b'; my $query = new CGI; print $query->header (-type => 'image/gif'); print pack ('H*', $trans); my $counter = 0; (open OFILE, "<$file") && ($counter=<OFILE>) && (close OFILE) if ( +-s $file); (open OFILE, ">$file") && (print OFILE ++$counter) && (close OFILE +); } =head1 THE FUTURE Welcome to... The Future! OK, most of you prolly don't remember Fires +ign Theater. Some ideas included providing a pointer to a directory of im +ages, being able to upload a single file from the command line, logging, upl +oading a new image after a certain period, regardless of hits, all sorts of s +tuff. But at some point, the rampant featuritis has to stop, and code has to + be validated, checked in, and released. =head1 SEE ALSO [ar0n] wrote a script called ''hup'' located in the ''Perlmonks.org Re +lated Scripts'' section of the ''Code Catacombs that handles'' uploading sin +gle images, changing passwords, and is a general command line interface in +to the user settings page. Check it out. =head1 WARRANTY You B<must> be high. =head1 AUTHOR J. C. Wren E<lt>jcwren@jcwren.comE<gt> =head1 COPYRIGHT Copyright (c) 2001 J.C.Wren. All rights reserved. This is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =head1 HISTORY Revision 1.00.00 2001/11/25 23:35:03 jcwren Initial checkin =cut

In reply to Home Node Image Rotator by jcwren

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others browsing the Monastery: (8)
    As of 2014-08-22 05:24 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (147 votes), past polls