From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 19 Jan 2012 00:54:16 +0000 (+0000)
Subject: wip multiplexer
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=commitdiff_plain;h=a8b01908436d44cb090abf3766615537270ca09a;ds=sidebyside

wip multiplexer
---

diff --git a/ttyacm-multiplex b/ttyacm-multiplex
new file mode 100755
index 0000000..727edf1
--- /dev/null
+++ b/ttyacm-multiplex
@@ -0,0 +1,245 @@
+#!/usr/bin/tclsh8.4
+# -*- tcl -*-
+
+proc debug {m} { puts "DEBUG $m" }
+
+proc log {m} { puts "LOG $m" }
+
+proc experror {m} {
+    error $m {} EXPECTED
+}
+
+proc find-devices {} {
+    global errorCode errorInfo devices
+    set base /sys/class/tty
+    foreach candidate [glob -nocomplain -directory $base -tails ttyACM*] {
+	debug "candidate $candidate"
+	if {[catch { file link $base/$candidate/device } ltarget]} {
+	    debug " readlink failed [lrange $errorCode 0 1]"
+	    switch -glob $errorCode {
+		{POSIX EINVAL *} continue
+		{POSIX ENOENT *} continue
+		default { error "$ltarget \[$errorCode] $errorInfo $errorCode" }
+	    }
+	}
+	if {![regexp {^(.*)\.(\d+)$} $ltarget dummy dbase interf]} {
+	    debug " readlink bad target $ltarget"
+	    continue
+	}
+	debug " approved $dbase $interf $candidate"
+	lappend devs($dbase) [list $interf $candidate]
+    }
+    set howmany [array size devs]
+    if {!$howmany} {
+	experror "no appropriate device(s) found"
+    }
+    if {$howmany > 1} {
+	experror "several appropriate device(s) found [array names $devs]"
+    }
+    set devices {}
+    foreach dev [lsort -index 0 -integer $devs([lindex [array names devs] 0])] {
+	lappend devices [lindex $dev 1]
+    }
+}
+
+proc reopen-our-device {} {
+    global devices dchan
+    find-devices
+    set dchan [open /dev/[lindex $devices 1] r+]
+    fconfigure $dchan -blocking no -buffering line -translation {crlf cr}
+    read $dchan; # flush input
+    puts $dchan ATE0
+    flush $dchan
+    after 250
+    set result [read $dchan]
+    if {![regexp -line {^OK$} $result]} { experror "got [logquote $result]" }
+    fileevent $dchan readable dchan-readable
+}
+
+proc devfailure {emsg} {
+    global errorCode errorInfo dchan
+    switch -glob $errorCode {
+	{POSIX *} - EXPECTED {
+	    log "device failure: $emsg"
+	}
+	default {
+	    log "unexpected device failure: $emsg"
+	    foreach l [split $errorInfo "\n"] {
+		log "  $l"
+	    }
+	}
+    }
+    if {[info exists dchan]} {
+	catch { close $dchan }
+	catch { unset dchan }
+    }
+}
+
+proc try-open-our-device {} {
+    global devices
+    if {[catch {
+	reopen-our-device
+    } emsg]} {
+	devfailure $emsg
+	return
+    }
+    sendout-async *TTYATMUX "*TTYATMUXDEVS [join $devices ,]"
+    sendout-async *TTYATMUX "*TTYATMUXOPEN"
+}
+
+proc dchan-readable {args} {
+    global dchan
+    while 1 {
+	if {[catch {
+	    gets $dchan l
+	} r]} {
+	    devfailure $r
+	    return
+	}
+	if {$r<0} {
+	    if {![eof $dchan]} return
+	    set errorCode EXPECTED
+	    devfailure "eof"
+	    return
+	}
+	dchan-line $l
+    }
+}
+
+proc async-notif-or-resp-varies {async_values asid l} {
+    set ll [llength [split $l ,]]
+    if {$ll == $async_values} {
+	async-notif $asid $l
+    } elseif {$ll == $async_values+1} {
+	sync-reply $l
+    } else {
+	bad-data $l "async-notif-or-resp-varies $ll"
+    }
+}
+
+proc async-notif-or-resp-fixed {asid l} {
+    global current_command_asid
+    if {![string compare $asid $current_command_asid]} {
+	sync-reply $l
+    } else {
+	async-notif $asid $l
+    }
+}
+
+proc async-notif-creg {asid l} {
+    set ll [llength [split $l ,]]
+    switch -exact $ll {
+	4 { sync-reply $l }
+	3 { 
+	    async-notif {+CREG} 2 2 $l
+	    async-notif {+CREG} 1 1 [lindex [split $l ,] 0]
+	}
+	2 { sync-reply $l }
+	1 { 
+	    async-notif {+CREG} 1 2 $l
+	}
+	default {
+	    bad-data $l "async-notif-creg $ll"
+	}
+    }
+}
+
+proc async-control-max0 {c l allows} {
+    async-control-core $c $l $allows {
+	set wanted 0
+    } {
+	set tw 0
+	manyset $ca($c) tw
+	if {$tw} { set wanted 1 }
+    } {
+	set send $wanted
+	foreach allow $allows { lappend $send [lindex $allow 0] }
+	sync-subcommand $c "$cmd=[join $send ,]" async-updated-ok $c
+    }
+}
+
+proc async-control-cmer {c l allows} {
+    async-control-core $c $l $allows {
+	set send 0,0,0,0
+    } {
+	set mode 0; set ind 0
+	manyset $ca($c) mode keyp disp ind bfr
+	if {$mode==3 && $ind} { set send 3,0,0,1 }
+    } {
+	sync-subcommand $c "$cmd=$send" async-updated-ok $c
+    }
+}
+
+proc async-updated-ok
+
+proc async-control-core {c l allows ubody_init ubody_perclient ubody_finish} {
+    global clients
+    uplevel 1 cmd cmd
+    if {[regexp {^(AT[^=?])\?$} dummy cmd]} {
+	sync-subcommand $c $cmd async-massage-result-subs $c $cmd
+    } elseif {[regexp {^(AT[^=?])=\?$} dummy cmd]} {
+	sync-subcommand $c $cmd async-massage-result-support $c $cmd $allows
+    } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} dummy cmd values]} {
+	set values [split $values ,]
+	if {[llength $values] > [llength $allows]} {
+	    bad-command "too many values"
+	    return
+	}
+	while {[llength $values] < [llength $allows]} {
+	    lappend values 0
+	}
+	foreach val $values allow $allows {
+	    if {[lsearch -exact $allow $val]<0} {
+		bad-command "$val not in allowed $allow ($allows)"
+		return
+	    }
+	}
+	uplevel 1 [list upvar #0 client_async/$cmd ca]
+	upvar #0 client_async/$cmd ca
+	set ca($c) $values
+	uplevel 1 $ubody_init
+	upvar 1 c uc
+	foreach uc [array names clients] {
+	    uplevel 1 $ubody_perclient
+	}
+	uplevel 1 $ubody_finish
+    } else {
+	bad-command "unknown async control syntax"
+    }
+}
+
+proc set-client-echo {c yn} {
+    global client_echo
+    set client_echo($c) 0
+    client-command-complete $c OK
+}
+
+proc process-client-command {c nl} {
+    switch -regexp $l {
+	{^AT\+CREG\b} { async-control-max0 $c $l {{0 1 2}} }
+	{^AT\+CGREG\b} { async-control-max0 $c $l {{0 1 2}} }
+	{^AT\*ERINFO\b} { async-control-max0 $c $l {{0 1}} }
+	{^AT\+CGEREP\b} { async-control-max0 $c $l {{0 1 2} 0} }
+	{^AT\+CMER\b} { async-control-cmer $c $l {{0 3} 0 0 {0 1} 0} }
+	{^ATE0$} { set-client-echo $c 0 }
+	{^ATE1$} { set-client-echo $c 1 }
+    
+
+proc dchan-line {l} {
+    global cclient
+    switch -regexp $l {
+	{\+CREG:}   { async-notif-creg             +CREG   $l }
+	{\+CGREG:}  { async-notif-creg             +CGREG      $l }
+	{\*ERINFO:} { async-notif-or-resp-fixed    *ERINFO $l }
+	{\+CGEV:}   { async-notif                  +CGEREP   $l }
+
+	{\+CIEV:}   { async-notif                  +CIEV   $l }
+    }
+
+    if {[info exists cclient
+
+proc sendout-async
+proc logquote
+
+
+try-open-our-device