| ︙ | | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
-
+
|
;; 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 33))
(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))
|
| ︙ | | |
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
+
+
+
+
+
|
(define (sdat-get-session-cookie vec) (vector-ref vec 26))
(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))
(define (sdat-set-params! vec val)(vector-set! vec 3 val))
(define (sdat-set-path-params! vec val)(vector-set! vec 4 val))
(define (sdat-set-session-key! vec val)(vector-set! vec 5 val))
(define (sdat-set-session-id! vec val)(vector-set! vec 6 val))
|
| ︙ | | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
+
+
+
+
|
(define (sdat-set-session-cookie! vec val)(vector-set! vec 26 val))
(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))
;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT
(define (session:initialize self)
(sdat-set-dbtype! self 'pg)
|
| ︙ | | |
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
+
+
+
+
|
(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))
)
;; Used for the strangely inconsistent handling of the config file. A better way is needed.
;;
;; (let ((dbtype (sdat-get-dbtype self)))
;; (print "dbtype: " dbtype)
;; (sdat-set-dbtype! self (eval dbtype))))
(define (session:setup self)
(let ((dbtype (sdat-get-dbtype self))
(debugmode (sdat-get-debugmode self))
|
| ︙ | | |
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
+
|
(if (file-exists? dbfname)
(begin
;; (session:log self "setting dbexists to #t")
(set! dbexists #t))))
(if debugmode (session:log self "INFO: setting up for pg db access to account info " dbinit)))
(if debugmode (session:log self "dbtype: " dbtype " dbfname: " dbfname " dbexists: " dbexists)))
(sdat-set-conn! self (dbi:open dbtype dbinit))
(set! *db* (sdat-get-conn self))
(if (and (not dbexists)(eq? dbtype 'sqlite3))
(begin
(print "WARNING: Setting up session db with sqlite3")
(session:setup-db self)))
(session:process-url-path self)
(session:setup-session-key self)
;; capture stdin if this is a POST
|
| ︙ | | |
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
|
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
|
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
+
|
(let* ((dir-style (sdat-get-page-dir-style self));; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
(dir (string-append (sdat-get-sroot self)
(if dir-style
(conc "/pages/")
(conc "/pages/" page)))))
(case dir-style
;; NB// Stored always loads both control and view
((stored)
((stored)((eval (string->symbol (conc "pages:" page)))))
((dir)
((eval (string->symbol (conc "pages:" page)))
self ;; the session
(sdat-get-conn self) ;; the db connection
(sdat-get-shared-hash self) ;; a shared hash table for passing data to/from page calls
))
((flat)
(load (conc dir page ".so"))
((eval (string->symbol (conc "pages:" page)))
self ;; the session
(sdat-get-conn self) ;; the db connection
(sdat-get-shared-hash self) ;; a shared hash table for passing data to/from page calls
))
;; first the control
(let ((control-file (conc "pages/" page "_ctrl.scm"))
(view-file (conc "pages/" page "_view.scm")))
(if (and (file-exists? control-file)
(not (eq? parts 'view)))
(begin
(session:set-called! self page)
(load control-file)))
(if (file-exists? view-file)
(if (not (eq? parts 'control))
(session:process-file view-file))
(list "<p>Page not found " page " </p>"))))
;; (let ((control-file (conc "pages/" page "_ctrl.scm"))
;; (view-file (conc "pages/" page "_view.scm")))
;; (if (and (file-exists? control-file)
;; (not (eq? parts 'view)))
;; (begin
;; (session:set-called! self page)
;; (load control-file)))
;; (if (file-exists? view-file)
;; (if (not (eq? parts 'control))
;; (session:process-file view-file))
;; (list "<p>Page not found " page " </p>")))
((flat))
|
| ︙ | | |