From 0c7799d7cea28bfc9d24ea4a152b5fa602118284 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sat, 20 Jun 2009 20:25:22 +0100 Subject: [PATCH] dictionary approver works --- .gitignore | 2 + pctb/Makefile | 3 +- pctb/dictionary-manager | 302 +++++++++++++++++++++++++++++--- pctb/dictionary-update-receiver | 164 +++++------------ pctb/testupdate-char | 1 - pctb/testupdate-char5 | 7 + 6 files changed, 338 insertions(+), 141 deletions(-) create mode 100644 pctb/testupdate-char5 diff --git a/.gitignore b/.gitignore index f795243..1a3777d 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ t core +vgcore.* pctb/*.o pctb/t.* @@ -10,3 +11,4 @@ pctb/u.* pctb/ypp-commodities pctb/#*#.* +pctb/_dict.log diff --git a/pctb/Makefile b/pctb/Makefile index f798e52..046493b 100644 --- a/pctb/Makefile +++ b/pctb/Makefile @@ -43,4 +43,5 @@ ypp-commodities: $(CONVERT_OBJS) -lnetpbm -lXtst -lX11 $(CONVERT_OBJS): ocr.h convert.h structure.h common.h clean: - rm -f $(TARGETS) *.o core core.* *~ t t.* u u.* ./#pages#.ppm + rm -f $(TARGETS) *.o core core.* *~ vgcore.* + rm -f t t.* u u.* v v.* ./#pages#.ppm diff --git a/pctb/dictionary-manager b/pctb/dictionary-manager index f15c99e..26c8807 100755 --- a/pctb/dictionary-manager +++ b/pctb/dictionary-manager @@ -49,11 +49,26 @@ proc must_gets {f lvar} { if {[gets $f l] < 0} { error "huh?" } } +proc must_gets_exactly {f expected} { + must_gets $f got + if {[string compare $expected $got]} { error "$expected $got ?" } +} + proc read_counted {f var} { - upvar 1 $var var + upvar 1 $var val must_gets $f count - set var [read $f $count] - if {[eof $f]} { error ? } + set val [read $f $count] + must_gets $f eol + if {[string length $eol]} { error "$eol ?" } + debug "READ_COUNTED $count $var" +} + +proc puts_counted {f dvar} { + upvar 1 $dvar d + set count [string length $d] + puts $f $count + puts $f $d + debug "PUTS_COUNTED $count $dvar" } #---------- display core ---------- @@ -549,7 +564,7 @@ proc recursor/text {} { focus .d.csr.csr.e bind_key Return { set strq [.d.csr.csr.e get] - if {[regexp {^(?:[!-[]|[]-~]|\\\\|\\x[0-9a-f]{2})+} $strq]} { + if {[regexp -line {^(?:[!-[]|[]-~]|\\\\|\\x[0-9a-f]{2})+} $strq]} { RETURN_RESULT DEFINE "$cur_0 $cur_1 $strq" } } @@ -641,6 +656,7 @@ proc read_database_entry/char {f context} { } proc write_database_header/char {f} { + global rows puts $f "$rows\n" } proc format_database_entry/char {bm strq} { @@ -704,9 +720,12 @@ proc RETURN_RESULT {how what} { #========== server for approving updates ========== -proc remote-serv-log {pirate event} { +proc remote-serv-log {dict pirate file event} { + global remoteserv_logf set t [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S %Z}] - set s [format "%s %15s %s" $t $pirate $event] + set s [format "%s %-6s %-31s %s %s\n" \ + $t $dict $pirate [file tail $file] $event] + puts -nonewline $remoteserv_logf $s } proc remote-serv/list {} { @@ -717,39 +736,276 @@ proc remote-serv/list {} { set f [open $file] set d [read $f] close $f - puts [string length $d] - puts -nonewline $d + puts_counted stdout d } puts end } -proc remote-serv/take {f args} { - global dropdir rows reqkind +proc remote-serv/take {yesno file dict} { + global dropdir dictdir rows reqkind database set rows "" - manyset $args yesno file pirate reqkind rows - read_counted stdin desc + debug "TAKE [list $yesno $file $dict]" + read_counted stdin pirate read_counted stdin key read_counted stdin val + + must_gets_exactly stdin confirmed + + if {![string compare pixmap $dict]} { + set reqkind pixmap + debug "DICT PIXMAP" + } elseif {[regexp {^(char)([1-9]\d*)$} $dict dummy reqkind rows]} { + debug "DICT CHAR rqk=$reqkind r=$rows." + } else { + error "$dict ?" + } + if {$yesno} { - read_database + read_database $dictdir/master-$dict.txt set database($key) $val write_database + set desc approve + } else { + set desc reject } - set ar [lindex {reject approve} $yesno] - remote-serv-log $pirate "$ar $reqkind $rows $desc" - file remove $file + remote-serv-log $dict $pirate $file "$desc $reqkind $rows" + file delete -force $file + + puts done +} + +proc remote-serv/noop {} { + puts ok } +set remoteserv_banner {ypp-sc-tools pctb remote-server v1} + proc main/remoteserv {} { - global argv dropdir - manyset $argv dropdir + global argv dropdir remoteserv_banner remoteserv_logf dictdir + manyset $argv dropdir dictdir + puts $remoteserv_banner + set remoteserv_logf [open $dropdir/_dict.log a] + fconfigure $remoteserv_logf -buffering line while 1 { - puts {ypp-sc-tools pctb remote-server v1} + flush stdout if {[gets stdin l] < 0} break eval remote-serv/$l } } +#========== updates approver ========== + +proc puts_server {s} { + global server + debug ">> $s" + puts $server $s +} +proc must_gets_server {lv} { + upvar 1 $lv l + global server + must_gets $server l + debug "<< $l" +} + +proc must_gets_exactly_server {expected} { + must_gets_server got + if {[string compare $expected $got]} { error "$expected $got ?" } +} + +proc regsub-data {exp subspec args} { + global data + if {![eval regsub $args -- [list $exp $data $subspec data]]} { + error "$exp >$data< ?" + } +} + +proc chop_counted {var} { + upvar 1 $var val + global data + if {![regexp {^(0|[1-9]\d*)\n} $data dummy l]} { error "$data ?" } + regsub-data {^.*\n} {} -line + set val [string range $data 0 [expr {$l-1}]] + set data [string range $data $l end] + debug "CHOP_COUNTED $l $var" + regsub-data {^\n} {} +} + +proc approve_decompose_data {specdata} { + global data + set data $specdata + + regsub-data {^ypp-sc-tools dictionary update v1\n} {} + uplevel 1 chop_counted pirate + uplevel 1 chop_counted dict + uplevel 1 chop_counted ctx + uplevel 1 chop_counted def + uplevel 1 chop_counted image + uplevel 1 chop_counted key + uplevel 1 chop_counted val + + return [uplevel 1 {list $dict $def $image}] +} + +proc approve_compare {fd1 fd2} { + manyset $fd1 file data; set sv1 [approve_decompose_data $data] + manyset $fd2 file data; set sv2 [approve_decompose_data $data] + return [string compare $sv1 $sv2] +} + +proc approve_showentry {ix file specdata} { + global approve_ixes + + approve_decompose_data $specdata + + set wb .app.e$ix + + frame $wb-inf + label $wb-inf.who -text $pirate + + entry $wb-inf.file -font fixed -relief flat + $wb-inf.file insert end [file tail $file] + $wb-inf.file configure -state readonly -width -1 + + pack $wb-inf.who $wb-inf.file -side top + + frame $wb-def + label $wb-def.scope -text "$dict $ctx" + label $wb-def.def -text $def + pack $wb-def.scope $wb-def.def -side bottom + + set ppm [exec pnmscale 2 << $image] + image create photo approve/$ix -data $ppm + label $wb-image -image approve/$ix -bd 2 -relief sunken + + frame $wb-act + button $wb-act.rej -text Reject -command [list approve_reject $ix] + pack $wb-act.rej + + grid $wb-def $wb-image $wb-act $wb-inf -padx 3 + grid configure $wb-image -ipadx 3 -ipady 3 + + lappend approve_ixes $ix +} + +proc approve_approve_reject_one {ix yesno} { + global approve_list server + manyset [lindex $approve_list $ix] file tdata + approve_decompose_data $tdata + puts_server "take $yesno $file $dict" + puts_counted $server pirate + puts_counted $server key + puts_counted $server val + puts_server confirmed + flush $server + must_gets_exactly_server done +} + +proc approve_check_server {} { + global server + puts_server noop + flush $server + must_gets_exactly_server ok +} + +proc approve_reject {ix} { + approve_check_server + approve_approve_reject_one $ix 0 + approve_fetch_list +} + +proc approve_these {} { + global approve_ixes + approve_check_server + foreach ix $approve_ixes { approve_approve_reject_one $ix 1 } + approve_fetch_list +} + +proc approve_fetch_list {} { + global server approve_list + set approve_list {} + puts_server list + flush $server + while 1 { + must_gets_server more + switch -exact $more { + yes { } + end { break } + default { error "$more ?" } + } + must_gets_server file + read_counted $server data + lappend approve_list [list $file $data] + } + + if {![llength $approve_list]} { puts "Nothing (more) to approve."; exit 0 } + + set approve_list [lsort -command approve_compare $approve_list] + approve_show_page 0 +} + +proc main/approve {} { + global argv server remoteserv_banner data approve_list approve_page + global userhost directory dictdir debug + + if {[llength $argv] != 3} { error "wrong # args" } + manyset $argv userhost directory dictdir + set cmd [list tclsh $directory/dictionary-manager] + if {$debug} { lappend cmd --debug-server } + lappend cmd --remote-server-1 $directory $dictdir + switch -glob $userhost { + {} { } + {* *} { set cmd $userhost } + * { set cmd [append [list ssh $userhost] $cmd] } + } + lappend cmd 2>@ stderr + set server [open |$cmd r+] + must_gets_exactly_server $remoteserv_banner + + button .left -text {<<} -command {approve_show_page -1} + button .right -text {>>} -command {approve_show_page +1} + + label .title -text {} + frame .app -bd 2 -relief groove + button .ok -text "Approve These" -command approve_these + pack .title .app -side top + pack .left -side left + pack .right -side right + pack .ok -side bottom + + set approve_page 0 + approve_fetch_list +} + +proc approve_show_page {delta} { + global approve_page approve_ixes approve_list userhost directory dictdir + + eval destroy [winfo children .app] + set approve_ixes {} + + set per_page 2 + incr approve_page $delta + + set ll [llength $approve_list] + set npages [expr {($ll+$per_page-1)/$per_page}] + if {$approve_page >= $npages} { incr approve_page -1 } + + set page_start [expr {$approve_page*$per_page}] + set page_end [expr {$page_start+$per_page-1}] + + for {set ix $page_start} {$ix < $ll && $ix <= $page_end} {incr ix} { + set fd [lindex $approve_list $ix] + eval approve_showentry $ix $fd + } + + .title configure -text \ + "$userhost\n$directory => $dictdir\nPage [expr {$approve_page+1}]/$npages" + + .left configure -state disabled + .right configure -state disabled + if {$approve_page>0} { .left configure -state normal } + if {$approve_page<$npages-1} { .right configure -state normal } +} + #========== main program ========== proc main/default {} { @@ -787,11 +1043,14 @@ proc debug {m} { } set mainkind default set ai 0 +set debug 0 foreach arg $argv { incr ai switch -exact -- $arg { - {--debug} { proc debug {m} { puts stderr "SHOW-THING $m" } } + {--debug} { set debug 1 } + {--debug-server} { proc debug {m} { puts stderr "DICT-MGR-SVR $m" }} {--noop-arg} { } + {--approve-updates} { set mainkind approve; break } {--automatic-1} { set mainkind automatic } {--remote-server-1} { set mainkind remoteserv; break } {--automatic*} - {--remote-server} @@ -799,6 +1058,9 @@ foreach arg $argv { default { error "huh $argv ?" } } } +if {$debug} { + proc debug {m} { puts stderr "DICT-MGR $m" } +} set argv [lrange $argv $ai end] main/$mainkind diff --git a/pctb/dictionary-update-receiver b/pctb/dictionary-update-receiver index 727b94b..3e04f6c 100755 --- a/pctb/dictionary-update-receiver +++ b/pctb/dictionary-update-receiver @@ -17,6 +17,7 @@ # The SC PCTB client does this so that use strict (qw(vars)); +use POSIX; $CGI::POST_MAX= 65536; $CGI::DISABLE_UPLOADS= 1; @@ -50,31 +51,15 @@ sub parseentryin__pixmap ($) { $ppm .= "\n"; } - my $icon= pipeval($ppm, - 'ppmtopgm', - 'pnmscale -xysize 156 80', - 'pnmnorm -bpercent 40 -wpercent 20', - 'pgmtopbm -threshold', - 'pnminvert', - 'pbmtoascii -2x4'); - - my $whole= pipeval($ppm, - 'ppmtopgm', - 'pnmnorm -bpercent 40 -wpercent 20', - 'pgmtopbm -threshold', - 'pnminvert', - 'pbmtoascii'); - - my $entry= "$def\n$ppm"; - return ('',$def,$entry,$icon,$w,$whole); + return ('',$def,$ppm,$ppm,$def); } #---------- characters ---------- -sub parseentryin__char ($) { - my ($ei) = @_; - $ei =~ m/^([1-9]\d{0,2})\n(Digit|Upper|Lower)\n((?:[-&\'A-F0-9a-f ]|\x20)+)\n/s or die; - my ($h,$ctx,$str)= ($1+0,$2,$3); +sub parseentryin__char ($$) { + my ($ei,$h) = @_; + $ei =~ m/^(Digit|Upper|Lower)\n((?:[-&\'A-F0-9a-f ]|\x20)+)\n/s or die; + my ($ctx,$str)= ($1,$2); #print STDERR ">$'<\n"; my @d= grep { m/./ } split /\n/, $'; #print STDERR ">@d<\n"; @@ -90,132 +75,73 @@ sub parseentryin__char ($) { my $ppm= "P2\n$w $h\n1\n"; for (my $y=0; $y<$h; $y++) { for (my $x=0; $x<$w; $x++) { - $ppm .= sprintf " %d", !!($d[$x] & (1<<$y)); + $ppm .= sprintf " %d", !($d[$x] & (1<<$y)); } $ppm .= "\n"; } - my $entry= sprintf "%d\n%s\n%s\n", $h,$ctx,$str; - map { $entry .= sprintf "%x\n", $_; } @d; + my $key= join ' ', $ctx, map { sprintf "%x", $_; } @d; -#print STDERR "[[[[\n$ppm\n]]]]"; - - my $icon= pipeval($ppm, -# "pnmscale -xysize 78 $h", - 'pgmtopbm -threshold', - 'pnminvert', - 'pbmtoascii'); - - return ("$ctx",$str,$entry, '',$w,$icon); -} - -#---------- useful stuff ---------- - -sub pipeval ($@) { - my ($val, @cmds) = @_; - my (@pids); - - my $lastpipe; - - foreach my $cmd ('',@cmds) { - my $pipe= new IO::Pipe or die $!; - my $pid= fork(); defined $pid or die $!; - - if (!$pid) { - $pipe->writer(); - if (!$lastpipe) { - print $pipe $val or die $!; - exit 0; - } else { - open STDIN, '<&', $lastpipe or die $!; - open STDOUT, '>&', $pipe or die $!; - close $lastpipe or die $!; - close $pipe or die $!; - exec $cmd; die $!; - } - } - $pipe->reader(); - if ($lastpipe) { close $lastpipe or die $!; } - $lastpipe= $pipe; - push @pids, $pid; - } - - $!=0; { local ($/)=undef; $val= <$lastpipe>; } - defined $val or die $!; - $lastpipe->error and die $!; close $lastpipe or die $!; - - foreach my $cmd ('(paste)', @cmds) { - my $pid= shift @pids; - waitpid($pid,0) == $pid or die "$pid $? $!"; - $?==0 or $?==13 or die "$cmd $?"; - } - return $val; + return ($ctx,$str,$ppm,$key,$str); } #---------- main program ---------- -my $path= path_info(); +my $dict= param('dict'); my $entry_in= param('entry'); defined $entry_in or die; +my $ocean= param('ocean'); +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"; + } +} + my $du=$ENV{'YPPSC_DICTUPDATES'}; chdir $du or die "$du $!" if defined $du; my $kind; +my @xa; -if ($path =~ /(pixmap|char)/) { - $kind=$1; +if ($dict =~ m/^pixmap$/) { + $kind= $&; +} elsif ($dict =~ m/^(char)([1-9]\d?)$/) { + ($kind,@xa)= ($1,$2); } else { - die "$path ?"; + die "$dict ?"; } +$dict= $&; -my ($ctx,$def,$entry,$icon,$width,$whole)= &{"parseentryin__$kind"}($entry_in); +my ($ctx,$def,$image,$key,$val)= &{"parseentryin__$kind"}($entry_in, @xa); my $fn_t= "_update.$$-xxxxxxxxxxxxxxxx.tmp"; open F, "> $fn_t" or die "$fn_t $!"; (stat F) or die $!; my $fn_i= sprintf "_update.$$-%016x.rdy", (stat _)[1]; -print F $whole or die $!; -close F or die $!; -rename $fn_t, $fn_i or die "$fn_t $fn_i $!"; - -__END__ - -$icon =~ s/^/ /mg; - -my $email= <> _dict.log" or die $!; +my $ll= sprintf "%s %-6s %-31s %s %s\n", $tm, $dict, $pirate, $fn_i, "submit"; +print L $ll or die $!; +close L or die $!; -print $email or die $!; +rename $fn_t, $fn_i or die "$fn_t $fn_i $!"; diff --git a/pctb/testupdate-char b/pctb/testupdate-char index 0f0c8f0..637e937 100644 --- a/pctb/testupdate-char +++ b/pctb/testupdate-char @@ -1,4 +1,3 @@ -15 Digit 0 3e0 diff --git a/pctb/testupdate-char5 b/pctb/testupdate-char5 new file mode 100644 index 0000000..a25def5 --- /dev/null +++ b/pctb/testupdate-char5 @@ -0,0 +1,7 @@ +Digit +5 +878 +848 +848 +488 +308 -- 2.30.2