#!/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 Getopt::Long;
use LWP::UserAgent;
use Time::Local;

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

# by default, this is not a test
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;

################################
# 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
  --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($_[0]); },
	    "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 = LWP::UserAgent->new(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 $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 ($fromtime, $totime) = @_;
  my @files;
  for (my $time = str2time(time2str("%Y:%m:%dT00:00:00", $fromtime));
       $time < $totime;
       $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;
}

# 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 a file, optionally saving it locally
sub fetchFile($;$) {
  my ($remotefile, $localfile) = @_;

  if ($verbose) {
    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 $verbose;
      ensureDir(dirPart($localfile));

      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 $verbose;
    die "Can't fetch $remotefile (".$resp->status_line.")";
  }
}

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



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

# first work out when the last time we were up to date is and 
# find present time.
my $timeoflastupdate = findLastUpdateTime();

if ($verbose) {
  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($timeoflastupdate, $timenow);
if ($verbose 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;
    # Strip scheme and host from absolute URLs
    $path =~ s{^[a-z]+://[a-z0-9\-\.]+/}{/};
    # 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 $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
    my $content = fetchFile("$remoteroot/$file","$workingdir/$file");
  }
  else {
    die "Unknown operation '$op'";
  }
}


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

# finish
exit 0;


