︙ | | | ︙ | |
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
;; TODO
;; Concept of order num incremented with each page access
;; if a branch is taken then a new session would need to be created
;;
;; make-vector-record session session dbtype dbinit conn params path-params session-key session-id domain toppage page curr-page content-type page-type sroot twikidir pagedat alt-page-dat pagevars pagevars-before sessionvars sessionvars-before globalvars globalvars-before logpt formdat request-method session-cookie curr-err log-port logfile seen-pages page-dir-style debugmode
(define (make-sdat)(make-vector 34))
(define (sdat-get-dbtype vec) (vector-ref vec 0))
(define (sdat-get-dbinit vec) (vector-ref vec 1))
(define (sdat-get-conn vec) (vector-ref vec 2))
(define (sdat-get-pgconn vec) (vector-ref (vector-ref vec 2) 1))
(define (sdat-get-params vec) (vector-ref vec 3))
(define (sdat-get-path-params vec) (vector-ref vec 4))
(define (sdat-get-session-key vec) (vector-ref vec 5))
|
|
|
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
;; TODO
;; Concept of order num incremented with each page access
;; if a branch is taken then a new session would need to be created
;;
;; make-vector-record session session dbtype dbinit conn params path-params session-key session-id domain toppage page curr-page content-type page-type sroot twikidir pagedat alt-page-dat pagevars pagevars-before sessionvars sessionvars-before globalvars globalvars-before logpt formdat request-method session-cookie curr-err log-port logfile seen-pages page-dir-style debugmode
(define (make-sdat)(make-vector 35))
(define (sdat-get-dbtype vec) (vector-ref vec 0))
(define (sdat-get-dbinit vec) (vector-ref vec 1))
(define (sdat-get-conn vec) (vector-ref vec 2))
(define (sdat-get-pgconn vec) (vector-ref (vector-ref vec 2) 1))
(define (sdat-get-params vec) (vector-ref vec 3))
(define (sdat-get-path-params vec) (vector-ref vec 4))
(define (sdat-get-session-key vec) (vector-ref vec 5))
|
︙ | | | ︙ | |
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
(define (sdat-get-curr-err vec) (vector-ref vec 27))
(define (sdat-get-log-port vec) (vector-ref vec 28))
(define (sdat-get-logfile vec) (vector-ref vec 29))
(define (sdat-get-seen-pages vec) (vector-ref vec 30))
(define (sdat-get-page-dir-style vec) (vector-ref vec 31))
(define (sdat-get-debugmode vec) (vector-ref vec 32))
(define (sdat-get-shared-hash vec) (vector-ref vec 33))
(define (session:get-shared vec varname)
(hash-table-ref/default (vector-ref vec 33) varname #f))
(define (sdat-set-dbtype! vec val)(vector-set! vec 0 val))
(define (sdat-set-dbinit! vec val)(vector-set! vec 1 val))
(define (sdat-set-conn! vec val)(vector-set! vec 2 val))
|
>
|
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
(define (sdat-get-curr-err vec) (vector-ref vec 27))
(define (sdat-get-log-port vec) (vector-ref vec 28))
(define (sdat-get-logfile vec) (vector-ref vec 29))
(define (sdat-get-seen-pages vec) (vector-ref vec 30))
(define (sdat-get-page-dir-style vec) (vector-ref vec 31))
(define (sdat-get-debugmode vec) (vector-ref vec 32))
(define (sdat-get-shared-hash vec) (vector-ref vec 33))
(define (sdat-get-script vec) (vector-ref vec 34))
(define (session:get-shared vec varname)
(hash-table-ref/default (vector-ref vec 33) varname #f))
(define (sdat-set-dbtype! vec val)(vector-set! vec 0 val))
(define (sdat-set-dbinit! vec val)(vector-set! vec 1 val))
(define (sdat-set-conn! vec val)(vector-set! vec 2 val))
|
︙ | | | ︙ | |
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
(define (sdat-set-curr-err! vec val)(vector-set! vec 27 val))
(define (sdat-set-log-port! vec val)(vector-set! vec 28 val))
(define (sdat-set-logfile! vec val)(vector-set! vec 29 val))
(define (sdat-set-seen-pages! vec val)(vector-set! vec 30 val))
(define (sdat-set-page-dir-style! vec val)(vector-set! vec 31 val))
(define (sdat-set-debugmode! vec val)(vector-set! vec 32 val))
(define (sdat-set-shared-hash! vec val)(vector-set! vec 33 val))
(define (session:set-shared! vec varname val)
(hash-table-set! (vector-ref vec 33) varname val))
;; The global session
(define s:session (make-sdat))
|
>
|
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
(define (sdat-set-curr-err! vec val)(vector-set! vec 27 val))
(define (sdat-set-log-port! vec val)(vector-set! vec 28 val))
(define (sdat-set-logfile! vec val)(vector-set! vec 29 val))
(define (sdat-set-seen-pages! vec val)(vector-set! vec 30 val))
(define (sdat-set-page-dir-style! vec val)(vector-set! vec 31 val))
(define (sdat-set-debugmode! vec val)(vector-set! vec 32 val))
(define (sdat-set-shared-hash! vec val)(vector-set! vec 33 val))
(define (sdat-set-script! vec val)(vector-set! vec 34 val))
(define (session:set-shared! vec varname val)
(hash-table-set! (vector-ref vec 33) varname val))
;; The global session
(define s:session (make-sdat))
|
︙ | | | ︙ | |
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
(sdat-set-pagevars! self (make-hash-table))
(sdat-set-sessionvars! self (make-hash-table))
(sdat-set-globalvars! self (make-hash-table))
(sdat-set-pagevars-before! self (make-hash-table))
(sdat-set-sessionvars-before! self (make-hash-table))
(sdat-set-globalvars-before! self (make-hash-table))
(sdat-set-domain! self "locahost") ;; end of defaults
(let* ((rawconfigdat (session:read-config self))
(configdat (if rawconfigdat (eval rawconfigdat) '()))
(sroot (s:find-param 'sroot configdat))
(logfile (s:find-param 'logfile configdat))
(dbtype (s:find-param 'dbtype configdat))
(dbinit (s:find-param 'dbinit configdat))
(domain (s:find-param 'domain configdat))
(twikidir (s:find-param 'twikidir configdat))
(page-dir (s:find-param 'page-dir-style configdat))
(debugmode (s:find-param 'debugmode configdat)))
(if sroot (sdat-set-sroot! self sroot))
(if logfile (sdat-set-logfile! self logfile))
(if dbtype (sdat-set-dbtype! self dbtype))
(if dbinit (sdat-set-dbinit! self dbinit))
(if domain (sdat-set-domain! self domain))
(if twikidir (sdat-set-twikidir! self twikidir))
(if debugmode (sdat-set-debugmode! self debugmode))
(sdat-set-page-dir-style! self page-dir)
;; (print "configdat: ")(pp configdat)
(if debugmode
(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype
" dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
)
(sdat-set-shared-hash! self (make-hash-table))
|
>
|
>
>
|
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
(sdat-set-pagevars! self (make-hash-table))
(sdat-set-sessionvars! self (make-hash-table))
(sdat-set-globalvars! self (make-hash-table))
(sdat-set-pagevars-before! self (make-hash-table))
(sdat-set-sessionvars-before! self (make-hash-table))
(sdat-set-globalvars-before! self (make-hash-table))
(sdat-set-domain! self "locahost") ;; end of defaults
(sdat-set-script! self #f)
(let* ((rawconfigdat (session:read-config self))
(configdat (if rawconfigdat (eval rawconfigdat) '()))
(sroot (s:find-param 'sroot configdat))
(logfile (s:find-param 'logfile configdat))
(dbtype (s:find-param 'dbtype configdat))
(dbinit (s:find-param 'dbinit configdat))
(domain (s:find-param 'domain configdat))
(twikidir (s:find-param 'twikidir configdat))
(page-dir (s:find-param 'page-dir-style configdat))
(debugmode (s:find-param 'debugmode configdat))
(script (s:find-param 'script configdat)))
(if sroot (sdat-set-sroot! self sroot))
(if logfile (sdat-set-logfile! self logfile))
(if dbtype (sdat-set-dbtype! self dbtype))
(if dbinit (sdat-set-dbinit! self dbinit))
(if domain (sdat-set-domain! self domain))
(if twikidir (sdat-set-twikidir! self twikidir))
(if debugmode (sdat-set-debugmode! self debugmode))
(if script (sdat-set-script! self script))
(sdat-set-page-dir-style! self page-dir)
;; (print "configdat: ")(pp configdat)
(if debugmode
(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype
" dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
)
(sdat-set-shared-hash! self (make-hash-table))
|
︙ | | | ︙ | |
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
|
(string-intersperse newresult "&")
(loop (car tail)(cadr tail)(cddr tail) newresult))))))
(define (session:link-to self page params)
(let* ((server (if (get-environment-variable "HTTP_HOST")
(get-environment-variable "HTTP_HOST")
(get-environment-variable "SERVER_NAME")))
(script (let ((script-name (string-split (get-environment-variable "SCRIPT_NAME") "/")))
(if (> (length script-name) 1)
(string-append (car script-name) "/" (cadr script-name))
(get-environment-variable "SCRIPT_NAME")))) ;; build script name from first two elements. This is a hangover from before I used ? in the URL.
(session-key (sdat-get-session-key self))
(paramstr (session:param->string params)))
;; (session:log self "server=" server " script=" script " page=" page)
(string-append "http://" server "/" script "/" page "?" paramstr))) ;; "/sn=" session-key)))
(define (session:cgi-out self)
(let* ((content (list (sdat-get-content-type self))) ;; '("Content-type: text/html; charset=iso-8859-1\n\n"))
(header (let ((cookie (sdat-get-session-cookie self)))
|
>
>
|
|
|
|
|
|
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
|
(string-intersperse newresult "&")
(loop (car tail)(cadr tail)(cddr tail) newresult))))))
(define (session:link-to self page params)
(let* ((server (if (get-environment-variable "HTTP_HOST")
(get-environment-variable "HTTP_HOST")
(get-environment-variable "SERVER_NAME")))
(force-script (sdat-get-script self))
(script (or force-script
(let ((script-name (string-split (get-environment-variable "SCRIPT_NAME") "/")))
(if (> (length script-name) 1)
(string-append (car script-name) "/" (cadr script-name))
(get-environment-variable "SCRIPT_NAME"))))) ;; build script name from first two elements. This is a hangover from before I used ? in the URL.)
(session-key (sdat-get-session-key self))
(paramstr (session:param->string params)))
;; (session:log self "server=" server " script=" script " page=" page)
(string-append "http://" server "/" script "/" page "?" paramstr))) ;; "/sn=" session-key)))
(define (session:cgi-out self)
(let* ((content (list (sdat-get-content-type self))) ;; '("Content-type: text/html; charset=iso-8859-1\n\n"))
(header (let ((cookie (sdat-get-session-cookie self)))
|
︙ | | | ︙ | |