#!/usr/bin/tclsh8.4 # -*- tcl -*- proc debug {m} { puts "DEBUG $m" } proc log {m} { puts "LOG $m" } proc experror {m} { error $m {} EXPECTED } proc find-devices {} { global errorCode errorInfo devices set base /sys/class/tty foreach candidate [glob -nocomplain -directory $base -tails ttyACM*] { debug "candidate $candidate" if {[catch { file link $base/$candidate/device } ltarget]} { debug " readlink failed [lrange $errorCode 0 1]" switch -glob $errorCode { {POSIX EINVAL *} continue {POSIX ENOENT *} continue default { error "$ltarget \[$errorCode] $errorInfo $errorCode" } } } if {![regexp {^(.*)\.(\d+)$} $ltarget dummy dbase interf]} { debug " readlink bad target $ltarget" continue } debug " approved $dbase $interf $candidate" lappend devs($dbase) [list $interf $candidate] } set howmany [array size devs] if {!$howmany} { experror "no appropriate device(s) found" } if {$howmany > 1} { experror "several appropriate device(s) found [array names $devs]" } set devices {} foreach dev [lsort -index 0 -integer $devs([lindex [array names devs] 0])] { lappend devices [lindex $dev 1] } } 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 puts $dchan ATE0 flush $dchan after 250 set result [read $dchan] if {![regexp -line {^OK$} $result]} { experror "got [logquote $result]" } fileevent $dchan readable dchan-readable } 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" } } } if {[info exists dchan]} { catch { close $dchan } catch { unset dchan } } } proc try-open-our-device {} { global devices if {[catch { reopen-our-device } emsg]} { devfailure $emsg return } sendout-async *TTYATMUX "*TTYATMUXDEVS [join $devices ,]" sendout-async *TTYATMUX "*TTYATMUXOPEN" } proc dchan-readable {args} { global dchan while 1 { if {[catch { gets $dchan l } r]} { devfailure $r return } if {$r<0} { if {![eof $dchan]} return set errorCode EXPECTED devfailure "eof" return } dchan-line $l } } 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-or-resp-fixed {asid l} { global current_command_asid if {![string compare $asid $current_command_asid]} { sync-reply $l } else { async-notif $asid $l } } proc async-notif-creg {asid l} { set ll [llength [split $l ,]] switch -exact $ll { 4 { sync-reply $l } 3 { async-notif {+CREG} 2 2 $l async-notif {+CREG} 1 1 [lindex [split $l ,] 0] } 2 { sync-reply $l } 1 { async-notif {+CREG} 1 2 $l } default { bad-data $l "async-notif-creg $ll" } } } proc async-control-max0 {c l allows} { async-control-core $c $l $allows { set wanted 0 } { set tw 0 manyset $ca($c) tw if {$tw} { set wanted 1 } } { set send $wanted foreach allow $allows { lappend $send [lindex $allow 0] } sync-subcommand $c "$cmd=[join $send ,]" async-updated-ok $c } } proc async-control-cmer {c l allows} { async-control-core $c $l $allows { set send 0,0,0,0 } { set mode 0; set ind 0 manyset $ca($c) mode keyp disp ind bfr if {$mode==3 && $ind} { set send 3,0,0,1 } } { sync-subcommand $c "$cmd=$send" async-updated-ok $c } } 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]} { set values [split $values ,] if {[llength $values] > [llength $allows]} { bad-command "too many values" return } while {[llength $values] < [llength $allows]} { lappend values 0 } foreach val $values allow $allows { if {[lsearch -exact $allow $val]<0} { bad-command "$val not in allowed $allow ($allows)" return } } uplevel 1 [list upvar #0 client_async/$cmd ca] upvar #0 client_async/$cmd ca set ca($c) $values uplevel 1 $ubody_init upvar 1 c uc foreach uc [array names clients] { uplevel 1 $ubody_perclient } uplevel 1 $ubody_finish } else { bad-command "unknown async control syntax" } } proc set-client-echo {c yn} { global client_echo set client_echo($c) 0 client-command-complete $c OK } proc process-client-command {c nl} { switch -regexp $l { {^AT\+CREG\b} { async-control-max0 $c $l {{0 1 2}} } {^AT\+CGREG\b} { async-control-max0 $c $l {{0 1 2}} } {^AT\*ERINFO\b} { async-control-max0 $c $l {{0 1}} } {^AT\+CGEREP\b} { async-control-max0 $c $l {{0 1 2} 0} } {^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 } 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 } {\+CGEV:} { async-notif +CGEREP $l } {\+CIEV:} { async-notif +CIEV $l } } if {[info exists cclient proc sendout-async proc logquote try-open-our-device