Overview
Comment:Mostly ported to Chicken 4.7.x
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | move-to-ck4.7.x
Files: files | file ages | folders
SHA1: 2274e4ac364cdf83d1ccc2c48130eb6a4c0f030a
User & Date: matt on 2011-10-02 19:47:56
Other Links: branch diff | manifest | tags
Context
2011-10-02
22:22
90% ported to chicken-scheme v4.7.0 check-in: 45412597aa user: matt tags: move-to-ck4.7.x
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
Changes

Modified Makefile from [1d36e0d212] to [90551885a6].

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
SOFILES     = $(MODULEFILES:%.scm=%.so)
CFILES      = $(MODULEFILES:%.scm=%.c)
OFILES      = $(MODULEFILES:%.scm=%.o)
TARGFILES   = $(notdir $(SOFILES))
MODULES     = $(addprefix $(TARGDIR)/modules/,$(TARGFILES))

install : $(TARGDIR)/stmlrun $(LOGDIR) $(MODULES)



stmlrun : stmlrun.scm formdat.scm  misc-stml.scm  session.scm stml.scm \
          setup.scm html-filter.scm requirements.scm keystore.scm \
          sugar.scm
	csc stmlrun.scm


$(TARGDIR)/stmlrun : stmlrun 
	cp stmlrun $(TARGDIR)
	chmod a+rx $(TARGDIR)/stmlrun

$(TARGDIR)/modules :
	mkdir -p $(TARGDIR)/modules

$(MODULES) : $(SOFILES) $(TARGDIR)/modules
	cp $< $@

# logging currently relies on this
#
$(LOGDIR) :
	mkdir -p $(LOGDIR)
	chmod a+rwx $(LOGDIR)

test: kiatoa.db
	echo '(exit)'| csi -q  ./tests/test.scm 

