Index: openacs-4/packages/xotcl-request-monitor/xotcl-request-monitor.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/xotcl-request-monitor.info,v diff -u -r1.2 -r1.3 --- openacs-4/packages/xotcl-request-monitor/xotcl-request-monitor.info 30 Dec 2005 00:07:23 -0000 1.2 +++ openacs-4/packages/xotcl-request-monitor/xotcl-request-monitor.info 17 Aug 2006 01:32:27 -0000 1.3 @@ -8,10 +8,10 @@ t request-monitor - + Gustaf Neumann Request Monitor with user tracking functionality - 2005-12-29 + 2006-08-16 This package provides a Request Monitor for OACS applications. It computes performance summary information such as requests/views per seconds, average response time, number of users connected, @@ -22,11 +22,11 @@ as well overall url statistics with performance measures. Updated for cirumventing handler calls openacs 5.2 for /resources/*. 0.28 provides calles for listing active communities and users active in these communities. 0.30 provides a nice graphical chats (many thanks to Nima) and a new interface to the background thread. In addition, -ns_returnfile_background is included +ns_returnfile_background is included; 0.38 using context form xotcl-core 0 - - + + Index: openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl 30 Dec 2005 00:07:23 -0000 1.2 +++ openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl 17 Aug 2006 01:32:27 -0000 1.3 @@ -59,7 +59,6 @@ } - Throttle instproc running {} { my array get running_url } @@ -75,7 +74,7 @@ # will make the sttistics for images look better than they are. set is_image_request [string match "image/*" $content_type] if {[my exists $var] && !$is_image_request && !$off} { - my log "### already $var" + #my log "### already $var" return [list 0 0 1] } else { my set $var $conn_time @@ -148,7 +147,7 @@ Throttle instproc add_url_stat {url time_used key pa} { catch {my unset running_url($key,$url)} - #my log "### unset running_url($key,$url)" + #my log "### unset running_url($key,$url) $errmsg" response_time_minutes add_url_stat $url $time_used $key } Throttle instforward report_url_stats response_time_minutes %proc @@ -656,82 +655,49 @@ set start_time [ns_conn start] } set t [ns_time diff [ns_time get] $start_time] + #my log "+++ $t [ns_conn url]" set ms [expr {[ns_time seconds $t]*1000 + [ns_time microseconds $t]/1000}] return $ms } throttle proc get_context {} { my instvar url query requestor user pa + #my log "--t [my exists context_initialized] url=[ns_conn url]" if {[my exists context_initialized]} return - set pa [ad_conn peeraddr] - my set community_id 0 + set url [ns_conn url] + + my set community_id 0 if {[info exists ::ad_conn(user_id)]} { + #my log "--t we have a user_id" # ordinary request, ad_conn is initialized - set requestor $::ad_conn(user_id) set package_id [ad_conn package_id] + ::xo::ConnectionContext require -package_id $package_id -url $url if {[info command dotlrn_community::get_community_id] ne "" && $package_id ne ""} { my set community_id [dotlrn_community::get_community_id \ -package_id $package_id] } } else { - # for requests bypassing the ordinary connection setup (resources in oacs 5.2) - # we have to get the user_id by ourselves - if { [catch { - if {[info command ad_cookie] ne ""} { - # we have the xotcl-based cookie code - set cookie_list [ad_cookie get_signed_with_expr "ad_session_id"] - } else { - set cookie_list [ad_get_signed_cookie_with_expr "ad_session_id"] - } - set cookie_data [split [lindex $cookie_list 0] {,}] - set untrusted_user_id [lindex $cookie_data 1] - set requestor $untrusted_user_id - } errmsg] } { - set requestor 0 - } + #my log "--t we have no user_id and cannot use ad_conn package_id" + ::xo::ConnectionContext require -url $url + # semi initialized, we are called from .../www/resources, drop it after this proc + #::xo::cc volatile } - #my log "get_context, user_id = $requestor" - # if user not authorized, use peer address as user id - if {$requestor == 0} { - set requestor $pa - set user "client from $pa" - } else { - set user "$requestor" - } - set url [ad_conn url] - set query [ad_conn query] + set requestor [::xo::cc requestor] + set user [::xo::cc user] + set query [ad_conn query] + set pa [ad_conn peeraddr] if {$query ne ""} { append url ?$query } - #my log "+++ setting url to $url" - #show_stack + #my log "### setting url to $url" + #xo::show_stack my set context_initialized 1 + #my log "--i leaving [ns_conn url] vars=[lsort [info vars]]" } -proc show_stack {{m 100}} { - if {[::info exists ::template::parse_level]} { - set parse_level $::template::parse_level - } else { - set parse_level "" - } - set msg "### tid=[::thread::id] <$parse_level> connected=[ns_conn isconnected] " - if {[ns_conn isconnected]} { - append msg "flags=[ad_conn flags] status=[ad_conn status] req=[ad_conn request]" - } - my log $msg - set max [info level] - if {$m<$max} {set max $m} - my log "### Call Stack (level: command)" - for {set i 0} {$i < $max} {incr i} { - if {[catch {set s [uplevel $i self]} msg]} { - set s "" - } - my log "### [format %5d -$i]:\t$s [info level [expr {-$i}]]" - } -} throttle ad_proc check {} { This method should be called once per request that is monitored. @@ -740,6 +706,7 @@ } { my instvar url requestor user pa query community_id my get_context + #my log "### check" foreach {toMuch ms repeat} \ [my throttle_check $requestor $pa $url \ @@ -822,8 +789,9 @@ my users community_access [my set requestor] $community_id } } -throttle proc {} args {my eval $args} +#throttle proc {} args {my eval $args} + ad_proc string_truncate_middle {{-ellipsis ...} {-len 100} string} { cut middle part of a string in case it is to long } { Index: openacs-4/packages/xotcl-request-monitor/www/last-requests.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/last-requests.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/xotcl-request-monitor/www/last-requests.tcl 30 Dec 2005 00:07:23 -0000 1.2 +++ openacs-4/packages/xotcl-request-monitor/www/last-requests.tcl 17 Aug 2006 01:32:27 -0000 1.3 @@ -6,7 +6,7 @@ } -query { request_key {all:optional 1} - {orderby:optional} + {orderby:optional "last_modified,desc"} } -properties { title:onevalue context:onevalue Index: openacs-4/packages/xotcl-request-monitor/www/last100.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/last100.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/xotcl-request-monitor/www/last100.tcl 30 Dec 2005 00:07:23 -0000 1.2 +++ openacs-4/packages/xotcl-request-monitor/www/last100.tcl 17 Aug 2006 01:32:27 -0000 1.3 @@ -3,7 +3,7 @@ @author Gustaf Neumann - @cvs-id $id + @cvs-id $Id$ } -query { {orderby:optional "time,desc"} } -properties { @@ -20,7 +20,7 @@ -instproc render-data {row} { html::div -style { border: 1px solid #a1a5a9; padding: 0px 5px 0px 5px; background: #e2e2e2} { - html::t [$row set [my name]] + html::t [$row set [my name]] } } Index: openacs-4/packages/xotcl-request-monitor/www/running.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/running.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/xotcl-request-monitor/www/running.tcl 30 Dec 2005 00:07:23 -0000 1.2 +++ openacs-4/packages/xotcl-request-monitor/www/running.tcl 17 Aug 2006 01:32:27 -0000 1.3 @@ -25,7 +25,7 @@ set title "Currently Running Requests ($nr_req/$nr_bg)" set context [list "Running Requests"] -TableWidget t1 \ +TableWidget create t1 -volatile \ -actions [subst { Action new -label Refresh -url [ad_conn url] -tooltip "Reload current page" }] \ @@ -45,7 +45,7 @@ set user_string $requestor } else { acs_user::get -user_id $requestor -array user - set user_string "$user(first_names) $user(last_name)" + set user_string "$user(first_names) $user(last_name) - $elapsed ms=$ms" } set user_url "last-requests?request_key=$requestor" lappend sortable_requests [list $user_string $user_url $url $ms ""] @@ -66,7 +66,7 @@ foreach r [lsort -decreasing -real -index 3 $sortable_requests] { foreach {user_string user_url url ms mode} $r break - if {$ms<0} {set ms [expr {-$ms}]} + if {$ms<0} {set ms [expr {-1*$ms}]} t1 add \ -user $user_string -user.href $user_url \ -url $url -elapsed $ms -background $mode Index: openacs-4/packages/xotcl-request-monitor/www/stat-details.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/stat-details.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/xotcl-request-monitor/www/stat-details.tcl 14 Dec 2005 16:09:02 -0000 1.1 +++ openacs-4/packages/xotcl-request-monitor/www/stat-details.tcl 17 Aug 2006 01:32:27 -0000 1.2 @@ -48,7 +48,7 @@ } -TableWidget t1 \ +TableWidget t1 -volatile \ -actions [subst { Action new -label "$label($all)" -url $url -tooltip "$tooltip($all)" Action new -label "Delete Statistics" -url flush-url-statistics \ Index: openacs-4/packages/xotcl-request-monitor/www/whos-online.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/whos-online.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/xotcl-request-monitor/www/whos-online.tcl 14 Dec 2005 16:09:02 -0000 1.1 +++ openacs-4/packages/xotcl-request-monitor/www/whos-online.tcl 17 Aug 2006 01:32:27 -0000 1.2 @@ -32,8 +32,6 @@ TableWidget t1 \ -actions [subst { Action new -label "$label($all)" -url $url -tooltip "$tooltip($all)" - Action new -label "Delete Statistics" -url flush-url-statistics \ - -tooltip "Delete URL Statistics" }] \ -columns [subst { AnchorField name -label "User" -orderby name