Rename session-manager to sessions
Slava Pestov
parent
ee46527023
commit
453f55cc5d
|
|
@ -194,7 +194,7 @@ test-db [
|
|||
<dispatcher>
|
||||
<action> <protected>
|
||||
<login>
|
||||
<session-manager>
|
||||
<sessions>
|
||||
sessions-in-db >>sessions
|
||||
"" add-responder
|
||||
add-quit-action
|
||||
|
|
@ -225,7 +225,7 @@ test-db [
|
|||
<dispatcher>
|
||||
<action> [ "text/plain" <content> [ "Hi" write ] >>body ] >>display
|
||||
<login>
|
||||
<session-manager>
|
||||
<sessions>
|
||||
sessions-in-db >>sessions
|
||||
"" add-responder
|
||||
add-quit-action
|
||||
|
|
|
|||
|
|
@ -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
|
||||
[
|
||||
<request>
|
||||
"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
|
||||
|
||||
[ ] [
|
||||
<foo> <session-manager>
|
||||
sessions-in-db >>sessions
|
||||
session-manager set
|
||||
<foo> <sessions>
|
||||
sessions set
|
||||
] unit-test
|
||||
|
||||
[
|
||||
[ ] [
|
||||
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
|
||||
|
||||
[ ] [
|
||||
<foo> <session-manager>
|
||||
sessions-in-db >>sessions
|
||||
session-manager set
|
||||
<foo> <sessions>
|
||||
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
|
||||
|
||||
[
|
||||
{ } <exiting-action> <session-manager>
|
||||
sessions-in-db >>sessions
|
||||
{ } <exiting-action> <sessions>
|
||||
call-responder
|
||||
] with-destructors response set
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -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 [ <session> select-tuple ] when ;
|
||||
|
||||
: init-sessions-table session ensure-table ;
|
||||
|
||||
: expired-sessions ( -- session )
|
||||
f <session>
|
||||
-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 ;
|
||||
|
||||
: <session-manager> ( responder -- responder' )
|
||||
session-manager new
|
||||
: <sessions> ( 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> 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 -- )
|
||||
<session-saver> 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 ;
|
||||
|
||||
: <session-cookie> ( id -- cookie )
|
||||
session-id-key <cookie>
|
||||
"$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 <session-cookie> 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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
:: <counter-action> ( quot -- action )
|
||||
<action> [
|
||||
count quot schange
|
||||
"" f <standard-redirect>
|
||||
] >>display ;
|
||||
|
||||
: <display-action> ( -- action )
|
||||
<action> [
|
||||
"text/html" <content>
|
||||
"resource:extra/webapps/counter/counter.fhtml" <fhtml> >>body
|
||||
] >>display ;
|
||||
|
||||
: <counter-app> ( -- responder )
|
||||
counter-app new-dispatcher
|
||||
[ 1+ ] <counter-action> "inc" add-responder
|
||||
[ 1- ] <counter-action> "dec" add-responder
|
||||
<display-action> "" add-responder
|
||||
<sessions> ;
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
<% USING: io math.parser http.server.sessions webapps.counter ; %>
|
||||
|
||||
<html>
|
||||
<body>
|
||||
<h1><% count sget number>string write %></h1>
|
||||
|
||||
<a href="inc">++</a>
|
||||
<a href="dec">--</a>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -47,7 +47,7 @@ IN: webapps.factor-website
|
|||
<boilerplate>
|
||||
"page" factor-template >>template
|
||||
<flows>
|
||||
<session-manager>
|
||||
<sessions>
|
||||
sessions-in-db >>sessions
|
||||
test-db <db-persistence> ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue