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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
# 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: system.tcl,v 1.23 2005/01/13 22:01:35 jfontain Exp $
package provide system [lindex {$Revision: 1.23 $} 1]
package require network 1
package require miscellaneous 1
package require stooop 4.1
namespace import stooop::*
package require switched
if {[catch {package require Thread 2.5}]} {
namespace eval system {variable threads 0}
} else { ;# load thread worker class implementation
package require threads 1
namespace eval system {variable threads 1}
}
package require linetask 1
namespace eval system {
array set data {
updates 0
0,label version 0,type ascii 0,message {kernel version}
1,label date 1,type clock 1,message {kernel build date}
2,label time 2,type clock 2,message {kernel build time}
3,label {CPU vendor} 3,type ascii 3,message {processor vendor identification}
4,label {CPU model} 4,type ascii 4,message {processor model name}
5,label {CPU speed} 5,type real 5,message {processor speed in megahertz}
6,label {CPU MIPS} 6,type real 6,message {processor speed in bogomips}
7,label {up time} 7,type dictionary 7,message {system uptime in d(ays), h(ours), m(inutes) and s(econds)}
8,label {idle time} 8,type dictionary 8,message {system idle time in d(ays), h(ours), m(inutes) and s(econds)}
9,label users 9,type integer 9,message {number of users currently logged on}
10,label processes 10,type integer 10,message {number of processes}
pollTimes {60 10 20 30 120 300 600}
views {{indices {0 1 2 3 4 5 6 7 8 9 10} swap 1}}
persistent 1
switches {-C 0 --daemon 0 -i 1 -p 1 -r 1 --remote 1}
}
set file [open system.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 threads ;# whether threads package is available
catch {set locator $options(-r)}
catch {set locator $options(--remote)} ;# favor long option
if {![info exists locator]} { ;# local host
set local(release) [open /proc/sys/kernel/osrelease] ;# keep local files open for better performance
set local(version) [open /proc/sys/kernel/version]
set local(uptime) [open /proc/uptime]
set local(load) [open /proc/loadavg]
set local(cpu) [open /proc/cpuinfo]
return ;# local monitoring
}
foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
set remote(rsh) [string equal $remote(protocol) rsh]
set data(identifier) system($remote(host))
# important: pack data in a single line using special control separator characters
set remote(command) {cat /proc/sys/kernel/osrelease /proc/sys/kernel/version /proc/uptime /proc/loadavg /proc/cpuinfo 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
append command " -T -l $remote(user) $remote(host)"
}
} else { ;# windows
if {$remote(rsh)} {
error {use -r(--remote) ssh://session syntax (see help)}
}
set remote(rsh) 0
set command "plink -ssh -batch -T $remote(host)" ;# note: host must be a putty session and pageant must be running
}
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 system::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
}
} else {
seek $local(release) 0 ;# rewind before retrieving data
seek $local(version) 0
seek $local(uptime) 0
seek $local(load) 0
seek $local(cpu) 0
process [split [::read $local(release)][::read $local(version)][::read $local(uptime)][::read $local(load)][::read -nonewline $local(cpu)] \n]
}
}
proc process {lines} {
variable data
# data is wholly updated at each poll, so reset each time in case of error:
array set data {0,0 {} 0,1 {} 0,2 {} 0,3 {} 0,4 {} 0,5 ? 0,6 ? 0,7 {} 0,8 {} 0,9 ? 0,10 ?} ;# use ? (void) for numbers
if {![regexp {^[\d\.]+} [lindex $lines 0]]} { ;# ignore extra characters, such as in 2.2.0-pre1
set message "invalid data: [lindex $lines 0]"
if {[llength $lines] > 1} {append message "..."}
flashMessage $message
incr data(updates)
return
}
set index 0
foreach line $lines {
switch $index {
0 { ;# release file
set data(0,0) $line
}
1 { ;# version file: ignore heading (#n, SMP, ...) and day. example : #1 Fri Oct 6 22:01:22 CEST 2000
set data(0,1) "[lrange $line end-4 end-3], [lindex $line end]" ;# month day, year
set data(0,2) [lindex $line end-2] ;# HH:MM:SS
}
2 { ;# uptime file
set data(0,7) [formattedTime [expr {round([lindex $line 0])}]]
set data(0,8) [formattedTime [expr {round([lindex $line 1])}]]
}
3 { ;# load file
scan $line {%*f %*f %*f %u/%u} data(0,9) data(0,10)
}
default { ;# cpu file
if {![regexp {^(.+?)\s+:\s+(.+?)$} $line dummy variable value]} continue
switch $variable {
vendor_id {set data(0,3) $value}
{model name} {set data(0,4) $value}
{cpu MHz} {set data(0,5) $value}
bogomips {set data(0,6) $value}
}
}
}
incr index
}
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)"
}
}
# 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
}
}
|
