#! /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
	}
}
