use strict;
-use Cwd;
-use Date::Parse;
-use Date::Format;
-use LWP::UserAgent;
-use Time::Local;
+use Date::Calc::Object; # For date/time math
+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
##################
-# by default, this is not a test
-my $istest = 0;
+# Verbose? (Debugging messages)
+my $verbose = 0;
# by default, this is the working directory
-my $workingdir = getcwd();
+my $workingdir = ".";
# get the time and date - using UTC
my $timenow = time();
# 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;
- }
+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) {
# 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);
+my $ua = new LWP::UserAgent( 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 #
###############
# 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;
+ 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);
}
-# 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);
+ print UPDATETIME time2str($timenow);
close (UPDATETIME);
}
# return an array of filename
-sub getChangesFileList()
+sub getChangesFileList($$)
{
+ my ($fromtime, $totime) = @_;
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);
+ 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{/[^/]*$}{};
+ $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 ($istest) {
+ 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) {
+ my $req = new HTTP::Request(GET => "$remotefile");
+
+ if ($localfile and -e $localfile) {
+ # Don't fetch unless more recent than local copy
+ my $stat = stat($localfile);
+ $req->header("If-Modified-Since" => time2str($stat->mtime));
+ }
+ my $resp = $ua->request($req);
+ if ($resp->is_success) { # 2xx codes
+ my $mtime = str2time($resp->header("Last-Modified"));
if ($localfile) {
- print STDERR " -> success\n" if $istest;
- my $localdir = dirPart($localfile);
- if (! -e $localdir) {
- mkdir $localdir or die "Can't create directory $localdir ($!)";
+ if ($verbose) {
+ print STDERR " -> success";
+ print STDERR "; mtime ".time2str($mtime) if $mtime;
+ print STDERR "\n";
}
+ 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
+
+ if ($mtime) {
+ utime $mtime, $mtime, $localfile;
+ }
}
return $resp->content;
}
+ elsif ($resp->is_redirect) { # 3xx codes
+ if ($resp->code == RC_NOT_MODIFIED) { # 304
+ print STDERR " -> not modified\n" if $verbose;
+ open (LOCAL, "<", "$localfile") or die "Can't open $localfile ($!)";
+ local $/; # slurp whole file
+ my $content = <LOCAL>;
+ close LOCAL;
+ return $content;
+ }
+ print STDERR " -> redirect (".$resp->code.")\n" if $verbose;
+ die "Can't fetch $remotefile (got redirect, not yet handled)";
+ }
else {
- print STDERR " -> failed\n" if $istest;
+ 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.")";
}
}
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($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;
+}
+
+# get the changes files
+my %changesfilecontent;
+foreach my $file (@changesfiles) { $changesfilecontent{$file} = 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 $changesfile (@changesfiles) {
+ my $changesfilecontent = $changesfilecontent{$changesfile};
+ if (not defined $changesfilecontent) {
+ print STDERR "Skipping changes file $changesfile; not present at remote end\n" if $verbose;
+ next;
+ }
+
+ my $date = $changesfile;
+ $date =~ s{^(?:.*/)?changes([0-9]+)\.txt$}{$1} or die "Can't extract date from changes filename $changesfile";
+
+ print STDERR "Processing changes file $changesfile\n" if $verbose;
+
+ my @changes = split /[\r\n]+/, $changesfilecontent;
+ foreach 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;
+
+ $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
+ # FIXME: don't insist on reading entire file into memory
+ my $content = fetchFile("$remoteroot/$file","$workingdir/$file");
+ die "File $remoteroot/$file not found" if not defined $content;
+ }
+ else {
+ die "Unknown operation '$op'";
+ }
+}
+
+
+# update the last "up-to-date" time
+saveLastUpdateTime();
+
+# finish
+exit 0;
+
+
projects / mir.git / blobdiff