#!/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 Date::Calc::Object;   # For date/time math
use File::Copy;           # For moving files
use File::stat;           # For getting mtimes
use Getopt::Long;         # For parsing command-line options
use HTTP::Status;         # For HTTP status codes
use LWP::UserAgent;       # For HTTP client functionality
use HTTP::Date;           # For HTTP-compatible str2time and time2str


##################
# Global variables
##################

# Verbose? (Debugging messages)
my $verbose = 0;

# by default, this is the working directory
my $workingdir = ".";

# 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;

# The root URL to fetch files from
my $remoteroot;

# The time we believe we were last up to date
my $timeoflastupdate;

# The most recent update we've just processed, for updating the above.
# We use this rather than $timenow, in case of clock discrepancies
# between the local and remote systems.
my $mostrecentupdateprocessed;

################################
# process command line arguments
################################

sub usage() {
  print STDERR <<EOF
Usage: update.pl [options]

  --remoteroot=url         Set the remote root URL to mirror from (mandatory)
  --workingdir=path        Set the root of the local mirror (default ".")
  --now=timestring         Pretend it's currently the specified time
  --lastupdate=timestring  Pretend we were last up-to-date at the specified time
  --list-change-files      Just list the change files we would fetch
  --verbose                Run in verbose mode
  --help                   Output this help

EOF
  ;
  exit 1;
}

GetOptions( "verbose!"           => \$verbose,
            "workingdir=s"       => \$workingdir,
	    "now=s"              => sub($$) { $timenow = str2time($_[1]) or die "Can't parse argument to --".join('=',@_); },
	    "lastupdate=s"       => sub($$) { $timeoflastupdate = str2time($_[1]) or die "Can't parse argument to --".join('=',@_); },
	    "remoteroot=s"       => \$remoteroot,
	    "list-change-files!" => \$listchangefiles,
	    "help"               => sub() { usage(); } );

usage() if not defined $remoteroot;

# 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 = new LWP::UserAgent( agent => "MirMirror/0.1",
                             keep_alive => 1 );


###############
# 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 Date::Calc->today()->date2time();
  my $lastupdatetimestr = <UPDATETIME>;
  close (UPDATETIME);
  
  chomp ($lastupdatetimestr);
  my $lastupdatetime = str2time ($lastupdatetimestr);
  die "Can't parse last update time" if not $lastupdatetime;
  return str2time ($lastupdatetimestr);
}

# write the given time into the last update file
sub saveLastUpdateTime($) {  
  my $time = $_[0];
  $time = $timeoflastupdate if !defined $time;

  print STDERR "Updating timestamp to ".time2str($time)."\n" if $verbose;
  open (UPDATETIME, ">", $lastupdatefile) or die "Can't open $lastupdatefile for writing ($!)";
  print UPDATETIME time2str($time); 
  close (UPDATETIME);
}

# return an array of filename 
sub getChangesFileList($$)
{
  my ($fromtime, $totime) = @_;
  my @files;
  my $time = Date::Calc->time2date($fromtime);
  my $maxtime = Date::Calc->time2date($totime);
  for (; $time <= $maxtime; ++$time) {
    my ($y,$m,$d) = $time->date;
    push @files, sprintf("changes%04d%02d%02d.txt",$y,$m,$d);
  }
  return @files;
}

# get the directory part of a filename
sub dirPart($) {
  my $dir = $_[0];
  $dir =~ s{/+[^/]*$}{};
  return $dir;
}

# ensure the given directory exists (like mkdir -p)
sub ensureDir($) {
  my $dir = $_[0];
  if (! -e $dir) {
    my $parent = dirPart($dir);
    &ensureDir($parent) if ($parent);
    mkdir $dir or die "Can't create directory $dir ($!)";
  }
}

# get the mtime of a file
sub getmtime($) {
  my $file = $_[0];
  my $stat = stat($file);
  die "Can't stat $file ($!)" if !$stat;
  return $stat->mtime;
}

# get a file, optionally saving it locally.
#   if a local filename is given, return:
#      undef if not found on the server
#      1 if found but not updated since local version
#      2 if found and more recent than local version
#
#   if no local filename is given, return the content of the
#   file, or undef if it was not found on the server
#
#   on all other errors, die
sub fetchFile($;$) {
  my ($remotefile, $localfile) = @_;

  if ($verbose) {
    print STDERR "fetching $remotefile";
    print STDERR " as $localfile" if $localfile;
  }

  my $req = new HTTP::Request(GET => "$remotefile");

  if ($localfile) {
    if (-e $localfile) {
      # Don't fetch unless more recent than local copy
      $req->header("If-Modified-Since" => time2str(getmtime($localfile)));
    }
    else {
      ensureDir(dirPart($localfile));
    }
  }
  my $resp = $ua->request($req, $localfile.".part");
  if ($resp->is_success) { # 2xx codes
    my $mtime = str2time($resp->header("Last-Modified"));
    if ($verbose) {
      print STDERR " -> success";
      print STDERR "; mtime ".time2str($mtime) if $mtime;
      print STDERR "\n";
    }

    if ($localfile) {
      if ($mtime) {
        utime $mtime, $mtime, $localfile.".part";
      }
      move($localfile.".part", $localfile) or die "Can't move $localfile into place";
    }
    return $localfile ? 2 : $resp->content;
  }
  elsif ($resp->is_redirect) { # 3xx codes
    if ($resp->code == RC_NOT_MODIFIED) { # 304
      print STDERR " -> not modified\n" if $verbose;
      die "Got 304 with no local file" if not $localfile;
      return 1;
    }
    print STDERR " -> redirect (".$resp->code.")\n" if $verbose;
    die "Can't fetch $remotefile (got redirect, not yet handled)";
  }
  else {
    if ($resp->code == RC_NOT_FOUND) { # 404
      print STDERR " -> not found\n" if $verbose;
      return undef;
    }

    print STDERR " -> failed (".$resp->code.")\n" if $verbose;
    die "Can't fetch $remotefile (".$resp->status_line.")";
  }
}

