← Back to branch summary

~ubuntu-branches/debian/stretch/alpine/stretch

« back to all changes in this revision

Viewing changes to web/cgi/session/monitor.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Asheesh Laroia
  • Date: 2007-02-17 13:17:42 UTC
  • Revision ID: james.westby@ubuntu.com-20070217131742-99x5c6cpg1pbkdhw
Tags: upstream-0.82+dfsg
Import upstream version 0.82+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
web/cgi/session/monitor.tcl
 
1
#!./tclsh
 
2
# $Id: monitor.tcl 391 2007-01-25 03:53:59Z mikes@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 pinetcld --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 pinetcld 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 "  Pinetcld 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
}
 
 
b'\\ No newline at end of file'