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 Cwd;
  33 use Date::Parse;
  34 use Date::Format;
  35 use Getopt::Long;
  36 use LWP::UserAgent;
  37 use Time::Local;
  38
  39 ##################
  40 # Global variables
  41 ##################
  42
  43 # by default, this is not a test
  44 my $verbose = 0;
  45
  46 # by default, this is the working directory
  47 my $workingdir = ".";
  48
  49 # get the time and date - using UTC
  50 my $timenow = time();
  51
  52 # if this is 1, we only list the change files that are needed and stop
  53 # otherwise we do our normal processing
  54 my $listchangefiles = 0;
  55
  56 # The root URL to fetch files from
  57 my $remoteroot;
  58
  59 ################################
  60 # process command line arguments
  61 ################################
  62
  63 sub usage() {
  64   print STDERR <<EOF
  65 Usage: update.pl [options]
  66
  67   --remoteroot=url       Set the remote root URL to mirror from (mandatory)
  68   --workingdir=path      Set the root of the local mirror (default ".")
  69   --now=timestring       Pretend it's currently the specified time
  70   --list-change-files    Just list the change files we would fetch
  71   --verbose              Run in verbose mode
  72   --help                 Output this help
  73
  74 EOF
  75   ;
  76   exit 1;
  77 }
  78
  79 GetOptions( "verbose!" => \$verbose,
  80             "workingdir=s" => \$workingdir,
  81             "now=s" => sub($) { $timenow = str2time($_[0]); },
  82             "remoteroot=s" => \$remoteroot,
  83             "list-change-files!" => \$listchangefiles,
  84             "help" => sub() { usage(); } );
  85
  86 usage() if not defined $remoteroot;
  87
  88 # the directory where all files with state are kept
  89 my $statedir = "$workingdir/state";
  90 if (! -e $statedir) {
  91         mkdir $statedir or die "Can't create $statedir";
  92 }
  93
  94 # the directory where changes files are kept
  95 my $changesdir = "$workingdir/changes";
  96
  97 # the file we want with the last time in it is
  98 my $lastupdatefile = "$statedir/lastupdate.txt";
  99
 100 # where we get changes files from
 101 my $changesroot = "$remoteroot/changes";
 102
 103 # LWP user agent for fetching files
 104 # keep_alive is important, to avoid the overhead of
 105 # establishing a new connection for each file we fetch
 106 my $ua = LWP::UserAgent->new(agent => "MirMirror/0.1",
 107                              keep_alive => 1);
 108
 109
 110 ###############
 111 # SUBROUTINES #
 112 ###############
 113
 114 # find the last update time
 115 # if the file with the update time has disappeared, alert the admin
 116 # and use the datestamp on the startpage file ( /en/index.html )
 117 sub findLastUpdateTime() {
 118   open (UPDATETIME, "<", $lastupdatefile) or return $timenow;
 119   my $lastupdatetimestr = <UPDATETIME>;
 120   close (UPDATETIME);
 121
 122   chomp ($lastupdatetimestr);
 123   return str2time ($lastupdatetimestr);
 124 }
 125
 126 # convert the date into a correctly formatted string
 127 sub date2ISOstr($) {
 128   return time2str ("%Y:%m:%dT%T", $_[0]);
 129 }
 130
 131 # convert the date into RFC2616 format
 132 sub date2HTTPstr($) {
 133   return time2str ("%Y:%m:%dT%T", $_[0]);
 134 }
 135
 136 # write the time now into the last update file
 137 sub saveLastUpdateTime() {
 138   open (UPDATETIME, ">", $lastupdatefile) or die "Can't open $lastupdatefile for writing ($!)";
 139   print UPDATETIME date2ISOstr($timenow);
 140   close (UPDATETIME);
 141 }
 142
 143 # return an array of filename
 144 sub getChangesFileList($$)
 145 {
 146   my ($fromtime, $totime) = @_;
 147   my @files;
 148   for (my $time = str2time(time2str("%Y:%m:%dT00:00:00", $fromtime));
 149        $time < $totime;
 150        $time += 86400) {
 151     push @files, time2str("changes%Y%m%d.txt", $time);
 152   }
 153   return @files;
 154 }
 155
 156 # get the directory part of a filename
 157 sub dirPart($) {
 158   my $dir = $_[0];
 159   $dir =~ s{/+[^/]*$}{};
 160   return $dir;
 161 }
 162
 163 # ensure the given directory exists (like mkdir -p)
 164 sub ensureDir($) {
 165   my $dir = $_[0];
 166   if (! -e $dir) {
 167     my $parent = dirPart($dir);
 168     &ensureDir($parent) if ($parent);
 169     mkdir $dir or die "Can't create directory $dir ($!)";
 170   }
 171 }
 172
 173 # get a file, optionally saving it locally
 174 sub fetchFile($;$) {
 175   my ($remotefile, $localfile) = @_;
 176
 177   if ($verbose) {
 178     print STDERR "fetching $remotefile";
 179     print STDERR " as $localfile" if $localfile;
 180   }
 181
 182   my $req = HTTP::Request->new(GET => "$remotefile");
 183   # TODO: If-Modified-Since
 184   my $resp = $ua->request(HTTP::Request->new(GET => "$remotefile"));
 185   if ($resp->is_success) {
 186     if ($localfile) {
 187       print STDERR " -> success\n" if $verbose;
 188       ensureDir(dirPart($localfile));
 189
 190       open (LOCAL, ">", "$localfile") or die "Can't open $localfile for writing ($!)";
 191       print LOCAL $resp->content or die "Error writing $localfile ($!)";
 192       close LOCAL or die "Error writing $localfile ($!)";
 193       # TODO: set mtime from Last-Modified
 194     }
 195     return $resp->content;
 196   }
 197   else {
 198     print STDERR " -> failed\n" if $verbose;
 199     die "Can't fetch $remotefile (".$resp->status_line.")";
 200   }
 201 }
 202
 203 # get a changes file
 204 sub getChangesFile($) {
 205   return fetchFile($changesroot."/".$_[0], $changesdir."/".$_[0]);
 206 }
 207
 208
 209
 210 ##################
 211 # the program flow
 212 ##################
 213
 214 # first work out when the last time we were up to date is and
 215 # find present time.
 216 my $timeoflastupdate = findLastUpdateTime();
 217
 218 if ($verbose) {
 219   print STDERR "timenow          is ".time2str("%c",$timenow)." \n";
 220   print STDERR "timeoflastupdate is ".time2str("%c",$timeoflastupdate)." \n\n";
 221 }
 222
 223 # Now we know which days' changes we need to get from the server
 224 my @changesfiles = getChangesFileList($timeoflastupdate, $timenow);
 225 if ($verbose or $listchangefiles) {
 226   foreach my $file (@changesfiles) { print STDERR "using changes file $file\n"; }
 227   exit 0 if $listchangefiles;
 228 }
 229
 230 # get the changes files
 231 my @changesfilecontent;
 232 foreach my $file (@changesfiles) { push @changesfilecontent, getChangesFile($file); }
 233
 234 # if the file has not changed (response code 304) then ignore it
 235
 236 # iterate over all the fetched files, building up a list of files
 237 # to fetch/delete
 238 my %files;
 239 foreach my $changes (@changesfilecontent) {
 240   my @changes = split /[\r\n]+/, $changes;
 241   foreach my $change (@changes) {
 242     my ($time, $op, $path) = split ' ', $change;
 243     # Strip scheme and host from absolute URLs
 244     $path =~ s{^[a-z]+://[a-z0-9\-\.]+/}{/};
 245     # TODO: Ignore changes prior to $timeoflastupdate
 246     # TODO: Ignore malformed lines, especially wacky paths that could be malicious
 247     $files{$path} = $op;
 248     print STDERR "Marked $path as '$op'\n" if $verbose;
 249   }
 250 }
 251
 252 # Fetch all files whose last operation was "add" or "change"
 253 # Delete all files whose last operation was "delete"
 254 while (my ($file, $op) = each %files) {
 255   if ($op eq "delete") {
 256     if (-e "$workingdir/$file") {
 257       # delete: if the file exists, remove it
 258       print STDERR "deleting $workingdir/$file\n" if $verbose;
 259       unlink "$workingdir/$file" or die "Can't delete $workingdir/$file ($!)";
 260     }
 261     else {
 262       print STDERR "not deleting $workingdir/$file beacuse it doesn't exist\n" if $verbose;
 263     }
 264   }
 265   elsif ($op eq "add" or $op eq "change" or $op eq "Modification") {
 266     # add/change: re-fetch the file
 267     my $content = fetchFile("$remoteroot/$file","$workingdir/$file");
 268   }
 269   else {
 270     die "Unknown operation '$op'";
 271   }
 272 }
 273
 274
 275 # update the last "up-to-date" time
 276 saveLastUpdateTime();
 277
 278 # finish
 279 exit 0;
 280
 281