Rsync replacement scripts, uses Perl to pull changed files to mirrors. The changes...
[mir.git] / scripts / mirror-scripts / update.pl
diff --git a/scripts/mirror-scripts/update.pl b/scripts/mirror-scripts/update.pl
new file mode 100755 (executable)
index 0000000..ee21c0b
--- /dev/null
@@ -0,0 +1,260 @@
+#!/usr/bin/perl -w
+
+# This script is to get the changes needed to update the 
+# files on a mir mirror.
+#
+# Full details (among other stuff) at
+# http://lists.indymedia.org/pipermail/imc-uk-tech/2006-May/0531-ib.html
+#
+# An extract is
+#
+# Mir will simply publish a list of file changes.  It will produce one
+# file per day.  The file will be publicly viewable on the web at
+#
+# /changes/changesYYYYMMDD.txt
+# 
+# So on May 28th, 2006, the file name would be
+#
+# /changes/changes20060528.txt
+# 
+# The format of the file will also be simple.  There will be three
+# columns.  First will be the time, then (add/change/delete) depending
+# whether the file is new, has been updated or deleted, and then the full
+# relative path of the file.  So an example line would be
+# 
+# 2006:01:24T09:08:17   add   /en/2006/05/341547.html
+#
+# This will have to be done for HTML files, media files and the include
+# files.
+
+use strict;
+
+use Cwd;
+use Date::Parse;
+use Date::Format;
+use LWP::UserAgent;
+use Time::Local;
+
+##################
+# Global variables
+##################
+
+# by default, this is not a test
+my $istest = 0;
+
+# by default, this is the working directory
+my $workingdir = getcwd();
+
+# get the time and date - using UTC
+my $timenow = time();
+
+# if this is 1, we only list the change files that are needed and stop
+# otherwise we do our normal processing
+my $listchangefiles = 0;
+
+my $outputfile;
+
+# The root URL to fetch files from
+my $remoteroot;
+
+################################
+# process command line arguments
+################################
+
+foreach my $argnum (0 .. $#ARGV) {
+  my $argument = $ARGV[$argnum];
+  if ($argument eq "--test") {
+    $istest = 1;
+  } elsif ($argument =~ /^--workingdir=(.*)$/) {
+    $workingdir = $1;
+  } elsif ($argument =~ /^--now=(.*)$/) {
+    $timenow = str2time($1);
+  } elsif ($argument =~ /^--output=(.*)$/) {
+    $outputfile = $1;
+  } elsif ($argument =~ /^--remoteroot=(.*)$/) {
+    $remoteroot = $1;
+  } elsif ($argument =~ /^--list-change-files/) {
+    $listchangefiles = 1;
+  }
+}
+
+# the directory where all files with state are kept
+my $statedir = "$workingdir/state";
+if (! -e $statedir) {
+       mkdir $statedir or die "Can't create $statedir";
+}
+
+# the directory where changes files are kept
+my $changesdir = "$workingdir/changes";
+
+# the file we want with the last time in it is
+my $lastupdatefile = "$statedir/lastupdate.txt";
+
+# where we get changes files from
+my $changesroot = "$remoteroot/changes";
+
+# LWP user agent for fetching files
+# keep_alive is important, to avoid the overhead of
+# establishing a new connection for each file we fetch
+my $ua = LWP::UserAgent->new(agent => "MirMirror/0.1",
+                             keep_alive => 1);
+
+
+##################
+# the program flow
+##################
+
+# first work out when the last time we were up to date is and 
+# find present time.
+my $timeoflastupdate = findLastUpdateTime();
+
+if ($istest) {
+  print STDERR "timenow          is ".time2str("%c",$timenow)." \n";
+  print STDERR "timeoflastupdate is ".time2str("%c",$timeoflastupdate)." \n\n";
+}
+
+# Now we know which days' changes we need to get from the server
+my @changesfiles = getChangesFileList();
+if ($istest or $listchangefiles) {
+  foreach my $file (@changesfiles) { print STDERR "using changes file $file\n"; }
+  exit 0 if $listchangefiles;
+}
+
+# get the changes files
+my @changesfilecontent;
+foreach my $file (@changesfiles) { push @changesfilecontent, getChangesFile($file); }
+
+# if the file has not changed (response code 304) then ignore it
+
+# iterate over all the fetched files, building up a list of files
+# to fetch/delete
+my %files;
+foreach my $changes (@changesfilecontent) {
+  my @changes = split /[\r\n]+/, $changes;
+  foreach my $change (@changes) {
+    my ($time, $op, $path) = split ' ', $change;
+    # TODO: Ignore changes prior to $timeoflastupdate
+    # TODO: Ignore malformed lines, especially wacky paths that could be malicious
+    $files{$path} = $op;
+    print STDERR "Marked $path as '$op'\n" if $istest;
+  }
+}
+
+# Fetch all files whose last operation was "add" or "change"
+# Delete all files whose last operation was "delete"
+while (my ($file, $op) = each %files) {
+  if ($op eq "delete") {
+    if (-e "$workingdir/$file") {
+      # delete: if the file exists, remove it
+      print STDERR "deleting $workingdir/$file\n" if $istest;
+      unlink "$workingdir/$file" or die "Can't delete $workingdir/$file ($!)";
+    }
+    else {
+      print STDERR "not deleting $workingdir/$file beacuse it doesn't exist\n" if $istest;
+    }
+  }
+  elsif ($op eq "add" or $op eq "change") {
+    # add/change: re-fetch the file
+    my $content = fetchFile("$remoteroot/$file","$workingdir/$file");
+  }
+  else {
+    die "Unknown operation '$op'";
+  }
+}
+
+
+# update the last "up-to-date" time
+saveLastUpdateTime() unless $istest;
+
+# finish
+exit 0;
+
+###############
+# SUBROUTINES #
+###############
+
+# find the last update time
+# if the file with the update time has disappeared, alert the admin
+# and use the datestamp on the startpage file ( /en/index.html )
+sub findLastUpdateTime() {
+  open (UPDATETIME, "<", $lastupdatefile) or return $timenow;
+  my $lastupdatetimestr = <UPDATETIME>;
+  close (UPDATETIME);
+  
+  chomp ($lastupdatetimestr);
+  return str2time ($lastupdatetimestr);
+}
+
+# convert the date into a correctly formatted string
+sub date2ISOstr($) {
+  return time2str ("%Y:%m:%dT%T", $_[0]);
+}
+
+# convert the date into RFC2616 format
+sub date2HTTPstr($) {
+  return time2str ("%Y:%m:%dT%T", $_[0]);
+}
+
+# write the time now into the last update file
+sub saveLastUpdateTime() {
+  open (UPDATETIME, ">", $lastupdatefile) or die "Can't open $lastupdatefile for writing ($!)";
+  print UPDATETIME date2ISOstr($timenow); 
+  close (UPDATETIME);
+}
+
+# return an array of filename 
+sub getChangesFileList()
+{
+  my @files;
+  for (my $time = str2time(time2str("%Y:%m:%dT00:00:00", $timeoflastupdate));
+       $time < $timenow;
+       $time += 86400) {
+    push @files, time2str("changes%Y%m%d.txt", $time);
+  }
+  return @files;
+}
+
+# get the directory part of a filename
+sub dirPart($) {
+  my $dir = $_[0];
+  $dir =~ s{/[^/]*$}{};
+  return $dir;
+}
+
+# get a file, optionally saving it locally
+sub fetchFile($;$) {
+  my ($remotefile, $localfile) = @_;
+
+  if ($istest) {
+    print STDERR "fetching $remotefile";
+    print STDERR " as $localfile" if $localfile;
+  }
+
+  my $req = HTTP::Request->new(GET => "$remotefile");
+  # TODO: If-Modified-Since
+  my $resp = $ua->request(HTTP::Request->new(GET => "$remotefile"));
+  if ($resp->is_success) {
+    if ($localfile) {
+      print STDERR " -> success\n" if $istest;
+      my $localdir = dirPart($localfile);
+      if (! -e $localdir) {
+        mkdir $localdir or die "Can't create directory $localdir ($!)";
+      }
+
+      open (LOCAL, ">", "$localfile") or die "Can't open $localfile for writing ($!)";
+      print LOCAL $resp->content or die "Error writing $localfile ($!)";
+      close LOCAL or die "Error writing $localfile ($!)";
+      # TODO: set mtime from Last-Modified
+    }
+    return $resp->content;
+  }
+  else {
+    print STDERR " -> failed\n" if $istest;
+    die "Can't fetch $remotefile (".$resp->status_line.")";
+  }
+}
+
+# get a changes file
+sub getChangesFile($) {
+  return fetchFile($changesroot."/".$_[0], $changesdir."/".$_[0]);
+}