web/cgi/session/monitor.tcl

   1 #!./tclsh
   2 # $Id: monitor.tcl 1074 2008-06-04 00:08:43Z hubert@u.washington.edu $
   3 # ========================================================================
   4 # Copyright 2006 University of Washington
   5 #
   6 # Licensed under the Apache License, Version 2.0 (the "License");
   7 # you may not use this file except in compliance with the License.
   8 # You may obtain a copy of the License at
   9 #
  10 #     http://www.apache.org/licenses/LICENSE-2.0
  11 #
  12 # ========================================================================
  13
  14 #  monitor.tcl
  15
  16 # read config
  17 source ./alpine.tcl
  18
  19 proc nicetime {timeoutput} {
  20   if {[regexp {^[0-9]+ } $timeoutput msec]} {
  21     return "[format {%d.%06d} [expr {$msec / 1000000}] [expr {$msec % 1000000}]] seconds"
  22   } else {
  23     return $timeoutput
  24   }
  25 }
  26
  27 # take process snapshot
  28 #set cmd "/bin/ps -lC alpined --sort=cutime"
  29 set cmd "/bin/ps -auxww --sort=cutime"
  30 if {[catch "exec $cmd" result]} {
  31   set prohdr "ps error: $result"
  32   set proclist {}
  33 } else {
  34   set r [split $result "\n"]
  35   set prochdr [lindex $r 0]
  36   set proclist [lrange $r 1 end]
  37 }
  38
  39 cgi_eval {
  40   cgi_html {
  41     cgi_head {
  42       cgi_title "Web Alpine Monitor"
  43       cgi_puts  "<style type='text/css'>"
  44       cgi_puts  ".monsec { text-decoration: underline ; margin: 4}"
  45       cgi_puts "</style>"
  46     }
  47
  48     cgi_body {
  49       cgi_h2 "WebPine Status // [info hostname] // [clock format [clock seconds]]"
  50
  51       ##
  52       ## system performance monitor
  53       ##n
  54       cgi_preformatted {
  55         # simple server load
  56         set cmd "/usr/ucb/uptime"
  57         if {[catch "exec $cmd" result]} {
  58           cgi_puts "uptime unavailable: $result"
  59         } else {
  60           cgi_puts [cgi_span class=monsec "Server uptime"]
  61           foreach l [split $result "\n"] {
  62             cgi_puts "  $l"
  63           }
  64         }
  65
  66         cgi_br
  67
  68         # list alpined adapters
  69         foreach l $proclist {
  70           if {[regexp $_wp(servlet) $l] || [regexp $_wp(pc_servlet) $l]} {
  71             lappend adapters $l
  72           }
  73         }
  74
  75         cgi_puts [cgi_span class=monsec "WebPine Adapters ([llength $adapters])"]
  76         cgi_puts "  $prochdr"
  77         foreach l $adapters {
  78           cgi_puts "  $l"
  79         }
  80
  81         cgi_br
  82
  83         # tmp disc usage
  84         cgi_puts [cgi_span class=monsec "Temp Directory Usage ($_wp(tmpdir))"]
  85         set cmd "/bin/df $_wp(tmpdir)"
  86         if {[catch "exec $cmd" result]} {
  87           cgi_puts "usage unavailable: $result"
  88         } else {
  89           foreach l [split $result "\n"] {
  90             cgi_puts "  $l"
  91           }
  92         }
  93
  94         cgi_br
  95
  96         # detach staging usage
  97         cgi_puts [cgi_span class=monsec "Detach Staging Usage ($_wp(tmpdir))"]
  98         set cmd "/bin/df $_wp(detachpath)"
  99         if {[catch "exec $cmd" result]} {
 100           cgi_puts "usage unavailable: $result"
 101         } else {
 102           foreach l [split $result "\n"] {
 103             cgi_puts "  $l"
 104           }
 105         }
 106
 107         if {[info exists report_env]} {
 108           cgi_br
 109
 110           cgi_puts [cgi_span class=monsec "Environment:"]
 111
 112           set cgiv {
 113             SERVER_SOFTWARE
 114             SERVER_NAME
 115             GATEWAY_INTERFACE
 116             SERVER_PROTOCOL
 117             SERVER_PORT
 118             REQUEST_METHOD
 119             PATH_INFO
 120             PATH_TRANSLATED
 121             SCRIPT_NAME
 122             QUERY_STRING
 123             REMOTE_HOST
 124             REMOTE_ADDR
 125             AUTH_TYPE
 126             REMOTE_USER
 127             REMOTE_IDENT
 128             CONTENT_TYPE
 129             CONTENT_LENGTH
 130             HTTP_ACCEPT
 131             HTTP_USER_AGENT
 132           }
 133           foreach v $cgiv {
 134             if {[info exists env($v)]} {
 135               cgi_puts "  $v: $env($v)"
 136             }
 137           }
 138         }
 139
 140
 141         ##
 142         ## session specific feedback
 143         ##
 144         if {[info exists _wp(monitors)]
 145             && [info exists env(REMOTE_USER)]
 146             && [lsearch -exact $_wp(monitors) $env(REMOTE_USER)] >= 0} {
 147
 148           cgi_br
 149
 150           cgi_puts [cgi_span class=monsec "Kerberos ticket cache info"]
 151           foreach l [glob "[file join $_wp(tmpdir) krb]*"] {
 152             set file [file join $_wp(tmpdir) $l]
 153             cgi_put "  [exec /bin/ls -l $file]"
 154             if {[catch {expr {[clock seconds] - [file mtime $file]}} d]} {
 155             } else {
 156               cgi_puts "  ([expr {$d / 3600}] hours, [expr {($d % 3600) / 60}] minutes old)"
 157             }
 158           }
 159
 160           cgi_br
 161
 162           cgi_puts [cgi_span class=monsec "uid_mapper Process"]
 163           # Condition of uid_mapper
 164           cgi_puts "  $prochdr"
 165           foreach l $proclist {
 166             if {[regexp uidmapper $l]} {
 167               lappend umlist $l
 168             }
 169           }
 170
 171           if {[info exists umlist]} {
 172             foreach l $umlist {
 173               cgi_puts "  $l"
 174             }
 175           } else {
 176             cgi_puts "  HELP!!! NO UIDMAPPER RUNNING!!!"
 177           }
 178
 179           cgi_br
 180
 181           if {[info exists _wp(hosts)] && [llength $_wp(hosts)]} {
 182             cgi_puts [cgi_span class=monsec "Session Performance (netid: $env(REMOTE_USER))"]
 183
 184             set sdata [lindex $_wp(hosts) 0]
 185             set User $env(REMOTE_USER)
 186             set env(IMAP_SERVER) "[subst [lindex $sdata 1]]/user=$env(REMOTE_USER)"
 187
 188             if {[llength $sdata] > 2 && [string length [lindex $sdata 2]]} {
 189               set defconf [subst [lindex $sdata 2]]
 190               set confloc "\{$env(IMAP_SERVER)\}$_wp(config)"
 191               cgi_puts "  User Config: $confloc"
 192
 193               # launch session
 194               cgi_put "  alpined Launch: "
 195               set ct [time {
 196                 if {[catch {exec [file join $_wp(bin) launch.tcl]} _wp(sessid)]} {
 197                   set err "FAILURE: $_wp(sessid)"
 198                 } else {
 199                   WPValidId $_wp(sessid)
 200                 }
 201               }]
 202
 203               if {[info exists err]} {
 204                 cgi_puts $err
 205               } else {
 206                 cgi_puts [nicetime $ct]
 207
 208                 cgi_put "  Open Inbox: "
 209                 set ct [time {
 210                   if {[catch {WPCmd PESession open $env(REMOTE_USER) "" $confloc $defconf} answer]} {
 211                     set err "FAILURE: "
 212                     if {[info exists answer]} {
 213                       if {[string length $answer] == 0} {
 214                         append err "Unknown Username or Incorrect Password"
 215                       } else {
 216                         append err $answer
 217                       }
 218                     } else {
 219                       append err "Unknown reason"
 220                     }
 221                   }
 222                 }]
 223
 224                 if {[info exists err]} {
 225                   cgi_puts $err
 226                 } else {
 227                   cgi_puts [nicetime $ct]
 228
 229                   cgi_put "  Fetch First Message: "
 230
 231                   set ct [time {
 232                     if {[catch {
 233                                  set msg [WPCmd PEMailbox first]
 234                                  set uid [WPCmd PEMailbox uid $msg]
 235                                  set txt [WPCmd PEMessage $uid text]
 236                                } txt]} {
 237                       set err $txt
 238                     }
 239                   }]
 240
 241                   if {[info exists err]} {
 242                     cgi_puts "FAILURE: $err"
 243                   } else {
 244                     cgi_puts [nicetime $ct]
 245
 246                     cgi_put "  Fetch Last Message: "
 247
 248                     set ct [time {
 249                       if {[catch {
 250                                     set msg [WPCmd PEMailbox last]
 251                                     set uid [WPCmd PEMailbox uid $msg]
 252                                     set txt [WPCmd PEMessage $uid text]
 253                                   } txt]} {
 254                         set err $txt
 255                       }
 256                     }]
 257
 258                     if {[info exists err]} {
 259                       cgi_puts "FAILURE: $err"
 260                     } else {
 261                       cgi_puts [nicetime $ct]
 262                     }
 263                   }
 264                 }
 265
 266                 set ct [time {
 267                   catch {WPCmd PESession close}
 268                   catch {WPCmd exit}
 269                 }]
 270
 271                 cgi_puts "  Close Session: [nicetime $ct]"
 272               }
 273             } else {
 274               cgi_puts "Invalid host configuration"
 275             }
 276
 277           }
 278         }
 279       }
 280     }
 281   }
 282 }