From 3d80a86a8c77e29a26e70aa810ebb2dea607208e Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 21 Jun 2009 21:22:59 +0100 Subject: [PATCH] wip upload testing --- pctb/convert.c | 2 +- pctb/convert.h | 1 + pctb/dictionary-manager | 136 ++++++++++++++++++++++++++++---- pctb/dictionary-update-receiver | 35 +++++--- pctb/resolve.c | 4 + 5 files changed, 150 insertions(+), 28 deletions(-) diff --git a/pctb/convert.c b/pctb/convert.c index 70b4769..fa9837f 100644 --- a/pctb/convert.c +++ b/pctb/convert.c @@ -57,12 +57,12 @@ static const char *o_outmode_str= 0; static enum mode o_mode= mode_all; static char *o_screenshot_fn; -static int o_quiet; static const char *o_serv_pctb, *o_serv_dict_fetch, *o_serv_dict_submit; const char *o_resolver= "./dictionary-manager"; FILE *screenshot_file; const char *o_ocean, *o_pirate; +int o_quiet; enum flags o_flags= ff_dict_fetch|ff_dict_submit|ff_dict_pirate; diff --git a/pctb/convert.h b/pctb/convert.h index 0231ca9..827c6a7 100644 --- a/pctb/convert.h +++ b/pctb/convert.h @@ -102,6 +102,7 @@ enum flags { extern enum flags o_flags; extern const char *o_ocean, *o_pirate; +extern int o_quiet; /*----- from pages.c -----*/ diff --git a/pctb/dictionary-manager b/pctb/dictionary-manager index c2ea2b5..b6f87a6 100755 --- a/pctb/dictionary-manager +++ b/pctb/dictionary-manager @@ -71,6 +71,12 @@ proc puts_counted {f dvar} { debug "PUTS_COUNTED $count $dvar" } +proc bgerror {m} { + global errorCode errorInfo + puts stderr "ERROR: $m\n[list $errorCode]\n$errorInfo\n"; + exit 16 +} + #---------- display core ---------- set mul 6 @@ -89,7 +95,7 @@ proc init_widgets {} { frame .privacy -bd 2 -relief groove pack .privacy -side top -padx 2 -pady 2 -fill x - upload_init_widgets + upload_init frame .d -bd 2 -relief groove -pady 2 -padx 2 @@ -159,12 +165,14 @@ proc helptext {t} { proc bind_key {k proc} { global keybindings - bind . $proc + bind .d $proc set keybindings($k) [expr {!![string length $proc]}] + .d configure -takefocus 1 } proc unbind_all_keys {} { global keybindings foreach k [array names keybindings] { bind_key $k {} } + .d configure -takefocus 0 } #---------- database read and write common wrapper ---------- @@ -218,6 +226,19 @@ proc write_database {} { file rename -force $database_fn.new $database_fn } +proc select_database {dbname_spec} { + global dbname + set dbname $dbname_spec + read_database "./#local-$dbname#.txt" +} + +proc do_database_update {im def} { + global database + maybe_upload_entry $im $def + set database($im) $def + write_database +} + proc required/char {} { global mulrows glyphsdone unk_l unk_r unk_contexts rows @@ -242,8 +263,9 @@ proc required/char {} { pack forget .d.pe pack .d.csr -side top -before .d.mi pack .d.got .d.ctx -side top -after .d.mi + focus .d - read_database "./#local-char$rows#.txt" + select_database char$rows draw_glyphsdone startup_cursor } @@ -326,8 +348,8 @@ proc pixmap_ok {} { rowname rowdesc set result "$colname - $rowname" debug "UPDATE PIXMAP AS >$result<" - set database($ppm) $result - write_database + + do_database_update $ppm $result done/$mainkind } @@ -346,7 +368,7 @@ proc required/pixmap {} { set alloptions [exec ./dictionary-pixmap-options $unk_what] - read_database "./#local-pixmap#.txt" + select_database pixmap set mulcols [image width image/main] set mulrows [image height image/main] @@ -356,6 +378,7 @@ proc required/pixmap {} { pack forget .d.csr .d.got pack .d.pe -side top -before .d.mi -pady 2 + .d configure -takefocus 0 #-pady 2 -fill x eval destroy [winfo children .d.pe.grid] @@ -381,7 +404,7 @@ proc required/pixmap {} { #========== UPLOADS TO DICTIONARY SERVER ========== -proc upload_init_widgets {} { +proc upload_init {} { global privacy_setting set privacy_setting [upload_status] @@ -414,6 +437,10 @@ proc upload_init_widgets {} { $w configure -state disabled } } + if {$privacy_setting} { + package require http + ::http::config -urlencoding utf-8 + } } proc upload_status {} { @@ -424,11 +451,85 @@ proc upload_status {} { if {![string compare 0 $env(YPPSC_PCTB_DICT_SUBMIT)]} { debug b; return 0 } if {![info exists env(YPPSC_PIRATE)]} { return 1 } + if {![info exists env(YPPSC_OCEAN)]} { return 1 } if {![string length $env(YPPSC_PIRATE)]} { return 1 } + if {![string length $env(YPPSC_OCEAN)]} { return 1 } return 2 } +proc maybe_upload_entry {im def} { + global reqkind privacy_setting env dbname quiet + + debug "DB-UPDATE PRIVACY $privacy_setting" + if {!$privacy_setting} return + + debug "DB-UPDATE UPLOADING" + + set pl {} + lappend pl dict $dbname + + if {$privacy_setting>=2} { + set pirate [string totitle $env(YPPSC_PIRATE)] + set ocean [string totitle $env(YPPSC_OCEAN)] + debug "DB-UPDATE NON-ANON $ocean $pirate" + lappend pl \ + pirate $pirate \ + ocean $ocean + } + lappend pl entry [format_database_entry/$reqkind $im $def] + + set url $env(YPPSC_PCTB_DICT_SUBMIT) + append url dictionary-update-receiver + + set query [eval ::http::formatQuery $pl] + regsub -all {%0d} $query {} query + debug "DB-UPDATE QUERY [string range $query 0 200]..." + + if {[regexp {^\.?/} $url]} { + set cmd [list $url $query] + debug "SUBMIT CMD [string range $cmd 0 200]..." + set body [eval exec $cmd 2>@ stderr] + regsub {^Content-Type: text/plain.*\n\n} $body {} body + } else { + + if {[catch { + set req [::http::geturl $url -query $query] + } emsg]} { + puts stderr \ + "\nWARNING: Cannot do dictionary upload: $emsg\n" + return + } + upvar #0 $req s + debug "DB-UPDATE DONE $req $s(status) [array names s]" + set ncode [::http::ncode $req] + + if {!(![string compare ok $s(status)] && + ![string compare 200 $ncode])} { + set m "\nWARNING: Dictionary upload failed:" + foreach v {status http error posterror} { + if {[info exists s($v)]} { append m "\n $v: $s($v)" } + } + puts stderr $m + return + } + set body $s(body) + ::http::cleanup $req + } + + if {![string match {OK *} $body]} { + set m "\nWARNING: Dictionary upload went wrong:\n" + append m "\n " [join [split $body "\n"] "\n "] + puts stderr $m + return + } + + if {!$quiet} { + puts stderr \ + "Uploaded $dbname dictionary entry `$def': $body" + } +} + #========== CHARACTER SET ========== #---------- xpm input processor ---------- @@ -622,16 +723,17 @@ proc recursor/text {} { .d.csr.csr.l configure -text {define:} pack .d.csr.csr.e -side left focus .d.csr.csr.e - bind_key Return { + bind .d.csr.csr.e { set strq [.d.csr.csr.e get] if {[regexp -line {^(?:[!-[]|[]-~]|\\\\|\\x[0-9a-f]{2})+} $strq]} { RETURN_RESULT DEFINE "$cur_0 $cur_1 $strq" } } - bind_key Escape { + bind .d.csr.csr.e { bind_key Escape {} pack forget .d.csr.csr.e set cur_mode 1 + focus .d recursor } } @@ -751,9 +853,8 @@ proc update_database/DEFINE {c0 c1 strq} { incr c1 -1 foreach c $ncontexts { set bm [dbkey $c $c0 $c1] - set database($bm) $strq + do_database_update $bm $strq } - write_database } proc update_database/DELETE {l r ctxs} { @@ -779,11 +880,11 @@ proc RETURN_RESULT {how what} { #========== server for approving updates ========== -proc remote-serv-log {dict pirate file event} { +proc remote-serv-log {dict pirate caller file event} { global remoteserv_logf set t [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S %Z}] - set s [format "%s %-6s %-31s %s %s\n" \ - $t $dict $pirate [file tail $file] $event] + set s [format "%s %-6s %-31s %-31s %s %s\n" \ + $t $dict $pirate $caller [file tail $file] $event] puts -nonewline $remoteserv_logf $s } @@ -805,6 +906,7 @@ proc remote-serv/take {yesno file dict} { set rows "" debug "TAKE [list $yesno $file $dict]" read_counted stdin pirate + read_counted stdin caller read_counted stdin key read_counted stdin val @@ -827,7 +929,7 @@ proc remote-serv/take {yesno file dict} { } else { set desc reject } - remote-serv-log $dict $pirate $file "$desc $reqkind $rows" + remote-serv-log $dict $pirate $caller $file "$desc $reqkind $rows" file delete -force $file puts done @@ -895,6 +997,7 @@ proc approve_decompose_data {specdata} { regsub-data {^ypp-sc-tools dictionary update v1\n} {} uplevel 1 chop_counted pirate + uplevel 1 chop_counted caller uplevel 1 chop_counted dict uplevel 1 chop_counted ctx uplevel 1 chop_counted def @@ -952,6 +1055,7 @@ proc approve_approve_reject_one {ix yesno} { approve_decompose_data $tdata puts_server "take $yesno $file $dict" puts_counted $server pirate + puts_counted $server caller puts_counted $server key puts_counted $server val puts_server confirmed @@ -1103,9 +1207,11 @@ proc debug {m} { } set mainkind default set ai 0 set debug 0 +set quiet 0 foreach arg $argv { incr ai switch -exact -- $arg { + {--quiet} { set quiet 1 } {--debug} { set debug 1 } {--debug-server} { proc debug {m} { puts stderr "DICT-MGR-SVR $m" }} {--noop-arg} { } diff --git a/pctb/dictionary-update-receiver b/pctb/dictionary-update-receiver index 8f53438..0ce8593 100755 --- a/pctb/dictionary-update-receiver +++ b/pctb/dictionary-update-receiver @@ -3,6 +3,12 @@ # This script is invoked when the YPP SC PCTB client talks to the # dictionary server. See README.privacy. + +# 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; @@ -18,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] ?"; @@ -62,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/, $'; @@ -156,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; @@ -190,6 +200,7 @@ To: $whoami Subject: pctb $dict $ctx $def [ypp-sc-tools] Pirate: $pirate +Caller: $caller Dictionary: $dict Context: $ctx Definition: $def @@ -237,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 $!; } @@ -248,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 ---------- @@ -271,4 +282,4 @@ if (eval { } close L or die $!; -print header('text/plain'), "$fn_i\n" or die $!; +print header('text/plain'), "OK $fn_i\n" or die $!; diff --git a/pctb/resolve.c b/pctb/resolve.c index 556c54b..0bd0579 100644 --- a/pctb/resolve.c +++ b/pctb/resolve.c @@ -25,6 +25,7 @@ * sponsored by Three Rings. */ +#include "convert.h" #include "ocr.h" static FILE *resolver; @@ -50,6 +51,7 @@ FILE *resolve_start(void) { sysassert( dup2(donepipe[1],4) ==4 ); EXECLP_HELPER("dictionary-manager", DEBUGP(callout) ? "--debug" : "--noop-arg", + o_quiet ? "--quiet" : "--noop-arg", "--automatic-1", (char*)0); sysassert(!"execlp dictionary-manager --automatic failed"); @@ -59,6 +61,8 @@ FILE *resolve_start(void) { resolver= fdopen(jobpipe[1],"w"); sysassert(resolver); resolver_done= donepipe[0]; } + + progress(""); return resolver; } -- 2.30.2