X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=ttyacm-multiplex;h=bc1f914156b90d23ed3af1114af6c58d6e6a3fbe;hp=727edf172d3fe33f4e58ab3fa539b18fa584729c;hb=2e355f70ace81b18ef77f3fdc45f347326165c08;hpb=a8b01908436d44cb090abf3766615537270ca09a

diff --git a/ttyacm-multiplex b/ttyacm-multiplex
index 727edf1..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,35 +103,54 @@ 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
     }
 }
 
-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 fixme this has wrong arguments
 
 proc async-notif-or-resp-fixed {asid l} {
     global current_command_asid
@@ -175,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"
@@ -214,6 +249,12 @@ proc set-client-echo {c yn} {
     client-command-complete $c OK
 }
 
+proc simple-command {c l} {
+    sync-subcommand $c $l simple-command-complete
+}
+
+proc client-command-complete
+
 proc process-client-command {c nl} {
     switch -regexp $l {
 	{^AT\+CREG\b} { async-control-max0 $c $l {{0 1 2}} }
@@ -223,20 +264,62 @@ 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
     switch -regexp $l {
-	{\+CREG:}   { async-notif-creg             +CREG   $l }
-	{\+CGREG:}  { async-notif-creg             +CGREG      $l }
-	{\*ERINFO:} { async-notif-or-resp-fixed    *ERINFO $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                  +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
+	}
+    }
+}
 
-	{\+CIEV:}   { async-notif                  +CIEV   $l }
+proc client-command-complete {c l} {
+    if {[trap-log "write to $c" { puts $c $l } dummy]} {
+	client-failure $c
     }
+}
 
-    if {[info exists cclient
+proc cchan-readable {
 
 proc sendout-async
 proc logquote