chiark / gitweb /
WIP dictionary updates - wip convert to ssh-remote
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sat, 20 Jun 2009 12:39:18 +0000 (13:39 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sat, 20 Jun 2009 12:39:18 +0000 (13:39 +0100)
pctb/dictionary-manager
pctb/dictionary-update-receiver

index 7aa7077..f15c99e 100755 (executable)
@@ -49,6 +49,13 @@ proc must_gets {f lvar} {
     if {[gets $f l] < 0} { error "huh?" }
 }
 
+proc read_counted {f var} {
+    upvar 1 $var var
+    must_gets $f count
+    set var [read $f $count]
+    if {[eof $f]} { error ? }
+}
+
 #---------- display core ----------
 
 set mul 6
@@ -695,6 +702,54 @@ proc RETURN_RESULT {how what} {
     done/$mainkind
 }
 
+#========== server for approving updates ==========
+
+proc remote-serv-log {pirate event} {
+    set t [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S %Z}]
+    set s [format "%s %15s %s" $t $pirate $event]
+}
+
+proc remote-serv/list {} {
+    global dropdir
+    foreach file [glob -nocomplain -type f -directory $dropdir _update.*.rdy] {
+       puts yes
+       puts $file
+       set f [open $file]
+       set d [read $f]
+       close $f
+       puts [string length $d]
+       puts -nonewline $d
+    }
+    puts end
+}
+
+proc remote-serv/take {f args} {
+    global dropdir rows reqkind
+    set rows ""
+    manyset $args yesno file pirate reqkind rows
+    read_counted stdin desc
+    read_counted stdin key
+    read_counted stdin val
+    if {$yesno} {
+       read_database
+       set database($key) $val
+       write_database
+    }
+    set ar [lindex {reject approve} $yesno]
+    remote-serv-log $pirate "$ar $reqkind $rows $desc"
+    file remove $file
+}
+
+proc main/remoteserv {} {
+    global argv dropdir
+    manyset $argv dropdir
+    while 1 {
+       puts {ypp-sc-tools pctb remote-server v1}
+       if {[gets stdin l] < 0} break
+       eval remote-serv/$l
+    }
+}
+
 #========== main program ==========
 
 proc main/default {} {
@@ -731,14 +786,19 @@ proc done/automatic {} {
 proc debug {m} { }
 
 set mainkind default
+set ai 0
 foreach arg $argv {
+    incr ai
     switch -exact -- $arg {
-       {--debug}        { proc debug {m} { puts stderr "SHOW-THING $m" } }
-       {--noop-arg}     { }
-       {--automatic-1}  { set mainkind automatic }
-       {--automatic*}   { error "incompatible versions - install problem" }
-       default          { error "huh $argv ?" }
+       {--debug}           { proc debug {m} { puts stderr "SHOW-THING $m" } }
+       {--noop-arg}        { }
+       {--automatic-1}     { set mainkind automatic }
+       {--remote-server-1} { set mainkind remoteserv; break }
+       {--automatic*} - {--remote-server}
+                           { error "incompatible versions - install problem" }
+       default             { error "huh $argv ?" }
     }
 }
+set argv [lrange $argv $ai end]
 
 main/$mainkind
index 9132c4e..727b94b 100755 (executable)
@@ -30,7 +30,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/^(\w+ \- \w[-+\'\"\#! 0-9a-z]*)\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] ?";
@@ -157,8 +157,9 @@ my $path= path_info();
 my $entry_in= param('entry');
 defined $entry_in or die;
 
-my $owner= `whoami`; $? and die $?;
-chomp $owner;
+my $du=$ENV{'YPPSC_DICTUPDATES'};
+chdir $du or die "$du $!"
+    if defined $du;
 
 my $kind;
 
@@ -170,6 +171,17 @@ if ($path =~ /(pixmap|char)/) {
 
 my ($ctx,$def,$entry,$icon,$width,$whole)= &{"parseentryin__$kind"}($entry_in);
 
+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= <<END