Overview
Comment:Bit more ported
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | move-to-ck4.7.x
Files: files | file ages | folders
SHA1: d3ad3e868e25dc407625777e02924da276267d0a
User & Date: matt on 2011-10-02 07:18:33
Other Links: branch diff | manifest | tags
Context
2011-10-02
19:47
Mostly ported to Chicken 4.7.x check-in: 2274e4ac36 user: matt tags: move-to-ck4.7.x
07:18
Bit more ported check-in: d3ad3e868e user: matt tags: move-to-ck4.7.x
05:44
Partially ported. Removing dependency on tinyclos check-in: d78243d7c2 user: matt tags: move-to-ck4.7.x
Changes

Modified session.scm from [42f79a48ef] to [0f87b604f7].

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92



































































93
94
95
96
97
98
99
19
20
21
22
23
24
25



































































26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








;; 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-session:sdat)(make-vector 33))
(define-inline (session:sdat-get-dbtype               vec)    (vector-ref  vec 0))
(define-inline (session:sdat-get-dbinit               vec)    (vector-ref  vec 1))
(define-inline (session:sdat-get-conn                 vec)    (vector-ref  vec 2))
(define-inline (session:sdat-get-params               vec)    (vector-ref  vec 3))
(define-inline (session:sdat-get-path-params          vec)    (vector-ref  vec 4))
(define-inline (session:sdat-get-session-key          vec)    (vector-ref  vec 5))
(define-inline (session:sdat-get-session-id           vec)    (vector-ref  vec 6))
(define-inline (session:sdat-get-domain               vec)    (vector-ref  vec 7))
(define-inline (session:sdat-get-toppage              vec)    (vector-ref  vec 8))
(define-inline (session:sdat-get-page                 vec)    (vector-ref  vec 9))
(define-inline (session:sdat-get-curr-page            vec)    (vector-ref  vec 10))
(define-inline (session:sdat-get-content-type         vec)    (vector-ref  vec 11))
(define-inline (session:sdat-get-page-type            vec)    (vector-ref  vec 12))
(define-inline (session:sdat-get-sroot                vec)    (vector-ref  vec 13))
(define-inline (session:sdat-get-twikidir             vec)    (vector-ref  vec 14))
(define-inline (session:sdat-get-pagedat              vec)    (vector-ref  vec 15))
(define-inline (session:sdat-get-alt-page-dat         vec)    (vector-ref  vec 16))
(define-inline (session:sdat-get-pagevars             vec)    (vector-ref  vec 17))
(define-inline (session:sdat-get-pagevars-before      vec)    (vector-ref  vec 18))
(define-inline (session:sdat-get-sessionvars          vec)    (vector-ref  vec 19))
(define-inline (session:sdat-get-sessionvars-before   vec)    (vector-ref  vec 20))
(define-inline (session:sdat-get-globalvars           vec)    (vector-ref  vec 21))
(define-inline (session:sdat-get-globalvars-before    vec)    (vector-ref  vec 22))
(define-inline (session:sdat-get-logpt                vec)    (vector-ref  vec 23))
(define-inline (session:sdat-get-formdat              vec)    (vector-ref  vec 24))
(define-inline (session:sdat-get-request-method       vec)    (vector-ref  vec 25))
(define-inline (session:sdat-get-session-cookie       vec)    (vector-ref  vec 26))
(define-inline (session:sdat-get-curr-err             vec)    (vector-ref  vec 27))
(define-inline (session:sdat-get-log-port             vec)    (vector-ref  vec 28))
(define-inline (session:sdat-get-logfile              vec)    (vector-ref  vec 29))
(define-inline (session:sdat-get-seen-pages           vec)    (vector-ref  vec 30))
(define-inline (session:sdat-get-page-dir-style       vec)    (vector-ref  vec 31))
(define-inline (session:sdat-get-debugmode            vec)    (vector-ref  vec 32))
(define-inline (session:sdat-set-dbtype!              vec val)(vector-set! vec 0 val))
(define-inline (session:sdat-set-dbinit!              vec val)(vector-set! vec 1 val))
(define-inline (session:sdat-set-conn!                vec val)(vector-set! vec 2 val))
(define-inline (session:sdat-set-params!              vec val)(vector-set! vec 3 val))
(define-inline (session:sdat-set-path-params!         vec val)(vector-set! vec 4 val))
(define-inline (session:sdat-set-session-key!         vec val)(vector-set! vec 5 val))
(define-inline (session:sdat-set-session-id!          vec val)(vector-set! vec 6 val))
(define-inline (session:sdat-set-domain!              vec val)(vector-set! vec 7 val))
(define-inline (session:sdat-set-toppage!             vec val)(vector-set! vec 8 val))
(define-inline (session:sdat-set-page!                vec val)(vector-set! vec 9 val))
(define-inline (session:sdat-set-curr-page!           vec val)(vector-set! vec 10 val))
(define-inline (session:sdat-set-content-type!        vec val)(vector-set! vec 11 val))
(define-inline (session:sdat-set-page-type!           vec val)(vector-set! vec 12 val))
(define-inline (session:sdat-set-sroot!               vec val)(vector-set! vec 13 val))
(define-inline (session:sdat-set-twikidir!            vec val)(vector-set! vec 14 val))
(define-inline (session:sdat-set-pagedat!             vec val)(vector-set! vec 15 val))
(define-inline (session:sdat-set-alt-page-dat!        vec val)(vector-set! vec 16 val))
(define-inline (session:sdat-set-pagevars!            vec val)(vector-set! vec 17 val))
(define-inline (session:sdat-set-pagevars-before!     vec val)(vector-set! vec 18 val))
(define-inline (session:sdat-set-sessionvars!         vec val)(vector-set! vec 19 val))
(define-inline (session:sdat-set-sessionvars-before!  vec val)(vector-set! vec 20 val))
(define-inline (session:sdat-set-globalvars!          vec val)(vector-set! vec 21 val))
(define-inline (session:sdat-set-globalvars-before!   vec val)(vector-set! vec 22 val))
(define-inline (session:sdat-set-logpt!               vec val)(vector-set! vec 23 val))
(define-inline (session:sdat-set-formdat!             vec val)(vector-set! vec 24 val))
(define-inline (session:sdat-set-request-method!      vec val)(vector-set! vec 25 val))
(define-inline (session:sdat-set-session-cookie!      vec val)(vector-set! vec 26 val))
(define-inline (session:sdat-set-curr-err!            vec val)(vector-set! vec 27 val))
(define-inline (session:sdat-set-log-port!            vec val)(vector-set! vec 28 val))
(define-inline (session:sdat-set-logfile!             vec val)(vector-set! vec 29 val))
(define-inline (session:sdat-set-seen-pages!          vec val)(vector-set! vec 30 val))
(define-inline (session:sdat-set-page-dir-style!      vec val)(vector-set! vec 31 val))
(define-inline (session:sdat-set-debugmode!           vec val)(vector-set! vec 32 val))
(define (make-sdat)(make-vector 33))
(define-inline (sdat-get-dbtype               vec)    (vector-ref  vec 0))
(define-inline (sdat-get-dbinit               vec)    (vector-ref  vec 1))
(define-inline (sdat-get-conn                 vec)    (vector-ref  vec 2))
(define-inline (sdat-get-params               vec)    (vector-ref  vec 3))
(define-inline (sdat-get-path-params          vec)    (vector-ref  vec 4))
(define-inline (sdat-get-session-key          vec)    (vector-ref  vec 5))
(define-inline (sdat-get-session-id           vec)    (vector-ref  vec 6))
(define-inline (sdat-get-domain               vec)    (vector-ref  vec 7))
(define-inline (sdat-get-toppage              vec)    (vector-ref  vec 8))
(define-inline (sdat-get-page                 vec)    (vector-ref  vec 9))
(define-inline (sdat-get-curr-page            vec)    (vector-ref  vec 10))
(define-inline (sdat-get-content-type         vec)    (vector-ref  vec 11))
(define-inline (sdat-get-page-type            vec)    (vector-ref  vec 12))
(define-inline (sdat-get-sroot                vec)    (vector-ref  vec 13))
(define-inline (sdat-get-twikidir             vec)    (vector-ref  vec 14))
(define-inline (sdat-get-pagedat              vec)    (vector-ref  vec 15))
(define-inline (sdat-get-alt-page-dat         vec)    (vector-ref  vec 16))
(define-inline (sdat-get-pagevars             vec)    (vector-ref  vec 17))
(define-inline (sdat-get-pagevars-before      vec)    (vector-ref  vec 18))
(define-inline (sdat-get-sessionvars          vec)    (vector-ref  vec 19))
(define-inline (sdat-get-sessionvars-before   vec)    (vector-ref  vec 20))
(define-inline (sdat-get-globalvars           vec)    (vector-ref  vec 21))
(define-inline (sdat-get-globalvars-before    vec)    (vector-ref  vec 22))
(define-inline (sdat-get-logpt                vec)    (vector-ref  vec 23))
(define-inline (sdat-get-formdat              vec)    (vector-ref  vec 24))
(define-inline (sdat-get-request-method       vec)    (vector-ref  vec 25))
(define-inline (sdat-get-session-cookie       vec)    (vector-ref  vec 26))
(define-inline (sdat-get-curr-err             vec)    (vector-ref  vec 27))
(define-inline (sdat-get-log-port             vec)    (vector-ref  vec 28))
(define-inline (sdat-get-logfile              vec)    (vector-ref  vec 29))
(define-inline (sdat-get-seen-pages           vec)    (vector-ref  vec 30))
(define-inline (sdat-get-page-dir-style       vec)    (vector-ref  vec 31))
(define-inline (sdat-get-debugmode            vec)    (vector-ref  vec 32))
(define-inline (sdat-set-dbtype!              vec val)(vector-set! vec 0 val))
(define-inline (sdat-set-dbinit!              vec val)(vector-set! vec 1 val))
(define-inline (sdat-set-conn!                vec val)(vector-set! vec 2 val))
(define-inline (sdat-set-params!              vec val)(vector-set! vec 3 val))
(define-inline (sdat-set-path-params!         vec val)(vector-set! vec 4 val))
(define-inline (sdat-set-session-key!         vec val)(vector-set! vec 5 val))
(define-inline (sdat-set-session-id!          vec val)(vector-set! vec 6 val))
(define-inline (sdat-set-domain!              vec val)(vector-set! vec 7 val))
(define-inline (sdat-set-toppage!             vec val)(vector-set! vec 8 val))
(define-inline (sdat-set-page!                vec val)(vector-set! vec 9 val))
(define-inline (sdat-set-curr-page!           vec val)(vector-set! vec 10 val))
(define-inline (sdat-set-content-type!        vec val)(vector-set! vec 11 val))
(define-inline (sdat-set-page-type!           vec val)(vector-set! vec 12 val))
(define-inline (sdat-set-sroot!               vec val)(vector-set! vec 13 val))
(define-inline (sdat-set-twikidir!            vec val)(vector-set! vec 14 val))
(define-inline (sdat-set-pagedat!             vec val)(vector-set! vec 15 val))
(define-inline (sdat-set-alt-page-dat!        vec val)(vector-set! vec 16 val))
(define-inline (sdat-set-pagevars!            vec val)(vector-set! vec 17 val))
(define-inline (sdat-set-pagevars-before!     vec val)(vector-set! vec 18 val))
(define-inline (sdat-set-sessionvars!         vec val)(vector-set! vec 19 val))
(define-inline (sdat-set-sessionvars-before!  vec val)(vector-set! vec 20 val))
(define-inline (sdat-set-globalvars!          vec val)(vector-set! vec 21 val))
(define-inline (sdat-set-globalvars-before!   vec val)(vector-set! vec 22 val))
(define-inline (sdat-set-logpt!               vec val)(vector-set! vec 23 val))
(define-inline (sdat-set-formdat!             vec val)(vector-set! vec 24 val))
(define-inline (sdat-set-request-method!      vec val)(vector-set! vec 25 val))
(define-inline (sdat-set-session-cookie!      vec val)(vector-set! vec 26 val))
(define-inline (sdat-set-curr-err!            vec val)(vector-set! vec 27 val))
(define-inline (sdat-set-log-port!            vec val)(vector-set! vec 28 val))
(define-inline (sdat-set-logfile!             vec val)(vector-set! vec 29 val))
(define-inline (sdat-set-seen-pages!          vec val)(vector-set! vec 30 val))
(define-inline (sdat-set-page-dir-style!      vec val)(vector-set! vec 31 val))
(define-inline (sdat-set-debugmode!           vec val)(vector-set! vec 32 val))

