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 fixme this has wrong arguments
 110
 111 proc async-notif-or-resp-fixed {asid l} {
 112     global current_command_asid
 113     if {![string compare $asid $current_command_asid]} {
 114         sync-reply $l
 115     } else {
 116         async-notif $asid $l
 117     }
 118 }
 119
 120 proc async-notif-creg {asid l} {
 121     set ll [llength [split $l ,]]
 122     switch -exact $ll {
 123         4 { sync-reply $l }
 124         3 {
 125             async-notif {+CREG} 2 2 $l
 126             async-notif {+CREG} 1 1 [lindex [split $l ,] 0]
 127         }
 128         2 { sync-reply $l }
 129         1 {
 130             async-notif {+CREG} 1 2 $l
 131         }
 132         default {
 133             bad-data $l "async-notif-creg $ll"
 134         }
 135     }
 136 }
 137
 138 proc async-control-max0 {c l allows} {
 139     async-control-core $c $l $allows {
 140         set wanted 0
 141     } {
 142         set tw 0
 143         manyset $ca($c) tw
 144         if {$tw} { set wanted 1 }
 145     } {
 146         set send $wanted
 147         foreach allow $allows { lappend $send [lindex $allow 0] }
 148         sync-subcommand $c "$cmd=[join $send ,]" async-updated-ok $c
 149     }
 150 }
 151
 152 proc async-control-cmer {c l allows} {
 153     async-control-core $c $l $allows {
 154         set send 0,0,0,0
 155     } {
 156         set mode 0; set ind 0
 157         manyset $ca($c) mode keyp disp ind bfr
 158         if {$mode==3 && $ind} { set send 3,0,0,1 }
 159     } {
 160         sync-subcommand $c "$cmd=$send" async-updated-ok $c
 161     }
 162 }
 163
 164 proc async-updated-ok
 165
 166 proc async-control-core {c l allows ubody_init ubody_perclient ubody_finish} {
 167     global clients
 168     uplevel 1 cmd cmd
 169     if {[regexp {^(AT[^=?])\?$} dummy cmd]} {
 170         sync-subcommand $c $cmd async-massage-result-subs $c $cmd
 171     } elseif {[regexp {^(AT[^=?])=\?$} dummy cmd]} {
 172         sync-subcommand $c $cmd async-massage-result-support $c $cmd $allows
 173     } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} dummy cmd values]} {
 174         set values [split $values ,]
 175         if {[llength $values] > [llength $allows]} {
 176             bad-command "too many values"
 177             return
 178         }
 179         while {[llength $values] < [llength $allows]} {
 180             lappend values 0
 181         }
 182         foreach val $values allow $allows {
 183             if {[lsearch -exact $allow $val]<0} {
 184                 bad-command "$val not in allowed $allow ($allows)"
 185                 return
 186             }
 187         }
 188         uplevel 1 [list upvar #0 client_async/$cmd ca]
 189         upvar #0 client_async/$cmd ca
 190         set ca($c) $values
 191         uplevel 1 $ubody_init
 192         upvar 1 c uc
 193         foreach uc [array names clients] {
 194             uplevel 1 $ubody_perclient
 195         }
 196         uplevel 1 $ubody_finish
 197     } else {
 198         bad-command "unknown async control syntax"
 199     }
 200 }
 201
 202 proc set-client-echo {c yn} {
 203     global client_echo
 204     set client_echo($c) 0
 205     client-command-complete $c OK
 206 }
 207
 208 proc sync-reply
 209
 210 proc client-command-complete
 211
 212 proc process-client-command {c nl} {
 213     switch -regexp $l {
 214         {^AT\+CREG\b} { async-control-max0 $c $l {{0 1 2}} }
 215         {^AT\+CGREG\b} { async-control-max0 $c $l {{0 1 2}} }
 216         {^AT\*ERINFO\b} { async-control-max0 $c $l {{0 1}} }
 217         {^AT\+CGEREP\b} { async-control-max0 $c $l {{0 1 2} 0} }
 218         {^AT\+CMER\b} { async-control-cmer $c $l {{0 3} 0 0 {0 1} 0} }
 219         {^ATE0$} { set-client-echo $c 0 }
 220         {^ATE1$} { set-client-echo $c 1 }
 221
 222
 223 proc dchan-line {l} {
 224     global cclient
 225     switch -regexp $l {
 226         {\+CREG:}   { async-notif-creg             +CREG     $l }
 227         {\+CGREG:}  { async-notif-creg             +CGREG    $l }
 228         {\*ERINFO:} { async-notif-or-resp-fixed    *ERINFO   $l }
 229         {\+CGEV:}   { async-notif                  +CGEREP   $l }
 230         {\+CIEV:}   { async-notif                  +CMER     $l }
 231     }
 232
 233 proc sendout-async
 234 proc logquote
 235
 236
 237 try-open-our-device