ttyacm-multiplex

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