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
|
# copyright (C) 1997-1999 Jean-Luc Fontaine (mailto:jfontain@multimania.com)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
set rcsId {$Id: apachex.tcl,v 1.6 1999/08/27 20:01:01 jfontain Exp $}
package provide apachex 1.2
package require apacheutilities 1.1
namespace eval apachex {
array set data {
updates 0
0,label server 0,type integer 0,message {server number}
1,label process 1,type dictionary 1,message {operating system process identifier}
2,label accesses 2,type integer 2,message {number of accesses for this connection / this child / this slot}
3,label mode 3,type ascii 3,message {_(waiting),Starting,Reading,W(sending),Keepalive,DNSlookup,Logging,G(finishing)}
4,label {CPU usage} 4,type real 4,message {CPU usage in seconds}
5,label {request age} 5,type dictionary\
5,message {time since beginning of most recent request, in d(ays), h(ours), m(inutes) and s(econds)}
6,label {request time} 6,type integer 6,message {milliseconds required to process most recent request}
7,label {connection traffic} 7,type real 7,message {kilobytes transferred for this connection}
8,label {child traffic} 8,type real 8,message {megabytes transferred for this child}
9,label {slot traffic} 9,type real 9,message {total megabytes transferred for this slot}
10,label client 10,type integer 10,message {client network address} 10,anchor left
11,label {virtual host} 11,type integer 11,message {server virtual host} 11,anchor left
12,label request 12,type integer 12,message {HTTP request} 12,anchor left
13,label traffic 13,type real 13,message {kilobytes per second being transferred for this slot}
pollTimes {10 5 20 30 60 120 300}
views {
{visibleColumns {0 1 2 3 4} sort {0 increasing}}
{visibleColumns {0 5 6 7 8 9 13} sort {0 increasing}}
{visibleColumns {0 10 11 12} sort {0 increasing}}
}
switches {-r 1 --remote 1}
}
set file [open [file join $::packageDirectory(apachex) apachex.htm]]
set data(helpText) [read $file] ;# initialize HTML help data from file
close $file
proc initialize {optionsName} {
upvar $optionsName options
variable url
variable data
set url [::apache::url options host apachex]
set data(identifier) apachex($host)
}
proc update {} {
variable url
variable transaction
if {[info exists transaction]} return ;# busy
set transaction [::http::geturl $url -command ::apachex::completed]
}
proc completed {token} {
variable data
variable last
variable transaction
set valid [expr {[lindex [set ${token}(http)] 1]==200}] ;# sole HTTP code for good transaction
if {$valid} {
set body [set ${token}(body)] ;# keep first table rows except the 1st row (column titles)
set lines [string range $body [expr {[string first </tr> $body]+5}] [expr {[string first </table> $body]-1}]]
regsub -all \n [string trim $lines] {} lines ;# carriage returns must be ignored
regsub -all \t $lines { } lines ;# replace all tabs by spaces as tabs will be used as separators
regsub {^<tr>} $lines {} lines ;# remove extreme table row markers
regsub {</tr>$} $lines {} lines
regsub -all {</tr> *<tr>} $lines \t lines ;# table row markers are row separators (use tab character as replacement)
set separator {<td[^>]*>} ;# table cell markers are cell separators
foreach line [split $lines \t] {
regsub ^$separator $line {} line ;# remove leftmost cell marker
regsub -all $separator $line \t line ;# use tab character as separator
set column 0
foreach cell [split $line \t] {
regsub -all {<[^>]+>} $cell {} cell ;# remove all remaining (formatting) tags
if {$column==0} {
# use server number as row number and ignore generation if present, as in apache version 1.3.6 (cell is n-g
# with n = child server number and g = generation, whereas in apache 1.3.3, only n is present)
scan $cell %u row
set current($row) {} ;# keep track of current rows for latter cleanup
set data($row,$column) $row
} else {
set data($row,$column) $cell
}
incr column
}
set data($row,5) [::apache::formattedTime $data($row,5)]
if {[info exists last($row,9)]} {
set data($row,13) [expr {($data($row,9)-$last($row,9))*1000.0}] ;# dynamic traffic in kilobytes
} else {
set data($row,13) 0
}
set last($row,9) $data($row,9) ;# save megabytes for slot for dynamic traffic calculations
}
}
foreach {name row} [array get data *,0] { ;# cleanup vanished rows data
if {[info exists current($row)]} continue
for {set column 0} {$column<=13} {incr column} {
unset data($row,$column)
}
catch {unset last($row,9)} ;# previous poll data may not exist
}
unset $token ;# free transaction data array (fully qualified and global)
unset transaction ;# ready for next transaction
incr data(updates)
}
}
|
