ttyacm-multiplex

   1 #!/usr/bin/tclsh8.4
   2 # -*- tcl -*-
   3
   4 set expected_devs 3
   5
   6 proc debug {m} { puts "DEBUG $m" }
   7
   8 proc log {m} { puts "LOG $m" }
   9
  10 proc experror {m} {
  11     error $m {} EXPECTED
  12 }
  13
  14 proc find-devices {} {
  15     global errorCode errorInfo devices expected_devs
  16     set base /sys/class/tty
  17     foreach candidate [glob -nocomplain -directory $base -tails ttyACM*] {
  18         debug "candidate $candidate"
  19         if {[catch { file link $base/$candidate/device } ltarget]} {
  20             debug " readlink failed [lrange $errorCode 0 1]"
  21             switch -glob $errorCode {
  22                 {POSIX EINVAL *} continue
  23                 {POSIX ENOENT *} continue
  24                 default { error "$ltarget \[$errorCode] $errorInfo $errorCode" }
  25             }
  26         }
  27         if {![regexp {^(.*)\.(\d+)$} $ltarget dummy dbase interf]} {
  28             debug " readlink bad target $ltarget"
  29             continue
  30         }
  31         debug " approved $dbase $interf $candidate"
  32         lappend devs($dbase) [list $interf $candidate]
  33     }
  34     set howmany [array size devs]
  35     if {!$howmany} {
  36         experror "no appropriate device(s) found"
  37     }
  38     if {$howmany > 1} {
  39         experror "several appropriate device(s) found [array names $devs]"
  40     }
  41     set devices {}
  42     foreach dev [lsort -index 0 -integer $devs([lindex [array names devs] 0])] {
  43         lappend devices [lindex $dev 1]
  44     }
  45     if {[llength $devices] != $expected_devs} {
  46         experror "wrong # devices ($devices), expected $expected"
  47     }
  48 }
  49
  50 proc create-dev-nodes {} {
  51     global devices expected_devs
  52     set ourdevs /dev/atmux
  53     set ttyat ttyAT
  54     for {set i 0} {$i < $expected_devs-1} {incr i} {
  55         set new $ttyAT$i
  56         file link -symbolic ../$device $ourdevs/.new.$new
  57         file rename -force $ourdevs/.new.$new $ourdevs/$new
  58         set wanted($new) 1
  59     }
  60     foreach candidate [glob -nocomplain -directory $ourdevs -tails ttyAT*] {
  61         if {![info exists wanted($candidate)]} {
  62             file remove $ourdevs/$candidate
  63         }
  64     }
  65 }
  66
  67 proc reopen-our-device {} {
  68     global devices dchan
  69     set dchan [open /dev/[lindex $devices 1] r+]
  70     fconfigure $dchan -blocking no -buffering line -translation {crlf cr}
  71     read $dchan; # flush input
  72     puts $dchan ATE0
  73     flush $dchan
  74     after 250
  75     set result [read $dchan]
  76     if {![regexp -line {^OK$} $result]} { experror "got [logquote $result]" }
  77     fileevent $dchan readable chan-readable $dchan dchan "modem device"
  78 }
  79
  80 proc devices {} {
  81     find-devices
  82     create-dev-nodes
  83     reopen-our-device
  84 }
  85
  86 proc dchan-failure {dummy} {
  87     global dchan
  88     if {[info exists dchan]} {
  89         catch { close $dchan }
  90         catch { unset dchan }
  91     }
  92 }
  93
  94 proc try-open-our-device {} {
  95     global devices
  96     if {[catch {
  97         reopen-our-device
  98     } emsg]} {
  99         devfailure $emsg
 100         return
 101     }
 102     sendout-async *TTYATMUX "*TTYATMUXDEVS [join $devices ,]"
 103     sendout-async *TTYATMUX "*TTYATMUXOPEN"
 104 }
 105
 106 proc trap-log {what body var} {
 107     global errorCode errorInfo
 108     upvar 1 $var result
 109     set rc [catch {
 110         uplevel 1 $body
 111     } result]
 112     switch -exact $rc {
 113         1 {
 114             switch -glob $errorCode {
 115                 {POSIX *} - EXPECTED { log "$what: $result" }
 116                 default {
 117                     log "unexpected: $what: $result"
 118                     foreach l [split $errorInfo "\n"] { log "  $l" }
 119                 }
 120             }
 121             return 1
 122         }
 123         0 {
 124             return 0
 125         }
 126         default {
 127             return -code $rc -errorinfo $errorInfo \
 128                 -errorcode $errorCode $result
 129         }
 130     }
 131 }
 132
 133 proc chan-readable {chan how what args} {
 134     while 1 {
 135         if {[trap-log "$what failure" {
 136             gets $chan l
 137         } r]} {
 138             $how-failure $chan
 139             return
 140         }
 141         if {$r<0} {
 142             if {![eof $chan]} return
 143             log "device eof"
 144             $how-failure $chan
 145             return
 146         }
 147         trap-log "error processing $what data" {
 148             $how-line $l
 149         } dummy
 150     }
 151 }
 152
 153 proc async-notif fixme this has wrong arguments
 154
 155 proc async-notif-or-resp-fixed {asid l} {
 156     global current_command_asid
 157     if {![string compare $asid $current_command_asid]} {
 158         sync-reply $l
 159     } else {
 160         async-notif $asid $l
 161     }
 162 }
 163
 164 proc async-notif-creg {asid l} {
 165     set ll [llength [split $l ,]]
 166     switch -exact $ll {
 167         4 { sync-reply $l }
 168         3 {
 169             async-notif {+CREG} 2 2 $l
 170             async-notif {+CREG} 1 1 [lindex [split $l ,] 0]
 171         }
 172         2 { sync-reply $l }
 173         1 {
 174             async-notif {+CREG} 1 2 $l
 175         }
 176         default {
 177             bad-data $l "async-notif-creg $ll"
 178         }
 179     }
 180 }
 181
 182 proc async-control-max0 {c l allows} {
 183     async-control-core $c $l $allows {
 184         set wanted 0
 185     } {
 186         set tw 0
 187         manyset $ca($c) tw
 188         if {$tw} { set wanted 1 }
 189     } {
 190         set send $wanted
 191         foreach allow $allows { lappend $send [lindex $allow 0] }
 192         sync-subcommand $c "$cmd=[join $send ,]" async-updated-ok $c
 193     }
 194 }
 195
 196 proc async-control-cmer {c l allows} {
 197     async-control-core $c $l $allows {
 198         set send 0,0,0,0
 199     } {
 200         set mode 0; set ind 0
 201         manyset $ca($c) mode keyp disp ind bfr
 202         if {$mode==3 && $ind} { set send 3,0,0,1 }
 203     } {
 204         sync-subcommand $c "$cmd=$send" async-updated-ok $c
 205     }
 206 }
 207
 208 proc async-updated-ok
 209
 210 proc async-control-core {c l allows ubody_init ubody_perclient ubody_finish} {
 211     global clients
 212     uplevel 1 cmd cmd
 213     if {[regexp {^(AT[^=?])\?$} $l dummy cmd]} {
 214         sync-subcommand $c $l async-massage-result-subs $c $cmd
 215     } elseif {[regexp {^(AT[^=?])=\?$} $l dummy cmd]} {
 216         sync-subcommand $c $l async-massage-result-support $c $cmd $allows
 217     } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} $l dummy cmd values]} {
 218         set values [split $values ,]
 219         if {[llength $values] > [llength $allows]} {
 220             bad-command "too many values"
 221             return
 222         }
 223         while {[llength $values] < [llength $allows]} {
 224             lappend values 0
 225         }
 226         foreach val $values allow $allows {
 227             if {[lsearch -exact $allow $val]<0} {
 228                 bad-command "$val not in allowed $allow ($allows)"
 229                 return
 230             }
 231         }
 232         uplevel 1 [list upvar #0 client_async/$cmd ca]
 233         upvar #0 client_async/$cmd ca
 234         set ca($c) $values
 235         uplevel 1 $ubody_init
 236         upvar 1 c uc
 237         foreach uc [array names clients] {
 238             uplevel 1 $ubody_perclient
 239         }
 240         uplevel 1 $ubody_finish
 241     } else {
 242         bad-command "unknown async control syntax"
 243     }
 244 }
 245
 246 proc set-client-echo {c yn} {
 247     global client_echo
 248     set client_echo($c) 0
 249     client-command-complete $c OK
 250 }
 251
 252 proc simple-command {c l} {
 253     sync-subcommand $c $l simple-command-complete
 254 }
 255
 256 proc client-command-complete
 257
 258 proc process-client-command {c nl} {
 259     switch -regexp $l {
 260         {^AT\+CREG\b} { async-control-max0 $c $l {{0 1 2}} }
 261         {^AT\+CGREG\b} { async-control-max0 $c $l {{0 1 2}} }
 262         {^AT\*ERINFO\b} { async-control-max0 $c $l {{0 1}} }
 263         {^AT\+CGEREP\b} { async-control-max0 $c $l {{0 1 2} 0} }
 264         {^AT\+CMER\b} { async-control-cmer $c $l {{0 3} 0 0 {0 1} 0} }
 265         {^ATE0$} { set-client-echo $c 0 }
 266         {^ATE1$} { set-client-echo $c 1 }
 267         {^AT\+CFUN\b} { simple-command $c $l }
 268         default { bad-command "unknown command" }
 269     }
 270 }
 271
 272 proc dchan-line {l} {
 273     global cclient
 274     switch -regexp $l {
 275         {\+CREG:}   { async-notif-creg             +CREG     $l }
 276         {\+CGREG:}  { async-notif-creg             +CGREG    $l }
 277         {\*ERINFO:} { async-notif-or-resp-fixed    *ERINFO   $l }
 278         {\+CGEV:}   { async-notif                  +CGEREP   $l }
 279         {\+CIEV:}   { async-notif                  +CMER     $l }
 280         default     { syync-reply $l }
 281     }
 282 }
 283
 284 proc cchan-line {c l} {
 285     lappend queue [list $c $l]
 286     check-busy
 287 }
 288
 289 proc sync-subcommand {c l args} {
 290     global busy dchan
 291     if {[info exists busy]} { error "already busy $busy; want $c $l $args" }
 292     if {[trap-log "write device" { puts $dchan $l } dummy]} {
 293
 294
 295 proc sync-reply {l} {
 296     global busy
 297     if {![info exists busy]} {
 298         bad-data $l "unexpected sync reply"
 299         return
 300     }
 301     eval $
 302
 303 proc check-busy {} {
 304     global busy queue
 305     while {![info exists busy] && [llength $queue]} {
 306         manyset [lindex $queue 0] c l
 307         set queue [lrange $queue 1 end]
 308         if {[trap-log "process for $c [logquote $l]"] {
 309             process-client-command $c $l
 310         } dummy]} {
 311             client-command-complete $c ERROR
 312         }
 313     }
 314 }
 315
 316 proc client-command-complete {c l} {
 317     if {[trap-log "write to $c" { puts $c $l } dummy]} {
 318         client-failure $c
 319     }
 320 }
 321
 322 proc cchan-readable {
 323
 324 proc sendout-async
 325 proc logquote
 326
 327
 328 try-open-our-device