JMeh 13 Jul 2017 - SerWatch (Serial Watcher)
SerWatch is a little Tcl library for analyzing protocols over a serial line.
I often have to connect serial devices like scales, PD controller or several testing machines and therefore I wrote this library. You have to make a serial adapter which has to be connected with both communication partners. Both serial data lines (TxD and RxD) must be connected to each of the RxD line of two additional serial adapters in your PC. I use USB virtual COM port adapters for my Mac. Here is a little schematic:
DB-25(f) DB-25(m)
2 -----*---------------- 2 TxD
3 -----|----------*----- 3 RxD
4 -----|----------|----- 4 RTS
5 -----|----------|----- 5 CTS
6 -----|----------|----- 6 DSR
7 -----|--*----*--|----- 7 GND
8 -----|--|----|--|----- 8 DCD
20 -----|--|----|--|----- 20 DTR
| | | |
| | | |
| | | |
DB-9(f) | | | | DB-9(f)
2 -----+ | | +----- 2 RxD
5 --------+ +-------- 5 GND
7 --\ /-- 7 RTS
8 --/ \-- 8 CTS
1 --\ /-- 1 DCD
4 --+ +-- 4 DTR
6 --/ \-- 6 DSRThen you can write a little Tcl script to use SerWatch like this:
package require Serwatch
Serwatch::Init -tty1 /dev/cu.usbserial-FTGZMSMJ -tty2 /dev/cu.usbserial-FTGZMTOX -hex no \
-baud 9600,e,8,2 -win . -log impact450.log -tout 5000I think, the parameters are self explained.
This shows in the main window what's going on, if the serial mode parameter is correct :-) and also writes all lines to the given log file.
Here is an example of a typical log:
09:59:02.000 INIT Serwatch
09:59:02.016 tty1 = /dev/ttyUSB0
09:59:02.016 tty2 = /dev/ttyUSB1
09:59:02.016 baud = 9600,e,7,1
09:59:02.031 tty1 OK (file5 = <-) -- reading input
09:59:02.043 tty2 OK (file6 = ->) -- reading input
10:03:30.648 <- ␂ U M ; T I P U 1 5 1 5 3 9 1 ␣ ␣ ␣ ␣ ; ␃ ␊ ␍
10:03:31.669 -> ␂ 0 0 A 0 0 0 1 ␃ ␊ ␍
10:03:31.880 <- ␊ ␍
10:03:36.885 timeout
10:03:44.262 <- ␂ U M ; B 0 0 0 1 ␣ ␣ ␣ ␣ ␣ ; ␃ ␊ ␍ ␣
10:03:45.298 -> ␂ 0 0 ␃ ␊ ␍
10:03:45.477 <- ␊ ␍
10:03:50.478 timeout
10:05:15.591 <- ␂ C B ; T I P U 1 5 1 5 3 9 1 ␣ ␣ ␣ ␣ ; ␃ ␊ ␍
10:05:16.628 -> ␂ 0 0 B 0 0 0 1 ␃ ␊ ␍
10:05:16.823 <- ␊ ␍
10:05:21.824 timeout
10:05:26.214 <- ␂ C B ; B 0 0 0 1 ␣ ␣ ␣ ␣ ␣ ␣ ; ␃ ␊ ␍
10:05:27.234 -> ␂ 0 0 ␃ ␊ ␍
10:05:27.413 <- ␊ ␍
10:05:32.417 timeout
10:05:41.011 <- ␂ C B ; 2 4 1 1 1 1 1 1 ; ␃ ␊ ␍
10:05:42.032 -> ␂ 0 0 ␃ ␊ ␍
10:05:42.211 <- ␊ ␍
10:05:47.214 timeout
10:05:54.513 <- ␂ C B ; S E E D ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ␣ ; ␃
10:05:55.550 -> ␂ 0 0 ␃ ␊ ␍
10:05:55.713 <- ␊ ␍
10:06:00.719 timeout
10:06:04.143 <- ␂ C B ; B ␣ ␣ ; ␃ ␊ ␍
10:06:05.180 -> ␂ 0 0 ␃ ␊ ␍
10:06:05.343 <- ␊ ␍
10:06:10.344 timeout
The library is tested on macos X, Linux and Windows.
And here is the source:
#
# Serial Watcher (serwatch)
# =========================
#
# Beobachtung zweier serieller Schnittstellen zur Analyse des Datenverkehrs
# zwischen zwei Geräten. Dazu muß ein doppel-T Kabel angefertigt werden:
#
# DB-25(f) DB25(m)
# 2 -----*---------------- 2 TxD
# 3 -----|----------*----- 3 RxD
# 4 -----|----------|----- 4 RTS
# 5 -----|----------|----- 5 CTS
# 6 -----|----------|----- 6 DSR
# 7 -----|--*----*--|----- 7 GND
# 8 -----|--|----|--|----- 8 DCD
# 20 -----|--|----|--|----- 20 DTR
# | | | |
# | | | |
# | | | |
# DB-9(f) | | | | DB-9(f)
# 2 -----+ | | +----- 2 RxD
# 5 --------+ +-------- 5 GND
# 7 --\ /-- 7 RTS
# 8 --/ \-- 8 CTS
# 1 --\ /-- 1 DCD
# 4 --+ +-- 4 DTR
# 6 --/ \-- 6 DSR
#
# Die beiden DB-25 sind 1:1 mit einander verbunden. Die beiden DB-9 Buchsen
# sind lediglich mit der Empfangsleitung und Masse mit den DB-25 verbunden.
# Vorsichtshalber sind die Handshake-Leitungen in den DB-9 Buchsen gebrückt
# (7-8 und 1-4-6).
#
namespace eval Serwatch {
variable config
array set config "
tty1 /dev/ttyS0
tty2 /dev/ttyS1
baud 9600,n,8,1
fd1 {}
fd2 {}
key {}
win {}
txw {}
sbw {}
timer {}
time0 {}
tout 1000
olen 0
lcnt 0
log {}
fdlog {}
hex 0
uchar yes
font Monaco
fsize 13
ascnm {NUL SOH STX ETX EOT ENQ ACK BEL BS TAB LF VT FF CR SO SI
DLE XON DC2 XOF DC4 NAK SYN ETB CAN EM SUB ESC FS GS RS US}
"
namespace export Init
}
proc Serwatch::Hex { c } {
variable config
binary scan $c c asc
if {$config(hex)} {
return [format %02X [expr {$asc & 0xFF}]]
} else {
if {$asc < 32} {
if {$config(uchar)} {
return [subst -nocommands -novariables "\\u24[format %02X $asc]"]
} else {
return [lindex $config(ascnm) $asc]
}
} elseif {$asc == 32} {
if {$config(uchar)} {
return "\u2423"
} else {
return ._.
}
} elseif {$asc > 126} {
return [format 0x%02X $asc]
} elseif {$asc == 127} {
if {$config(uchar)} {
return "\u2421"
} else {
return DEL
}
}
}
return $c
}
proc Serwatch::Read { fd key } {
variable config
after cancel $config(timer)
if {[eof $config($fd)]} {
Serwatch::Close
return
}
if {[set c [read $config($fd) 1]] != ""} {
if {$config(tout) != {}} {
set config(timer) [after $config(tout) Serwatch::Timeout]
}
Message $key [Hex $c]
}
}
proc Serwatch::Timeout {} {
Message "timeout"
}
proc Serwatch::Close {} {
variable config
catch { close $config(fd1) }
catch { close $config(fd2) }
set config(fd1) {}
set config(fd2) {}
after 1000 Serwatch::Init
}
proc Serwatch::Init { args } {
variable config
if {$args != {}} {
set argn [llength $args]
for {set argi 0} {$argi < $argn} {incr argi} {
set arg [lindex $args $argi]
switch -- $arg {
-tty1 - -tty2 - -baud - -win - -tout - -log - -hex {
set opt [string range $arg 1 end]
set config($opt) [lindex $args [incr argi]]
}
default {
set opts "-tty1, -tty2, -baud, -win, -tout, -log, or -hex"
error "bad option \"$arg\": must be $opts"
}
}
}
}
if {$config(log) != {}} {
catch { open $config(log) a } config(fdlog)
}
set t0 [clock seconds]
while 1 {
set usec [clock clicks -milliseconds]; set sec [clock seconds]
if {$sec != $t0} {
set config(time0) [expr {$usec % 1000}]
break
}
}
Message INIT Serwatch
Message tty1 "= $config(tty1)"
Message tty2 "= $config(tty2)"
Message baud "= $config(baud)"
set ok 1
foreach {tty fd key} {tty1 fd1 <- tty2 fd2 ->} {
if {$config($tty) != "none"} {
if {[regexp {^tcp:([\w\.]+):(\w+)$} $config($tty) all host port]} {
set rc [catch { set config($fd) [socket $host $port] } err]
} else {
set rc [catch { set config($fd) [open $config($tty) r+] } err]
if {$rc == 0} {
set rc [catch { fconfigure $config($fd) -mode $config(baud) } err]
}
}
if {$rc == 0} {
fconfigure $config($fd) -buffering none -blocking 1 -translation binary
Message $tty "OK ($config($fd) = $key) -- reading input"
fileevent $config($fd) readable [list Serwatch::Read $fd $key]
} else {
Message ERROR $err
set ok 0
}
}
}
if {!$ok} {
Serwatch::Close
return 0
}
return 1
}
proc Serwatch::Dlg {} {
variable config
if {![winfo exists $config(win)]} {
toplevel $config(win)
wm title $config(win) "Serial Watcher"
wm resizable $config(win) 0 1
}
if {$config(win) == "."} {
set frm .swf
} else {
set frm $config(win).swf
}
font create AsciiFont -family $config(font) -size $config(fsize) -slant roman -weight bold
pack [frame $frm] -fill both -expand yes
pack [scrollbar $frm.sb -command "$frm.txt yview" -takefocus 0] \
-side right -expand 0 -fill y
pack [text $frm.txt -font AsciiFont -width 80 -height 25 \
-state disabled -wrap none -yscrollcommand "$frm.sb set"] \
-side right -expand 1 -fill both
set config(txw) $frm.txt
set config(sbw) $frm.sb
}
proc Serwatch::Message { key {str ""} } {
variable config
if {$key != $config(key)} {
set sec [clock seconds]; set msec [clock clicks -milliseconds]
set tstr [clock format $sec -format %H:%M:%S]
append tstr .[format %03u [expr {($msec - $config(time0)) % 1000}]]
set out "\n$tstr $key $str"
set config(olen) [string length $out]
incr config(lcnt)
} else {
set out " $str"
incr config(olen) [string length $out]
if {$config(olen) >= 75} { set key * }
}
if {$config(win) != {}} {
if {$config(txw) == {}} {
Serwatch::Dlg
}
catch {
set scrpos [lindex [$config(txw) yview] 1]
$config(txw) configure -state normal
$config(txw) insert end $out
$config(txw) configure -state disabled
if {$scrpos == 1} { $config(txw) see end }
if {$config(lcnt) > 2500} {
$config(txw) configure -state normal
$config(txw) delete 0.0 9.0
$config(txw) configure -state disabled
incr config(lcnt) -10
}
}
} else {
puts -nonewline stdout $out; flush stdout
}
if {$config(fdlog) != {}} {
puts -nonewline $config(fdlog) $out
if {$key == "timeout"} { flush $config(fdlog) }
}
set config(key) $key
}
package provide Serwatch 1.2 
