1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: usb.tcl,v 1.16 2005/02/12 20:39:48 jfontain Exp $
package provide usb [lindex {$Revision: 1.16 $} 1]
package require network 1
package require stooop 4.1
namespace import stooop::*
package require switched
if {[catch {package require Thread 2.5}]} {
namespace eval usb {variable threads 0}
} else { ;# load thread worker class implementation
package require threads 1
namespace eval usb {variable threads 1}
}
package require linetask 1
namespace eval usb {
array set data {
updates 0
0,label bus 0,type dictionary 0,message {bus number}
1,label device 1,type dictionary 1,message {device number}
2,label vendor 2,type dictionary 2,message {vendor identifier}
3,label product 3,type dictionary 3,message {product identifier}
4,label description 4,type ascii 4,message {device description} 4,anchor left
indexColumns {0 1}
pollTimes {60 10 20 30 120 300 600}
persistent 1
switches {-C 0 --daemon 0 -i 1 -p 1 --path 1 -r 1 --remote 1}
}
set file [open usb.htm]
set data(helpText) [::read $file] ;# initialize HTML help data from file
close $file
unset file
proc initialize {optionsName} {
upvar 1 $optionsName options
variable local
variable remote
variable data
variable threads ;# whether threads package is available
set path /sbin ;# default path for lsusb command
catch {set path $options(--path)} ;# may be overriden by user
set path [file join $path lsusb]
catch {set locator $options(-r)}
catch {set locator $options(--remote)} ;# favor long option
if {![info exists locator]} { ;# local host
exec $path ;# detect errors early by attempting immediate data retrieval
set local(command) $path
return ;# local monitoring
}
# for remote monitoring, decode protocol, remote user and host
foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
set remote(rsh) [string equal $remote(protocol) rsh]
set data(identifier) usb($remote(host))
# important: pack data in a single line using special control separator characters
set remote(command) "$path 2>&1 | tr '\\n' '\\v'"
if {[string equal $::tcl_platform(platform) unix]} {
if {$remote(rsh)} {
set command "rsh -n -l $remote(user) $remote(host) {$remote(command)}"
} else {
set command ssh
if {[info exists options(-C)]} {append command { -C}} ;# data compression
if {[info exists options(-i)]} {append command " -i \"$options(-i)\""} ;# identity file
if {[info exists options(-p)]} {append command " -p $options(-p)"} ;# port
# note: redirect standard error to pipe output in order to be able to detect remote errors
append command " -T -l $remote(user) $remote(host) 2>@ stdout"
}
} else { ;# windows
if {$remote(rsh)} {
error {use -r(--remote) ssh://session syntax (see help)}
}
set remote(rsh) 0 ;# note: host must be a putty session and pageant must be running
set command "plink -ssh -batch -T $remote(host) 2>@ stdout"
}
if {$remote(rsh)} {
set access r ;# writing to pipe is not needed
} else {
set access r+ ;# bi-directional pipe
# terminate remote command output by a newline so that the buffered stream flushes it through the pipe as soon as the
# remote data becomes available:
append remote(command) {; echo}
}
set remote(task) [new lineTask\
-command $command -callback usb::read -begin 0 -access $access -translation lf -threaded $threads\
]
if {![info exists options(--daemon)] && !$remote(rsh)} { ;# for ssh, detect errors early when not in daemon mode
lineTask::begin $remote(task)
} ;# note: for rsh, shell and command need be restarted at each update
set remote(busy) 0
}
proc update {} {
variable remote
variable local
if {[info exists remote]} {
if {$remote(busy)} return ;# core invocation while waiting for remote data
set remote(busy) 1
if {[lineTask::end $remote(task)]} { ;# rsh or ssh daemon mode
lineTask::begin $remote(task) ;# note: for rsh, shell and command are restarted here each time
}
if {!$remote(rsh)} {
lineTask::write $remote(task) $remote(command) ;# start data retrieval by sending command to remote side
}
} elseif {[catch {set result [exec $local(command)]} message]} { ;# immediate retrieval failure on local host
flashMessage "lsusb error: $message"
} else {
process [split $result \n]
}
}
proc process {lines} { ;# process USB data lines and update display
variable data
# from lsusb source code: printf("Bus %s Device %s: ID %04x:%04x %s %s\n", bus, device, vid, pid, vendor, product);
set expression {^Bus (.+) Device (.+): ID ([[:xdigit:]]+):([[:xdigit:]]+) (.*)$}
foreach line $lines {
if {![regexp $expression $line dummy bus device vendor product description]} {
flashMessage "invalid line: $line" ;# should never happen
continue
}
# generate unique 32 unsigned integer from bus and device numbers (each 3 decimal digits maximum length: 16 bits each)
set row [format %u [expr {($bus << 16) | $device}]]
set data($row,0) $bus ;# fill or update row
set data($row,1) $device
set data($row,2) $vendor
set data($row,3) $product
set data($row,4) $description
set current($row) {}
}
foreach name [array names data *,0] { ;# cleanup disappeared entries
set row [lindex [split $name ,] 0]
if {![info exists current($row)]} {array unset data $row,\[0-9\]*}
}
incr data(updates)
}
proc read {line} { ;# read remote data now that it is available and possibly handle errors
variable remote
switch $lineTask::($remote(task),event) {
end {
# either valid data availability as rsh connection was closed, or connection broken for ssh, in which case remote
# shell command will be attempted to be restarted at next update
}
error { ;# some communication error occured
set message "error on remote data: $lineTask::($remote(task),error)"
}
timeout { ;# remote host did not respond in time
set message "timeout on remote host: $remote(host)"
}
}
# unpack list while removing extra last separator without copying to a variable for better performance, as data could be big
# note: in case of an unexpected event, task insures that line is empty
if {[info exists message]} {
flashMessage $message
}
process [split [string trimright $line \v] \v]
set remote(busy) 0
}
}
|
