#!/usr/bin/tclsh8.4
# -*- tcl -*-

set expected_devs 3

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 expected_devs
    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]
    }
    if {[llength $devices] != $expected_devs} {
	experror "wrong # devices ($devices), expected $expected"
    }
}

proc create-dev-nodes {} {
    global devices expected_devs
    set ourdevs /dev/atmux
    set ttyat ttyAT
    for {set i 0} {$i < $expected_devs-1} {incr i} {
	set new $ttyAT$i
	file link -symbolic ../$device $ourdevs/.new.$new
	file rename -force $ourdevs/.new.$new $ourdevs/$new
	set wanted($new) 1
    }
    foreach candidate [glob -nocomplain -directory $ourdevs -tails ttyAT*] {
	if {![info exists wanted($candidate)]} {
	    file remove $ourdevs/$candidate
	}
    }
}

proc reopen-our-device {} {
    global devices dchan
    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 chan-readable $dchan dchan "modem device"
}

proc devices {} {
    find-devices
    create-dev-nodes
    reopen-our-device
}

proc dchan-failure {dummy} {
    global dchan
    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 trap-log {what body var} {
    global errorCode errorInfo
    upvar 1 $var result
    set rc [catch {
	uplevel 1 $body
    } result]
    switch -exact $rc {
	1 {
	    switch -glob $errorCode {
		{POSIX *} - EXPECTED { log "$what: $result" }
		default {
		    log "unexpected: $what: $result"
		    foreach l [split $errorInfo "\n"] { log "  $l" }
		}
	    }
	    return 1
	}
	0 {
	    return 0
	}
	default {
	    return -code $rc -errorinfo $errorInfo \
		-errorcode $errorCode $result
	}
    }
}

proc chan-readable {chan how what args} {
    while 1 {
	if {[trap-log "$what failure" {
	    gets $chan l
	} r]} {
	    $how-failure $chan
	    return
	}
	if {$r<0} {
	    if {![eof $chan]} return
	    log "device eof"
	    $how-failure $chan
	    return
	}
	trap-log "error processing $what data" {
	    $how-line $l
	} dummy
    }
}

proc async-notif fixme this has wrong arguments

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[^=?])\?$} $l dummy cmd]} {
	sync-subcommand $c $l async-massage-result-subs $c $cmd
    } elseif {[regexp {^(AT[^=?])=\?$} $l dummy cmd]} {
	sync-subcommand $c $l async-massage-result-support $c $cmd $allows
    } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} $l 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 simple-command {c l} {
    sync-subcommand $c $l simple-command-complete
}

proc client-command-complete

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 }
	{^AT\+CFUN\b} { simple-command $c $l }
	default { bad-command "unknown command" }
    }
}

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                  +CMER     $l }
	default     { syync-reply $l }
    }
}

proc cchan-line {c l} {
    lappend queue [list $c $l]
    check-busy
}

proc sync-subcommand {c l args} {
    global busy dchan
    if {[info exists busy]} { error "already busy $busy; want $c $l $args" }
    if {[trap-log "write device" { puts $dchan $l } dummy]} {
	

proc sync-reply {l} {
    global busy
    if {![info exists busy]} {
	bad-data $l "unexpected sync reply"
	return
    }
    eval $

proc check-busy {} {
    global busy queue
    while {![info exists busy] && [llength $queue]} {
	manyset [lindex $queue 0] c l
	set queue [lrange $queue 1 end]
	if {[trap-log "process for $c [logquote $l]"] {
	    process-client-command $c $l
	} dummy]} {
	    client-command-complete $c ERROR
	}
    }
}

proc client-command-complete {c l} {
    if {[trap-log "write to $c" { puts $c $l } dummy]} {
	client-failure $c
    }
}

proc cchan-readable {

proc sendout-async
proc logquote


try-open-our-device