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 Date::Calc::Object;   # For date/time math
  33 use File::stat;           # For getting mtimes
  34 use Getopt::Long;         # For parsing command-line options
  35 use HTTP::Status;         # For HTTP status codes
  36 use LWP::UserAgent;       # For HTTP client functionality
  37 use HTTP::Date;           # For HTTP-compatible str2time and time2str
  38
  39
  40 ##################
  41 # Global variables
  42 ##################
  43
  44 # Verbose? (Debugging messages)
  45 my $verbose = 0;
  46
  47 # by default, this is the working directory
  48 my $workingdir = ".";
  49
  50 # get the time and date - using UTC
  51 my $timenow = time();
  52
  53 # if this is 1, we only list the change files that are needed and stop
  54 # otherwise we do our normal processing
  55 my $listchangefiles = 0;
  56
  57 # The root URL to fetch files from
  58 my $remoteroot;
  59
  60 ################################
  61 # process command line arguments
  62 ################################
  63
  64 sub usage() {
  65   print STDERR <<EOF
  66 Usage: update.pl [options]
  67
  68   --remoteroot=url       Set the remote root URL to mirror from (mandatory)
  69   --workingdir=path      Set the root of the local mirror (default ".")
  70   --now=timestring       Pretend it's currently the specified time
  71   --list-change-files    Just list the change files we would fetch
  72   --verbose              Run in verbose mode
  73   --help                 Output this help
  74
  75 EOF
  76   ;
  77   exit 1;
  78 }
  79
  80 GetOptions( "verbose!" => \$verbose,
  81             "workingdir=s" => \$workingdir,
  82             "now=s" => sub($) { $timenow = str2time($_[0]); },
  83             "remoteroot=s" => \$remoteroot,
  84             "list-change-files!" => \$listchangefiles,
  85             "help" => sub() { usage(); } );
  86
  87 usage() if not defined $remoteroot;
  88
  89 # the directory where all files with state are kept
  90 my $statedir = "$workingdir/state";
  91 if (! -e $statedir) {
  92         mkdir $statedir or die "Can't create $statedir";
  93 }
  94
  95 # the directory where changes files are kept
  96 my $changesdir = "$workingdir/changes";
  97
  98 # the file we want with the last time in it is
  99 my $lastupdatefile = "$statedir/lastupdate.txt";
 100
 101 # where we get changes files from
 102 my $changesroot = "$remoteroot/changes";
 103
 104 # LWP user agent for fetching files
 105 # keep_alive is important, to avoid the overhead of
 106 # establishing a new connection for each file we fetch
 107 my $ua = new LWP::UserAgent( agent => "MirMirror/0.1",
 108                              keep_alive => 1 );
 109
 110
 111 ###############
 112 # SUBROUTINES #
 113 ###############
 114
 115 # find the last update time
 116 # if the file with the update time has disappeared, alert the admin
 117 # and use the datestamp on the startpage file ( /en/index.html )
 118 sub findLastUpdateTime() {
 119   open (UPDATETIME, "<", $lastupdatefile) or return Date::Calc->today()->date2time();
 120   my $lastupdatetimestr = <UPDATETIME>;
 121   close (UPDATETIME);
 122
 123   chomp ($lastupdatetimestr);
 124   my $lastupdatetime = str2time ($lastupdatetimestr);
 125   die "Can't parse last update time" if not $lastupdatetime;
 126   return str2time ($lastupdatetimestr);
 127 }
 128
 129 # write the time now into the last update file
 130 sub saveLastUpdateTime() {
 131   open (UPDATETIME, ">", $lastupdatefile) or die "Can't open $lastupdatefile for writing ($!)";
 132   print UPDATETIME time2str($timenow);
 133   close (UPDATETIME);
 134 }
 135
 136 # return an array of filename
 137 sub getChangesFileList($$)
 138 {
 139   my ($fromtime, $totime) = @_;
 140   my @files;
 141   my $time = Date::Calc->time2date($fromtime);
 142   my $maxtime = Date::Calc->time2date($totime);
 143   for (; $time <= $maxtime; ++$time) {
 144     my ($y,$m,$d) = $time->date;
 145     push @files, sprintf("changes%04d%02d%02d.txt",$y,$m,$d);
 146   }
 147   return @files;
 148 }
 149
 150 # get the directory part of a filename
 151 sub dirPart($) {
 152   my $dir = $_[0];
 153   $dir =~ s{/+[^/]*$}{};
 154   return $dir;
 155 }
 156
 157 # ensure the given directory exists (like mkdir -p)
 158 sub ensureDir($) {
 159   my $dir = $_[0];
 160   if (! -e $dir) {
 161     my $parent = dirPart($dir);
 162     &ensureDir($parent) if ($parent);
 163     mkdir $dir or die "Can't create directory $dir ($!)";
 164   }
 165 }
 166
 167 # get a file, optionally saving it locally
 168 sub fetchFile($;$) {
 169   my ($remotefile, $localfile) = @_;
 170
 171   if ($verbose) {
 172     print STDERR "fetching $remotefile";
 173     print STDERR " as $localfile" if $localfile;
 174   }
 175
 176   my $req = new HTTP::Request(GET => "$remotefile");
 177
 178   if ($localfile and -e $localfile) {
 179     # Don't fetch unless more recent than local copy
 180     my $stat = stat($localfile);
 181     $req->header("If-Modified-Since" => time2str($stat->mtime));
 182   }
 183   my $resp = $ua->request($req);
 184   if ($resp->is_success) { # 2xx codes
 185     my $mtime = str2time($resp->header("Last-Modified"));
 186     if ($localfile) {
 187       if ($verbose) {
 188         print STDERR " -> success";
 189         print STDERR "; mtime ".time2str($mtime) if $mtime;
 190         print STDERR "\n";
 191       }
 192       ensureDir(dirPart($localfile));
 193
 194       open (LOCAL, ">", "$localfile") or die "Can't open $localfile for writing ($!)";
 195       print LOCAL $resp->content or die "Error writing $localfile ($!)";
 196       close LOCAL or die "Error writing $localfile ($!)";
 197
 198       if ($mtime) {
 199         utime $mtime, $mtime, $localfile;
 200       }
 201     }
 202     return $resp->content;
 203   }
 204   elsif ($resp->is_redirect) { # 3xx codes
 205     if ($resp->code == RC_NOT_MODIFIED) { # 304
 206       print STDERR " -> not modified\n" if $verbose;
 207       open (LOCAL, "<", "$localfile") or die "Can't open $localfile ($!)";
 208       local $/; # slurp whole file
 209       my $content = <LOCAL>;
 210       close LOCAL;
 211       return $content;
 212     }
 213     print STDERR " -> redirect (".$resp->code.")\n" if $verbose;
 214     die "Can't fetch $remotefile (got redirect, not yet handled)";
 215   }
 216   else {
 217     if ($resp->code == RC_NOT_FOUND) { # 404
 218       print STDERR " -> not found\n" if $verbose;
 219       return undef;
 220     }
 221
 222     print STDERR " -> failed (".$resp->code.")\n" if $verbose;
 223     die "Can't fetch $remotefile (".$resp->status_line.")";
 224   }
 225 }
 226
 227 # get a changes file
 228 sub getChangesFile($) {
 229   return fetchFile($changesroot."/".$_[0], $changesdir."/".$_[0]);
 230 }
 231
 232
 233
 234 ##################
 235 # the program flow
 236 ##################
 237
 238 # first work out when the last time we were up to date is and
 239 # find present time.
 240 my $timeoflastupdate = findLastUpdateTime();
 241
 242 if ($verbose) {
 243   print STDERR "timenow          is ".time2str($timenow)." \n";
 244   print STDERR "timeoflastupdate is ".time2str($timeoflastupdate)." \n\n";
 245 }
 246
 247 # Now we know which days' changes we need to get from the server
 248 my @changesfiles = getChangesFileList($timeoflastupdate, $timenow);
 249 if ($verbose) {
 250   foreach my $file (@changesfiles) { print STDERR "using changes file $file\n"; }
 251 }
 252
 253 if ($listchangefiles) {
 254   foreach my $file (@changesfiles) { print "$file\n"; }
 255   exit 0;
 256 }
 257
 258 # get the changes files
 259 my %changesfilecontent;
 260 foreach my $file (@changesfiles) { $changesfilecontent{$file} = getChangesFile($file); }
 261
 262 # if the file has not changed (response code 304) then ignore it
 263
 264 # iterate over all the fetched files, building up a list of files
 265 # to fetch/delete
 266 my %files;
 267 foreach my $changesfile (@changesfiles) {
 268   my $changesfilecontent = $changesfilecontent{$changesfile};
 269   if (not defined $changesfilecontent) {
 270     print STDERR "Skipping changes file $changesfile; not present at remote end\n" if $verbose;
 271     next;
 272   }
 273
 274   my $date = $changesfile;
 275   $date =~ s{^(?:.*/)?changes([0-9]+)\.txt$}{$1} or die "Can't extract date from changes filename $changesfile";
 276
 277   print STDERR "Processing changes file $changesfile\n" if $verbose;
 278
 279   my @changes = split /[\r\n]+/, $changesfilecontent;
 280   foreach my $change (@changes) {
 281     my ($time, $op, $path) = split ' ', $change;
 282
 283     # Ignore malformed lines, especially wacky paths that could be malicious
 284     if ($time =~ /[^0-9:]/) {
 285       die "Invalid time $time in $changesfile";
 286     }
 287
 288     if ($path =~ m{(?:^|/)\.\.(?:/|$)}) {
 289       die "Invalid path $path (contains ..) in $changesfile";
 290     }
 291
 292     # Strip scheme and host from absolute URLs
 293     $path =~ s{^[a-z]+://[a-z0-9\-\.]+/}{/};
 294
 295     # Combine time with date and parse
 296     $time = str2time("$date $time");
 297     if (not defined $time) {
 298       die "Failed to parse datetime '$date $time'";
 299     }
 300
 301     # Ignore changes prior to $timeoflastupdate
 302     next if $time < $timeoflastupdate;
 303
 304     $files{$path} = $op;
 305     print STDERR "Marked $path as '$op'\n" if $verbose;
 306   }
 307 }
 308
 309 # Fetch all files whose last operation was "add" or "change"
 310 # Delete all files whose last operation was "delete"
 311 while (my ($file, $op) = each %files) {
 312   if ($op eq "delete") {
 313     if (-e "$workingdir/$file") {
 314       # delete: if the file exists, remove it
 315       print STDERR "deleting $workingdir/$file\n" if $verbose;
 316       unlink "$workingdir/$file" or die "Can't delete $workingdir/$file ($!)";
 317     }
 318     else {
 319       print STDERR "not deleting $workingdir/$file beacuse it doesn't exist\n" if $verbose;
 320     }
 321   }
 322   elsif ($op eq "add" or $op eq "change" or $op eq "Modification") {
 323     # add/change: re-fetch the file
 324     # FIXME: don't insist on reading entire file into memory
 325     my $content = fetchFile("$remoteroot/$file","$workingdir/$file");
 326     die "File $remoteroot/$file not found" if not defined $content;
 327   }
 328   else {
 329     die "Unknown operation '$op'";
 330   }
 331 }
 332
 333
 334 # update the last "up-to-date" time
 335 saveLastUpdateTime();
 336
 337 # finish
 338 exit 0;
 339
 340