Gustaf Neumann
WU Vienna
Request Monitor with user tracking functionality
@@ -34,7 +34,7 @@
BSD-Style
2
-
+
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.43.2.9 -r1.43.2.10
--- openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl 27 Jan 2017 17:03:10 -0000 1.43.2.9
+++ openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl 29 Jan 2017 18:15:15 -0000 1.43.2.10
@@ -7,8 +7,8 @@
#############################################################################
if {"async-cmd" ni [ns_job queues]} {
- ns_job create async-cmd 10
- ns_job configure -jobsperthread 10000
+ ns_job create async-cmd 4
+ #ns_job configure -jobsperthread 10000
}
::xotcl::THREAD create throttle {
@@ -23,14 +23,14 @@
#
Class create package_parameter \
-parameter {{default ""} value name} \
- -instproc defaultmethod {} {my value} \
- -instproc update {value} {my value $value} \
+ -instproc defaultmethod {} {return ${:value}} \
+ -instproc update {value} {set :value $value} \
-instproc init {} {
- my name [namespace tail [self]]
- my value [parameter::get_from_package_key \
- -package_key "xotcl-request-monitor" \
- -parameter [my name] \
- -default [my default]]
+ set :name [namespace tail [self]]
+ set :value [parameter::get_from_package_key \
+ -package_key "xotcl-request-monitor" \
+ -parameter ${:name} \
+ -default ${:default}]
}
package_parameter log-dir \
@@ -73,14 +73,14 @@
#
Class create AsyncLogFile -parameter {filename {mode a}}
AsyncLogFile instproc init {} {
- if {![my exists filename]} {
- my filename $::logdir/[namespace tail [self]]
+ if {![info exists :filename]} {
+ set :filename $::logdir/[namespace tail [self]]
}
set :handle [bgdelivery do AsyncDiskWriter new -autoflush true]
- bgdelivery do [set :handle] open -filename [my filename] -mode [my mode]
+ bgdelivery do ${:handle} open -filename ${:filename} -mode ${:mode}
}
AsyncLogFile instproc write {msg} {
- bgdelivery do [set :handle] async_write $msg\n
+ bgdelivery do ${:handle} async_write $msg\n
}
# open the used log-files
@@ -99,7 +99,7 @@
Class create Throttle -parameter {
{timeWindow 10}
{timeoutMs 2000}
- {startThrottle 7}
+ {startThrottle 11}
{toMuch 10}
{alerts 0} {throttles 0} {rejects 0} {repeats 0}
}
@@ -113,8 +113,8 @@
Throttle instproc add_statistics { type requestor ip_adress url query } {
#set furl [expr {$query ne "" ? "$url?$query" : $url}]
- my incr ${type}s
- #my log "++++ add_statistics -type $type -user_id $requestor "
+ incr :${type}s
+ # :log "++++ add_statistics -type $type -user_id $requestor "
set entry [ThrottleStat new -childof [self]::stats \
-type $type -requestor $requestor \
-timestamp [clock seconds] \
@@ -152,7 +152,7 @@
}
Throttle instproc running {} {
- my array get running_url
+ array get :running_url
}
#
@@ -172,7 +172,7 @@
}
}
Throttle instproc update_threads_state {} {
- array set threadInfo [my server_threads]
+ array set threadInfo [:server_threads]
incr ::threads_busy [expr {$threadInfo(current) - $threadInfo(idle)}]
incr ::threads_current $threadInfo(current)
incr ::threads_datapoints
@@ -189,9 +189,9 @@
seconds ++
- my update_threads_state
+ :update_threads_state
- set var running_url($requestKey,$url)
+ set var :running_url($requestKey,$url)
#
# Check first, whether the same user has already the same request
# issued; if yes, block this request. Caveat: some html-pages
@@ -201,15 +201,15 @@
[string match "image/*" $content_type]
|| $content_type in { text/css application/javascript application/x-javascript }
}]
- if {[my exists $var] && !$is_embedded_request && !${:off}} {
+ if {[info exists $var] && !$is_embedded_request && !${:off}} {
#ns_log notice "### already $var"
return [list 0 0 1]
} else {
- set :$var $conn_time
+ set $var $conn_time
#ns_log notice "### new $var"
}
set t1 [clock milliseconds]
- my register_access $requestKey $pa $url $community_id $is_embedded_request
+ :register_access $requestKey $pa $url $community_id $is_embedded_request
set t2 [clock milliseconds]
if {$t2 - $t0 > 500} {
@@ -221,7 +221,7 @@
# number of 14 is arbitrary. One of our single real request might
# have up to 14 subrequests (through iframes)....
#
- if {${:off} || $is_embedded_request || [my array size running_url] < 14} {
+ if {${:off} || $is_embedded_request || [array size :running_url] < 14} {
#
# Maybe the throttler is off, or we have an embedded request or
# less than 14 running requests running. Everything is
@@ -237,11 +237,11 @@
# to keep only the active request keys in an associative array.
#
incr :alerts
- if {[my exists active($requestKey)]} {
+ if {[info exists :active($requestKey)]} {
# if more than one request for this key is already active,
# return blocking time
lassign [set :active($requestKey)] to cnt
- set retMs [expr {$cnt > [my startThrottle] ? 500 : 0}]
+ set retMs [expr {$cnt > ${:startThrottle} ? 500 : 0}]
# cancel the timeout
after cancel $to
} else {
@@ -250,9 +250,9 @@
}
incr cnt
# establish a new timeout
- set to [after [my timeoutMs] [list [self] cancel $requestKey]]
+ set to [after ${:timeoutMs} [list [self] cancel $requestKey]]
set :active($requestKey) [list $to $cnt]
- if {$cnt <= [my toMuch]} {
+ if {$cnt <= ${:toMuch}} {
set cnt 0
}
return [list $cnt $retMs 0]
@@ -261,33 +261,33 @@
Throttle instproc statistics {} {
return "
- | Number of alerts: | [my alerts] |
- | Number of throttles: | [my throttles] |
- | Number of rejects: | [my rejects] |
- | Number of repeats: | [my repeats] |
+ | Number of alerts: | [:alerts] |
+ | Number of throttles: | [:throttles] |
+ | Number of rejects: | [:rejects] |
+ | Number of repeats: | [:repeats] |
\n"
}
Throttle instproc cancel {requestKey} {
# cancel a timeout and clean up active request table for this key
- if {[my exists active($requestKey)]} {
+ if {[info exists :active($requestKey)]} {
after cancel [lindex [set :active($requestKey)] 0]
- my unset active($requestKey)
- #my log "+++ Cancel $requestKey block"
+ unset :active($requestKey)
+ # :log "+++ Cancel $requestKey block"
} else {
- my log "+++ Cancel for $requestKey failed !!!"
+ :log "+++ Cancel for $requestKey failed !!!"
}
}
Throttle instproc active { } {
# return the currently active requests (for debugging and introspection)
- return [my array get active]
+ return [array get :active]
}
Throttle instproc add_url_stat {method url partialtimes key pa content_type} {
#ns_log notice "Throttle.add_url_stat($method,$url,$partialtimes,$key,$pa,$content_type)"
- catch {my unset running_url($key,$url)}
- #my log "### unset running_url($key,$url) $errmsg"
+ catch {unset :running_url($key,$url)}
+ # :log "### unset running_url($key,$url) $errmsg"
if {[string match "text/html*" $content_type]} {
[Users current_object] add_view $key
}
@@ -300,22 +300,22 @@
Class create ThrottleTrace
ThrottleTrace instproc log {msg} {
- if {![my exists traceFile]} {
+ if {![info exists :traceFile]} {
set file $::logdir/calls
set :traceFile [open $file a]
set :traceCounter 0
}
- puts [set :traceFile] $msg
+ puts ${:traceFile} $msg
}
ThrottleTrace instproc throttle_check args {
catch {
incr :traceCounter
- my log "CALL [set :traceCounter] [self args]"
+ :log "CALL ${:traceCounter} [self args]"
}
next
}
ThrottleTrace instproc add_url_stat args {
- catch {my log "END [set :traceCounter] [self args]"}
+ catch {:log "END ${:traceCounter} [self args]"}
next
}
@@ -356,7 +356,7 @@
set color yellow
}
incr ::count(longcalls:$color)
- catch {my log [list $url $totaltime $key $pa $content_type]}
+ catch {:log [list $url $totaltime $key $pa $content_type]}
}
next
}
@@ -412,7 +412,7 @@
an instance variable to the same value. This is used here
in combination with changing parameters
} {
- foreach object [my allinstances] {
+ foreach object [:allinstances] {
$object set $var $value
}
}
@@ -421,10 +421,10 @@
incr :c
}
Counter instproc end {} {
- if {[my exists report]} {
- [my report] incr c ${:c}
+ if {[info exists :report]} {
+ [:report] incr c ${:c}
}
- my finalize ${:c}
+ :finalize ${:c}
set :c 0
}
@@ -440,14 +440,14 @@
#
lappend :trend $n
set lt [llength ${:trend}]
- if {$lt > [my nr_trend_elements]} {
- set :trend [lrange ${:trend} $lt-[my nr_trend_elements] end]
+ if {$lt > ${:nr_trend_elements}} {
+ set :trend [lrange ${:trend} $lt-${:nr_trend_elements} end]
}
#
# stats keeps nr_stats_elements highest values with time stamp
#
lappend :stats [list $timestamp $n]
- set :stats [lrange [lsort -real -decreasing -index 1 ${:stats}] 0 [my nr_stats_elements]-1]
+ set :stats [lrange [lsort -real -decreasing -index 1 ${:stats}] 0 ${:nr_stats_elements}-1]
}
Counter instproc finalize {n} {
if {[info exists :to]} {
@@ -456,20 +456,20 @@
# update statistics
#
set now [clock format [clock seconds]]
- my add_value $now $n
+ :add_value $now $n
#
# log if necessary
#
- catch {if {[my logging]} {my log_to_file $now [self] $n}}
+ catch {if {${:logging}} {:log_to_file $now [self] $n}}
#
} else {
ns_log notice "[self] has no timeout defined"
}
- set :to [after [my timeoutMs] [list [self] end]]
+ set :to [after ${:timeoutMs} [list [self] end]]
}
Counter instproc init {} {
- set :to [after [my timeoutMs] [list [self] end]]
+ set :to [after ${:timeoutMs} [list [self] end]]
next
}
Counter instproc destroy {} {
@@ -492,40 +492,41 @@
# The counter logs its intrinsic value (c) anyhow, which are the
# authenticated users. We also want to record the number of
# unauthenticated users, and do this here manually.
- my log_to_file $now [self]-non-auth $ip
+ :log_to_file $now [self]-non-auth $ip
set :c $auth
Users perDayCleanup
next
}
Class create MaxCounter -superclass Counter -instproc end {} {
- my c [Users nr_active]
- if {[my exists report]} {
- [my report] instvar {c rc}
- if {$rc < [my c]} {set rc [my c]}
+ set :c [Users nr_active]
+ if {[info exists :report]} {
+ if {[${:report} set c] < ${:c}} {
+ ${:report} set c ${:c}
+ }
}
- my finalize [my c]
- my c 0
+ :finalize ${:c}
+ set :c 0
}
MaxCounter create user_count_hours -timeoutMs [expr {60000*60}] -logging 1
MaxCounter create user_count_minutes -timeoutMs 60000 -report user_count_hours -logging 1
Class create AvgCounter -superclass Counter \
-parameter {{t 0} {atleast 1}} -instproc end {} {
- if {[my c]>0} {
- set avg [expr {int([my t]*1.0/[my c])}]
- } else {
- set avg 0
- }
- if {[my exists report]} {
- [my report] incr c [my c]
- [my report] incr t [my t]
- }
- my finalize $avg
- my c 0
- my t 0
- }
+ if {${:c} > 0} {
+ set avg [expr {int(${:t} * 1.0 / ${:c})}]
+ } else {
+ set avg 0
+ }
+ if {[info exists :report]} {
+ ${:report} incr c ${:c}
+ ${:report} incr t ${:t}
+ }
+ :finalize $avg
+ set :c 0
+ set :t 0
+ }
Class create UrlCounter -superclass AvgCounter \
-parameter {
@@ -537,7 +538,7 @@
UrlCounter instproc add_url_stat {url ms requestor} {
#ns_log notice "UrlCounter.add_url_stat($url,$ms,$requestor)"
my ++
- # my log "[self proc] $url /$ms/ $requestor (${:c})"
+ # :log "[self proc] $url /$ms/ $requestor (${:c})"
incr :t $ms
### set up a value for the right ordering in last 100.
@@ -557,16 +558,16 @@
}
UrlCounter instproc last100 {} {
- my array get last100
+ array get :last100
}
UrlCounter instproc flush_url_stats {} {
- my log "flush_url_stats"
- my array unset stat
- my array unset cnt
+ :log "flush_url_stats"
+ array unset :stat
+ array unset :cnt
}
UrlCounter instproc url_stats {} {
set result [list]
- foreach url [my array names stat] {
+ foreach url [array names :stat] {
lappend result [list $url [set :stat($url)] [set :cnt($url)]]
}
set result [lsort -real -decreasing -index 1 $result]
@@ -576,12 +577,12 @@
# truncate statistics if necessary
set max [max-url-stats]
if {$max>1} {
- set result [my url_stats]
+ set result [:url_stats]
set l [llength $result]
for {set i $max} {$i<$l} {incr i} {
set url [lindex $result $i 0]
- my unset stat($url)
- my unset cnt($url)
+ unset :stat($url)
+ unset :cnt($url)
}
set result [lrange $result 0 $max-1]
return $result
@@ -590,7 +591,7 @@
}
UrlCounter instproc cleanup_stats {} {
# truncate statistics if necessary
- #my check_truncate_stats
+ # :check_truncate_stats
# we use the timer to check other parameters as well here
set time_window [time-window]
if {$time_window != [throttler timeWindow]} {
@@ -600,9 +601,9 @@
return ""
}
UrlCounter instproc report_url_stats {} {
- set stats [my check_truncate_stats]
+ set stats [:check_truncate_stats]
if {$stats eq ""} {
- set stats [my url_stats]
+ set stats [:url_stats]
}
return $stats
}
@@ -665,7 +666,7 @@
} {
if {$full} {
set info [list]
- foreach key [my array names pa] {
+ foreach key [array names :pa] {
set entry [list $key [set :pa($key)]]
foreach var [list timestamp hits expSmooth switches] {
set k ${var}($key)
@@ -675,50 +676,62 @@
}
return $info
} else {
- return [my array names pa]
+ return [array names :pa]
}
}
Users proc unknown { obj args } {
- my log "unknown called with $obj $args"
+ :log "unknown called with $obj $args"
}
Users ad_proc nr_active {} {
@return number of active users (in time window)
} {
- return [my array size pa]
+ return [array size :pa]
}
Users ad_proc nr_users_time_window {} {
@return number of different ip addresses and authenticated users (in time window)
} {
set ip 0; set auth 0
- foreach i [my array names pa] {
+ foreach i [array names :pa] {
if {[::xo::is_ip $i]} {incr ip} {incr auth}
}
return [list $ip $auth]
}
Users ad_proc user_is_active {uid} {
@return boolean value whether user is active
} {
- my exists pa($uid)
+ info exists :pa($uid)
}
Users ad_proc hits {uid} {
@param uid request key
@return Number of hits by this user (in time window)
} {
- if {[my exists hits($uid)]} {return [set :hits($uid)]} else {return 0}
+ if {[info exists :hits($uid)]} {
+ return [set :hits($uid)]
+ } else {
+ return 0
+ }
}
Users ad_proc last_pa {uid} {
@param uid request key
@return last peer address of the specified users
} {
- if {[my exists pa($uid)]} { return [set :pa($uid)]} else { return "" }
+ if {[info exists :pa($uid)]} {
+ return [set :pa($uid)]
+ } else {
+ return ""
+ }
}
Users proc last_click {uid} {
- if {[my exists timestamp($uid)]} {return [set :timestamp($uid)]} else {return 0}
+ if {[info exists :timestamp($uid)]} {
+ return [set :timestamp($uid)]
+ } else {
+ return 0
+ }
}
Users proc last_requests {uid} {
- if {[my exists pa($uid)]} {
+ if {[info exists :pa($uid)]} {
set urls [list]
foreach i [Users info instances] {
if {[$i exists urls($uid)]} {
@@ -764,15 +777,14 @@
}
Users proc current_object {} {
- throttler instvar timeWindow
set now [clock seconds]
- set mkey [expr { ($now / 60) % $timeWindow}]
+ set mkey [expr { ($now / 60) % [throttler timeWindow]}]
set obj [self]::users::$mkey
if {$mkey ne ${:last_mkey}} {
- if {${:last_mkey} ne ""} {my purge_access_stats}
+ if {${:last_mkey} ne ""} {:purge_access_stats}
# create or recreate the container object for that minute
- if {[my isobject $obj]} {
+ if {[:isobject $obj]} {
$obj destroy
}
Users create $obj -point_in_time $now
@@ -782,10 +794,9 @@
}
Users proc purge_access_stats {} {
- throttler instvar timeWindow
set time [clock seconds]
# purge stale entries (for low traffic)
- set secs [expr {$timeWindow * 60}]
+ set secs [expr {[throttler timeWindow] * 60}]
if { [info commands [self]::users::${:last_mkey}] ne ""
&& $time - [[self]::users::${:last_mkey} point_in_time] > $secs
} {
@@ -800,7 +811,7 @@
}
Users proc community_access {requestor pa community_id} {
- [my current_object] community_access $requestor $pa $community_id
+ [:current_object] community_access $requestor $pa $community_id
}
Users proc entered_community {key now community_id data reason} {
@@ -836,7 +847,7 @@
set seconds [expr {$now - [dict get $data start]}]
set clicks [dict get $data clicks]
} else {
- if {[my exists timestamp($key)]} {
+ if {[info exists :timestamp($key)]} {
set seconds [expr {$now - [set :timestamp($key)]}]
set clicks 0
} else {
@@ -855,11 +866,11 @@
ns_log warning "::xo::request_monitor_record_activity left_system slow, can lead to filter time >1sec: total time [expr {$t1 - $t0}]"
}
}
- catch {my unset user_in_community($key)}
- catch {my unset refcount($key)}
- catch {my unset pa($key)}
- catch {my unset expSmooth($key)}
- catch {my unset switches($key)}
+ catch {unset :user_in_community($key)}
+ catch {unset :refcount($key)}
+ catch {unset :pa($key)}
+ catch {unset :expSmooth($key)}
+ catch {unset :switches($key)}
}
Users instproc init {} {
@@ -917,10 +928,10 @@
#
# Keep the currently active users in the per-minute objects.
#
- set var user_in_community($key,$community_id)
- if {![my exists $var]} {
- set :$var 1
- my lappend in_community($community_id) $key
+ set var :user_in_community($key,$community_id)
+ if {![info exists $var]} {
+ set $var 1
+ lappend :in_community($community_id) $key
}
}
@@ -980,15 +991,15 @@
set class [self class]
if {$key ne $pa} {
- my check_pa_change $key $pa $url
+ :check_pa_change $key $pa $url
}
#
# Increase the number of requests that were issued from the user
# in the current minute.
#
- set counter active($key)
- if {[incr :$counter] == 1} {
+ set counter :active($key)
+ if {[incr $counter] == 1} {
#
# On the first occurrence in the current minute, increment the
# global reference count
@@ -1005,7 +1016,7 @@
#
# Register the fact that the user is doing something in the community
#
- my community_access $key $pa $community_id
+ :community_access $key $pa $community_id
}
#
@@ -1036,18 +1047,18 @@
# The array "urls" keeps triples of time stamps, urls and peer
# addresses per user.
#
- my lappend urls($key) [list [my point_in_time] $url $pa]
+ lappend :urls($key) [list ${:point_in_time} $url $pa]
#
# The global array "hits" keeps overall activity of the user.
#
$class incr hits($key)
$class set timestamp($key) [clock seconds]
- #ns_log notice "[self] addKey ENDS $class timestamp($key) [$class set timestamp($key)] counter $counter value [set :$counter]"
+ #ns_log notice "[self] addKey ENDS $class timestamp($key) [$class set timestamp($key)] counter $counter value [set $counter]"
}
Users instproc add_view {uid} {
- #my log "#### add_view $uid"
+ # :log "#### add_view $uid"
incr :views($uid)
}
Users proc views_per_minute {uid} {
@@ -1068,11 +1079,11 @@
Users instproc destroy {} {
set class [self class]
- #ns_log notice "=== [self] destroy [my array names active]"
+ #ns_log notice "=== [self] destroy [array names :active]"
if {[Users set last_mkey] eq [self]} {
Users set last_mkey ""
}
- foreach key [my array names active] {
+ foreach key [array names :active] {
if {[::xo::is_ip $key]} {
set pa $key
} else {
@@ -1085,7 +1096,7 @@
}
Users proc expSmooth {ts key} {
set mins [expr {$ts/60}]
- if {[my exists expSmooth($key)]} {
+ if {[info exists :expSmooth($key)]} {
lassign [set :expSmooth($key)] _ aggval lastmins hits
set mindiff [expr {$mins-$lastmins}]
if {$mindiff == 0} {
@@ -1115,7 +1126,7 @@
# the counters of logged-in and not logged-in users.... but not
# in cases, where the timestamp data was restored.
#
- if {![my exists timestamp($key)]} {
+ if {![info exists :timestamp($key)]} {
if {[::xo::is_ip $key]} {incr :ip24} {incr :auth24}
}
}
@@ -1124,17 +1135,17 @@
Users proc decrRefCount {key pa hitcount} {
#ns_log notice "=== decrRefCount $key $hitcount"
- if {[my exists refcount($key)]} {
+ if {[info exists :refcount($key)]} {
set x [incr :refcount($key) -1]
incr :hits($key) -$hitcount
if {$x < 1} {
#
# The user fell out of the per-minute objects due to
# inactivity.
#
- set var user_in_community($key)
- if {[info exists :$var]} {
- set data [set :$var]
+ set var :user_in_community($key)
+ if {[info exists $var]} {
+ set data [set $var]
Users left_community $key $pa [clock seconds] [dict get $data community_id] $data inactive
Users left_system $key $pa [clock seconds] $data inactive
} else {
@@ -1145,7 +1156,7 @@
# content, but when the user was logged in, this should
# not happen - it ist at least unusal
#
- set address [expr {[my exists pa($pa)] ? "peer address [set :pa($pa)]" : ""}]
+ set address [expr {[info exists :pa($pa)] ? "peer address [set :pa($pa)]" : ""}]
ns_log warning "no community info for $key available $address"
}
}
@@ -1163,55 +1174,58 @@
#
set :ip24 0
set :auth24 0
- foreach i [my array names timestamp] {
+ foreach i [array names :timestamp] {
if {[::xo::is_ip $i]} {incr :ip24} {incr :auth24}
}
}
Users proc nr_users_per_day {} {
- return [list [set :ip24] [set :auth24]]
+ return [list ${:ip24} ${:auth24}]
}
Users proc users_per_day {} {
- my instvar timestamp
set ip [list]; set auth [list]
- foreach i [array names timestamp] {
- if {[::xo::is_ip $i]} {lappend ip [list $i $timestamp($i)]} {lappend auth [list $i $timestamp($i)]}
+ foreach i [array names :timestamp] {
+ if {[::xo::is_ip $i]} {
+ set var ip
+ } else {
+ set var auth
+ }
+ lappend $var [list $i [set :timestamp($i)]]
}
return [list $ip $auth]
}
Users proc time_window_cleanup {} {
#ns_log notice "=== time_window_cleanup"
# purge stale entries (maintenance only)
- throttler instvar timeWindow
set now [clock seconds]
- set maxdiff [expr {$timeWindow * 60}]
- foreach i [lsort [my array names pa]] {
+ set maxdiff [expr {[throttler timeWindow] * 60}]
+ foreach i [lsort [array names :pa]] {
set purge 0
- if {![my exists timestamp($i)]} {
+ if {![info exists :timestamp($i)]} {
ns_log notice "throttle: no timestamp for $i"
set purge 1
} else {
set age [expr {$now - [set :timestamp($i)]}]
if {$age > $maxdiff} {
- if {[my exists pa($i)]} {
- ns_log notice "throttle: entry stale $i => [my exists pa($i)], age=$age"
+ if {[info exists :pa($i)]} {
+ ns_log notice "throttle: entry stale $i => [info exists :pa($i)], age=$age"
set purge 1
}
}
}
if {$purge} {
ns_log notice "=== time_window_cleanup unsets pa($i)"
- my unset pa($i)
- catch {my unset refcount($i)}
- catch {my unset expSmooth($i)}
- catch {my unset switches($i)}
+ unset :pa($i)
+ catch {unset :refcount($i)}
+ catch {unset :expSmooth($i)}
+ catch {unset :switches($i)}
}
}
- foreach i [lsort [my array names refcount]] {
- if {![my exists pa($i)]} {
+ foreach i [lsort [array names :refcount]] {
+ if {![info exists :pa($i)]} {
ns_log notice "throttle: void refcount for $i"
- my unset refcount($i)
+ unset :refcount($i)
}
}
}
@@ -1220,24 +1234,24 @@
set :ip24 0
set :auth24 0
set secsPerDay [expr {3600*24}]
- foreach i [lsort [my array names timestamp]] {
+ foreach i [lsort [array names :timestamp]] {
set secs [expr {[clock seconds]-[set :timestamp($i)]}]
- # my log "--- $i: last click $secs secs ago"
+ # :log "--- $i: last click $secs secs ago"
if {$secs > $secsPerDay} {
#foreach {d h m s} [clock format [expr {$secs-$secsPerDay}] \
# -format {%j %H %M %S}] break
#regexp {^[0]+(.*)$} $d match d
#regexp {^[0]+(.*)$} $h match h
#incr d -1
#incr h -1
- #my log "--- $i expired $d days $h hours $m minutes ago"
- my unset timestamp($i)
+ # :log "--- $i expired $d days $h hours $m minutes ago"
+ unset :timestamp($i)
ns_log notice "UNSET timestamp($i) deleted due to perDayCleanup after $secs seconds (> $secsPerDay)"
} else {
if {[::xo::is_ip $i]} {incr :ip24} {incr :auth24}
}
}
- #ns_log notice "=== auth24 perDayCleanup -> [set :ip24] [set :auth24]"
+ #ns_log notice "=== auth24 perDayCleanup -> ${:ip24} ${:auth24}"
dump write
}
@@ -1246,11 +1260,11 @@
dump proc read {} {
# make sure, timestamp exists as an array
array set Users::timestamp [list]
- if {[file readable [set :file]]} {
+ if {[file readable ${:file}]} {
# in case of disk-full, the file might be damaged, so make sure,
# we can continue
- if {[catch {source [set :file]} errorMsg]} {
- ns_log error "during source of [set :file]:\n$errorMsg"
+ if {[catch {source ${:file}} errorMsg]} {
+ ns_log error "during source of ${:file}:\n$errorMsg"
}
}
# The dump file data is merged with maybe preexisting data
@@ -1261,7 +1275,7 @@
# When old data is restored, don't trust user-info unless it is
# very recent (e.g. younger than 3 munutes)
#
- if {[clock seconds] - [file mtime [set :file]] > 180} {
+ if {[clock seconds] - [file mtime ${:file}] > 180} {
Users array unset user_in_community
}
}
@@ -1280,12 +1294,12 @@
}
}
if {$sync} {
- set dumpFile [open [set :file] w]
+ set dumpFile [open ${:file} w]
puts -nonewline $dumpFile $cmd
close $dumpFile
} else {
set dumpFile [bgdelivery do AsyncDiskWriter new]
- bgdelivery do $dumpFile open -filename [set :file]
+ bgdelivery do $dumpFile open -filename ${:file}
bgdelivery do $dumpFile async_write $cmd
bgdelivery do $dumpFile close
}
@@ -1307,7 +1321,7 @@
# define a class value, which refreshes itself all "refresh" ms.
#
Class create Value -parameter {{value ""} {refresh 10000}}
- Value instproc updateValue {} {set :handle [after [my refresh] [list [self] updateValue]]}
+ Value instproc updateValue {} {set :handle [after ${:refresh} [list [self] updateValue]]}
#
# define a object loadAvg.
@@ -1319,7 +1333,7 @@
set procloadavg /proc/loadavg
if {[file readable $procloadavg]} {
set f [open $procloadavg];
- my value [lrange [read $f] 0 2];
+ set :value [lrange [read $f] 0 2]
close $f
}
next
@@ -1386,7 +1400,7 @@
timeWindow:Time window for computing detailed statistics; can
be configured via OACS package parameter time-window
timeoutMs: Time window to keep statistics for a user
- startThrottle: If user requests more than this #, he is throttled
+ startThrottle: If user requests more than this #, thre requests are delayed. When larger than toMuc, the parameter is ignored
toMuch: If user requests more than this #, he is kicked out
The throttler is defined as a class running in a detached thread. See XOTcl API for Thread management for more details.
@@ -1451,16 +1465,16 @@
}
throttle proc get_context {} {
- #my log "--t [my exists context_initialized] url=[ns_conn url]"
- if {[my exists context_initialized]} return
+ # :log "--t [info exists :context_initialized] url=[ns_conn url]"
+ if {[info exists :context_initialized]} return
set :url [ns_conn url]
set :method [ns_conn method]
set :community_id 0
if {[info exists ::ad_conn(package_id)]} {
set :community_id [ad_conn subsite_id]
- #my log "--t we have a package_id"
+ # :log "--t we have a package_id"
# ordinary request, ad_conn is initialized
set package_id [ad_conn package_id]
::xo::ConnectionContext require -package_id $package_id -url ${:url}
@@ -1474,7 +1488,7 @@
#
# Requests for /resources/* land here
#
- #my log "--t we have no package_id , subsite_id ?[info exists ::ad_conn(subsite_id)] [ns_conn url]"
+ # :log "--t we have no package_id , subsite_id ?[info exists ::ad_conn(subsite_id)] [ns_conn url]"
::xo::ConnectionContext require -url ${:url}
}
@@ -1485,10 +1499,10 @@
if {${:query} ne ""} {
append :url ?${:query}
}
- #my log "### setting url to ${:url}"
+ # :log "### setting url to ${:url}"
#xo::show_stack
set :context_initialized 1
- #my log "--i leaving [ns_conn url] vars=[lsort [info vars]]"
+ # :log "--i leaving [ns_conn url] vars=[lsort [info vars]]"
}
throttle ad_proc check {} {
@@ -1498,26 +1512,26 @@
} {
set t0 [clock milliseconds]
- my get_context
- #my log "### check"
+ :get_context
+ # :log "### check"
- lassign [my throttle_check ${:requestor} ${:pa} ${:url} \
+ lassign [:throttle_check ${:requestor} ${:pa} ${:url} \
[ns_conn start] [ns_guesstype [ns_conn url]] ${:community_id}] \
toMuch ms repeat
set t1 [clock milliseconds]
if {$repeat} {
- my add_statistics repeat ${:requestor} ${:pa} ${:url} ${:query}
+ :add_statistics repeat ${:requestor} ${:pa} ${:url} ${:query}
set result -1
} elseif {$toMuch} {
- my log "*** we have to refuse user ${:requestor} with $toMuch requests"
- my add_statistics reject ${:requestor} ${:pa} ${:url} ${:query}
+ :log "*** we have to refuse user ${:requestor} with $toMuch requests"
+ :add_statistics reject ${:requestor} ${:pa} ${:url} ${:query}
set result $toMuch
} elseif {$ms} {
- my log "*** we have to block user ${:requestor} for $ms ms"
- my add_statistics throttle ${:requestor} ${:pa} ${:url} ${:query}
+ :log "*** we have to block user ${:requestor} for $ms ms"
+ :add_statistics throttle ${:requestor} ${:pa} ${:url} ${:query}
after $ms
- my log "*** continue for user ${:requestor}"
+ :log "*** continue for user ${:requestor}"
set result 0
} else {
set result 0
@@ -1558,11 +1572,11 @@
# the next procs are for the filters (registered from the -init file)
####
throttle proc postauth args {
- #my log "+++ [self proc] [ad_conn url] auth ms [my partialtimes] [ad_conn isconnected]"
- #my do set ::cookies([set :requestor]) [ns_set get [ns_conn headers] Cookie]
- set r [my check]
+ # :log "+++ [self proc] [ad_conn url] auth ms [:partialtimes] [ad_conn isconnected]"
+ # :do set ::cookies(${:requestor}) [ns_set get [ns_conn headers] Cookie]
+ set r [:check]
if {$r < 0} {
- set url [set :url]
+ set url ${:url}
ns_return 200 text/html "
[_ xotcl-request-monitor.repeated_operation]
[_ xotcl-request-monitor.operation_blocked]"
@@ -1575,33 +1589,31 @@
Please slow down your requests...
"
return filter_return
} else {
- #my log "-- filter_ok"
+ # :log "-- filter_ok"
return filter_ok
}
}
throttle proc trace args {
- #my log "+++ [self proc] <$args> [ad_conn url] [my partialtimes] [ad_conn isconnected]"
+ # :log "+++ [self proc] <$args> [ad_conn url] [:partialtimes] [ad_conn isconnected]"
# OpenACS 5.2 bypasses for requests to /resources the user filter
# in these cases pre- or postauth are not called, but only trace.
# So we have to make sure we have the needed context here
- my get_context
- #my log "CT=[ns_set array [ns_conn outputheaders]] -- [set :url]"
+ :get_context
+ # :log "CT=[ns_set array [ns_conn outputheaders]] -- ${:url}"
- my add_url_stat ${:method} ${:url} [my partialtimes] ${:requestor} ${:pa} \
+ :add_url_stat ${:method} ${:url} [:partialtimes] ${:requestor} ${:pa} \
[ns_set get [ns_conn outputheaders] Content-Type]
- my unset context_initialized
+ unset :context_initialized
return filter_ok
}
throttle proc community_access {community_id} {
- my get_context
- if {[set :community_id] eq ""} {
- my users community_access [set :requestor] [set :pa] $community_id
+ :get_context
+ if {${:community_id} eq ""} {
+ :users community_access ${:requestor} ${:pa} $community_id
}
}
-#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/last100.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/last100.tcl,v
diff -u -r1.7.2.4 -r1.7.2.5
--- openacs-4/packages/xotcl-request-monitor/www/last100.tcl 26 Jan 2017 11:48:29 -0000 1.7.2.4
+++ openacs-4/packages/xotcl-request-monitor/www/last100.tcl 29 Jan 2017 18:15:15 -0000 1.7.2.5
@@ -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 [:name]]
}
}
Index: openacs-4/packages/xotcl-request-monitor/www/last101.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/last101.tcl,v
diff -u -r1.3.2.3 -r1.3.2.4
--- openacs-4/packages/xotcl-request-monitor/www/last101.tcl 26 Jan 2017 11:48:29 -0000 1.3.2.3
+++ openacs-4/packages/xotcl-request-monitor/www/last101.tcl 29 Jan 2017 18:15:15 -0000 1.3.2.4
@@ -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 [:name]]
}
}
@@ -101,7 +101,7 @@
html::t -disableOutputEscaping "»\n"
html::a -href "/request-monitor" {html::t "XOTcl Request Monitor"}
html::t -disableOutputEscaping "»\n"
- html::t [my set context]
+ html::t ${:context}
html::div -style "clear:both;"
}
html::div -id status {
@@ -122,7 +122,7 @@
}
} ;# end of site header
html::div -id "youarehere" {
- html::t [my set title]
+ html::t ${:title}
}
html::br
html::div -id "portal-navigation" {