# 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.

include install.cfg

SRCFILES    = stml.scm misc-stml.scm session.scm sqltbl.scm formdat.scm setup.scm stmlrun.scm keystore.scm html-filter.scm cookie.scm 
MODULEFILES = $(wildcard modules/*/*-mod.scm)
SOFILES     = $(MODULEFILES:%.scm=%.so)
CFILES      = $(MODULEFILES:%.scm=%.c)
OFILES      = $(SRCFILES:%.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 sqltbl.scm
# 	csc stmlrun.scm

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



	csc $(OFILES) -o stmlrun

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

		       (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)
  (cond
   ((string? val) val)
   ((number? val) (number->string val))
   ((symbol? val) (symbol->string 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-class <session> ()
;;   (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))

;; 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
  (sdat-set-curr-page! self   "home")
  (sdat-set-content-type! self "Content-type: text/html; charset=iso-8859-1\n\n")

(define (session:page-get self key)
  (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  (sdat-get-session-id self)))
    (if (not session-id)
	(err:log "ERROR: No session id in session object! session:get-vars")

;;  PURPOSE.

(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)
  (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)
  (let ((errmsg (sdat-get-curr-err s:session)))
    (if errmsg ((if wrapperfunc

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

(handle-exceptions
 exn   
 (begin
   (print "Content-type: text/html")
   (print "")
   (print "<html> <head> <title>EXCEPTION</title> </head> <body>")
   (print "   QUERY_STRING is: <b> " (get-environment-variable "QUERY_STRING") " </b> <br>")
   (print "<pre>")
   ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
   (print-error-message exn)
   (print-call-chain)
   (print "</pre>")
   (print "<table>")
   (for-each (lambda (var)
	       (print "<tr><td>" (car var) "</td><td>" (cdr var) "</td></tr>"))
	     (get-environment-variables))
   (print "</table>")
   (print "</body></html>"))
 (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)
 )