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 \
          sugar.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
test: kiatoa.db cookie.so
	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
# 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
	

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

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

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

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

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

	 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)

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

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

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

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

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

;;  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))
(sdat-set-log-port! s:session ;; (current-error-port))
	   (open-output-file (sdat-get-logfile s:session) #:append))

;; (s:log "HTTP_COOKIE" (getenv "HTTP_COOKIE"))
;; (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 

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

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