chiark / gitweb /
Installation fixes
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 29 Jul 2009 20:56:03 +0000 (21:56 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 29 Jul 2009 20:56:03 +0000 (21:56 +0100)
yarrg/Commods.pm
yarrg/commod-email-processor
yarrg/commod-update-receiver
yarrg/dictionary-update-receiver

index 67277c2..97cba04 100644 (file)
@@ -332,4 +332,17 @@ sub check_tsv_line ($$) {
     return @v;
 }
 
     return @v;
 }
 
+sub cgi_get_caller () {
+    my $caller= $ENV{'REMOTE_ADDR'};
+    $caller= 'LOCAL' unless defined $caller;
+
+    my $fwdf= $ENV{'HTTP_X_FORWARDED_FOR'};
+    if (defined $fwdf) {
+       $fwdf =~ s/\s//g;
+       $fwdf =~ s/[^0-9.,]/?/g;
+       $caller= "$fwdf";
+    }
+    return $caller;
+}
+
 1;
 1;
index d2f0e81..bf42c0d 100755 (executable)
@@ -49,6 +49,12 @@ use strict (qw(vars));
 use POSIX;
 use MIME::Parser;
 
 use POSIX;
 use MIME::Parser;
 
+BEGIN {
+    my $selfdir= $0;
+    $selfdir =~ s,/+[^/]*$,,;
+    chdir("$selfdir") or die "$selfdir $!";
+}
+
 use Commods;
 use CommodsDatabase;
 
 use Commods;
 use CommodsDatabase;
 
index 16a9ac6..6fac8a2 100755 (executable)
@@ -51,12 +51,15 @@ use CGI qw/:standard -private_tempfiles/;
 
 setlocale(LC_CTYPE, "en_GB.UTF-8");
 
 
 setlocale(LC_CTYPE, "en_GB.UTF-8");
 
+our $now= time;  defined $now or die $!;
+
 my $re_any= "^(.*)\$";
 
 parse_info_serverside();
 
 sub fail ($) {
     my ($msg) = @_;
 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');
     print header(-status=>'400 Bad commodity update',
                 -type=>'text/plain',
                 -charset=>'us-ascii');
@@ -74,6 +77,27 @@ sub must_param ($$) {
 
 my %o;
 
 
 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{'clientname'}= must_param('clientname',$re_any);
 my $clientinfo= $clients{$o{'clientname'}};
 fail('unknown client') unless defined $clientinfo;
@@ -110,16 +134,25 @@ foreach my $islands (values %$arches) {
 fail("unknown island") unless $island_found;
 
 $o{'timestamp'}= must_param('timestamp', "^([1-9]\\d{1,20})\$");
 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)\$");
 
 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',
 my $mcontent= MIME::Entity->build(To => 'yarrg-commod-updates',
+                                 Subject => $pwd,
                                  Type => 'multipart/mixed',
                                  Boundary => '=',
                                  Type => 'multipart/mixed',
                                  Boundary => '=',
+                                 'Message-ID' => $mid,
                                  Charset => 'utf-8');
 
 get_our_version(\%o, 'server');
                                  Charset => 'utf-8');
 
 get_our_version(\%o, 'server');
@@ -160,7 +193,7 @@ my $dedupedtsv= pipethrough_prep();
 
 while (<GZ>) {
     my @v= check_tsv_line($_,\&fail);
 
 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 $!;
 }
 
 GZ->error and die $!;
@@ -186,3 +219,6 @@ $?=0; close M; $? and fail("sendmail failed code $?");
 print header(-type=>'text/plain', -charset=>'us-ascii'),
       "OK\n"
     or die $!;
 print header(-type=>'text/plain', -charset=>'us-ascii'),
       "OK\n"
     or die $!;
+
+addlog("accepted $o{'clientspec'}");
+close LOG or die $!;
index eee7d14..cd26a26 100755 (executable)
@@ -205,15 +205,7 @@ if (defined $ocean && defined $pirate) {
     $pirate= '';
 }
 
     $pirate= '';
 }
 
-my $caller= $ENV{'REMOTE_ADDR'};
-$caller= 'LOCAL' unless defined $caller;
-
-my $fwdf= $ENV{'HTTP_X_FORWARDED_FOR'};
-if (defined $fwdf) {
-    $fwdf =~ s/\s//g;
-    $fwdf =~ s/[^0-9.,]/?/g;
-    $caller= "$fwdf,$pirate";
-}
+my $caller= cgi_get_caller();
 
 my $kind;
 my @xa;
 
 my $kind;
 my @xa;