1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
|
-
-
+
+
+
+
+
+
+
+
-
+
|
;; Copyright 2007-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(declare (unit session))
(use (prefix dbi dbi:))
;; (declare (unit session))
(module session
*
(import chicken scheme data-structures extras srfi-13 ports posix files srfi-1)
(use formdat html-filter misc-stml)
(use (prefix dbi dbi:) srfi-69)
(require-extension regex)
(declare (uses cookie))
(use cookie) ;; (declare (uses cookie))
;; sessions table
;; id session_id session_key
;; create table sessions (id serial not null,session-key text);
;; session_vars table
;; id session_id page_id key value
|
761
762
763
764
765
766
767
768
769
770
771
772
773
774
|
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
|
+
+
+
+
+
+
+
+
+
+
+
|
"\r")
"\\r")
res)) ;; should return #f if not a string and can't escape it?
(else (if (string? res)
(s:html-filter->string res '())
res)))))
#;(define (session:get-param-from params key)
(let ((r1 (regexp (conc "^" (s:any->string key) "=(.*)$"))))
(if (null? params) #f
(let loop ((head (car params))
(tail (cdr params)))
(let ((match (string-match r1 head)))
(if match
(list-ref match 1)
(if (null? tail) #f
(loop (car tail)(cdr tail)))))))))
;; params are stored as list of key=val
;;
(define (session:get-param self key type-params)
;; (session:log s:session "params=" (slot-ref s:session 'params))
(let* ((params (sdat-get-params self))
(res (session:get-param-from params key)))
(session:apply-type-preference res type-params)))
|
866
867
868
869
870
871
872
|
883
884
885
886
887
888
889
890
891
892
893
894
895
896
|
+
+
+
+
+
+
+
|
(print "Content-Length: " (if (blob? dat)
(blob-size dat)
0))
(print "Keep-Alive: timeout=15, max=100")
(print "Connection: Keep-Alive")
(print "")
(write-string (blob->string dat) #f (current-output-port))))
;; was in setup
;;
(define (s:log . msg)
(apply session:log s:session msg))
)
|