Script Library: 1213 scripts
 

acgiss.r

rebol [ Library: [ level: 'intermediate platform: 'all type: [tool] domain: [cgi html web] tested-under: [apache xitami] support: none license: [mit] see-also: none ] file: %acgiss.r author: "Sunanda" version: 0.0.1 Date: 12-jan-2005 purpose: "Provide basic cookie support for CGI scripts" Title: "Anonymous CGI session services" license: 'mit documentation: http://www.rebol.org/cgi-bin/cgiwrap/rebol/documentation.r?script=acgiss.r ] acgiss: make object! [ ;; --------------------------- ;; Session-related data fields ;; --------------------------- ;; FOR SECURITY, WE RECOMMEND YOU CHANGE ALL OF THESE ;; BEFORE DEPLOYING.....SEE DOCUMENTATION FOR DETAILS. _parameters: reduce [ "session-cookie-id" "acgiss" "session-folder" join what-dir %../acgiss-work-folder/ "session-duration" 24:00:00 ] set-parameter: func [ id [string!] value /local pointer ][ pointer: find/skip _parameters id 2 either none? pointer [ append _parameters id append _parameters value ][ pointer: next pointer poke _parameters index? pointer value ] return true ] get-parameter: func [ id [string!] ][ return select _parameters id ] ;; -------------------------------- ;; Session-related public functions ;; -------------------------------- get-session-record: func [ /local cookie session-file-name session-record ][ ;; Find the incoming cookie, if there is one ;; ----------------------------------------- cookie: select system/options/cgi/other-headers "HTTP_COOKIE" if none? cookie [return _make-session-template-object] ;; If it's one of ours, ;; winkle out the session id ;; ------------------------- cookie: parse/all cookie "=" if not all [ 2 = length? cookie cookie/1 = get-parameter "session-cookie-id" ][return _make-session-template-object] ;; Retrieve the saved session file, if any ;; --------------------------------------- session-file-name: _get-session-file-name join get-parameter "session-cookie-id" ["=" cookie/2] if error? try [ session-record: first reduce load/all decompress read/binary session-file-name ][return _make-session-template-object] ;; Check the session file ain't expired ;; ------------------------------------ probe session-record if all [not none? session-record/session-expires session-record/session-expires < now ][ end-session session-record return _make-session-template-object ] return session-record ] ;; =========================== save-session: func [ session-record [object!] /force-cookie-write ;; print cookie even if we may not need to /local pointer expiry-details session-file-name cookie temp ][ ;; add expires= to cookie if needed ;; -------------------------------- expiry-details: copy "" if not none? session-record/session-expires [ expiry-details: rejoin ["; expires " to-idate session-record/session-expires] ] cookie: rejoin [ "set-cookie: " session-record/session-id expiry-details ] pointer: find system/options/cgi/other-headers "HTTP_COOKIE" ;; write the cookie header, if needed ;; ---------------------------------- ;; the pointer test means this function ;; can be called multiple times, but ;; will write the cookie header at ;; most once. ;; ----------------------------------- if any [ force-cookie-write ;; [need to]/[want to] print cookie header regardless none? pointer ;; new session, so hasn't been written yet ][print cookie] ;; update the HTTP header ;; ---------------------- ;; So any later calls to ;; get-session-data will ;; not create a new session ;; ------------------------ either none? pointer [ append system/options/cgi/other-headers "HTTP_COOKIE" append system/options/cgi/other-headers session-record/session-id ][ poke system/options/cgi/other-headers (1 + index? pointer) session-record/session-id ] ;; update or create the session data record ;; ---------------------------------------- session-record/session-status: "old" session-file-name: _get-session-file-name session-record/session-id if not exists? temp: get-parameter "session-folder" [make-dir/deep temp] write/binary session-file-name compress mold session-record return true ] ;; =========================== end-session: func [ session-record [object!] /local pointer session-file-name ][ ;; remove HTTP header, if any ;; -------------------------- pointer: system/options/cgi/other-headers "HTTP_COOKIE" if not none? pointer [remove remove pointer] ;; remove session file, if any ;; --------------------------- session-file-name: _get-session-file-name session-record/session-id error? try [delete session-file-name] ;; sneak some folder purging in on the sly ;; --------------------------------------- purge-expired-sessions/limit 5 return true ] ;; =========================== extend-session: func [ session-record [object!] extra-time [time!] ;; can be negative to shorten or end a session ][ session-record/session-expires: now + extra-time save-session/force-cookie-write session-record return true ] ;; =========================== purge-expired-sessions: func [ /limit max-to-purge /local session-file-name session-record session-folder ][ if not limit [max-to-purge: 999'999'999] session-folder: get-parameter "session-folder" if not all [exists? session-folder dir? session-folder] [return true] foreach file-name read session-folder [ session-file-name: join session-folder file-name error? try [ session-record: first reduce load/all decompress read/binary session-file-name if session-record/scads-record-type = "acgiss" [ if session-record/session-expires < now [ delete session-file-name max-to-purge: max-to-purge - 1 if max-to-purge < 1 [return true] ] ;; if ] ;; if ] ;; try ] ;; for return true ] ;; --------------------------------- ;; Session-related private functions ;; --------------------------------- _make-session-template-object: func [ /local ent-fields session-expiry ][ ;; entrophy fields ;; --------------- ;; To create a session id that is not easily ;; guessable by someone who knows some external ;; details (like session start time, user ip address) ;; etc. ent-fields: copy [] error? try [append ent-fields to-tuple system/options/cgi/remote-addr] error? try [append ent-fields length? read get-parameter "session-folder"] append ent-fields now/precise append ent-fields mold _parameters random/secure ent-fields session-expiry: none error? try [session-expiry: now + get-parameter "session-duration"] return make object! [ scads-record-type: "acgiss" session-status: "new" session-expires: session-expiry session-id: rejoin [ "" get-parameter "session-cookie-id" "=" _checksum-string random/secure mold ent-fields ] ;; rejoin user-data: copy [] ] ] ;; =========================== _get-session-file-name: func [ session-id ][ return rejoin [get-parameter "session-folder" session-id ".ssd"] ] ;; =========================== _checksum-string: func [ item /local str letters ][ ;; Converts a checksum/secure field into ;; something that is usable as part of a ;; file name on all known REBOL platforms: ;; also adds a little extra randomness for ;; luck letters: "abcdef" str: form checksum/secure item replace str "#" random/secure copy/part letters random/secure 5 replace str "}" random/secure copy/part letters random/secure 5 replace str "{" random/secure copy/part letters random/secure 5 return uppercase str ] ] ;; end of acgiss object
halt ;; to terminate script if DO'ne from webpage
Notes