Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -24,22 +24,25 @@ # stmlrun : stmlrun.scm formdat.scm misc-stml.scm session.scm stml.scm \ # setup.scm html-filter.scm requirements.scm keystore.scm \ # cookie.scm sqltbl.scm # csc stmlrun.scm -$(TARGDIR)/stmlrun : stmlrun +$(TARGDIR)/stmlrun : stmlrun install stmlrun $(TARGDIR) chmod a+rx $(TARGDIR)/stmlrun $(TARGDIR)/modules : mkdir -p $(TARGDIR)/modules $(MODULES) : $(SOFILES) $(TARGDIR)/modules cp $< $@ -stmlrun : $(OFILES) stmlrun.scm requirements.scm +stmlrun : $(OFILES) stmlrun.scm requirements.scm stmlcommon.scm csc $(OFILES) -o stmlrun + +stmlmodule.so : $(OFILES) stmlmodule.scm stmlrun.scm requirements.scm stmlcommon.scm + csc $(OFILES) -s stmlmodule.scm # logging currently relies on this # $(LOGDIR) : mkdir -p $(LOGDIR) Index: misc-stml.scm ================================================================== --- misc-stml.scm +++ misc-stml.scm @@ -170,15 +170,16 @@ (s:log res) (loop (read-line p)(cons (list l "
") 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)))) + (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) (cond ((string? val) val) Index: session.scm ================================================================== --- session.scm +++ session.scm @@ -93,44 +93,12 @@ (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-class () -;; (dbtype ;; 'pg or 'sqlite3 -;; dbinit -;; conn -;; params ;; params from the key=val&key1=val2 string -;; path-params ;; remaining params from the path -;; session-key -;; session-id -;; domain -;; toppage ;; defaults to "index" - override in .stml.config if desired -;; page ;; the page name - defaults to home -;; curr-page ;; the current page being evaluated -;; content-type ;; the default content type is text/html, override to deliver other stuff -;; page-type ;; use in conjunction with content-type to deliver other payloads -;; sroot -;; twikidir ;; location for twikis - needs to be fully writable by web server -;; pagedat -;; alt-page-dat -;; pagevars ;; session vars specific to this page -;; pagevars-before -;; sessionvars ;; session vars visible to all pages -;; sessionvars-before -;; globalvars ;; global vars visible to all sessions -;; globalvars-before -;; logpt -;; formdat -;; request-method -;; session-cookie -;; curr-err -;; log-port -;; logfile -;; seen-pages -;; page-dir-style ;; #t = new style, #f = old style -;; debugmode)) +;; 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) (sdat-set-page! self "home") ;; these are defaults @@ -450,17 +418,17 @@ ;; 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))) + (hash-table-ref/default ht (s:any->string 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))) + (hash-table-delete! ht (s:any->string key)))) ;; get ALL keys for this page and store in the session pagevars hash ;; (define (session:get-vars self) (let ((session-id (sdat-get-session-id self))) Index: setup.scm ================================================================== --- setup.scm +++ setup.scm @@ -10,14 +10,10 @@ (declare (unit setup)) (declare (uses session)) (require-extension srfi-69) (require-extension regex) -;; -(define s:session (make-sdat)) -(session: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) @@ -24,17 +20,13 @@ (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) (sdat-set-curr-err! s:session args)) ;; Usage: (s:get-err s:big) (define (s:get-err wrapperfunc) ADDED stmlcommon.scm Index: stmlcommon.scm ================================================================== --- /dev/null +++ stmlcommon.scm @@ -0,0 +1,65 @@ +;; Copyright 2007-2011, 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. + +;; (require-extension syntax-case) +;; (declare (run-time-macros)) + +(include "requirements.scm") +(declare (uses cookie)) +(declare (uses html-filter)) +(declare (uses misc-stml)) +(declare (uses formdat)) +(declare (uses stml)) +(declare (uses session)) +(declare (uses setup)) ;; s:session gets created here +(declare (uses sqltbl)) +(declare (uses keystore)) + +(define (stml:cgi-session session) + (session:initialize session) + (session:setup session) + (session:get-vars session) + + (sdat-set-log-port! session ;; (current-error-port)) + (open-output-file (sdat-get-logfile session) #:append)) + (s:validate-inputs) + (session:run-actions session) + (sdat-set-pagedat! session + (append (sdat-get-pagedat session) + (s:call (sdat-get-toppage session)))) + (if (eq? (sdat-get-page-type session) 'html) ;; default is html. + (session:cgi-out session) + (session:alt-out session)) + (session:save-vars session) + (session:close session)) + +(define (stml:main proc) + (handle-exceptions + exn + (begin + (print "Content-type: text/html") + (print "") + (print " EXCEPTION ") + (print " QUERY_STRING is: " (get-environment-variable "QUERY_STRING") "
") + (print "
")
+     ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
+     (print-error-message exn)
+     (print-call-chain)
+     (print "
") + (print "") + (for-each (lambda (var) + (print "")) + (get-environment-variables)) + (print "
" (car var) "" (cdr var) "
") + (print "")) + + (if proc (proc s:session) (stml:cgi-session s:session)) + ;; (raise-error) + ;; (exit) + )) Index: stmlrun.scm ================================================================== --- stmlrun.scm +++ stmlrun.scm @@ -10,49 +10,8 @@ ;; PURPOSE. ;; (require-extension syntax-case) ;; (declare (run-time-macros)) -(handle-exceptions - exn - (begin - (print "Content-type: text/html") - (print "") - (print " EXCEPTION ") - (print " QUERY_STRING is: " (get-environment-variable "QUERY_STRING") "
") - (print "
")
-   ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
-   (print-error-message exn)
-   (print-call-chain)
-   (print "
") - (print "") - (for-each (lambda (var) - (print "")) - (get-environment-variables)) - (print "
" (car var) "" (cdr var) "
") - (print "")) - (include "requirements.scm") - (declare (uses cookie)) - (declare (uses html-filter)) - (declare (uses misc-stml)) - (declare (uses formdat)) - (declare (uses stml)) - (declare (uses session)) - (declare (uses setup)) ;; s:session gets created here - (declare (uses sqltbl)) - (declare (uses keystore)) - - (sdat-set-log-port! s:session ;; (current-error-port)) - (open-output-file (sdat-get-logfile s:session) #:append)) - (s:validate-inputs) - (session:run-actions s:session) - (sdat-set-pagedat! s:session - (append (sdat-get-pagedat s:session) - (s:call (sdat-get-toppage s:session)))) - (if (eq? (sdat-get-page-type s:session) 'html) ;; default is html. - (session:cgi-out s:session) - (session:alt-out s:session)) - (session:save-vars s:session) - (session:close s:session) - ;; (raise-error) - ;; (exit) - ) +(include "stmlcommon.scm") + +(stml:main #f)