scripts/mirror-scripts/update.pl

   1 #!/usr/bin/perl -w
   2
   3 # This script is to get the changes needed to update the
   4 # files on a mir mirror.
   5 #
   6 # Full details (among other stuff) at
   7 # http://lists.indymedia.org/pipermail/imc-uk-tech/2006-May/0531-ib.html
   8 #
   9 # An extract is
  10 #
  11 # Mir will simply publish a list of file changes.  It will produce one
  12 # file per day.  The file will be publicly viewable on the web at
  13 #
  14 # /changes/changesYYYYMMDD.txt
  15 #
  16 # So on May 28th, 2006, the file name would be
  17 #
  18 # /changes/changes20060528.txt
  19 #
  20 # The format of the file will also be simple.  There will be three
  21 # columns.  First will be the time, then (add/change/delete) depending
  22 # whether the file is new, has been updated or deleted, and then the full
  23 # relative path of the file.  So an example line would be
  24 #
  25 # 2006:01:24T09:08:17   add   /en/2006/05/341547.html
  26 #
  27 # This will have to be done for HTML files, media files and the include
  28 # files.
  29
  30 use strict;
  31
  32 use File::stat;
  33 use Getopt::Long;
  34 use HTTP::Status;
  35 use LWP::UserAgent;
  36 use Time::Local;
  37
  38 use Date::Parse;
  39 use Date::Format;
  40
  41 # This has name conflicts with Date::Parse and
  42 # Date::Format; don't import its names.
  43 use HTTP::Date ();
  44
  45 ##################
  46 # Global variables
  47 ##################
  48
  49 # by default, this is not a test
  50 my $verbose = 0;
  51
  52 # by default, this is the working directory
  53 my $workingdir = ".";
  54
  55 # get the time and date - using UTC
  56 my $timenow = time();
  57
  58 # if this is 1, we only list the change files that are needed and stop
  59 # otherwise we do our normal processing
  60 my $listchangefiles = 0;
  61
  62 # The root URL to fetch files from
  63 my $remoteroot;
  64
  65 ################################
  66 # process command line arguments
  67 ################################
  68
  69 sub usage() {
  70   print STDERR <<EOF
  71 Usage: update.pl [options]
  72
  73   --remoteroot=url       Set the remote root URL to mirror from (mandatory)
  74   --workingdir=path      Set the root of the local mirror (default ".")
  75   --now=timestring       Pretend it's currently the specified time
  76   --list-change-files    Just list the change files we would fetch
  77   --verbose              Run in verbose mode
  78   --help                 Output this help
  79
  80 EOF
  81   ;
  82   exit 1;
  83 }
  84
  85 GetOptions( "verbose!" => \$verbose,
  86             "workingdir=s" => \$workingdir,
  87             "now=s" => sub($) { $timenow = str2time($_[0]); },
  88             "remoteroot=s" => \$remoteroot,
  89             "list-change-files!" => \$listchangefiles,
  90             "help" => sub() { usage(); } );
  91
  92 usage() if not defined $remoteroot;
  93
  94 # the directory where all files with state are kept
  95 my $statedir = "$workingdir/state";
  96 if (! -e $statedir) {
  97         mkdir $statedir or die "Can't create $statedir";
  98 }
  99
 100 # the directory where changes files are kept
 101 my $changesdir = "$workingdir/changes";
 102
 103 # the file we want with the last time in it is
 104 my $lastupdatefile = "$statedir/lastupdate.txt";
 105
 106 # where we get changes files from
 107 my $changesroot = "$remoteroot/changes";
 108
 109 # LWP user agent for fetching files
 110 # keep_alive is important, to avoid the overhead of
 111 # establishing a new connection for each file we fetch
 112 my $ua = new LWP::UserAgent( agent => "MirMirror/0.1",
 113                              keep_alive => 1 );
 114
 115
 116 ###############
 117 # SUBROUTINES #
 118 ###############
 119
 120 # find the last update time
 121 # if the file with the update time has disappeared, alert the admin
 122 # and use the datestamp on the startpage file ( /en/index.html )
 123 sub findLastUpdateTime() {
 124   open (UPDATETIME, "<", $lastupdatefile) or return $timenow;
 125   my $lastupdatetimestr = <UPDATETIME>;
 126   close (UPDATETIME);
 127
 128   chomp ($lastupdatetimestr);
 129   return str2time ($lastupdatetimestr);
 130 }
 131
 132 # convert the date into a correctly formatted string
 133 sub date2ISOstr($) {
 134   return time2str ("%Y:%m:%dT%T", $_[0]);
 135 }
 136
 137 # convert the date into RFC2616 format
 138 sub date2HTTPstr($) {
 139   return time2str ("%Y:%m:%dT%T", $_[0]);
 140 }
 141
 142 # write the time now into the last update file
 143 sub saveLastUpdateTime() {
 144   open (UPDATETIME, ">", $lastupdatefile) or die "Can't open $lastupdatefile for writing ($!)";
 145   print UPDATETIME date2ISOstr($timenow);
 146   close (UPDATETIME);
 147 }
 148
 149 # return an array of filename
 150 sub getChangesFileList($$)
 151 {
 152   my ($fromtime, $totime) = @_;
 153   my @files;
 154   for (my $time = str2time(time2str("%Y:%m:%dT00:00:00", $fromtime));
 155        $time < $totime;
 156        $time += 86400) {
 157     push @files, time2str("changes%Y%m%d.txt", $time);
 158   }
 159   return @files;
 160 }
 161
 162 # get the directory part of a filename
 163 sub dirPart($) {
 164   my $dir = $_[0];
 165   $dir =~ s{/+[^/]*$}{};
 166   return $dir;
 167 }
 168
 169 # ensure the given directory exists (like mkdir -p)
 170 sub ensureDir($) {
 171   my $dir = $_[0];
 172   if (! -e $dir) {
 173     my $parent = dirPart($dir);
 174     &ensureDir($parent) if ($parent);
 175     mkdir $dir or die "Can't create directory $dir ($!)";
 176   }
 177 }
 178
 179 # get a file, optionally saving it locally
 180 sub fetchFile($;$) {
 181   my ($remotefile, $localfile) = @_;
 182
 183   if ($verbose) {
 184     print STDERR "fetching $remotefile";
 185     print STDERR " as $localfile" if $localfile;
 186   }
 187
 188   my $req = new HTTP::Request(GET => "$remotefile");
 189
 190   if ($localfile and -e $localfile) {
 191     # Don't fetch unless more recent than local copy
 192     my $stat = stat($localfile);
 193     $req->header("If-Modified-Since" => HTTP::Date::time2str($stat->mtime));
 194   }
 195   my $resp = $ua->request($req);
 196   if ($resp->is_success) { # 2xx codes
 197     my $mtime = HTTP::Date::str2time($resp->header("Last-Modified"));
 198     if ($localfile) {
 199       if ($verbose) {
 200         print STDERR " -> success";
 201         print STDERR "; mtime ".time2str("%c", $mtime) if $mtime;
 202         print STDERR "\n";
 203       }
 204       ensureDir(dirPart($localfile));
 205
 206       open (LOCAL, ">", "$localfile") or die "Can't open $localfile for writing ($!)";
 207       print LOCAL $resp->content or die "Error writing $localfile ($!)";
 208       close LOCAL or die "Error writing $localfile ($!)";
 209
 210       if ($mtime) {
 211         utime $mtime, $mtime, $localfile;
 212       }
 213     }
 214     return $resp->content;
 215   }
 216   elsif ($resp->is_redirect) { # 3xx codes
 217     if ($resp->code == RC_NOT_MODIFIED) { # 304
 218       print STDERR " -> not modified\n" if $verbose;
 219       open (LOCAL, "<", "$localfile") or die "Can't open $localfile ($!)";
 220       local $/; # slurp whole file
 221       my $content = <LOCAL>;
 222       close LOCAL;
 223       return $content;
 224     }
 225     print STDERR " -> redirect (".$resp->code.")\n" if $verbose;
 226     die "Can't fetch $remotefile (got redirect, not yet handled)";
 227   }
 228   else {
 229     print STDERR " -> failed (".$resp->code.")\n" if $verbose;
 230     die "Can't fetch $remotefile (".$resp->status_line.")";
 231   }
 232 }
 233
 234 # get a changes file
 235 sub getChangesFile($) {
 236   return fetchFile($changesroot."/".$_[0], $changesdir."/".$_[0]);
 237 }
 238
 239
 240
 241 ##################
 242 # the program flow
 243 ##################
 244
 245 # first work out when the last time we were up to date is and
 246 # find present time.
 247 my $timeoflastupdate = findLastUpdateTime();
 248
 249 if ($verbose) {
 250   print STDERR "timenow          is ".time2str("%c",$timenow)." \n";
 251   print STDERR "timeoflastupdate is ".time2str("%c",$timeoflastupdate)." \n\n";
 252 }
 253
 254 # Now we know which days' changes we need to get from the server
 255 my @changesfiles = getChangesFileList($timeoflastupdate, $timenow);
 256 if ($verbose or $listchangefiles) {
 257   foreach my $file (@changesfiles) { print STDERR "using changes file $file\n"; }
 258   exit 0 if $listchangefiles;
 259 }
 260
 261 # get the changes files
 262 my %changesfilecontent;
 263 foreach my $file (@changesfiles) { $changesfilecontent{$file} = getChangesFile($file); }
 264
 265 # if the file has not changed (response code 304) then ignore it
 266
 267 # iterate over all the fetched files, building up a list of files
 268 # to fetch/delete
 269 my %files;
 270 foreach my $changes (@changesfiles) {
 271   my $date = $changes;
 272   $date =~ s{^(?:.*/)?changes([0-9]+)\.txt$}{$1} or die "Can't extract date from changes filename $changes";
 273
 274   my @changes = split /[\r\n]+/, $changesfilecontent{$changes};
 275   foreach my $change (@changes) {
 276     my ($time, $op, $path) = split ' ', $change;
 277
 278     # Ignore malformed lines, especially wacky paths that could be malicious
 279     if ($time =~ /[^0-9:]/) {
 280       die "Invalid time $time in $changes";
 281     }
 282
 283     if ($path =~ m{(?:^|/)\.\.(?:/|$)}) {
 284       die "Invalid path $path (contains ..) in $changes";
 285     }
 286
 287     # Strip scheme and host from absolute URLs
 288     $path =~ s{^[a-z]+://[a-z0-9\-\.]+/}{/};
 289
 290     # Combine time with date and parse
 291     $time = str2time("$date $time");
 292     if (not defined $time) {
 293       die "Failed to parse datetime '$date $time'";
 294     }
 295
 296     # Ignore changes prior to $timeoflastupdate
 297     next if $time < $timeoflastupdate;
 298
 299     $files{$path} = $op;
 300     print STDERR "Marked $path as '$op'\n" if $verbose;
 301   }
 302 }
 303
 304 # Fetch all files whose last operation was "add" or "change"
 305 # Delete all files whose last operation was "delete"
 306 while (my ($file, $op) = each %files) {
 307   if ($op eq "delete") {
 308     if (-e "$workingdir/$file") {
 309       # delete: if the file exists, remove it
 310       print STDERR "deleting $workingdir/$file\n" if $verbose;
 311       unlink "$workingdir/$file" or die "Can't delete $workingdir/$file ($!)";
 312     }
 313     else {
 314       print STDERR "not deleting $workingdir/$file beacuse it doesn't exist\n" if $verbose;
 315     }
 316   }
 317   elsif ($op eq "add" or $op eq "change" or $op eq "Modification") {
 318     # add/change: re-fetch the file
 319     my $content = fetchFile("$remoteroot/$file","$workingdir/$file");
 320   }
 321   else {
 322     die "Unknown operation '$op'";
 323   }
 324 }
 325
 326
 327 # update the last "up-to-date" time
 328 saveLastUpdateTime();
 329
 330 # finish
 331 exit 0;
 332
 333