# modules
#
%.so : %.scm
	csc -I modules/* -s $<

all : $(SOFILES)

dbi.so : dbi.scm
	csc -i dbi.scm

installdbi : dbi.so
	cp dbi.so /usr/local/lib/chicken/3/
# 
# $(CFILES): build/%.c: ../scm/%.scm ../scm/macros.scm
# 	chicken $< -output-file $@
# 
# 
# $(OFILES): src/%.o: src/%.c
# 	gcc -c $< `chicken-config -cflags` -o $@
# 
# $(src_code): %: src/%.o src/laedlib.o src/layobj.o
# 	gcc src/$*.o src/laedlib.o src/layobj.o -o $* `chicken-config -libs`
# 







>
>



|



















|







|
|
|
|
|
|
<











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
53
54
55
56
57
58

59
60
61
62
63
64
65
66
67
68
69
SOFILES     = $(MODULEFILES:%.scm=%.so)
CFILES      = $(MODULEFILES:%.scm=%.c)
OFILES      = $(MODULEFILES:%.scm=%.o)
TARGFILES   = $(notdir $(SOFILES))
MODULES     = $(addprefix $(TARGDIR)/modules/,$(TARGFILES))

install : $(TARGDIR)/stmlrun $(LOGDIR) $(MODULES)

all : $(SOFILES)

stmlrun : stmlrun.scm formdat.scm  misc-stml.scm  session.scm stml.scm \
          setup.scm html-filter.scm requirements.scm keystore.scm \
          cookie.scm
	csc stmlrun.scm


$(TARGDIR)/stmlrun : stmlrun 
	cp stmlrun $(TARGDIR)
	chmod a+rx $(TARGDIR)/stmlrun

$(TARGDIR)/modules :
	mkdir -p $(TARGDIR)/modules

$(MODULES) : $(SOFILES) $(TARGDIR)/modules
	cp $< $@

# logging currently relies on this
#
$(LOGDIR) :
	mkdir -p $(LOGDIR)
	chmod a+rwx $(LOGDIR)

test: kiatoa.db cookie.so
	echo '(exit)'| csi -q  ./tests/test.scm 

# modules
#
%.so : %.scm
	csc -I modules/* -s $<

# Cookie is a special case for now. Make a loadable so for test
# Complile it in by include (see dependencies above).
cookie.so : cookie.scm
	csc -s cookie.scm
	


# 
# $(CFILES): build/%.c: ../scm/%.scm ../scm/macros.scm
# 	chicken $< -output-file $@
# 
# 
# $(OFILES): src/%.o: src/%.c
# 	gcc -c $< `chicken-config -cflags` -o $@
# 
# $(src_code): %: src/%.o src/laedlib.o src/layobj.o
# 	gcc src/$*.o src/laedlib.o src/layobj.o -o $* `chicken-config -libs`
# 

Modified formdat.scm from [3adbf991ae] to [36ecd60344].

145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
(define formdat:bin-data-name-rex (regexp "\\Wname=\"([^\"]+)\""))
(define formdat:bin-file-name-rex (regexp "\\Wfilename=\"([^\"]+)\""))
(define formdat:bin-file-type-rex (regexp "Content-Type:\\s+([^\\s]+)"))
(define formdat:delim-patt-rex    (regexp "^\\-+[0-9]+\\-*$"))

;; returns a hash with entries for all forms - could well use a proplist?
(define (formdat:load-all)
  (let ((request-method (getenv "REQUEST_METHOD")))
    (if (and request-method
	     (string=? request-method "POST"))
	(formdat:load-all-port (current-input-port)))))

;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
  (let* ((formdat        (make-formdat:formdat)))







|







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
(define formdat:bin-data-name-rex (regexp "\\Wname=\"([^\"]+)\""))
(define formdat:bin-file-name-rex (regexp "\\Wfilename=\"([^\"]+)\""))
(define formdat:bin-file-type-rex (regexp "Content-Type:\\s+([^\\s]+)"))
(define formdat:delim-patt-rex    (regexp "^\\-+[0-9]+\\-*$"))

;; returns a hash with entries for all forms - could well use a proplist?
(define (formdat:load-all)
  (let ((request-method (get-environment-variable "REQUEST_METHOD")))
    (if (and request-method
	     (string=? request-method "POST"))
	(formdat:load-all-port (current-input-port)))))

;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
  (let* ((formdat        (make-formdat:formdat)))

Modified misc-stml.scm from [97e4132f22] to [f5de1fb05e].

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
		   (s:html (s:head 
			    (s:title err)
			    (s:body
			     (s:h1 "ERROR")
			     (s:p err)))))))

(define (s:validate-uri)
  (let ((uri (getenv "REQUEST_URI"))
	(qrs (getenv "QUERY_STRING")))
    (if (not uri)
	(set! uri qrs))
    (if uri
	(string-match 
	 (regexp "^(/[a-z\\-\\._:0-9]*)*(|\\?([A-Za-z0-9_\\-\\+]+=[A-Za-z0-9_\\-\\.\\+]*&{0,1})*)$") uri)
	(begin
	  (s:log "REQUEST URI NOT AVAILABLE!")
	  (let ((p (open-input-pipe "env")))
	    (let loop ((l (read-line p))
		       (res '()))
	      (if (eof-object? l)
		  (s:log res)
		  (loop (read-line p)(cons (list l "<BR>") res)))))
	  #t))))

(define (s:validate-inputs)
  (if (not (s:validate-uri))(begin (s:error-page "Bad URI" (let ((ref (getenv "HTTP_REFERER")))
							     (if ref
								 (list "referred from" ref)
								 "")))
				   (exit))))

;; anything except a list is converted to a string!!!
(define (s:any->string val)







|
|
















|







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
		   (s:html (s:head 
			    (s:title err)
			    (s:body
			     (s:h1 "ERROR")
			     (s:p err)))))))

(define (s:validate-uri)
  (let ((uri (get-environment-variable "REQUEST_URI"))
	(qrs (get-environment-variable "QUERY_STRING")))
    (if (not uri)
	(set! uri qrs))
    (if uri
	(string-match 
	 (regexp "^(/[a-z\\-\\._:0-9]*)*(|\\?([A-Za-z0-9_\\-\\+]+=[A-Za-z0-9_\\-\\.\\+]*&{0,1})*)$") uri)
	(begin
	  (s:log "REQUEST URI NOT AVAILABLE!")
	  (let ((p (open-input-pipe "env")))
	    (let loop ((l (read-line p))
		       (res '()))
	      (if (eof-object? l)
		  (s:log res)
		  (loop (read-line p)(cons (list l "<BR>") res)))))
	  #t))))

(define (s:validate-inputs)
  (if (not (s:validate-uri))(begin (s:error-page "Bad URI" (let ((ref (get-environment-variable "HTTP_REFERER")))
							     (if ref
								 (list "referred from" ref)
								 "")))
				   (exit))))

;; anything except a list is converted to a string!!!
(define (s:any->string val)

Modified session.scm from [0f87b604f7] to [4f92f7adcd].

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)
    (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)







|
|







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)
    (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
    (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-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)







|







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 (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
	 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)
	      (sdat-set-page! self (car parts)))
	  ;; (session:log self "url-path=" url-path " parts=" parts)







|
|







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    (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
    (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))







|







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 (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
	       (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   (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)))







|
|
>
>
|
>
>
|
<
>
|
|
|







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* ((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 

					(vector (sdat-get-pagevars self)
						(sdat-get-pagevars-before self)))))
		    (master-ht   (vector-ref before-after-ht 0))
		    (before-ht   (vector-ref before-after-ht 1))
		    (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)))
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
					  (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.
;;           ))))

;; (pg:sql-null-object? element)
(define (session:read-config self)
  (let ((name (string-append "." (pathname-file (car (argv))) ".config")))
    (if (not (file-exists? name))
	(print name " not found at " (current-directory))
	(let* ((fp (open-input-file name))
	       (initargs (read fp)))







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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))))))


































;; (pg:sql-null-object? element)
(define (session:read-config self)
  (let ((name (string-append "." (pathname-file (car (argv))) ".config")))
    (if (not (file-exists? name))
	(print name " not found at " (current-directory))
	(let* ((fp (open-input-file name))
	       (initargs (read fp)))
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
	(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") "/")))
		   (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 (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"))







|
|
|
|


|







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 (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"))

Modified setup.scm from [a5066a3ddf] to [c6717dd49d].

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
                    wrapperfunc
                    s:strong) errmsg) '())))

(define (s:current-page)
  (sdat-get-page s:session))

(define (s:delete-session)
  (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)







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
                    wrapperfunc
                    s:strong) errmsg) '())))

(define (s:current-page)
  (sdat-get-page s:session))

(define (s:delete-session)
  (session:delete-session s:session (sdat-get-session-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)

Modified stmlrun.scm from [88627319f4] to [cf9034b401].

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
;;  PURPOSE.

;; (require-extension syntax-case)
;; (declare (run-time-macros))

(require-library dbi)

(define getenv get-environment-variable)
(include "requirements.scm")
(include "cookie.scm")
(include "html-filter.scm")
(include "misc-stml.scm")
(include "formdat.scm")
(include "stml.scm")
;; (include "dbi.scm")
(include "session.scm")
(include "setup.scm") ;; s:session gets created here
(include "sqltbl.scm")
(include "keystore.scm")
;; (include "sugar.scm")

(slot-set! s:session 'log-port ;; (current-error-port))
	   (open-output-file (slot-ref s:session 'logfile) #:append))

;; (s:log "HTTP_COOKIE" (getenv "HTTP_COOKIE"))
;; (s:log "stdin-dat=" (slot-ref s:session 'stdin-dat))

(s:validate-inputs)

(session:run-actions s:session)

(slot-set! s:session 'pagedat 







<













|
|

|







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
;;  PURPOSE.

;; (require-extension syntax-case)
;; (declare (run-time-macros))

(require-library dbi)


(include "requirements.scm")
(include "cookie.scm")
(include "html-filter.scm")
(include "misc-stml.scm")
(include "formdat.scm")
(include "stml.scm")
;; (include "dbi.scm")
(include "session.scm")
(include "setup.scm") ;; s:session gets created here
(include "sqltbl.scm")
(include "keystore.scm")
;; (include "sugar.scm")

(sdat-set-log-port! s:session ;; (current-error-port))
	   (open-output-file (sdat-get-logfile s:session) #:append))

;; (s:log "HTTP_COOKIE" (get-environment-variable "HTTP_COOKIE"))
;; (s:log "stdin-dat=" (slot-ref s:session 'stdin-dat))

(s:validate-inputs)

(session:run-actions s:session)

(slot-set! s:session 'pagedat 

Modified tests/test.scm from [525e5f0347] to [6a4cc3871f].

13
14
15
16
17
18
19

20
21
22
23
24
25
26

(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 "./html-filter.scm")
(load "./keystore.scm")







>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

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

(require-library dbi)

(load "./requirements.scm")
(load "./cookie.so")
(load "./misc-stml.scm")
(load "./formdat.scm")
(load "./stml.scm")
(load "./session.scm")
;(load "./sqltbl.scm")
(load "./html-filter.scm")
(load "./keystore.scm")
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

;; (test "Session var del"                    #f   (s:session-var-get "nick"))

;; test person

(load "./tests/models/test.scm")

(print "Session key is " (slot-ref s:session 'session-key))

(test "Delete session" #t (s:delete-session))

(let ((fh (open-input-pipe "ls ./tests/pages/*/control.scm")))
  (let loop ((l (read-line fh)))
    (if (not (eof-object? l))
        (begin







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

;; (test "Session var del"                    #f   (s:session-var-get "nick"))

;; test person

(load "./tests/models/test.scm")

(print "Session key is " (sdat-get-session-key s:session))

(test "Delete session" #t (s:delete-session))

(let ((fh (open-input-pipe "ls ./tests/pages/*/control.scm")))
  (let loop ((l (read-line fh)))
    (if (not (eof-object? l))
        (begin