#!/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 take the
#  time to update your homenode picture?  Now, with the new miracle homenode 
#  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 pixel image.
#  Along with getting this remarkable 1x1 clear pixel image, it increments a 
#  counter file (which also tells you how many people have accessed your 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 your 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 possibility
#  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 under the 
#  same terms as Perl itself.
#
#  (P.S, That Linux flag has gotten stale, [tilly].  You need to use this.)
#  

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}      || die "No username.  Program terminated.\n";
   $config {password}      = $args {p} || $config {password}      || die "No password.  Program terminated.\n";
   $config {homenode}      = $args {n} || $config {homenode}      || die "No homenode ID.  Program terminated.\n";
   $config {imgListFile}   = $args {I} || $config {imgListFile}   || die "No image list file.  Program terminated.\n";
   $config {counterFile}   = $args {C} || $config {counterFile}   || die "No counter file.  Program terminated.\n";
   $config {lastPicFile}   = $args {L} || $config {lastPicFile}   || die "No last pic file.  Program terminated.\n";
   $config {updateEvery}   = $args {e} || $config {updateEvery}   || die "No update every counter.  Program terminated.\n";
   $config {checkInverval} = $args {c} || $config {checkInterval} || die "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}                                              || die "\$config {baseurl} not defined.  Program terminated.\n";
   $config {pmsite}                                               || die "\$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 list file \"", $config {imgListFile}, "\": $!";
   chomp (@{$config {picList}} = <PICLIST>);
   close PICLIST;

   die "Must have at least 2 images for rotation.\n" if (scalar @{$config {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! File \"", $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}) + $config {updateEvery};
   print scalar localtime, ": counter=$thisCount, ", $nextCount - $thisCount, " hits to next upload.\n" if ($config {verbose});

   #
   #  Recommended only after testing.  Since STDOUT and STDERR are closed, 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 "Eeek! 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 100,000
#  iterations, the distribution was very close to uniform.
#
sub randomPicture
{
   my $newimg;
   my $lastimg = "";

   if ((-s $config {lastPicFile}) && open LASTPIC, $config {lastPicFile})
   {
      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 ($significantUpdate);
         $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::Headers->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 {$_}, UNSAFE_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/userpass/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 homenode]
                    [-I imageListFile] [-C counterFile] [-L lastPictureFile]
                    [-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 line
   -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 changes
   -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 line
   -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 changes
   -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 keep 
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 publication
(remember, Lord vroom doesn't want your pr0n collection in your homenode!),
and after so many accesses, *poof*, a new picture from your list of images
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 uploaded
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 cronjob,
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 to be 
uploaded to.  While unlikely, it's possible that a node might have been
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 home 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 uploaded
to the home node.  The file should contain the complete path to each file,
1 per line.  Currently, the monastery only supports .JPG and .GIF files.
While the script checks that the specified files exist, it does not check
the format of the files.  The default filename is $ENV{HOME}/.hnirotate.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 mechanism
that is used to communicate home node hits to this script.  Because the
"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 must
be a directory that the UID of the script has write permission to.  The
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, the
images will be sequentially stepped through.  With this, a reasonably
random image will be selected.  The B<-L> filename is in part responsible
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 image.
Some people like to indicate that a new image is a major event in their
lives, and for those people with that condition, this meets their needs.

=item B<-o>

One shot mode.  Upload a new random picture immediately, and exit.  Useful
for a manual freshening of the home node picture.  This option overrides
the B<-D> (daemon) option.

=item B<-D>

Run script as a daemon.  Uses B<Proc::Daemon>, and detaches itself from the
controlling terminal.  This is a useful flag if you put scripts like this in
your system startup files.  It is a B<bad> flag to use if you use inittab
to spawn jobs, since inittab will think the script finished after it detaches.
Note that if the B<-v> (verbose) flag was specified, it will be overridden, 
since detaching from the controlling terminal closes B<STDOUT> and B<STDERR>.
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 rotation
at startup, along with the time each time the homenode is hit, how many 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 necessary
arguments are present, that the B<-I> filename exists, and that the images 
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 line, 
someone else can see those with ''ps'' on most systems.  Since your 
perlmonks.org account should be more sacred than your mothers maiden name, 
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 want it 
where it can be seen.  There are two ways you can protect your password.
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 the
B<-P> option, and require the script to interactively prompt you for your
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 100 
users at last count, your want to be careful about compromising information. 

=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 counter
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 counter
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 Firesign
Theater.  Some ideas included providing a pointer to a directory of images,
being able to upload a single file from the command line, logging, uploading
a new image after a certain period, regardless of hits, all sorts of stuff.  
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 Related
Scripts'' section of the ''Code Catacombs that handles'' uploading single
images, changing passwords, and is a general command line interface into 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