| ︙ | | |
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
-
-
+
+
|
(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)))
(print "configdat: ")(pp configdat)
(print "sroot: " sroot " logfile: " logfile " dbtype: " dbtype " dbinit: " dbinit " domain: " domain)
;; (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)
|
| ︙ | | |
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
-
+
|
(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
(sdat-set-request-method! self (getenv "REQUEST_METHOD"))
(sdat-set-request-method! self (get-environment-variable "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 (sdat-get-conn self)))
(for-each
(lambda (stmt)
|
| ︙ | | |
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
-
-
+
+
|
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")))
(let ((path-info (get-environment-variable "PATH_INFO"))
(query-string (get-environment-variable "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)
(sdat-set-page! self (car parts)))
;; (session:log self "url-path=" url-path " parts=" parts)
|
| ︙ | | |
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
-
+
|
(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")))
(let ((http-session (get-environment-variable "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))
|
| ︙ | | |
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
|
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
|
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
|
(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)))
(let* ((before-after-ht (cond
((string=? page "*sessionvars*")
(vector (sdat-get-sessionvars self)
(sdat-get-sessionvars-before self)))
((string=? page "*globalvars*")
(vector (sdat-get-globalvars self)
(sdat-get-globalvars-before self)))
(else
(before-slot-name (string->symbol (string-append (symbol->string master-slot-name)
"-before")))
(master-ht (sdat-get-aster-slot-name self))
(before-ht (sdat-get-efore-slot-name self))
|
| ︙ | | |
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
|
512
513
514
515
516
517
518
519
520
521
522
523
524
525
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
(set! changed-count (+ changed-count 1)))
conn
(s:sqlparam ins-query session-id page key master-value)))
(else (err:log "Shouldn't get here")))))
all-keys))) ;; process all keys
(list "*sessionvars*" "*globalvars*" page-name))))))
;; ;; (print del-query)
;; (for-each
;; (lambda (page)
;; (pg:query-for-each (lambda (tuple)
;; (set! status #t))
;; (s:sqlparam del-query session-id page-name)
;; conn))
;; (list page-name "*sessionvars"))
;; ;; NOTE: The following approach is inefficient and a little dangerous. Need to keep
;; ;; two hashes, before and after and use the delta to drive updating the db OR
;; ;; even better move to using rpc with a central process for maintaining state
;; ;; write the session page specific vars to the db
;; (for-each (lambda (key)
;; (pg:query-for-each (lambda (tuple)
;; (set! status #t))
;; (s:sqlparam ins-query session-id page-name
;; (s:any->string key) ;; just in case it is a symbol
;; (hash-table-ref pagevars key))
;; conn))
;; (hash-table-keys pagevars))
;; ;; write the session specific vars to the db
;; ;; BUG!!! THIS IS LAZY AND WILL BREAK FOR SOMEONE ACCESSING THE SAME SESSION FROM TWO WINDOWS!!!
;; (for-each (lambda (key)
;; (pg:query-for-each (lambda (tuple)
;; (set! status #t))
;; (s:sqlparam ins-query session-id "*sessionvars*"
;; (s:any->string key) ;; just in case it is a symbol
;; (hash-table-ref sessionvars key))
;; conn))
;; (hash-table-keys sessionvars))
;; ;; global vars will require a little more care - delaying for now.
;; ))))
|
| ︙ | | |
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
|
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
|
-
-
-
-
+
+
+
+
-
+
|
(let ((newresult (cons (string-append (s:any->string key) "=" (s:any->string val))
result)))
(if (< (length tail) 1) ;; true if done
(string-intersperse newresult "&")
(loop (car tail)(cadr tail)(cddr tail) newresult))))))
(define (session:link-to self page params)
(let* ((server (if (getenv "HTTP_HOST")
(getenv "HTTP_HOST")
(getenv "SERVER_NAME")))
(script (let ((script-name (string-split (getenv "SCRIPT_NAME") "/")))
(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))
(getenv "SCRIPT_NAME")))) ;; build script name from first two elements. This is a hangover from before I used ? in the URL.
(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"))
|
| ︙ | | |