chiark / gitweb /
wip multiplexer
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Thu, 19 Jan 2012 20:28:20 +0000 (20:28 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Thu, 19 Jan 2012 20:28:20 +0000 (20:28 +0000)
ttyacm-multiplex

index cdb4638..bc1f914 100755 (executable)
@@ -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