From 2bd5a59bf618766427eff5e1bc4ebd00eb74ed6c Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 19 Jan 2012 20:28:20 +0000 Subject: [PATCH] wip multiplexer --- ttyacm-multiplex | 155 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 123 insertions(+), 32 deletions(-) diff --git a/ttyacm-multiplex b/ttyacm-multiplex index cdb4638..bc1f914 100755 --- a/ttyacm-multiplex +++ b/ttyacm-multiplex @@ -1,6 +1,8 @@ #!/usr/bin/tclsh8.4 # -*- tcl -*- +set expected_devs 3 + proc debug {m} { puts "DEBUG $m" } proc log {m} { puts "LOG $m" } @@ -10,7 +12,7 @@ proc experror {m} { } proc find-devices {} { - global errorCode errorInfo devices + global errorCode errorInfo devices expected_devs set base /sys/class/tty foreach candidate [glob -nocomplain -directory $base -tails ttyACM*] { debug "candidate $candidate" @@ -40,11 +42,30 @@ proc find-devices {} { foreach dev [lsort -index 0 -integer $devs([lindex [array names devs] 0])] { lappend devices [lindex $dev 1] } + if {[llength $devices] != $expected_devs} { + experror "wrong # devices ($devices), expected $expected" + } +} + +proc create-dev-nodes {} { + global devices expected_devs + set ourdevs /dev/atmux + set ttyat ttyAT + for {set i 0} {$i < $expected_devs-1} {incr i} { + set new $ttyAT$i + file link -symbolic ../$device $ourdevs/.new.$new + file rename -force $ourdevs/.new.$new $ourdevs/$new + set wanted($new) 1 + } + foreach candidate [glob -nocomplain -directory $ourdevs -tails ttyAT*] { + if {![info exists wanted($candidate)]} { + file remove $ourdevs/$candidate + } + } } 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 @@ -53,22 +74,17 @@ proc reopen-our-device {} { after 250 set result [read $dchan] if {![regexp -line {^OK$} $result]} { experror "got [logquote $result]" } - fileevent $dchan readable dchan-readable + fileevent $dchan readable chan-readable $dchan dchan "modem device" } -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" - } - } - } +proc devices {} { + find-devices + create-dev-nodes + reopen-our-device +} + +proc dchan-failure {dummy} { + global dchan if {[info exists dchan]} { catch { close $dchan } catch { unset dchan } @@ -87,22 +103,50 @@ proc try-open-our-device {} { sendout-async *TTYATMUX "*TTYATMUXOPEN" } -proc dchan-readable {args} { - global dchan +proc trap-log {what body var} { + global errorCode errorInfo + upvar 1 $var result + set rc [catch { + uplevel 1 $body + } result] + switch -exact $rc { + 1 { + switch -glob $errorCode { + {POSIX *} - EXPECTED { log "$what: $result" } + default { + log "unexpected: $what: $result" + foreach l [split $errorInfo "\n"] { log " $l" } + } + } + return 1 + } + 0 { + return 0 + } + default { + return -code $rc -errorinfo $errorInfo \ + -errorcode $errorCode $result + } + } +} + +proc chan-readable {chan how what args} { while 1 { - if {[catch { - gets $dchan l + if {[trap-log "$what failure" { + gets $chan l } r]} { - devfailure $r + $how-failure $chan return } if {$r<0} { - if {![eof $dchan]} return - set errorCode EXPECTED - devfailure "eof" + if {![eof $chan]} return + log "device eof" + $how-failure $chan return } - dchan-line $l + trap-log "error processing $what data" { + $how-line $l + } dummy } } @@ -166,11 +210,11 @@ 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]} { + if {[regexp {^(AT[^=?])\?$} $l dummy cmd]} { + sync-subcommand $c $l async-massage-result-subs $c $cmd + } elseif {[regexp {^(AT[^=?])=\?$} $l dummy cmd]} { + sync-subcommand $c $l async-massage-result-support $c $cmd $allows + } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} $l dummy cmd values]} { set values [split $values ,] if {[llength $values] > [llength $allows]} { bad-command "too many values" @@ -205,7 +249,9 @@ proc set-client-echo {c yn} { client-command-complete $c OK } -proc sync-reply +proc simple-command {c l} { + sync-subcommand $c $l simple-command-complete +} proc client-command-complete @@ -218,7 +264,10 @@ proc process-client-command {c nl} { {^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 } - + {^AT\+CFUN\b} { simple-command $c $l } + default { bad-command "unknown command" } + } +} proc dchan-line {l} { global cclient @@ -228,7 +277,49 @@ proc dchan-line {l} { {\*ERINFO:} { async-notif-or-resp-fixed *ERINFO $l } {\+CGEV:} { async-notif +CGEREP $l } {\+CIEV:} { async-notif +CMER $l } + default { syync-reply $l } + } +} + +proc cchan-line {c l} { + lappend queue [list $c $l] + check-busy +} + +proc sync-subcommand {c l args} { + global busy dchan + if {[info exists busy]} { error "already busy $busy; want $c $l $args" } + if {[trap-log "write device" { puts $dchan $l } dummy]} { + + +proc sync-reply {l} { + global busy + if {![info exists busy]} { + bad-data $l "unexpected sync reply" + return + } + eval $ + +proc check-busy {} { + global busy queue + while {![info exists busy] && [llength $queue]} { + manyset [lindex $queue 0] c l + set queue [lrange $queue 1 end] + if {[trap-log "process for $c [logquote $l]"] { + process-client-command $c $l + } dummy]} { + client-command-complete $c ERROR + } } +} + +proc client-command-complete {c l} { + if {[trap-log "write to $c" { puts $c $l } dummy]} { + client-failure $c + } +} + +proc cchan-readable { proc sendout-async proc logquote -- 2.30.2