;; (define-class <session> ()
;;   (dbtype       ;; 'pg or 'sqlite3
;;    dbinit
;;    conn
;;    params       ;; params from the key=val&key1=val2 string
;;    path-params  ;; remaining params from the path
124
125
126
127
128
129
130
131
132
133
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


165
166
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182
183


184
185
186
187

188
189
190
191
192
193
194
195

196
197
198
199
200
201
202
203
204
205
206
207




208
209
210

211
212
213
214
215

216
217
218
219

220
221
222
223
224

225
226
227

228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246

247
248
249

250
251

252
253
254
255

256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

277
278
279
280

281
282
283
284
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314
315
316
317
318

319
320
321
322
323
324
325
326
327
328
329
330

331
332
333
334
335
336
337
338
339

340
341
342
343


344
345
346

347
348
349
350
351


352
353
354
355
356
357
358
359
360
361
362
363

364
365
366
367
368

369
370
371
372
373
374

375
376
377


378
379
380
381
382
383
384
385
386
387
388

389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413
414
415
416
417









418
419
420
421
422
423
424
124
125
126
127
128
129
130

















131
132
133
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
165
166
167
168
169
170
171
172
173
174
175
176


177
178
179
180
181
182
183
184
185
186
187

188
189
190
191
192
193
194
195


196
197
198
199
200

201
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216
217




218
219
220
221
222
223

224
225
226
227
228

229
230
231
232

233
234
235
236
237

238
239
240

241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259

260
261
262

263
264

265
266
267
268

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289

290
291
292
293

294
295
296
297
298
299
300
301
302
303
304
305

306
307
308
309
310
311
312
313
314
315
316
317
318
319

320
321
322
323
324
325
326
327
328
329
330
331

332
333
334
335
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
351
352

353
354
355


356
357
358
359

360
361
362
363


364
365
366
367
368
369
370
371
372
373
374
375
376

377
378
379
380
381

382
383
384
385
386
387

388
389


390
391
392
393
394
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418

419
420
421
422









423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+









-
+







-
-
+
+



-
+







-
+








-
-
-
-
+
+
+
+


-
+




-
+



-
+




-
+


-
+


















-
+


-
+

-
+



-
+




















-
+



-
+











-
+













-
+











-
+











-
+








-
+


-
-
+
+


-
+



-
-
+
+











-
+




-
+





-
+

-
-
+
+










-
+
















-
+



-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







;;    logfile
;;    seen-pages
;;    page-dir-style  ;; #t = new style, #f = old style
;;    debugmode))

