ttyacm-multiplex

   1 #!/usr/bin/tclsh8.4
   2 # -*- tcl -*-
   3
   4 proc debug {m} { puts "DEBUG $m" }
   5
   6 proc log {m} { puts "LOG $m" }
   7
   8 proc experror {m} {
   9     error $m {} EXPECTED
  10 }
  11
  12 proc find-devices {} {
  13     global errorCode errorInfo devices
  14     set base /sys/class/tty
  15     foreach candidate [glob -nocomplain -directory $base -tails ttyACM*] {
  16         debug "candidate $candidate"
  17         if {[catch { file link $base/$candidate/device } ltarget]} {
  18             debug " readlink failed [lrange $errorCode 0 1]"
  19             switch -glob $errorCode {
  20                 {POSIX EINVAL *} continue
  21                 {POSIX ENOENT *} continue
  22                 default { error "$ltarget \[$errorCode] $errorInfo $errorCode" }
  23             }
  24         }
  25         if {![regexp {^(.*)\.(\d+)$} $ltarget dummy dbase interf]} {
  26             debug " readlink bad target $ltarget"
  27             continue
  28         }
  29         debug " approved $dbase $interf $candidate"
  30         lappend devs($dbase) [list $interf $candidate]
  31     }
  32     set howmany [array size devs]
  33     if {!$howmany} {
  34         experror "no appropriate device(s) found"
  35     }
  36     if {$howmany > 1} {
  37         experror "several appropriate device(s) found [array names $devs]"
  38     }
  39     set devices {}
  40     foreach dev [lsort -index 0 -integer $devs([lindex [array names devs] 0])] {
  41         lappend devices [lindex $dev 1]
  42     }
  43 }
  44
  45 proc reopen-our-device {} {
  46     global devices dchan
  47     find-devices
  48     set dchan [open /dev/[lindex $devices 1] r+]
  49     fconfigure $dchan -blocking no -buffering line -translation {crlf cr}
  50     read $dchan; # flush input
  51     puts $dchan ATE0
  52     flush $dchan
  53     after 250
  54     set result [read $dchan]
  55     if {![regexp -line {^OK$} $result]} { experror "got [logquote $result]" }
  56     fileevent $dchan readable dchan-readable
  57 }
  58
  59 proc devfailure {emsg} {
  60     global errorCode errorInfo dchan
  61     switch -glob $errorCode {
  62         {POSIX *} - EXPECTED {
  63             log "device failure: $emsg"
  64         }
  65         default {
  66             log "unexpected device failure: $emsg"
  67             foreach l [split $errorInfo "\n"] {
  68                 log "  $l"
  69             }
  70         }
  71     }
  72     if {[info exists dchan]} {
  73         catch { close $dchan }
  74         catch { unset dchan }
  75     }
  76 }
  77
  78 proc try-open-our-device {} {
  79     global devices
  80     if {[catch {
  81         reopen-our-device
  82     } emsg]} {
  83         devfailure $emsg
  84         return
  85     }
  86     sendout-async *TTYATMUX "*TTYATMUXDEVS [join $devices ,]"
  87     sendout-async *TTYATMUX "*TTYATMUXOPEN"
  88 }
  89
  90 proc dchan-readable {args} {
  91     global dchan
  92     while 1 {
  93         if {[catch {
  94             gets $dchan l
  95         } r]} {
  96             devfailure $r
  97             return
  98         }
  99         if {$r<0} {
 100             if {![eof $dchan]} return
 101             set errorCode EXPECTED
 102             devfailure "eof"
 103             return
 104         }
 105         dchan-line $l
 106     }
 107 }
 108
 109 proc async-notif-or-resp-varies {async_values asid l} {
 110     set ll [llength [split $l ,]]
 111     if {$ll == $async_values} {
 112         async-notif $asid $l
 113     } elseif {$ll == $async_values+1} {
 114         sync-reply $l
 115     } else {
 116         bad-data $l "async-notif-or-resp-varies $ll"
 117     }
 118 }
 119
 120 proc async-notif-or-resp-fixed {asid l} {
 121     global current_command_asid
 122     if {![string compare $asid $current_command_asid]} {
 123         sync-reply $l
 124     } else {
 125         async-notif $asid $l
 126     }
 127 }
 128
 129 proc async-notif-creg {asid l} {
 130     set ll [llength [split $l ,]]
 131     switch -exact $ll {
 132         4 { sync-reply $l }
 133         3 {
 134             async-notif {+CREG} 2 2 $l
 135             async-notif {+CREG} 1 1 [lindex [split $l ,] 0]
 136         }
 137         2 { sync-reply $l }
 138         1 {
 139             async-notif {+CREG} 1 2 $l
 140         }
 141         default {
 142             bad-data $l "async-notif-creg $ll"
 143         }
 144     }
 145 }
 146
 147 proc async-control-max0 {c l allows} {
 148     async-control-core $c $l $allows {
 149         set wanted 0
 150     } {
 151         set tw 0
 152         manyset $ca($c) tw
 153         if {$tw} { set wanted 1 }
 154     } {
 155         set send $wanted
 156         foreach allow $allows { lappend $send [lindex $allow 0] }
 157         sync-subcommand $c "$cmd=[join $send ,]" async-updated-ok $c
 158     }
 159 }
 160
 161 proc async-control-cmer {c l allows} {
 162     async-control-core $c $l $allows {
 163         set send 0,0,0,0
 164     } {
 165         set mode 0; set ind 0
 166         manyset $ca($c) mode keyp disp ind bfr
 167         if {$mode==3 && $ind} { set send 3,0,0,1 }
 168     } {
 169         sync-subcommand $c "$cmd=$send" async-updated-ok $c
 170     }
 171 }
 172
 173 proc async-updated-ok
 174
 175 proc async-control-core {c l allows ubody_init ubody_perclient ubody_finish} {
 176     global clients
 177     uplevel 1 cmd cmd
 178     if {[regexp {^(AT[^=?])\?$} dummy cmd]} {
 179         sync-subcommand $c $cmd async-massage-result-subs $c $cmd
 180     } elseif {[regexp {^(AT[^=?])=\?$} dummy cmd]} {
 181         sync-subcommand $c $cmd async-massage-result-support $c $cmd $allows
 182     } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} dummy cmd values]} {
 183         set values [split $values ,]
 184         if {[llength $values] > [llength $allows]} {
 185             bad-command "too many values"
 186             return
 187         }
 188         while {[llength $values] < [llength $allows]} {
 189             lappend values 0
 190         }
 191         foreach val $values allow $allows {
 192             if {[lsearch -exact $allow $val]<0} {
 193                 bad-command "$val not in allowed $allow ($allows)"
 194                 return
 195             }
 196         }
 197         uplevel 1 [list upvar #0 client_async/$cmd ca]
 198         upvar #0 client_async/$cmd ca
 199         set ca($c) $values
 200         uplevel 1 $ubody_init
 201         upvar 1 c uc
 202         foreach uc [array names clients] {
 203             uplevel 1 $ubody_perclient
 204         }
 205         uplevel 1 $ubody_finish
 206     } else {
 207         bad-command "unknown async control syntax"
 208     }
 209 }
 210
 211 proc set-client-echo {c yn} {
 212     global client_echo
 213     set client_echo($c) 0
 214     client-command-complete $c OK
 215 }
 216
 217 proc process-client-command {c nl} {
 218     switch -regexp $l {
 219         {^AT\+CREG\b} { async-control-max0 $c $l {{0 1 2}} }
 220         {^AT\+CGREG\b} { async-control-max0 $c $l {{0 1 2}} }
 221         {^AT\*ERINFO\b} { async-control-max0 $c $l {{0 1}} }
 222         {^AT\+CGEREP\b} { async-control-max0 $c $l {{0 1 2} 0} }
 223         {^AT\+CMER\b} { async-control-cmer $c $l {{0 3} 0 0 {0 1} 0} }
 224         {^ATE0$} { set-client-echo $c 0 }
 225         {^ATE1$} { set-client-echo $c 1 }
 226
 227
 228 proc dchan-line {l} {
 229     global cclient
 230     switch -regexp $l {
 231         {\+CREG:}   { async-notif-creg             +CREG   $l }
 232         {\+CGREG:}  { async-notif-creg             +CGREG      $l }
 233         {\*ERINFO:} { async-notif-or-resp-fixed    *ERINFO $l }
 234         {\+CGEV:}   { async-notif                  +CGEREP   $l }
 235
 236         {\+CIEV:}   { async-notif                  +CIEV   $l }
 237     }
 238
 239     if {[info exists cclient
 240
 241 proc sendout-async
 242 proc logquote
 243
 244
 245 try-open-our-device