# get a changes file
sub getChangesFile($) {
  return fetchFile($changesroot."/".$_[0], $changesdir."/".$_[0]);
}


# update the timestamp if the new one is more recent
sub updatestamp(\$$) {
  my ($stampref, $newtime) = @_;
  $$stampref = $newtime if (!defined $$stampref or $newtime > $$stampref);
}


##################
# the program flow
##################

# first work out when the last time we were up to date is, if
# it wasn't overridden on the command line
$timeoflastupdate = findLastUpdateTime() if !defined $timeoflastupdate;

if ($verbose) {
  print STDERR "timenow          is ".time2str($timenow)." \n";
  print STDERR "timeoflastupdate is ".time2str($timeoflastupdate)." \n\n";
}

# Now we know which days' changes we need to get from the server
my @changesfiles = getChangesFileList($timeoflastupdate, $timenow);
if ($verbose) {
  foreach my $file (@changesfiles) { print STDERR "using changes file $file\n"; }
}

if ($listchangefiles) {
  foreach my $file (@changesfiles) { print "$file\n"; }
  exit 0;
}

# fetch each changes file in turn, building up a list of files
# to fetch/delete
my %files;
foreach my $changesfile (@changesfiles)
{
  my $rv = getChangesFile($changesfile);

  # If the file isn't there, ignore it
  if (! -e "$changesdir/$changesfile") {
    print STDERR "Skipping changes file $changesfile; not present\n" if $verbose;
    next;
  }

  my $date = $changesfile;
  $date =~ s{^(?:.*/)?changes([0-9]+)\.txt$}{$1} or die "Can't extract date from changes filename $changesfile";

  # The file exists, set most recent update to at lease "YYYY-MM-DD 00:00:00"
  updatestamp($mostrecentupdateprocessed, str2time("$date 00:00:00"));

  # If the file has not changed (response code 304) then ignore it
  # Also check mtime against "last update" time so that we won't ignore
  # it if previous runs have been failing
  if ((!$rv or $rv < 2) and getmtime("$changesdir/$changesfile") < $timeoflastupdate) {
    print STDERR "Skipping changes file $changesfile; not changed since last run\n" if $verbose;
    next;
  }

  print STDERR "Processing changes file $changesfile\n" if $verbose;

  open (CHANGES, "<", "$changesdir/$changesfile") or die "Can't open $changesfile";
  while (my $change = <CHANGES>) {
    my ($time, $op, $path) = split ' ', $change;

    # Ignore malformed lines, especially wacky paths that could be malicious
    if ($time =~ /[^0-9:]/) {
      die "Invalid time $time in $changesfile";
    }

    if ($path =~ m{(?:^|/)\.\.(?:/|$)}) {
      die "Invalid path $path (contains ..) in $changesfile";
    }

    # Strip scheme and host from absolute URLs
    $path =~ s{^[a-z]+://[a-z0-9\-\.]+/}{/};

    # Combine time with date and parse
    $time = str2time("$date $time");
    if (not defined $time) {
      die "Failed to parse datetime '$date $time'";
    }

    # Ignore changes prior to $timeoflastupdate
    next if $time < $timeoflastupdate;

    # Update timestamp
    updatestamp($mostrecentupdateprocessed, $time);

    $files{$path} = $op;
    print STDERR "Marked $path as '$op'\n" if $verbose;
  }
}

# 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 $verbose;
      unlink "$workingdir/$file" or die "Can't delete $workingdir/$file ($!)";
    }
    else {
      print STDERR "not deleting $workingdir/$file beacuse it doesn't exist\n" if $verbose;
    }
  }
  elsif ($op eq "add" or $op eq "change" or $op eq "Modification") {
    # add/change: re-fetch the file
    fetchFile("$remoteroot/$file","$workingdir/$file") or die "File $remoteroot/$file not found";
  }
  else {
    die "Unknown operation '$op'";
  }
}


# update the last "up-to-date" time
saveLastUpdateTime($mostrecentupdateprocessed);

# finish
exit 0;


