X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=blobdiff_plain;f=pctb%2Fdictionary-update-receiver;h=015f051f9a9af996e8d8237c4c68bf7188c0af17;hp=078b9f8c312ffd300d6bbf205b743a672b7937f8;hb=32d9a8bd2043de0c85734b78eb487fc2d8f09d07;hpb=9739f45fc783a87f02d1f435cf04fde3899ad4c7

diff --git a/pctb/dictionary-update-receiver b/pctb/dictionary-update-receiver
index 078b9f8..015f051 100755
--- a/pctb/dictionary-update-receiver
+++ b/pctb/dictionary-update-receiver
@@ -1,20 +1,13 @@
 #!/usr/bin/perl -w
 #
-# This script is invoked when the YPP SC PCTB client phones home to
-# provide updated character set OCR data or updated screenshot pixmap
-# interpretation (island name) data.
-#
-# The client will also phone home anyway to fetch the latest parsedb
-# before 
-#
-# This allows me (the operator of the SC server) to:
-#    - review the choices made by the user
-#    - if they are correct, incorporate them in the next client version
-#    - if they are wrong, incorporate fixes of them, or contradictions of them,
-#      in
+# This script is invoked when the YPP SC PCTB client talks to the
+# dictionary server.  See README.privacy.
 
-# The information reported 
-# The SC PCTB client does this so that 
+
+# upload testing runes:
+#
+# YPPSC_PCTB_DICT_UPDATE=./ YPPSC_PCTB_DICT_SUBMIT=./ ./ypp-commodities --ocean midnight --pirate aristarchus --find-island --same --raw-tsv >raw.tsv  
+# ./dictionary-manager --debug --approve-updates '' . .
 
 use strict (qw(vars));
 use POSIX;
@@ -31,7 +24,7 @@ use IO::Handle;
 sub parseentryin__pixmap ($) {
     my ($entry_in) = @_;
     $entry_in =~
-	m/^(\w+ \- \w[-+\'\"\#! 0-9a-z]*)\nP3\n([1-9]\d{1,3}) ([1-9]\d{1,3})\n255\n/s or die;
+	m/^(\S+ \- .*)\nP3\n([1-9]\d{1,3}) ([1-9]\d{1,3})\n255\n/s or die;
     my ($def,$w,$h)= ($1, $2+0, $3+0);
     my @d= grep { m/./ } split /\s+/, $';
     @d == $w*$h*3 or die "$d[0]|$d[1]|...|$d[$#d-1]|$d[$#d] ?";
@@ -75,7 +68,7 @@ sub parseentryin__pixmap ($) {
 
 sub parseentryin__char ($$) {
     my ($ei,$h) = @_;
-    $ei =~ m/^(Digit|Upper|Lower)\n((?:[-&\'A-F0-9a-f ]|\x20)+)\n/s or die;
+    $ei =~ m/^(Digit|Upper|Lower)\n([^\n]+)\n/s or die;
     my ($ctx,$str)= ($1,$2);
 #print STDERR ">$'<\n";
     my @d= grep { m/./ } split /\n/, $';
@@ -169,13 +162,17 @@ my $pirate= param('pirate');
 if (defined $ocean && defined $pirate) {
     $pirate= "$ocean - $pirate";
 } else {
-    $pirate= $ENV{'REMOTE_ADDR'};
-    my $fwdf= $ENV{'HTTP_X_FORWARDED_FOR'};
-    if (defined $fwdf) {
-	$fwdf =~ s/\s//g;
-	$fwdf =~ s/[^0-9.,]/?/g;
-	$pirate= "$fwdf,$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 $kind;
@@ -203,6 +200,7 @@ To: $whoami
 Subject: pctb $dict $ctx $def [ypp-sc-tools]
 
 Pirate:     $pirate
+Caller:     $caller
 Dictionary: $dict
 Context:    $ctx
 Definition: $def
@@ -250,7 +248,7 @@ my $fn_i= sprintf "_update.$$-%016x.rdy", (stat _)[1];
 
 print F "ypp-sc-tools dictionary update v1\n";
 
-foreach my $v ($pirate,$dict,$ctx,$def,$image,$key,$val) {
+foreach my $v ($pirate,$caller,$dict,$ctx,$def,$image,$key,$val) {
     printf F "%d\n", length($v) or die $!;
     print F $v,"\n" or die $!;
 }
@@ -261,7 +259,7 @@ my @tm= localtime;
 my $tm= strftime "%Y-%m-%d %H:%M:%S %Z", @tm;
 
 open L, ">> _dict.log" or die $!;
-my $ll= sprintf "%s %-6s %-31s %s", $tm, $dict, $pirate, $fn_i;
+my $ll= sprintf "%s %-6s %-31s %-31s %s", $tm, $dict, $pirate, $caller, $fn_i;
 
 #---------- commit everything ----------
 
@@ -270,7 +268,7 @@ L->flush or die $!;
 
 if (eval {
 
-    open S, "|sendmail -odb -oee -oi -t" or die $!;
+    open S, "|/usr/lib/sendmail -odb -oee -oi -t" or die $!;
     print S $email or die $!;
     $!=0; $?=0; close S or die $!; $? and die $?;
 
@@ -281,7 +279,8 @@ if (eval {
     print L "$ll stored\n" or die $!;
 } else {
     print L "$ll ERROR! $@\n" or die $!;
+    exit 1;
 }
 close L or die $!;
 
-print header('text/plain'), "$fn_i\n" or die $!;
+print header('text/plain'), "OK $fn_i\n" or die $!;