X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=blobdiff_plain;f=yarrg%2Fcommod-update-receiver;h=6fac8a27b688e659682d8d8625e2e0d4e682ace7;hp=70cf36a93bdfe96aa51446172f2b53349786439f;hb=7d2fec305c9bdc622a41a343332331b25472fa20;hpb=877b0ba6b2d72d7957e2a8015520b87371cba6c9 diff --git a/yarrg/commod-update-receiver b/yarrg/commod-update-receiver index 70cf36a..6fac8a2 100755 --- a/yarrg/commod-update-receiver +++ b/yarrg/commod-update-receiver @@ -25,13 +25,17 @@ # are used without permission. This program is not endorsed or # sponsored by Three Rings. - -# Uploads contain: -# ocean canonical mixed case -# island canonical mixed case +# All calls contain: # clientname "ypp-sc-tools" # clientversion 2.1-g2e06a26 [from git-describe --tags HEAD] # clientfixes "lastpage" [space separated list] +# +# Timestamp requests contain: +# requesttimestamp +# +# Uploads contain: +# ocean canonical mixed case +# island canonical mixed case # data filename=deduped.tsv.gz output of yarrg --tsv @@ -47,12 +51,15 @@ use CGI qw/:standard -private_tempfiles/; setlocale(LC_CTYPE, "en_GB.UTF-8"); +our $now= time; defined $now or die $!; + my $re_any= "^(.*)\$"; parse_info_serverside(); sub fail ($) { my ($msg) = @_; + addlog("failing $msg"); print header(-status=>'400 Bad commodity update', -type=>'text/plain', -charset=>'us-ascii'); @@ -70,6 +77,27 @@ sub must_param ($$) { my %o; +my $midtmp= "_mid-pid$$.hold"; +open MIDTMP, ">$midtmp" or die "$midtmp $!"; +stat MIDTMP or die $!; +my $ino= (stat _)[1]; +my $midino= "_mid-ino$$.hold"; +rename $midtmp, $midino or die "$midtmp $midino $!"; +close MIDTMP or die $!; + +our $hostname= `hostname -f`; $? and die $?; chomp $hostname or die; +our $mid= "<$now.$$.$ino\@$hostname>"; +our $pwd= `pwd`; $? and die $?; chomp($pwd); +our $caller= cgi_get_caller; + +sub addlog ($) { + print LOG "$mid $caller $_[0]\n" or die $!; + flush LOG or die $!; +} + +open LOG, ">>_upload.log" or die $!; +addlog("receiving"); + $o{'clientname'}= must_param('clientname',$re_any); my $clientinfo= $clients{$o{'clientname'}}; fail('unknown client') unless defined $clientinfo; @@ -84,6 +112,12 @@ foreach my $bug (@$clientinfo) { $o{'clientversion'}= must_param('clientversion', "^(\\d[-+._0-9a-zA-Z]+)\$"); +if (param('requesttimestamp')) { + my $now= time; defined $now or die; + print header(-type=>'text/plain', -charset=>'us-ascii'), "OK $now.\n"; + exit(0); +} + $o{'ocean'}= must_param('ocean', $re_any); $o{'island'}= must_param('island', $re_any); @@ -100,16 +134,25 @@ foreach my $islands (values %$arches) { fail("unknown island") unless $island_found; $o{'timestamp'}= must_param('timestamp', "^([1-9]\\d{1,20})\$"); -my $now= time; defined $now or die $!; fail("clock skew") if $o{'timestamp'} >= $now; my $indatafh= upload('data'); defined $indatafh or fail("data is not a file"); my $datafile= must_param('data',"^(deduped\\.tsv\\.gz)\$"); +foreach my $mid (<_mid-*.hold>) { + if (!stat $mid) { $!==&ENOENT or die "$mid $!"; next; } + my $age= (stat _)[9]; + next if $age < 60; + unlink $mid or $!==&ENOENT or die "$mid $!"; +} + + my $mcontent= MIME::Entity->build(To => 'yarrg-commod-updates', + Subject => $pwd, Type => 'multipart/mixed', Boundary => '=', + 'Message-ID' => $mid, Charset => 'utf-8'); get_our_version(\%o, 'server'); @@ -150,7 +193,7 @@ my $dedupedtsv= pipethrough_prep(); while () { my @v= check_tsv_line($_,\&fail); - print $dedupedtsv join('\t',@v),"\n" or die $!; + print $dedupedtsv join("\t",@v),"\n" or die $!; } GZ->error and die $!; @@ -176,3 +219,6 @@ $?=0; close M; $? and fail("sendmail failed code $?"); print header(-type=>'text/plain', -charset=>'us-ascii'), "OK\n" or die $!; + +addlog("accepted $o{'clientspec'}"); +close LOG or die $!;