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
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 {} {
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