5748867 [rkeene@sledge /home/rkeene/projects/rivet-cgi/packages/session]$ cat -n session-class.tcl
   1: #
   2: # Session - Itcl object for web session management for Rivet
   3: #
   4: # $Id: session-class.tcl,v 1.5 2004/11/05 16:28:59 karl Exp $
   5: #
   6: 
   7: # Copyright 2004 The Apache Software Foundation
   8: 
   9: # Licensed under the Apache License, Version 2.0 (the "License");
  10: # you may not use this file except in compliance with the License.
  11: # You may obtain a copy of the License at
  12: 
  13: #	http://www.apache.org/licenses/LICENSE-2.0
  14: 
  15: # Unless required by applicable law or agreed to in writing, software
  16: # distributed under the License is distributed on an "AS IS" BASIS,
  17: # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18: # See the License for the specific language governing permissions and
  19: # limitations under the License.
  20: 
  21: package provide Session 1.0
  22: package require Itcl
  23: 
  24: ::itcl::class Session {
  25:     # true if the page being processed didn't have a previous session
  26:     public variable isNewSession 1
  27: 
  28:     # contains the reason why this session is a new session, or "" if it isn't
  29:     public variable newSessionReason ""
  30: 
  31:     # the routine that will handle saving data, could use DIO, could use
  32:     # flatfiles, etc.
  33:     public variable saveHandler ""
  34: 
  35:     # the name of the DIO object that we'll use to access the database
  36:     public variable dioObject "DIO"
  37: 
  38:     # the name of the cookie used to set the session ID
  39:     public variable cookieName "rivetSession"
  40: 
  41:     # the probability that garbage collection will occur in percent.
  42:     public variable gcProbability 1
  43: 
  44:     # the number of seconds after which data will be seen as "garbage"
  45:     # and cleaned up -- defaults to 1 day
  46:     public variable gcMaxLifetime 86400
  47: 
  48:     # the substring you want to check each HTTP referer for.  If the
  49:     # referer was sent by the browser and the substring is not found,
  50:     # the session will be deleted.
  51:     public variable refererCheck ""
  52: 
  53:     public variable entropyFile "/dev/urandom"
  54: 
  55:     # the number of bytes which will be read from the entropy file
  56:     public variable entropyLength 0
  57: 
  58:     # set the scramble code to something unique for the site or the
  59:     # app or whatever, to slightly increase the unguessability of
  60:     # session ids
  61:     public variable scrambleCode "some random string"
  62: 
  63:     # the lifetime of the cookie in minutes.  0 means until the browser
  64:     # is closed.
  65:     public variable cookieLifetime 0
  66: 
  67:     # the lifetime of the session in seconds.  this will be updated if
  68:     # additional pages are fetched while the session is still alive.
  69:     public variable sessionLifetime 7200
  70: 
  71:     # if a request is being processed, a session is active, and this many
  72:     # seconds have elapsed since the session was created or the session
  73:     # update time was last updated, the session update time will be updated
  74:     # (the session being in use extends the session lifetime)
  75:     public variable sessionRefreshInterval 900
  76: 
  77:     # the webserver subpath that the session cookie applies to -- defaults
  78:     # to /
  79:     public variable cookiePath "/"
  80: 
  81:     # the domain to set in the session cookie
  82:     public variable cookieDomain ""
  83: 
  84:     # the status of the last operation, "" if ok
  85:     public variable status
  86: 
  87:     # specifies whether cookies should only be sent over secure connections
  88:     public variable cookieSecure 0
  89: 
  90:     # the name of the table that session info will be stored in
  91:     public variable sessionTable "rivet_session"
  92: 
  93:     # the name of the table that contains cached session data
  94:     public variable sessionCacheTable "rivet_session_cache"
  95: 
  96:     # the file that debug messages will be written to
  97:     public variable debugFile stdout
  98: 
  99:     # set debug mode to 1 to trace through and see the session object
 100:     # do its thing
 101:     public variable debugMode 1
 102: 
 103:     constructor {args} {
 104: 	eval configure $args
 105:     }
 106: 
 107:     method status {args} {
 108: 	if {$args == ""} {
 109: 	    return $status
 110: 	}
 111: 	set status $args
 112:     }
 113: 
 114:     # get_entropy_bytes - read entropyLength bytes from a random data
 115:     # device, such as /dev/random or /dev/urandom, available on some
 116:     # systems as a way to generate random data
 117:     #
 118:     # if entropyLength is 0 (the default) or entropyFile isn't defined
 119:     # or doesn't open successfully, returns an empty string
 120:     #
 121:     method get_entropy_bytes {} {
 122: 	if {$entropyLength == 0 || $entropyFile == ""} {
 123: 	    return ""
 124: 	}
 125: 	if {[catch {open $entropyFile} fp] == 1} {
 126: 	    return ""
 127: 	}
 128: 
 129: 	set entropyBytes [read $fp $entropyLength]
 130: 	close $fp
 131: 	if {[binary scan $entropyBytes h* data]} {
 132: 	    debug "get_entropy_bytes: returning '$data'"
 133: 	    return $data
 134: 	}
 135: 	error "software bug - binary scan behaved unexpectedly"
 136:     }
 137: 
 138:     #
 139:     # gen_session_id - generate a session ID by md5'ing as many things
 140:     # as we can get our hands on.
 141:     #
 142:     method gen_session_id {args} {
 143: 	package require md5
 144: 
 145: 	# if the Apache unique ID module is installed, the environment
 146: 	# variable UNIQUE_ID will have been set.  If not, we'll get an
 147: 	# empty string, which won't hurt anything.
 148: 	set uniqueID [env UNIQUE_ID]
 149: 
 150: 	set sessionIdKey "$uniqueID[clock clicks][pid]$args[clock seconds]$scrambleCode[get_entropy_bytes]"
 151: 	debug "gen_session_id - feeding this to md5: '$sessionIdKey'"
 152: 	return [::md5::md5 $sessionIdKey]
 153:     }
 154: 
 155:     #
 156:     # do_garbage_collection - delete dead sessions from the session table.
 157:     #    corresponding session table cache entries will automatically be
 158:     #    deleted as well (assuming they've been defined with ON DELETE CASCADE)
 159:     #
 160:     method do_garbage_collection {} {
 161: 	debug "do_garbage_collection: performing garbage collection"
 162: 	set result [$dioObject exec "delete from $sessionTable where timestamp 'now' - session_update_time > interval '$gcMaxLifetime seconds';"]
 163: 	$result destroy
 164:     }
 165: 
 166:     #
 167:     # consider_garbage_collection - perform a garbage collection gcProbability
 168:     #   percent of the time.  For example, if gcProbability is 1, about 1 in
 169:     #   every 100 times this routine is called, garbage collection will be
 170:     #   performed.
 171:     #
 172:     method consider_garbage_collection {} {
 173: 	if {rand() <= $gcProbability / 100.0} {
 174: 	    do_garbage_collection
 175: 	}
 176:     }
 177: 
 178:     #
 179:     # set_session_cookie - set a session cookie to the specified value --
 180:     #  other cookie attributes are controlled by variables defined in the
 181:     #  object
 182:     #
 183:     method set_session_cookie {value} {
 184: 	cookie set $cookieName $value \
 185: 	    -path $cookiePath \
 186: 	    -minutes $cookieLifetime \
 187: 	    -secure $cookieSecure
 188:     }
 189: 
 190:     #
 191:     # id - get the session ID of the current browser
 192:     #
 193:     # returns a session ID if their session cookie matches a current session.
 194:     # returns an empty string if they do not have a session.
 195:     #
 196:     # status will be set to an empty string if all is ok, "timeout" if
 197:     # the session had timed out, "no_cookie" if no cookie was previously
 198:     # defined (session id could still be valid though -- first visit)
 199:     #
 200:     # ...caches the results in the info array to avoid calls to the database
 201:     # in subsequent requests for the user ID from the same page, a common
 202:     # occurrence.
 203:     #
 204:     method id {} {
 205: 	::request::global sessionInfo
 206: 
 207: 	status ""
 208: 
 209: 	# if we already know the session ID, we're done.
 210: 	# (i.e. we've already validated them earlier in the 
 211: 	# handling of the current page.)
 212: 
 213: 	if {[info exists sessionInfo(sessionID)]} { 
 214: 	    debug "id called, returning cached ID '$sessionInfo(sessionID)'"
 215: 	    return $sessionInfo(sessionID) 
 216: 	}
 217: 
 218: 	#
 219: 	# see if they have a session cookie.  if they don't,
 220: 	# set status and return.
 221: 	#
 222: 	set sessionCookie [cookie get $cookieName]
 223: 	if {$sessionCookie == ""} {
 224: 	    # they did not have a cookie set, they are not logged in
 225: 	    status "no_cookie"
 226: 	    debug "id: no session cookie '$cookieName'"
 227: 	    return ""
 228: 	}
 229: 
 230: 	# there is a session Cookie, grab the remote address of the connection,
 231: 	# see if our state table says he has logged into us from this
 232: 	# address within our login timeout window and we've given him
 233: 	# this session
 234: 
 235: 	debug "id: found session cookie '$cookieName' value '$sessionCookie'"
 236: 
 237: 	set a(session_id) $sessionCookie
 238: 	set a(ip_address) [env REMOTE_ADDR]
 239: 
 240: 	# see if there's a record matching the session ID cookie and
 241: 	# IP address
 242: 	set kf [list session_id ip_address]
 243: 	set key [$dioObject makekey a $kf]
 244: 	if {![$dioObject fetch $key a -table $sessionTable -keyfield $kf]} {
 245: 	    debug "id: no entry in the session table for session '$sessionCookie' and address [env REMOTE_ADDR]: [$dioObject errorinfo]"
 246: 	    status "no_session"
 247: 	    return ""
 248: 	}
 249: 
 250: 	## Carve the seconds out of the session_update_time field in the
 251: 	# $sessionTable table.  Trim off the timezone at the end.
 252: 	set secs [clock scan [string range $a(session_update_time) 0 18]]
 253: 
 254: 	# if the session has timed out, delete the session and return -1
 255: 
 256: 	if {[expr $secs + $sessionLifetime] < [clock seconds]} {
 257: 	    $dioObject delete $key -table $sessionTable -keyfield $kf
 258: 	    debug "id: session '$sessionCookie' timed out"
 259: 	    status "timeout"
 260: 	    return ""
 261: 	}
 262: 
 263: 	# Their session is still alive.  If the session refresh 
 264: 	# interval time has expired, update the session update time in the 
 265: 	# database (we don't update every time they request a page for 
 266: 	# performance reasons)  The idea is it's been at least 15 minutes or 
 267: 	# something like that since they've logged in, and they're still 
 268: 	# doing stuff, so reset their session update time to now
 269: 
 270: 	if {[expr $secs + $sessionRefreshInterval] < [clock seconds]} {
 271: 	    debug "session '$sessionCookie' alive, refreshing session update time"
 272: 	    set a(session_update_time) now
 273: 	    if {![$dioObject store a -table $sessionTable -keyfield $kf]} {
 274: 		debug "id: Failed to store $sessionTable: [$dioObject errorinfo]"
 275: 		puts "Failed to store $sessionTable: [$dioObject errorinfo]"
 276: 	    }
 277: 	}
 278: 
 279: 	#
 280: 	# THEY VALIDATED.  Cache the session ID in the sessionInfo array
 281: 	# that will only exist for the handling of this request, set that
 282: 	# this is not a new session (at least one previous request has been
 283: 	# handled with this session ID) and return the session ID
 284: 	#
 285: 	debug "id: active session, '$a(session_id)'"
 286: 	set sessionInfo(sessionID) $a(session_id)
 287: 	set isNewSession 0
 288: 	return $a(session_id)
 289:     }
 290: 
 291:     #
 292:     # store - given a package name, a key string, and a data string,
 293:     #  store the data in the rivet session cache
 294:     #
 295:     method store {packageName key data} {
 296: 	set a(session_id) [id]
 297: 	set a(package) $packageName
 298: 	set a(key) $key
 299: 
 300: 	regsub -all {\\} $data {\\\\} data
 301: 	set a(data) $data
 302: 
 303: 	debug "store session data, package '$packageName', key '$key', data '$data'"
 304: 	set kf [list session_id package key]
 305: 
 306: 	if {![$dioObject store a -table $sessionCacheTable -keyfield $kf]} {
 307: 	    puts "Failed to store $sessionCacheTable '$kf'"
 308: 	    parray a
 309: 	    error [$dioObject errorinfo]
 310: 	}
 311:     }
 312: 
 313:     #
 314:     # fetch - given a package name and a key, return the data stored
 315:     #   for this session
 316:     #
 317:     method fetch {packageName key} {
 318: 	set kf [list session_id package key]
 319: 
 320: 	set a(session_id) [id]
 321: 	set a(package) $packageName
 322: 	set a(key) $key
 323: 
 324: 	set key [$dioObject makekey a $kf]
 325: 	if {![$dioObject fetch $key a -table $sessionCacheTable -keyfield $kf]} {
 326: 	    status [$dioObject errorinfo]
 327: 	    puts "error: [$dioObject errorinfo]"
 328: 	    debug "fetch session data failed, package '$packageName', key '$key', error '[$dioObject errorinfo]'"
 329: 	    return ""
 330: 	}
 331: 
 332: 	debug "fetch session data succeeded, package '$packageName', key '$key', result '$a(data)'"
 333: 
 334: 	return $a(data)
 335:     }
 336: 
 337:     #
 338:     # delete - given a user ID and looking at their IP address we inherited
 339:     # from the environment (thanks, webserver), remove them from the session
 340:     # table.  (the session table is how the server remembers stuff about
 341:     # sessions)
 342:     #
 343:     method delete_session {{session_id ""}} {
 344: 	variable conf
 345: 
 346: 	set ip_address [env REMOTE_ADDR]
 347: 
 348: 	if {$session_id == ""} {
 349: 	    set session_id [id]
 350: 	}
 351: 
 352: 	debug "delete session $session_id"
 353: 
 354: 	set kf [list session_id ip_address]
 355: 	$dioObject delete [list $session_id $ip_address] -table $sessionTable -keyfield $kf
 356: 
 357: 	## NEED TO delete saved session data here too, from the
 358: 	# $sessionCacheTable structure.
 359:     }
 360: 
 361:     #
 362:     # create_session - Generate a session ID and store the session in the
 363:     #  session table.
 364:     #
 365:     # returns the session_id
 366:     #
 367:     method create_session {} {
 368: 	global conf
 369: 
 370: 	## Create their session by storing their session information in 
 371: 	# the session table.
 372: 	set a(ip_address) [env REMOTE_ADDR]
 373: 	set a(session_start_time) now
 374: 	set a(session_update_time) now
 375: 
 376: 	set a(session_id) [gen_session_id $a(ip_address)]
 377: 
 378: 	set kf [list ip_address session_id]
 379: 	if {![$dioObject store a -table $sessionTable -keyfield $kf]} {
 380: 	    debug "Failed to store $sessionTable: [$dioObject errorinfo]"
 381: 	    puts "Failed to store $sessionTable: [$dioObject errorinfo]"
 382: 	}
 383: 
 384: 	debug "create_session: ip $a(ip_address), id '$a(session_id)'"
 385: 
 386: 	return $a(session_id)
 387:     }
 388: 
 389:     #
 390:     # activate - find the session ID if they have one.  if they don't, create
 391:     # one and drop a cookie on them.
 392:     #
 393:     method activate {} {
 394: 	::request::global sessionInfo
 395: 
 396: 	debug "activate: checking out the situation"
 397: 
 398: 	# a small percentage of the time, try to delete stale session data
 399: 	consider_garbage_collection
 400: 
 401: 	set id [id]
 402: 	if {$id != ""} {
 403: 	    debug "activate: returning session id '$id'"
 404: 	    return $id
 405: 	}
 406: 
 407: 	# it's a new session, save the reason for why it's a new session,
 408: 	# set that it's a new session, drop a session cookie on the browser
 409: 	# that issued this request, set the session ID cache variable, and 
 410: 	# return the cookie ID
 411: 	set newSessionReason [status]
 412: 	debug "activate: new session, reason '$newSessionReason'"
 413: 	set id [create_session]
 414: 	set isNewSession 1
 415: 	set_session_cookie $id
 416: 	set sessionInfo(sessionID) $id
 417: 	debug "activate: created session '$id' and set cookie (theoretically)"
 418: 	return $id
 419:     }
 420: 
 421:     #
 422:     # is_new_sesion - return a 1 if it's a new session, else a zero if there
 423:     # were one or more prior pages creating and/or using this session ID
 424:     #
 425:     method is_new_session {} {
 426: 	return $isNewSession
 427:     }
 428: 
 429:     #
 430:     # new_session_reason - return the reason why a session is new, either
 431:     # it didn't have a cookie "no_cookie", there was a cookie but no
 432:     # matching session "no_session", or there was a cookie and a session
 433:     # but the session has timed out "timeout".  if the session isn't new,
 434:     # returns ""
 435:     #
 436:     method new_session_reason {} {
 437: 	return $newSessionReason
 438:     }
 439: 
 440:     #
 441:     # debug - output a debugging message
 442:     #
 443:     method debug {message} {
 444: 	if {$debugMode} {
 445: 	    puts $debugFile "$this (debug) $message<br>"
 446: 	}
 447:     }
 448: }
 449: 
5748868 [rkeene@sledge /home/rkeene/projects/rivet-cgi/packages/session]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2004-11-05 16:28:59