;; create table session_vars (id serial not null,session_id integer,page text,key text,value text);

;; TODO
;;  Concept of order num incremented with each page access
;;     if a branch is taken then a new session would need to be created
;;

;; make-vector-record session session dbtype dbinit conn params path-params session-key session-id domain toppage page curr-page content-type page-type sroot twikidir pagedat alt-page-dat pagevars pagevars-before sessionvars sessionvars-before globalvars globalvars-before logpt formdat request-method session-cookie curr-err log-port logfile seen-pages page-dir-style debugmode
(define (make-sdat)(make-vector 33))
(define (sdat-get-dbtype               vec)    (vector-ref  vec 0))
(define (sdat-get-dbinit               vec)    (vector-ref  vec 1))
(define (sdat-get-conn                 vec)    (vector-ref  vec 2))
(define (sdat-get-params               vec)    (vector-ref  vec 3))
(define (sdat-get-path-params          vec)    (vector-ref  vec 4))
(define (sdat-get-session-key          vec)    (vector-ref  vec 5))
(define (sdat-get-session-id           vec)    (vector-ref  vec 6))
(define (sdat-get-domain               vec)    (vector-ref  vec 7))
(define (sdat-get-toppage              vec)    (vector-ref  vec 8))
(define (sdat-get-page                 vec)    (vector-ref  vec 9))
(define (sdat-get-curr-page            vec)    (vector-ref  vec 10))
(define (sdat-get-content-type         vec)    (vector-ref  vec 11))
(define (sdat-get-page-type            vec)    (vector-ref  vec 12))
(define (sdat-get-sroot                vec)    (vector-ref  vec 13))
(define (sdat-get-twikidir             vec)    (vector-ref  vec 14))
(define (sdat-get-pagedat              vec)    (vector-ref  vec 15))
(define (sdat-get-alt-page-dat         vec)    (vector-ref  vec 16))
(define (sdat-get-pagevars             vec)    (vector-ref  vec 17))
(define (sdat-get-pagevars-before      vec)    (vector-ref  vec 18))
(define (sdat-get-sessionvars          vec)    (vector-ref  vec 19))
(define (sdat-get-sessionvars-before   vec)    (vector-ref  vec 20))
(define (sdat-get-globalvars           vec)    (vector-ref  vec 21))
(define (sdat-get-globalvars-before    vec)    (vector-ref  vec 22))
(define (sdat-get-logpt                vec)    (vector-ref  vec 23))
(define (sdat-get-formdat              vec)    (vector-ref  vec 24))
(define (sdat-get-request-method       vec)    (vector-ref  vec 25))
(define (sdat-get-session-cookie       vec)    (vector-ref  vec 26))
(define (sdat-get-curr-err             vec)    (vector-ref  vec 27))
(define (sdat-get-log-port             vec)    (vector-ref  vec 28))
(define (sdat-get-logfile              vec)    (vector-ref  vec 29))
(define (sdat-get-seen-pages           vec)    (vector-ref  vec 30))
(define (sdat-get-page-dir-style       vec)    (vector-ref  vec 31))
(define (sdat-get-debugmode            vec)    (vector-ref  vec 32))
(define (sdat-set-dbtype!              vec val)(vector-set! vec 0 val))
(define (sdat-set-dbinit!              vec val)(vector-set! vec 1 val))
(define (sdat-set-conn!                vec val)(vector-set! vec 2 val))
(define (sdat-set-params!              vec val)(vector-set! vec 3 val))
(define (sdat-set-path-params!         vec val)(vector-set! vec 4 val))
(define (sdat-set-session-key!         vec val)(vector-set! vec 5 val))
(define (sdat-set-session-id!          vec val)(vector-set! vec 6 val))
(define (sdat-set-domain!              vec val)(vector-set! vec 7 val))
(define (sdat-set-toppage!             vec val)(vector-set! vec 8 val))
(define (sdat-set-page!                vec val)(vector-set! vec 9 val))
(define (sdat-set-curr-page!           vec val)(vector-set! vec 10 val))
(define (sdat-set-content-type!        vec val)(vector-set! vec 11 val))
(define (sdat-set-page-type!           vec val)(vector-set! vec 12 val))
(define (sdat-set-sroot!               vec val)(vector-set! vec 13 val))
(define (sdat-set-twikidir!            vec val)(vector-set! vec 14 val))
(define (sdat-set-pagedat!             vec val)(vector-set! vec 15 val))
(define (sdat-set-alt-page-dat!        vec val)(vector-set! vec 16 val))
(define (sdat-set-pagevars!            vec val)(vector-set! vec 17 val))
(define (sdat-set-pagevars-before!     vec val)(vector-set! vec 18 val))
(define (sdat-set-sessionvars!         vec val)(vector-set! vec 19 val))
(define (sdat-set-sessionvars-before!  vec val)(vector-set! vec 20 val))
(define (sdat-set-globalvars!          vec val)(vector-set! vec 21 val))
(define (sdat-set-globalvars-before!   vec val)(vector-set! vec 22 val))
(define (sdat-set-logpt!               vec val)(vector-set! vec 23 val))
(define (sdat-set-formdat!             vec val)(vector-set! vec 24 val))
(define (sdat-set-request-method!      vec val)(vector-set! vec 25 val))
(define (sdat-set-session-cookie!      vec val)(vector-set! vec 26 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")
  (sdat-set-page-type! self   'html)
  (sdat-set-toppage! self     "index")
  (sdat-set-params! self      '())           ;;
  (sdat-set-path-params! self '())
  (sdat-set-session-key! self #f)
  (sdat-set-pagedat! self     '())
  (sdat-set-alt-page-dat! self #f)
  (sdat-set-sroot! self       "./")
  (sdat-set-session-cookie! self #f)
  (sdat-set-curr-err! self #f)
  (sdat-set-log-port! self (current-error-port))
  (sdat-set-seen-pages! self '())
  (sdat-set-page-dir-style! self #t) ;; #t : pages/<pagename>_(view|cntl).scm
                                      ;; #f : pages/<pagename>/(view|control).scm 
  (sdat-set-debugmode!          self #f)
  			     
  (sdat-set-pagevars!           self (make-hash-table))
  (sdat-set-sessionvars!        self (make-hash-table))
  (sdat-set-globalvars!         self (make-hash-table))
  (sdat-set-pagevars-before!    self (make-hash-table))
  (sdat-set-sessionvars-before! self (make-hash-table))
  (sdat-set-globalvars-before!  self (make-hash-table))
  (sdat-set-domain!             self "locahost")   ;; end of defaults
  (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)
;;     (sdat-set-dbtype! self (eval dbtype))))

(define (session:setup self)
  (let ((dbtype (sdat-get-dbtype self))
	(dbinit (eval (sdat-get-dbinit self)))
	(dbexists #f))
    (let ((dbfname (alist-ref 'dbname dbinit)))
      (if (eq? dbtype 'sqlite3)
	  (if (file-exists? dbfname)
	      (begin
		;; (session:log self "setting dbexists to #t")
		(set! dbexists #t))))
      ;; (session:log self "dbtype: " dbtype " dbfname: " dbfname " dbexists: " dbexists))
      )
    (sdat-set-conn! self (dbi:open dbtype dbinit))
    (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)
       (dbi:exec conn stmt))
     (list "CREATE TABLE session_vars (id INTEGER PRIMARY KEY,session_id INTEGER,page TEXT,key TEXT,value TEXT);"
	   "CREATE TABLE sessions (id INTEGER PRIMARY KEY,session_key TEXT,last_used TIMESTAMP);"
           "CREATE TABLE metadata (id INTEGER PRIMARY KEY,key TEXT,value TEXT);"))))
;;  ;; if we have a session_key look up the session-id and store it
;;  (sdat-set-session-id! self (session:get-id self)))

;; only set session-cookie when a new session is created
(define (session:setup-session-key self)  
  (let* ((sk  (session:extract-session-key self))
         (sid (if sk (session:get-id self sk) #f)))
    (if (not sid) ;; need a new key
        (let* ((new-key (session:get-new-key self))
               (new-sid (session:get-id self new-key)))
          (sdat-set-session-key! self new-key)
          (sdat-set-session-id! self new-sid)
          (sdat-set-session-cookie! self (session:make-cookie self)))
        (sdat-set-session-id! self sid))))

(define (session:make-cookie self)
  ;; (list (conc "session_key=" (sdat-get-session-key self) "; Path=/; Domain=." (sdat-get-domain self) "; Max-Age=" (* 86400 14) "; Version=1"))) 
  (list (string-substitute 
	 ";" "; " 
	 (car (construct-cookie-string 
	       ;; warning! messing up this itty bitty bit of code will cost much time!
	       `(("session_key" ,(sdat-get-session-key self)
		  expires: ,(+ (current-seconds) (* 14 86400)) 
		  max-age: (* 14 86400)
		  path: "/" ;; 
		  domain: ,(string-append "." (sdat-get-domain self))
		  version: 1)) 0)))))

;; look up a given session key and return the id if found, #f if not found
(define (session:get-id self session-key)
  ;; (let ((session-key (sdat-get-session-key self)))
  (if session-key
      (let ((query (string-append "SELECT id FROM sessions WHERE session_key='" session-key "'"))
            (conn (sdat-get-conn self))
            (result #f))
	(dbi:for-each-row 
	 (lambda (tuple)
	   (set! result (vector-ref tuple 0)))
	 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)
	  (if (> numparts 1)
	      (sdat-set-path-params! self (cdr parts)))
          (if query-string
              (sdat-set-params! self (string-split query-string "&")))))))

;; BUGGY!
(define (session:get-new-key self)
  (let ((conn   (sdat-get-conn self))
        (tmpkey (session:make-rand-string 20))
        (status #f))
    (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))
    ;;     (pg:query-for-each (lambda (tuple)
    ;;                          (set! result (vector-ref tuple 0))) ;; (vector-ref tuple 0)))
    ;;                        (s:sqlparam query session-key)
    ;;                        (sdat-get-conn self))
    ;;                        conn)
    (dbi:for-each-row (lambda (tuple)
			(set! result (vector-ref tuple 0))) ;; (vector-ref tuple 0)))
		      (sdat-get-conn self)
		      (s:sqlparam query session-key))
    result))

;; delete all records for a session
;;
(define (session:delete-session self session-key)
  (let ((session-id (session:get-session-id self session-key))
        (qry        (conc "BEGIN;"
			  "DELETE FROM session_vars WHERE session_id=?;"
                          "DELETE FROM sessions WHERE id=?;"
			  "COMMIT;"))
        (conn              (sdat-get-conn self)))
    (if session-id
        (begin
          (dbi:exec conn qry session-id session-id)
	  (session:initialize self)
	  (session:setup self)))
    (not (session:get-session-id self session-key))))

;; (define (session:delete-session self session-key)
;;   (let ((session-id (session:get-session-id self session-key))
;;         (queries    (list "BEGIN;"
;; 			  "DELETE FROM session_vars WHERE session_id=?;"
;;                           "DELETE FROM sessions WHERE id=?;"
;; 			  "COMMIT;"))
;;         (conn              (sdat-get-conn self)))
;;     (if session-id
;;         (begin
;;           (for-each
;;            (lambda (query)
;;              (dbi:exec conn query session-id))
;; 	   queries)
;; 	  (initialize self '())
;; 	  (session:setup self)))
;;     (not (session:get-session-id self session-key))))

(define (session:extract-key self key)
  (let ((params (sdat-get-params self)))
    (session:extract-key-from-param self params key)))

(define (session:extract-key-from-param self params key)
  (let ((r1     (regexp (string-append "^" key "=([^=]+)$"))))
    (if (< (length params) 1) #f
	(let loop ((head   (car params))
		   (tail   (cdr params)))
	  (let ((match (string-match r1 head)))
	    (cond
	     (match
	      (let ((session-key (list-ref match 1)))
		(sdat-set-session-key! self (list-ref match 1))
		session-key))
	     ((null? tail)
	      #f)
	     (else
	      (loop (car tail)
		    (cdr tail)))))))))

(define (session:set-page! self page_name)
  (sdat-set-page! self page_name))

(define (session:close self)
  (dbi:close (sdat-get-conn self)))
;; (close-output-port (sdat-get-logpt self))

(define (session:err-msg self msg)
  (hash-table-set! (sdat-get-sessionvars self) "ERROR_MSG"
		   (string-intersperse (map s:any->string msg) " ")))

(define (session:prev-err self)
  (let ((prev-err (hash-table-ref/default (sdat-get-sessionvars-before self) "ERROR_MSG" #f))
	(curr-err (hash-table-ref/default (sdat-get-sessionvars self) "ERROR_MSG" #f)))
    (if prev-err prev-err
	(if curr-err curr-err #f))))

;; session vars
;; 1. keys are always a string NOT a symbol
;; 2. values are always a string conversion is the responsibility of the 
;;    consuming function (at least for now, I'd like to change this)

;; set a session var for the current page
;;
(define (session:set! self key value)
  (hash-table-set! (sdat-get-pagevars self) (s:any->string key) (s:any->string value)))

;; del a var for the current page
;;
(define (session:del! self key)
  (hash-table-delete! (sdat-get-pagevars self) (s:any->string key)))

;; get the appropriate hash given a page "*sessionvars*, *globalvars* or page
;;
(define (session:get-page-hash self page)
  (if (string=? page "*sessionvars*")
      (sdat-get-sessionvars self)
      (if (string=? page "*globalvars*")
	  (sdat-get-globalvars self)
	  (sdat-get-pagevars self))))

;; set a session var for a given page
;;
(define (session:set! self page key value)
  (let ((ht (session:get-page-hash self page)))
    (hash-table-set! ht (s:any->string key) (s:any->string value))))

;; get session vars for the current page
;;
(define (session: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")
	(let* ((result             #f)
	       (conn               (sdat-get-conn self))
	       (pagevars-before    (sdat-get-pagevars-before self))
	       (sessionvars-before (sdat-get-sessionvars-before self))
	       (globalvars-before  (sdat-get-globalvars-before self))
	       (pagevars           (sdat-get-pagevars self))
	       (sessionvars        (sdat-get-sessionvars self))
	       (globalvars         (sdat-get-globalvars self))
	       (page-name          (sdat-get-page self))
	       (session-key        (sdat-get-session-key self))
	       (query              (string-append
				    "SELECT key,value FROM session_vars INNER JOIN sessions ON session_vars.session_id=sessions.id "
				    "WHERE session_key=? AND page=?;")))
	  ;; first the page specific vars
	  (dbi:for-each-row (lambda (tuple)
			      (let ((k (vector-ref tuple 0))
				    (v (vector-ref tuple 1)))

				    (v (vector-ref tuple 1)))
				(hash-table-set! globalvars-before k v)
				(hash-table-set! globalvars        k v)))
			    conn
			    (s:sqlparam query session-key "*globalvars"))
	  ))))

(define (session:save-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")
	(let* ((status      #f)
	       (conn        (sdat-get-conn self))
	       (page-name   (sdat-get-page self))
	       (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)))

					  (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)))
	  (close-input-port fp)
	  initargs))))

      (if (eof-object? hed)
	  res
	  (loop (read-line p)(append res (list hed)))))))

;; May 2011, putting all pages into one directory for the following reasons:
;;   1. want filename to reflect page name (emacs limitation)
;;   2. that's it! no other reason. could make it configurable ...
(define (session:call-parts self page parts)
  (sdat-set-curr-page! self page)
  ;; (session:log self "page-dir-style: " (sdat-get-page-dir-style self))
  (let* ((dir-style ;; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
	  (sdat-get-page-dir-style self))
	 (dir     (string-append (sdat-get-sroot self) 
				 (if dir-style 
				     (conc "/pages/")
				     (conc "/pages/" page))))
	 (control (string-append dir (if dir-style 
					 (conc page "_ctrl.scm")
					 "/control.scm")))
	 (view    (string-append dir (if dir-style 

			 (else '())))
		      (port-map eval (lambda ()(read p))))))
	  ;; (map close-input-port inps)
	  (close-input-port p)
	  dat)
	(list "<p>Page not found " page " </p>"))))

(define (session:call self page)
  (session:call-parts self page 'both))

(define (session:call self page parts)
  (session:call-parts self page 'both))

(define (session:load-model self model)
  (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
    (if (file-exists? model.so)
	(load model.so)
	(if (file-exists? model.scm)
	    (load model.scm)
	    (s:log "ERROR: model " model.scm " not found")))))

(define (session:model-path self model)
  (string-append (sdat-get-sroot self) "/models/" model ".scm"))

(define (session:pp-formdat self)
  (let ((dat (formdat:all->strings (sdat-get-formdat self))))
    (string-intersperse dat "<br> ")))

(define (session:param->string params)
  ;; (err:log "params=" params)
  (if (< (length params) 1)
      ""
      (let loop ((key (car params))
		 (val (cadr params))
		 (tail (cddr params))
		 (result '()))
	(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"))
	 (header   (let ((cookie (sdat-get-session-cookie self)))
		     (if cookie
			 (cons (string-append "Set-Cookie: " (car cookie))
			       content)
			 content)))
	 (pagedat  (sdat-get-pagedat self)))
    (s:cgi-out 
     (cons header pagedat))))

(define (session:log self . msg)
  (with-output-to-port (sdat-get-log-port self) ;; (sdat-get-logpt self)
    (lambda () 
      (apply print msg))))

(define (session:get-param self key)
  ;; (session:log s:session "params=" (slot-ref s:session 'params))
  (let ((params (sdat-get-params self)))
    (session:get-param-from params key)))

;; This one will get the first value found regardless of form
(define (session:get-input self key)
  (let* ((formdat (sdat-get-formdat self)))
    (if (not formdat) #f
	(if (or (string? key)(number? key)(symbol? key))
	    (if (eq? (class-of formdat) <formdat>)
		(formdat:get formdat key)
		(begin
		  (session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
		  #f))
	    (session:log self "ERROR: bad key " key)))))

(define (session:run-actions self)
  (let* ((action    (session:get-param self 'action))
	 (page      (sdat-get-page self)))
    ;; (print "action=" action " page=" page)
    (if action
	(let ((action-lst  (string-split action ".")))
	  ;; (print "action-lst=" action-lst)
	  (if (not (= (length action-lst) 2)) 
	      (err:log "Action should be of form: module.action")
	      (let* ((targ-page   (car action-lst))

		    ((eval (string->symbol proc-name)) targ-action) ;; unsafe execution
		    (condition-case ((eval (string->symbol proc-name)) targ-action)
				    ((exn file) (s:log "file error"))
				    ((exn i/o)  (s:log "i/o error"))
				    ((exn )     (s:log "Action not implemented: " proc-name " action: " targ-action))
				    (var ()     (s:log "Unknown Error"))))))))))

(define (session:never-called-page? self page)
  (session:log self "Checking for page: " page)
  (not (member page (sdat-get-seen-pages self))))

(define (session:set-called! self page)
  (sdat-set-seen-pages! self (cons page (sdat-get-seen-pages self))))

;;======================================================================
;; Alternative data type delivery
;;======================================================================

(define (session:alt-out self)
  (let ((dat (sdat-get-alt-page-dat self)))
    ;; (s:log "dat is: " dat)
    ;; (print "HTTP/1.1 200 OK")
    (print "Date: " (time->string (seconds->utc-time (current-seconds))))
    (print "Content-Type: " (sdat-get-content-type self))
    (print "Accept-Ranges: bytes")
    (print "Content-Length: " (if (blob? dat)
				  (blob-size dat)
				  0))
    (print "Keep-Alive: timeout=15, max=100")
    (print "Connection: Keep-Alive")
    (print "")
    (write-string (blob->string dat) #f (current-output-port))))