#! /usr/bin/env tclsh
namespace eval lGrLMS60bip3LjM8MIrkFuV#0uR4sikAcVh@W#V# {
namespace eval [info cmdcount] {
package require {ycl proc}
[yclprefix] proc alias alias [yclprefix] proc alias
alias aliases [yclprefix] proc aliases
aliases {
{ycl chan chan} {
command
}
{ycl dict deep}
{ycl dict} {
ddict deep
}
{ycl keep keep}
{ycl list} {
take
}
{ycl proc} {
optswitch
}
{ycl string printable}
}
package require pki
proc listen args {
#package require tls
dict size $args
set serverargs {}
foreach {opt val} $args {
switch $opt {
port {
set port $val
}
default {
error [list {unknown option} $opt]
}
}
}
#set chan [tls::socket -server [list $_ serve] $port]
set chan [socket -server [list [
info coroutine]] {*}$serverargs $port]
set sockets [chan configure $chan -sockname]
puts [list listening sockets $sockets]
accept
}
proc accept {} {
while 1 {
lassign [yieldto return -level 0] chan host port
puts [list request from host $host port $port chan $chan]
set count [command $chan command]
if {$count < 0 && [eof $chan]} {
break
}
puts [list received command [printable ascii 0 $command]]
lassign $command[set command {}] header command
if {[dict exists $header encrypted]} {
set encrypted 1
set key [keep pkikey]
set command [keep decrypt -unpad -binary -priv $command[set command {}] $key]
puts [list decrypted [printable ascii 0 $command]]
lassign $command[set command {}] header1 command
} else {
set encrypted 0
}
catch {keep dispatch {*}$command} cres copts
ddict set rheader counter [keep counter]
set response [list $rheader [list $cres[set cres {}] $copts[
set copts {}]]]
if {$encrypted} {
puts [list encrypting response]
ddict set rheader2 encrypted 1
set response [list $rheader2 [
keep encrypt -pad -binary -priv $response $key]]
}
puts [list responding chan $chan [printable $response]]
puts $chan [list $response]
flush $chan
}
}
proc main_coro {argv argv0} {
yield [info coroutine]
set listenargs {}
while {[llength $argv]} {
take argv arg
optswitch $arg {
keep {
take argv keep
}
port {
take argv port
}
}
}
[yclprefix] keep keep .new [namespace current]::keep
puts [list initializing keep]
keep .init workdir $keep
keep pkikey
puts [list done initializing]
if {![info exists port]} {
set port [dict get [keep defaults] listen port]
}
lappend listenargs port $port
listen {*}$listenargs
}
set coroutine [coroutine main main_coro $argv $argv0]
after 0 [list $coroutine]
vwait [namespace current]::status
exit $status
}
}