diff options
Diffstat (limited to 'web/cgi/session/monitor.tcl')
| -rwxr-xr-x | web/cgi/session/monitor.tcl | 282 |
1 files changed, 282 insertions, 0 deletions
diff --git a/web/cgi/session/monitor.tcl b/web/cgi/session/monitor.tcl new file mode 100755 index 00000000..70edf61f --- /dev/null +++ b/web/cgi/session/monitor.tcl @@ -0,0 +1,282 @@ +#!./tclsh +# $Id: monitor.tcl 1074 2008-06-04 00:08:43Z hubert@u.washington.edu $ +# ======================================================================== +# Copyright 2006 University of Washington +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# ======================================================================== + +# monitor.tcl + +# read config +source ./alpine.tcl + +proc nicetime {timeoutput} { + if {[regexp {^[0-9]+ } $timeoutput msec]} { + return "[format {%d.%06d} [expr {$msec / 1000000}] [expr {$msec % 1000000}]] seconds" + } else { + return $timeoutput + } +} + +# take process snapshot +#set cmd "/bin/ps -lC alpined --sort=cutime" +set cmd "/bin/ps -auxww --sort=cutime" +if {[catch "exec $cmd" result]} { + set prohdr "ps error: $result" + set proclist {} +} else { + set r [split $result "\n"] + set prochdr [lindex $r 0] + set proclist [lrange $r 1 end] +} + +cgi_eval { + cgi_html { + cgi_head { + cgi_title "Web Alpine Monitor" + cgi_puts "<style type='text/css'>" + cgi_puts ".monsec { text-decoration: underline ; margin: 4}" + cgi_puts "</style>" + } + + cgi_body { + cgi_h2 "WebPine Status // [info hostname] // [clock format [clock seconds]]" + + ## + ## system performance monitor + ##n + cgi_preformatted { + # simple server load + set cmd "/usr/ucb/uptime" + if {[catch "exec $cmd" result]} { + cgi_puts "uptime unavailable: $result" + } else { + cgi_puts [cgi_span class=monsec "Server uptime"] + foreach l [split $result "\n"] { + cgi_puts " $l" + } + } + + cgi_br + + # list alpined adapters + foreach l $proclist { + if {[regexp $_wp(servlet) $l] || [regexp $_wp(pc_servlet) $l]} { + lappend adapters $l + } + } + + cgi_puts [cgi_span class=monsec "WebPine Adapters ([llength $adapters])"] + cgi_puts " $prochdr" + foreach l $adapters { + cgi_puts " $l" + } + + cgi_br + + # tmp disc usage + cgi_puts [cgi_span class=monsec "Temp Directory Usage ($_wp(tmpdir))"] + set cmd "/bin/df $_wp(tmpdir)" + if {[catch "exec $cmd" result]} { + cgi_puts "usage unavailable: $result" + } else { + foreach l [split $result "\n"] { + cgi_puts " $l" + } + } + + cgi_br + + # detach staging usage + cgi_puts [cgi_span class=monsec "Detach Staging Usage ($_wp(tmpdir))"] + set cmd "/bin/df $_wp(detachpath)" + if {[catch "exec $cmd" result]} { + cgi_puts "usage unavailable: $result" + } else { + foreach l [split $result "\n"] { + cgi_puts " $l" + } + } + + if {[info exists report_env]} { + cgi_br + + cgi_puts [cgi_span class=monsec "Environment:"] + + set cgiv { + SERVER_SOFTWARE + SERVER_NAME + GATEWAY_INTERFACE + SERVER_PROTOCOL + SERVER_PORT + REQUEST_METHOD + PATH_INFO + PATH_TRANSLATED + SCRIPT_NAME + QUERY_STRING + REMOTE_HOST + REMOTE_ADDR + AUTH_TYPE + REMOTE_USER + REMOTE_IDENT + CONTENT_TYPE + CONTENT_LENGTH + HTTP_ACCEPT + HTTP_USER_AGENT + } + foreach v $cgiv { + if {[info exists env($v)]} { + cgi_puts " $v: $env($v)" + } + } + } + + + ## + ## session specific feedback + ## + if {[info exists _wp(monitors)] + && [info exists env(REMOTE_USER)] + && [lsearch -exact $_wp(monitors) $env(REMOTE_USER)] >= 0} { + + cgi_br + + cgi_puts [cgi_span class=monsec "Kerberos ticket cache info"] + foreach l [glob "[file join $_wp(tmpdir) krb]*"] { + set file [file join $_wp(tmpdir) $l] + cgi_put " [exec /bin/ls -l $file]" + if {[catch {expr {[clock seconds] - [file mtime $file]}} d]} { + } else { + cgi_puts " ([expr {$d / 3600}] hours, [expr {($d % 3600) / 60}] minutes old)" + } + } + + cgi_br + + cgi_puts [cgi_span class=monsec "uid_mapper Process"] + # Condition of uid_mapper + cgi_puts " $prochdr" + foreach l $proclist { + if {[regexp uidmapper $l]} { + lappend umlist $l + } + } + + if {[info exists umlist]} { + foreach l $umlist { + cgi_puts " $l" + } + } else { + cgi_puts " HELP!!! NO UIDMAPPER RUNNING!!!" + } + + cgi_br + + if {[info exists _wp(hosts)] && [llength $_wp(hosts)]} { + cgi_puts [cgi_span class=monsec "Session Performance (netid: $env(REMOTE_USER))"] + + set sdata [lindex $_wp(hosts) 0] + set User $env(REMOTE_USER) + set env(IMAP_SERVER) "[subst [lindex $sdata 1]]/user=$env(REMOTE_USER)" + + if {[llength $sdata] > 2 && [string length [lindex $sdata 2]]} { + set defconf [subst [lindex $sdata 2]] + set confloc "\{$env(IMAP_SERVER)\}$_wp(config)" + cgi_puts " User Config: $confloc" + + # launch session + cgi_put " alpined Launch: " + set ct [time { + if {[catch {exec [file join $_wp(bin) launch.tcl]} _wp(sessid)]} { + set err "FAILURE: $_wp(sessid)" + } else { + WPValidId $_wp(sessid) + } + }] + + if {[info exists err]} { + cgi_puts $err + } else { + cgi_puts [nicetime $ct] + + cgi_put " Open Inbox: " + set ct [time { + if {[catch {WPCmd PESession open $env(REMOTE_USER) "" $confloc $defconf} answer]} { + set err "FAILURE: " + if {[info exists answer]} { + if {[string length $answer] == 0} { + append err "Unknown Username or Incorrect Password" + } else { + append err $answer + } + } else { + append err "Unknown reason" + } + } + }] + + if {[info exists err]} { + cgi_puts $err + } else { + cgi_puts [nicetime $ct] + + cgi_put " Fetch First Message: " + + set ct [time { + if {[catch { + set msg [WPCmd PEMailbox first] + set uid [WPCmd PEMailbox uid $msg] + set txt [WPCmd PEMessage $uid text] + } txt]} { + set err $txt + } + }] + + if {[info exists err]} { + cgi_puts "FAILURE: $err" + } else { + cgi_puts [nicetime $ct] + + cgi_put " Fetch Last Message: " + + set ct [time { + if {[catch { + set msg [WPCmd PEMailbox last] + set uid [WPCmd PEMailbox uid $msg] + set txt [WPCmd PEMessage $uid text] + } txt]} { + set err $txt + } + }] + + if {[info exists err]} { + cgi_puts "FAILURE: $err" + } else { + cgi_puts [nicetime $ct] + } + } + } + + set ct [time { + catch {WPCmd PESession close} + catch {WPCmd exit} + }] + + cgi_puts " Close Session: [nicetime $ct]" + } + } else { + cgi_puts "Invalid host configuration" + } + + } + } + } + } + } +}
\ No newline at end of file |