# are used without permission. This program is not endorsed or
# sponsored by Three Rings.
-
-# Uploads contain:
-# ocean canonical mixed case
-# island canonical mixed case
-# clientname "ypp-sc-tools"
-# clientversion 2.1-g2e06a26 [from git-describe --tags HEAD]
-# clientfixes "lastpage" [space separated list]
-# data filename=deduped.tsv.gz output of yarrg --tsv
-
-
use strict (qw(vars));
use POSIX;
use MIME::Entity;
use CGI qw/:standard -private_tempfiles/;
-setlocale(LC_CTYPE, "en_GB.UTF-8");
+set_ctype_utf8();
+
+our $now= time; defined $now or die $!;
my $re_any= "^(.*)\$";
-parse_masters();
+parse_info_serverside();
sub fail ($) {
my ($msg) = @_;
+ addlog("failing $msg");
print header(-status=>'400 Bad commodity update',
-type=>'text/plain',
-charset=>'us-ascii');
- print "Error: $msg\n";
+ print "\nError: $msg\n";
exit 0;
}
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;
$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);
my $arches= $oceans{$o{'ocean'}};
fail("unknown ocean") unless $arches;
+parse_info_serverside_ocean($o{'ocean'});
+
my $island_found= 0;
foreach my $islands (values %$arches) {
my $sources= $islands->{$o{'island'}};
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 $!";
+}
+
+$o{'instance'}= $ENV{'YARRG_INSTANCE'};
+
my $mcontent= MIME::Entity->build(To => 'yarrg-commod-updates',
+ Subject => $ENV{'YARRG_INSTANCE'},
Type => 'multipart/mixed',
Boundary => '=',
+ 'Message-ID' => $mid,
Charset => 'utf-8');
get_our_version(\%o, 'server');
while (<GZ>) {
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 $!;
$?=0; close M; $? and fail("sendmail failed code $?");
print header(-type=>'text/plain', -charset=>'us-ascii'),
- "OK\n"
+ "OK\nThank you for your submission to YARRG.\n"
or die $!;
+
+addlog("accepted $o{'clientspec'}");
+close LOG or die $!;