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