1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs combinators db.tuples db.types
4 furnace.cache furnace.redirection furnace.sessions
5 furnace.utilities hashtables html.templates.chloe.syntax http
6 http.server kernel logging math.parser namespaces urls ;
9 TUPLE: aside < server-state
10 session method url post-data ;
12 : <aside> ( id -- aside )
13 aside new-server-state ;
16 { "session" "SESSION" BIG-INTEGER +not-null+ }
17 { "method" "METHOD" { VARCHAR 10 } }
19 { "post-data" "POST_DATA" FACTOR-BLOB }
22 CONSTANT: aside-id-key "__a"
24 TUPLE: asides < server-state-manager ;
26 : <asides> ( responder -- responder' )
27 asides new-server-state-manager ;
31 : get-aside ( id -- aside )
32 dup [ aside get-state ] when check-session ;
34 : request-aside-id ( request -- id )
35 aside-id-key swap request-params at string>number ;
37 : request-aside ( request -- aside )
38 request-aside-id get-aside ;
40 : set-aside ( aside -- )
41 [ id>> aside-id set ] when* ;
43 : init-asides ( asides -- )
45 request get request-aside
48 M: asides call-responder*
49 [ init-asides ] [ call-next-method ] bi ;
51 : touch-aside ( aside -- )
52 asides get touch-state ;
54 : begin-aside ( url -- )
57 session get id>> >>session
58 request get method>> >>method
59 request get post-data>> >>post-data
60 [ touch-aside ] [ insert-tuple ] [ set-aside ] tri ;
62 : end-aside-post ( aside -- response )
65 over post-data>> >>post-data
68 [ [ post-data>> params>> params set ] [ url>> url set ] bi ]
69 [ url>> path>> split-path asides get responder>> call-responder ] bi ;
71 \ end-aside-post DEBUG add-input-logging
73 ERROR: end-aside-in-get-error ;
75 : move-on ( id -- response )
76 post-request? [ end-aside-in-get-error ] unless
78 { "GET" [ url>> <redirect> ] }
79 { "HEAD" [ url>> <redirect> ] }
80 { "POST" [ end-aside-post ] }
83 : end-aside ( default -- response )
84 [ drop aside-id get aside-id off get-aside ]
85 [ move-on ] [ <redirect> ] ??if ;
89 "aside" optional-attr {
90 { "none" [ aside-id off ] }
91 { "begin" [ url get begin-aside ] }
96 M: asides modify-query
99 aside-id-key associate assoc-union
102 M: asides modify-form