From 453f55cc5dd18f0af4531f92e91d5f3137c0588a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 29 Apr 2008 05:58:34 -0500 Subject: [PATCH] Rename session-manager to sessions --- extra/http/http-tests.factor | 4 +- .../server/sessions/sessions-tests.factor | 61 +++++------ extra/http/server/sessions/sessions.factor | 101 ++++++++++-------- extra/webapps/counter/counter.factor | 29 +++++ extra/webapps/counter/counter.fhtml | 10 ++ .../factor-website/factor-website.factor | 2 +- 6 files changed, 126 insertions(+), 81 deletions(-) create mode 100644 extra/webapps/counter/counter.factor create mode 100644 extra/webapps/counter/counter.fhtml diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor index e624f56573..0791ce9401 100755 --- a/extra/http/http-tests.factor +++ b/extra/http/http-tests.factor @@ -194,7 +194,7 @@ test-db [ - + sessions-in-db >>sessions "" add-responder add-quit-action @@ -225,7 +225,7 @@ test-db [ [ "text/plain" [ "Hi" write ] >>body ] >>display - + sessions-in-db >>sessions "" add-responder add-quit-action diff --git a/extra/http/server/sessions/sessions-tests.factor b/extra/http/server/sessions/sessions-tests.factor index c95ff30069..b4cf0bd679 100755 --- a/extra/http/server/sessions/sessions-tests.factor +++ b/extra/http/server/sessions/sessions-tests.factor @@ -1,16 +1,12 @@ IN: http.server.sessions.tests USING: tools.test http http.server.sessions -http.server.sessions.storage http.server.sessions.storage.db http.server.actions http.server math namespaces kernel accessors prettyprint io.streams.string io.files splitting destructors sequences db db.sqlite continuations ; : with-session [ - >r - [ session-manager get swap save-session-after ] - [ \ session set ] bi - r> call + >r [ save-session-after ] [ session set ] bi r> call ] with-destructors ; inline TUPLE: foo ; @@ -31,18 +27,18 @@ M: foo call-responder* "id" get session-id-key set-query-param "/" >>path request set - { } session-manager get call-responder + { } sessions get call-responder [ write-response-body drop ] with-string-writer ] with-destructors ; -: session-manager-mock-test +: sessions-mock-test [ "GET" >>method "cookies" get >>cookies "/" >>path request set - { } session-manager get call-responder + { } sessions get call-responder [ write-response-body drop ] with-string-writer ] with-destructors ; @@ -60,14 +56,15 @@ M: foo call-responder* init-sessions-table [ ] [ - - sessions-in-db >>sessions - session-manager set + + sessions set ] unit-test [ - empty-session - 123 >>id session set + [ ] [ + empty-session + 123 >>id session set + ] unit-test [ ] [ 3 "x" sset ] unit-test @@ -81,39 +78,38 @@ M: foo call-responder* ] with-scope [ t ] [ - session-manager get begin-session id>> - session-manager get sessions>> get-session session? + begin-session id>> + get-session session? ] unit-test [ { 5 0 } ] [ [ - session-manager get begin-session + begin-session dup [ 5 "a" sset ] with-session dup [ "a" sget , ] with-session dup [ "x" sget , ] with-session - id>> session-manager get sessions>> delete-session + drop ] { } make ] unit-test [ 0 ] [ - session-manager get begin-session id>> - session-manager get sessions>> get-session [ "x" sget ] with-session + begin-session id>> + get-session [ "x" sget ] with-session ] unit-test [ { 5 0 } ] [ [ - session-manager get begin-session id>> - dup session-manager get sessions>> get-session [ 5 "a" sset ] with-session - dup session-manager get sessions>> get-session [ "a" sget , ] with-session - dup session-manager get sessions>> get-session [ "x" sget , ] with-session - session-manager get sessions>> delete-session + begin-session id>> + dup get-session [ 5 "a" sset ] with-session + dup get-session [ "a" sget , ] with-session + dup get-session [ "x" sget , ] with-session + drop ] { } make ] unit-test [ ] [ - - sessions-in-db >>sessions - session-manager set + + sessions set ] unit-test [ @@ -121,7 +117,7 @@ M: foo call-responder* "GET" >>method "/" >>path request set - { "etc" } session-manager get call-responder response set + { "etc" } sessions get call-responder response set [ "1" ] [ [ response get write-response-body drop ] with-string-writer ] unit-test response get ] with-destructors @@ -129,9 +125,9 @@ M: foo call-responder* [ ] [ response get cookies>> "cookies" set ] unit-test - [ "2" ] [ session-manager-mock-test ] unit-test - [ "3" ] [ session-manager-mock-test ] unit-test - [ "4" ] [ session-manager-mock-test ] unit-test + [ "2" ] [ sessions-mock-test ] unit-test + [ "3" ] [ sessions-mock-test ] unit-test + [ "4" ] [ sessions-mock-test ] unit-test [ [ ] [ @@ -142,8 +138,7 @@ M: foo call-responder* request set [ - { } - sessions-in-db >>sessions + { } call-responder ] with-destructors response set ] unit-test diff --git a/extra/http/server/sessions/sessions.factor b/extra/http/server/sessions/sessions.factor index df2a5bbd28..a428fb79b9 100755 --- a/extra/http/server/sessions/sessions.factor +++ b/extra/http/server/sessions/sessions.factor @@ -1,13 +1,10 @@ ! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs kernel math.parser namespaces random -accessors quotations hashtables sequences continuations -fry calendar combinators destructors -http -http.server -http.server.sessions.storage -http.server.sessions.storage.null -html.elements ; +USING: assocs kernel math.intervals math.parser namespaces +random accessors quotations hashtables sequences continuations +fry calendar combinators destructors alarms +db db.tuples db.types +http http.server html.elements ; IN: http.server.sessions TUPLE: session id expires namespace changed? ; @@ -16,6 +13,28 @@ TUPLE: session id expires namespace changed? ; session new swap >>id ; +session "SESSIONS" +{ + { "id" "ID" +random-id+ system-random-generator } + { "expires" "EXPIRES" BIG-INTEGER +not-null+ } + { "namespace" "NAMESPACE" FACTOR-BLOB } +} define-persistent + +: get-session ( id -- session ) + dup [ select-tuple ] when ; + +: init-sessions-table session ensure-table ; + +: expired-sessions ( -- session ) + f + -1.0/0.0 now timestamp>millis [a,b] >>expires + select-tuples ; + +: start-expiring-sessions ( db seq -- ) + '[ + , , [ expired-sessions [ delete-tuple ] each ] with-db + ] 5 minutes every drop ; + GENERIC: init-session* ( responder -- ) M: object init-session* drop ; @@ -24,12 +43,11 @@ M: dispatcher init-session* default>> init-session* ; M: filter-responder init-session* responder>> init-session* ; -TUPLE: session-manager < filter-responder sessions timeout domain ; +TUPLE: sessions < filter-responder timeout domain ; -: ( responder -- responder' ) - session-manager new +: ( responder -- responder' ) + sessions new swap >>responder - null-sessions >>sessions 20 minutes >>timeout ; : (session-changed) ( session -- ) @@ -50,11 +68,11 @@ TUPLE: session-manager < filter-responder sessions timeout domain ; [ namespace>> swap change-at ] keep (session-changed) ; inline -: init-session ( session managed -- ) - >r session r> '[ , init-session* ] with-variable ; +: init-session ( session -- ) + session [ sessions get init-session* ] with-variable ; : cutoff-time ( -- time ) - session-manager get timeout>> from-now timestamp>millis ; + sessions get timeout>> from-now timestamp>millis ; : touch-session ( session -- ) cutoff-time >>expires drop ; @@ -64,57 +82,50 @@ TUPLE: session-manager < filter-responder sessions timeout domain ; H{ } clone >>namespace dup touch-session ; -: begin-session ( responder -- session ) - >r empty-session r> - [ init-session ] - [ sessions>> new-session ] - [ drop ] - 2tri ; +: begin-session ( -- session ) + empty-session [ init-session ] [ insert-tuple ] [ ] tri ; ! Destructor -TUPLE: session-saver manager session ; +TUPLE: session-saver session ; C: session-saver M: session-saver dispose - [ session>> ] [ manager>> sessions>> ] bi - over changed?>> [ - [ drop touch-session ] [ update-session ] 2bi - ] [ 2drop ] if ; + session>> dup changed?>> [ + [ touch-session ] [ update-tuple ] bi + ] [ drop ] if ; -: save-session-after ( manager session -- ) +: save-session-after ( session -- ) add-always-destructor ; -: existing-session ( path manager session -- response ) - [ nip session set ] - [ save-session-after ] - [ drop responder>> ] 2tri - call-responder ; +: existing-session ( path session -- response ) + [ session set ] [ save-session-after ] bi + sessions get responder>> call-responder ; : session-id-key "factorsessid" ; -: cookie-session-id ( -- id/f ) - request get session-id-key get-cookie +: cookie-session-id ( request -- id/f ) + session-id-key get-cookie dup [ value>> string>number ] when ; -: post-session-id ( -- id/f ) - session-id-key request get post-data>> at string>number ; +: post-session-id ( request -- id/f ) + session-id-key swap post-data>> at string>number ; : request-session-id ( -- id/f ) - request get method>> { + request get dup method>> { { "GET" [ cookie-session-id ] } { "HEAD" [ cookie-session-id ] } { "POST" [ post-session-id ] } } case ; -: request-session ( responder -- session/f ) - >r request-session-id r> sessions>> get-session ; +: request-session ( -- session/f ) + request-session-id get-session ; : ( id -- cookie ) session-id-key - "$session-manager" resolve-base-path >>path - session-manager get timeout>> from-now >>expires - session-manager get domain>> >>domain ; + "$sessions" resolve-base-path >>path + sessions get timeout>> from-now >>expires + sessions get domain>> >>domain ; : put-session-cookie ( response -- response' ) session get id>> number>string put-cookie ; @@ -126,8 +137,8 @@ M: session-saver dispose session get id>> number>string =value input/> ; -M: session-manager call-responder* ( path responder -- response ) +M: sessions call-responder* ( path responder -- response ) [ session-form-field ] add-form-hook - dup session-manager set - dup request-session [ dup begin-session ] unless* + sessions set + request-session [ begin-session ] unless* existing-session put-session-cookie ; diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor new file mode 100644 index 0000000000..37b4c8e5e1 --- /dev/null +++ b/extra/webapps/counter/counter.factor @@ -0,0 +1,29 @@ +USING: math kernel accessors http.server http.server.actions +http.server.sessions http.server.templating.fhtml locals ; +IN: webapps.counter + +SYMBOL: count + +TUPLE: counter-app < dispatcher ; + +M: counter-app init-session* + drop 0 count sset ; + +:: ( quot -- action ) + [ + count quot schange + "" f + ] >>display ; + +: ( -- action ) + [ + "text/html" + "resource:extra/webapps/counter/counter.fhtml" >>body + ] >>display ; + +: ( -- responder ) + counter-app new-dispatcher + [ 1+ ] "inc" add-responder + [ 1- ] "dec" add-responder + "" add-responder + ; diff --git a/extra/webapps/counter/counter.fhtml b/extra/webapps/counter/counter.fhtml new file mode 100644 index 0000000000..521096f105 --- /dev/null +++ b/extra/webapps/counter/counter.fhtml @@ -0,0 +1,10 @@ +<% USING: io math.parser http.server.sessions webapps.counter ; %> + + + +

<% count sget number>string write %>

+ + ++ + -- + + diff --git a/extra/webapps/factor-website/factor-website.factor b/extra/webapps/factor-website/factor-website.factor index 0c7b95525e..4136024f03 100644 --- a/extra/webapps/factor-website/factor-website.factor +++ b/extra/webapps/factor-website/factor-website.factor @@ -47,7 +47,7 @@ IN: webapps.factor-website "page" factor-template >>template - + sessions-in-db >>sessions test-db ;