;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT
(define (initialize self)
  (session:sdat-set-dbtype! self      'pg)
  (session:sdat-set-page! self        "home")        ;; these are defaults
  (session:sdat-set-curr-page! self   "home")
  (session:sdat-set-content-type! self "Content-type: text/html; charset=iso-8859-1\n\n")
  (session:sdat-set-page-type! self   'html)
  (session:sdat-set-toppage! self     "index")
  (session:sdat-set-params! self      '())           ;;
  (session:sdat-set-path-params! self '())
  (session:sdat-set-session-key! self #f)
  (session:sdat-set-pagedat! self     '())
  (session:sdat-set-alt-page-dat! self #f)
  (session:sdat-set-sroot! self       "./")
  (session:sdat-set-session-cookie! self #f)
  (session:sdat-set-curr-err! self #f)
  (session:sdat-set-log-port! self (current-error-port))
  (session:sdat-set-seen-pages! self '())
  (session:sdat-set-page-dir-style! self #t) ;; #t : pages/<pagename>_(view|cntl).scm
  (sdat-set-dbtype! self      'pg)
  (sdat-set-page! self        "home")        ;; these are defaults
  (sdat-set-curr-page! self   "home")
  (sdat-set-content-type! self "Content-type: text/html; charset=iso-8859-1\n\n")
  (sdat-set-page-type! self   'html)
  (sdat-set-toppage! self     "index")
  (sdat-set-params! self      '())           ;;
  (sdat-set-path-params! self '())
  (sdat-set-session-key! self #f)
  (sdat-set-pagedat! self     '())
  (sdat-set-alt-page-dat! self #f)
  (sdat-set-sroot! self       "./")
  (sdat-set-session-cookie! self #f)
  (sdat-set-curr-err! self #f)
  (sdat-set-log-port! self (current-error-port))
  (sdat-set-seen-pages! self '())
  (sdat-set-page-dir-style! self #t) ;; #t : pages/<pagename>_(view|cntl).scm
                                      ;; #f : pages/<pagename>/(view|control).scm 
  (session:sdat-set-debugmode! self #f)
  (for-each (lambda (slot-name)
              (session:sdat-set-lot-name! self (make-hash-table)))
            (list 'pagevars 'sessionvars 'globalvars 'pagevars-before 
		  'sessionvars-before 'globalvars-before))
  (session:sdat-set-domain! self "locahost")   ;; end of defaults
  (initialize-slots self (session:read-config self))

  (sdat-set-debugmode!          self #f)
  			     
  (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) '()))
  ;; FIXME - NOT AUTOMATICALLY TRANSLATED
  ;; some values read in from the config file need to be evaled
  (session:sdat-set-dbtype! self (eval (session:sdat-get-dbtype self))))

	 (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)))
    (print "configdat: ")(pp configdat)
    (print "sroot: " sroot " logfile: " logfile " dbtype: " dbtype " dbinit: " dbinit " domain: " domain)
    (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))))
;;   (let ((dbtype (sdat-get-dbtype self)))
;;     (print "dbtype: " dbtype)
;;     (sdat-set-dbtype! self (eval dbtype))))

(define (session:setup self)
  (let ((dbtype (session:sdat-get-dbtype self))
	(dbinit (eval (session:sdat-get-dbinit self)))
  (let ((dbtype (sdat-get-dbtype self))
	(dbinit (eval (sdat-get-dbinit self)))
	(dbexists #f))
    (let ((dbfname (alist-ref 'dbname dbinit)))
      (if (eq? dbtype 'sqlite3)
	  (if (file-exists? dbfname)
	      (begin
		;; (session:log self "setting dbexists to #t")
		(set! dbexists #t))))
      ;; (session:log self "dbtype: " dbtype " dbfname: " dbfname " dbexists: " dbexists))
      )
    (session:sdat-set-conn! self (dbi:open dbtype dbinit))
    (sdat-set-conn! self (dbi:open dbtype dbinit))
    (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
    (session:sdat-set-request-method! self (getenv "REQUEST_METHOD"))
    (session:sdat-set-formdat! self (formdat:load-all))))
    (sdat-set-request-method! self (getenv "REQUEST_METHOD"))
    (sdat-set-formdat! self (formdat:load-all))))

;; setup the db with session tables, works for sqlite only right now
(define (session:setup-db self)
  (let ((conn (session:sdat-get-conn self)))
  (let ((conn (sdat-get-conn self)))
    (for-each 
     (lambda (stmt)
       (dbi:exec conn stmt))
     (list "CREATE TABLE session_vars (id INTEGER PRIMARY KEY,session_id INTEGER,page TEXT,key TEXT,value TEXT);"
	   "CREATE TABLE sessions (id INTEGER PRIMARY KEY,session_key TEXT,last_used TIMESTAMP);"
           "CREATE TABLE metadata (id INTEGER PRIMARY KEY,key TEXT,value TEXT);"))))
;;  ;; if we have a session_key look up the session-id and store it
;;  (session:sdat-set-session-id! self (session:get-id self)))
;;  (sdat-set-session-id! self (session:get-id self)))

;; only set session-cookie when a new session is created
(define (session:setup-session-key self)  
  (let* ((sk  (session:extract-session-key self))
         (sid (if sk (session:get-id self sk) #f)))
    (if (not sid) ;; need a new key
        (let* ((new-key (session:get-new-key self))
               (new-sid (session:get-id self new-key)))
          (session:sdat-set-session-key! self new-key)
          (session:sdat-set-session-id! self new-sid)
          (session:sdat-set-session-cookie! self (session:make-cookie self)))
        (session:sdat-set-session-id! self sid))))
          (sdat-set-session-key! self new-key)
          (sdat-set-session-id! self new-sid)
          (sdat-set-session-cookie! self (session:make-cookie self)))
        (sdat-set-session-id! self sid))))

(define (session:make-cookie self)
  ;; (list (conc "session_key=" (session:sdat-get-session-key self) "; Path=/; Domain=." (session:sdat-get-domain self) "; Max-Age=" (* 86400 14) "; Version=1"))) 
  ;; (list (conc "session_key=" (sdat-get-session-key self) "; Path=/; Domain=." (sdat-get-domain self) "; Max-Age=" (* 86400 14) "; Version=1"))) 
  (list (string-substitute 
	 ";" "; " 
	 (car (construct-cookie-string 
	       ;; warning! messing up this itty bitty bit of code will cost much time!
	       `(("session_key" ,(session:sdat-get-session-key self)
	       `(("session_key" ,(sdat-get-session-key self)
		  expires: ,(+ (current-seconds) (* 14 86400)) 
		  max-age: (* 14 86400)
		  path: "/" ;; 
		  domain: ,(string-append "." (session:sdat-get-domain self))
		  domain: ,(string-append "." (sdat-get-domain self))
		  version: 1)) 0)))))

;; look up a given session key and return the id if found, #f if not found
(define (session:get-id self session-key)
  ;; (let ((session-key (session:sdat-get-session-key self)))
  ;; (let ((session-key (sdat-get-session-key self)))
  (if session-key
      (let ((query (string-append "SELECT id FROM sessions WHERE session_key='" session-key "'"))
            (conn (session:sdat-get-conn self))
            (conn (sdat-get-conn self))
            (result #f))
	(dbi:for-each-row 
	 (lambda (tuple)
	   (set! result (vector-ref tuple 0)))
	 conn query)
	(if result (dbi:exec conn (conc "UPDATE sessions SET last_used=" (dbi:now conn) " WHERE session_key=?;") session-key))
        result)
      #f))

;; 
(define (session:process-url-path self)
  (let ((path-info    (getenv "PATH_INFO"))
	(query-string (getenv "QUERY_STRING")))
    ;; (session:log self "path-info=" path-info " query-string=" query-string)
    (if path-info
	(let* ((parts    (string-split path-info "/"))
	       (numparts (length parts)))
	  (if (> numparts 0)
	      (session:sdat-set-page! self (car parts)))
	      (sdat-set-page! self (car parts)))
	  ;; (session:log self "url-path=" url-path " parts=" parts)
	  (if (> numparts 1)
	      (session:sdat-set-path-params! self (cdr parts)))
	      (sdat-set-path-params! self (cdr parts)))
          (if query-string
              (session:sdat-set-params! self (string-split query-string "&")))))))
              (sdat-set-params! self (string-split query-string "&")))))))

;; BUGGY!
(define (session:get-new-key self)
  (let ((conn   (session:sdat-get-conn self))
  (let ((conn   (sdat-get-conn self))
        (tmpkey (session:make-rand-string 20))
        (status #f))
    (dbi:for-each-row (lambda (tuple)
			(set! status #t))
		      conn (string-append "INSERT INTO sessions (session_key) VALUES ('" tmpkey "')"))
    tmpkey))

;; returns session key IFF it is in the HTTP_COOKIE 
(define (session:extract-session-key self)
  (let ((http-session (getenv "HTTP_COOKIE")))
    (if http-session 
        (session:extract-key-from-param self (list http-session) "session_key")
        #f)))

(define (session:get-session-id self session-key)
  (let ((query "SELECT id FROM sessions WHERE session_key=?;")
        (result #f))
    ;;     (pg:query-for-each (lambda (tuple)
    ;;                          (set! result (vector-ref tuple 0))) ;; (vector-ref tuple 0)))
    ;;                        (s:sqlparam query session-key)
    ;;                        (session:sdat-get-conn self))
    ;;                        (sdat-get-conn self))
    ;;                        conn)
    (dbi:for-each-row (lambda (tuple)
			(set! result (vector-ref tuple 0))) ;; (vector-ref tuple 0)))
		      (session:sdat-get-conn self)
		      (sdat-get-conn self)
		      (s:sqlparam query session-key))
    result))

;; delete all records for a session
;;
(define (session:delete-session self session-key)
  (let ((session-id (session:get-session-id self session-key))
        (qry        (conc "BEGIN;"
			  "DELETE FROM session_vars WHERE session_id=?;"
                          "DELETE FROM sessions WHERE id=?;"
			  "COMMIT;"))
        (conn              (session:sdat-get-conn self)))
        (conn              (sdat-get-conn self)))
    (if session-id
        (begin
          (dbi:exec conn qry session-id session-id)
	  (initialize self '())
	  (session:setup self)))
    (not (session:get-session-id self session-key))))

;; (define (session:delete-session self session-key)
;;   (let ((session-id (session:get-session-id self session-key))
;;         (queries    (list "BEGIN;"
;; 			  "DELETE FROM session_vars WHERE session_id=?;"
;;                           "DELETE FROM sessions WHERE id=?;"
;; 			  "COMMIT;"))
;;         (conn              (session:sdat-get-conn self)))
;;         (conn              (sdat-get-conn self)))
;;     (if session-id
;;         (begin
;;           (for-each
;;            (lambda (query)
;;              (dbi:exec conn query session-id))
;; 	   queries)
;; 	  (initialize self '())
;; 	  (session:setup self)))
;;     (not (session:get-session-id self session-key))))

(define (session:extract-key self key)
  (let ((params (session:sdat-get-params self)))
  (let ((params (sdat-get-params self)))
    (session:extract-key-from-param self params key)))

(define (session:extract-key-from-param self params key)
  (let ((r1     (regexp (string-append "^" key "=([^=]+)$"))))
    (if (< (length params) 1) #f
	(let loop ((head   (car params))
		   (tail   (cdr params)))
	  (let ((match (string-match r1 head)))
	    (cond
	     (match
	      (let ((session-key (list-ref match 1)))
		(session:sdat-set-session-key! self (list-ref match 1))
		(sdat-set-session-key! self (list-ref match 1))
		session-key))
	     ((null? tail)
	      #f)
	     (else
	      (loop (car tail)
		    (cdr tail)))))))))

(define (session:set-page! self page_name)
  (session:sdat-set-page! self page_name))
  (sdat-set-page! self page_name))

(define (session:close self)
  (dbi:close (session:sdat-get-conn self)))
;; (close-output-port (session:sdat-get-logpt self))
  (dbi:close (sdat-get-conn self)))
;; (close-output-port (sdat-get-logpt self))

(define (session:err-msg self msg)
  (hash-table-set! (session:sdat-get-sessionvars self) "ERROR_MSG"
  (hash-table-set! (sdat-get-sessionvars self) "ERROR_MSG"
		   (string-intersperse (map s:any->string msg) " ")))

(define (session:prev-err self)
  (let ((prev-err (hash-table-ref/default (session:sdat-get-sessionvars-before self) "ERROR_MSG" #f))
	(curr-err (hash-table-ref/default (session:sdat-get-sessionvars self) "ERROR_MSG" #f)))
  (let ((prev-err (hash-table-ref/default (sdat-get-sessionvars-before self) "ERROR_MSG" #f))
	(curr-err (hash-table-ref/default (sdat-get-sessionvars self) "ERROR_MSG" #f)))
    (if prev-err prev-err
	(if curr-err curr-err #f))))

;; session vars
;; 1. keys are always a string NOT a symbol
;; 2. values are always a string conversion is the responsibility of the 
;;    consuming function (at least for now, I'd like to change this)

;; set a session var for the current page
;;
(define (session:set! self key value)
  (hash-table-set! (session:sdat-get-pagevars self) (s:any->string key) (s:any->string value)))
  (hash-table-set! (sdat-get-pagevars self) (s:any->string key) (s:any->string value)))

;; del a var for the current page
;;
(define (session:del! self key)
  (hash-table-delete! (session:sdat-get-pagevars self) (s:any->string key)))
  (hash-table-delete! (sdat-get-pagevars self) (s:any->string key)))

;; get the appropriate hash given a page "*sessionvars*, *globalvars* or page
;;
(define (session:get-page-hash self page)
  (if (string=? page "*sessionvars*")
      (session:sdat-get-sessionvars self)
      (sdat-get-sessionvars self)
      (if (string=? page "*globalvars*")
	  (session:sdat-get-globalvars self)
	  (session:sdat-get-pagevars self))))
	  (sdat-get-globalvars self)
	  (sdat-get-pagevars self))))

;; set a session var for a given page
;;
(define (session:set! self page key value)
  (let ((ht (session:get-page-hash self page)))
    (hash-table-set! ht (s:any->string key) (s:any->string value))))

;; get session vars for the current page
;;
(define (session:get self key)
  (hash-table-ref/default (session:sdat-get-pagevars self) key #f))
  (hash-table-ref/default (sdat-get-pagevars self) key #f))

;; get session vars for a specified page
;;
(define (session:get self page key)
  (let ((ht (session:get-page-hash self page)))
    (hash-table-ref/default ht key #f)))

;; delete a session var for a specified page
;;
(define (session:del! self page key)
  (let ((ht (session:get-page-hash self page)))
    (hash-table-delete! ht key)))

;; get ALL keys for this page and store in the session pagevars hash
;;
(define (session:get-vars self)
  (let ((session-id  (session:sdat-get-session-id self)))
  (let ((session-id  (sdat-get-session-id self)))
    (if (not session-id)
	(err:log "ERROR: No session id in session object! session:get-vars")
	(let* ((result             #f)
	       (conn               (session:sdat-get-conn self))
	       (pagevars-before    (session:sdat-get-pagevars-before self))
	       (sessionvars-before (session:sdat-get-sessionvars-before self))
	       (globalvars-before  (session:sdat-get-globalvars-before self))
	       (pagevars           (session:sdat-get-pagevars self))
	       (sessionvars        (session:sdat-get-sessionvars self))
	       (globalvars         (session:sdat-get-globalvars self))
	       (page-name          (session:sdat-get-page self))
	       (session-key        (session:sdat-get-session-key self))
	       (conn               (sdat-get-conn self))
	       (pagevars-before    (sdat-get-pagevars-before self))
	       (sessionvars-before (sdat-get-sessionvars-before self))
	       (globalvars-before  (sdat-get-globalvars-before self))
	       (pagevars           (sdat-get-pagevars self))
	       (sessionvars        (sdat-get-sessionvars self))
	       (globalvars         (sdat-get-globalvars self))
	       (page-name          (sdat-get-page self))
	       (session-key        (sdat-get-session-key self))
	       (query              (string-append
				    "SELECT key,value FROM session_vars INNER JOIN sessions ON session_vars.session_id=sessions.id "
				    "WHERE session_key=? AND page=?;")))
	  ;; first the page specific vars
	  (dbi:for-each-row (lambda (tuple)
			      (let ((k (vector-ref tuple 0))
				    (v (vector-ref tuple 1)))
441
442
443
444
445
446
447
448

449
450
451
452
453


454
455
456
457
458
459
460
461
462
463
464
465
466
467
468


469
470
471
472
473
474
475
455
456
457
458
459
460
461

462
463
464
465


466
467
468
469
470
471
472
473
474
475
476
477
478
479
480


481
482
483
484
485
486
487
488
489







-
+



-
-
+
+













-
-
+
+







				(hash-table-set! globalvars-before k v)
				(hash-table-set! globalvars        k v)))
			    conn
			    (s:sqlparam query session-key "*globalvars"))
	  ))))

(define (session:save-vars self)
  (let ((session-id  (session:sdat-get-session-id self)))
  (let ((session-id  (sdat-get-session-id self)))
    (if (not session-id)
	(err:log "ERROR: No session id in session object! session:get-vars")
	(let* ((status      #f)
	       (conn        (session:sdat-get-conn self))
	       (page-name   (session:sdat-get-page self))
	       (conn        (sdat-get-conn self))
	       (page-name   (sdat-get-page self))
	       (del-query   "DELETE FROM session_vars WHERE session_id=? AND page=? AND key=?;")
	       (ins-query   "INSERT INTO session_vars (session_id,page,key,value) VALUES(?,?,?,?);")
	       (upd-query   "UPDATE session_vars set value=? WHERE key=? AND session_id=? AND page=?;")
	       (changed-count 0))
	  ;; save the delta only
	  (for-each
	   (lambda (page) ;; page is: "*globalvars*" "*sessionvars*" or otherstring
	     (let* ((master-slot-name (cond
				       ((string=? page "*sessionvars*") 'sessionvars)
				       ((string=? page "*globalvars*")  'globalvars)
				       (else 'pagevars)))
		    (before-slot-name (string->symbol (string-append (symbol->string master-slot-name)
								     "-before")))
		    (master-ht   (session:sdat-get-aster-slot-name self))
		    (before-ht   (session:sdat-get-efore-slot-name self))
		    (master-ht   (sdat-get-aster-slot-name self))
		    (before-ht   (sdat-get-efore-slot-name self))
		    (master-keys (hash-table-keys master-ht))
		    (before-keys (hash-table-keys before-ht))
		    (all-keys (delete-duplicates (append master-keys before-keys))))
	       (for-each 
		(lambda (key)
		  (let ((master-value (hash-table-ref/default master-ht key #f))
			(before-value (hash-table-ref/default before-ht key #f)))
563
564
565
566
567
568
569
570
571
572
573
574





575
576
577
578
579
580
581
577
578
579
580
581
582
583





584
585
586
587
588
589
590
591
592
593
594
595







-
-
-
-
-
+
+
+
+
+







	  res
	  (loop (read-line p)(append res (list hed)))))))

;; May 2011, putting all pages into one directory for the following reasons:
;;   1. want filename to reflect page name (emacs limitation)
;;   2. that's it! no other reason. could make it configurable ...
(define (session:call-parts self page parts)
  (session:sdat-set-curr-page! self page)
  ;; (session:log self "page-dir-style: " (session:sdat-get-page-dir-style self))
  (let* ((dir-style ;; (equal? (session:sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
	  (session:sdat-get-page-dir-style self))
	 (dir     (string-append (session:sdat-get-sroot self) 
  (sdat-set-curr-page! self page)
  ;; (session:log self "page-dir-style: " (sdat-get-page-dir-style self))
  (let* ((dir-style ;; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
	  (sdat-get-page-dir-style self))
	 (dir     (string-append (sdat-get-sroot self) 
				 (if dir-style 
				     (conc "/pages/")
				     (conc "/pages/" page))))
	 (control (string-append dir (if dir-style 
					 (conc page "_ctrl.scm")
					 "/control.scm")))
	 (view    (string-append dir (if dir-style 
629
630
631
632
633
634
635
636
637


638
639
640
641
642
643
644
645

646
647
648

649
650
651
652
653
654
655
643
644
645
646
647
648
649


650
651
652
653
654
655
656
657
658

659
660
661

662
663
664
665
666
667
668
669







-
-
+
+







-
+


-
+







(define (session:call self page)
  (session:call-parts self page 'both))

(define (session:call self page parts)
  (session:call-parts self page 'both))

(define (session:load-model self model)
  (let ((model.scm (string-append (session:sdat-get-sroot self) "/models/" model ".scm"))
	(model.so  (string-append (session:sdat-get-sroot self) "/models/" model ".so")))
  (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
    (if (file-exists? model.so)
	(load model.so)
	(if (file-exists? model.scm)
	    (load model.scm)
	    (s:log "ERROR: model " model.scm " not found")))))

(define (session:model-path self model)
  (string-append (session:sdat-get-sroot self) "/models/" model ".scm"))
  (string-append (sdat-get-sroot self) "/models/" model ".scm"))

(define (session:pp-formdat self)
  (let ((dat (formdat:all->strings (session:sdat-get-formdat self))))
  (let ((dat (formdat:all->strings (sdat-get-formdat self))))
    (string-intersperse dat "<br> ")))

(define (session:param->string params)
  ;; (err:log "params=" params)
  (if (< (length params) 1)
      ""
      (let loop ((key (car params))
666
667
668
669
670
671
672
673

674
675
676
677
678
679
680


681
682
683
684
685

686
687
688
689
690

691
692
693
694
695
696

697
698
699
700
701

702
703
704
705
706
707
708
709
710
711
712
713

714
715
716
717
718
719
720
680
681
682
683
684
685
686

687
688
689
690
691
692


693
694
695
696
697
698

699
700
701
702
703

704
705
706
707
708
709

710
711
712
713
714

715
716
717
718
719
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734







-
+





-
-
+
+




-
+




-
+





-
+




-
+











-
+







  (let* ((server    (if (getenv "HTTP_HOST")
			(getenv "HTTP_HOST")
			(getenv "SERVER_NAME")))
	 (script (let ((script-name (string-split (getenv "SCRIPT_NAME") "/")))
		   (if (> (length script-name) 1)
		       (string-append (car script-name) "/" (cadr script-name))
		       (getenv "SCRIPT_NAME")))) ;; build script name from first two elements. This is a hangover from before I used ? in the URL.
	 (session-key (session:sdat-get-session-key self))
	 (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 (session:sdat-get-content-type self))) ;; '("Content-type: text/html; charset=iso-8859-1\n\n"))
	 (header   (let ((cookie (session:sdat-get-session-cookie 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)))
		     (if cookie
			 (cons (string-append "Set-Cookie: " (car cookie))
			       content)
			 content)))
	 (pagedat  (session:sdat-get-pagedat self)))
	 (pagedat  (sdat-get-pagedat self)))
    (s:cgi-out 
     (cons header pagedat))))

(define (session:log self . msg)
  (with-output-to-port (session:sdat-get-log-port self) ;; (session:sdat-get-logpt self)
  (with-output-to-port (sdat-get-log-port self) ;; (sdat-get-logpt self)
    (lambda () 
      (apply print msg))))

(define (session:get-param self key)
  ;; (session:log s:session "params=" (slot-ref s:session 'params))
  (let ((params (session:sdat-get-params self)))
  (let ((params (sdat-get-params self)))
    (session:get-param-from params key)))

;; This one will get the first value found regardless of form
(define (session:get-input self key)
  (let* ((formdat (session:sdat-get-formdat self)))
  (let* ((formdat (sdat-get-formdat self)))
    (if (not formdat) #f
	(if (or (string? key)(number? key)(symbol? key))
	    (if (eq? (class-of formdat) <formdat>)
		(formdat:get formdat key)
		(begin
		  (session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
		  #f))
	    (session:log self "ERROR: bad key " key)))))

(define (session:run-actions self)
  (let* ((action    (session:get-param self 'action))
	 (page      (session:sdat-get-page self)))
	 (page      (sdat-get-page self)))
    ;; (print "action=" action " page=" page)
    (if action
	(let ((action-lst  (string-split action ".")))
	  ;; (print "action-lst=" action-lst)
	  (if (not (= (length action-lst) 2)) 
	      (err:log "Action should be of form: module.action")
	      (let* ((targ-page   (car action-lst))
733
734
735
736
737
738
739
740

741
742
743

744
745
746
747
748
749
750

751
752
753
754

755
756
757
758
759
760
761
762
747
748
749
750
751
752
753

754
755
756

757
758
759
760
761
762
763

764
765
766
767

768
769
770
771
772
773
774
775
776







-
+


-
+






-
+



-
+








				    ((exn file) (s:log "file error"))
				    ((exn i/o)  (s:log "i/o error"))
				    ((exn )     (s:log "Action not implemented: " proc-name " action: " targ-action))
				    (var ()     (s:log "Unknown Error"))))))))))

(define (session:never-called-page? self page)
  (session:log self "Checking for page: " page)
  (not (member page (session:sdat-get-seen-pages self))))
  (not (member page (sdat-get-seen-pages self))))

(define (session:set-called! self page)
  (session:sdat-set-seen-pages! self (cons page (session:sdat-get-seen-pages self))))
  (sdat-set-seen-pages! self (cons page (sdat-get-seen-pages self))))

;;======================================================================
;; Alternative data type delivery
;;======================================================================

(define (session:alt-out self)
  (let ((dat (session:sdat-get-alt-page-dat self)))
  (let ((dat (sdat-get-alt-page-dat self)))
    ;; (s:log "dat is: " dat)
    ;; (print "HTTP/1.1 200 OK")
    (print "Date: " (time->string (seconds->utc-time (current-seconds))))
    (print "Content-Type: " (session:sdat-get-content-type self))
    (print "Content-Type: " (sdat-get-content-type self))
    (print "Accept-Ranges: bytes")
    (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))))

Modified setup.scm from [9d72fef321] to [a5066a3ddf].

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
27
28
29
30
31

32
33
34
35

36
37
38
39
40
41

42
43
44

45
46
47
48
49
50
51
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
27
28
29
30
31

32
33
34
35

36
37
38
39
40
41

42
43
44

45
46
47
48
49
50
51
52










-
+
+



















-
+



-
+





-
+


-
+







;; Copyright 2007-2008, 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.

;; 
(define s:session (make <session>))
(define s:session (make-sdat))
(initialize s:session)

;; use this for getting data from page to page when scope and evals
;; get in the way
(define s:local-vars (make-hash-table))

(define (s:local-set! k v)
  (hash-table-set! s:local-vars k v))

(define (s:local-get k)
  (hash-table-ref/default s:local-vars k #f))

(session:setup s:session)

(define (s:log . msg)
  (apply session:log s:session msg))

(session:get-vars s:session)

(define (s:set-err . args)
  (slot-set! s:session 'curr-err args))
  (sdat-set-curr-err s:session args))

;; Usage: (s:get-err s:big)
(define (s:get-err wrapperfunc)
  (let ((errmsg (slot-ref s:session 'curr-err)))
  (let ((errmsg (sdat-get-curr-err s:session)))
    (if errmsg ((if wrapperfunc
                    wrapperfunc
                    s:strong) errmsg) '())))

(define (s:current-page)
  (slot-ref s:session 'page))
  (sdat-get-page s:session))

(define (s:delete-session)
  (session:delete-session s:session (slot-ref s:session 'session-key)))
  (session:delete-session s:session (sdat-get-sesson-key s:session)))

(define (s:call page . partsl)
  (if (null? partsl)
      (session:call s:session page)
      (session:call s:session page (car partsl))))

(define (s:link-to page . params)
91
92
93
94
95
96
97
98

99
100
101
102
92
93
94
95
96
97
98

99
100
101
102
103







-
+




(define (s:load-model model)
  (session:load-model s:session model))

(define (s:model-path model)
  (session:model-path s:session model))

(define (s:db)
  (slot-ref s:session 'conn))
  (sdat-get-conn s:session))

(define (s:never-called-page? page)
  (session:never-called-page? s:session page))

Modified tests/test.scm from [0840de6e92] to [525e5f0347].

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
27
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
27
28
29
30
31












+
+
+
+







-
+







#!/usr/local/bin/csi -q 

;; Copyright 2007-2008, 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.

(use test md5)

(require-extension sqlite3)
(import (prefix sqlite3 sqlite3:))

(require-library dbi)

(load "./requirements.scm")
(load "./misc-stml.scm")
(load "./formdat.scm")
(load "./stml.scm")
(load "./session.scm")
(load "./sqltbl.scm")
;(load "./sqltbl.scm")
(load "./html-filter.scm")
(load "./keystore.scm")

;; Test the primitive dbi interface

(system "rm -f tests/test.db")
(define db (dbi:open 'sqlite3 '((dbname . "tests/test.db"))))