;;   <http://www.netscape.com/newsref/std/cookie_spec.html>

(declare (unit cookie))
(require-extension srfi-1 srfi-13 srfi-14 regex)
;; (use  srfi-1 srfi-13 srfi-14 regex)
;; (declare (export parse-cookie-string construct-cookie-string))

#>
#include <time.h>
<#

(define fmt-time
  (foreign-lambda* c-string ((long secs_since_epoch))
    "static char buf[256];"
    "time_t t = (time_t) secs_since_epoch;"
    "strftime(buf, sizeof(buf), \"%a, %d-%b-%Y %H:%M:%S GMT\", gmtime(&t));"
    "return(buf);"))


;; (define (fmt-time seconds)
;;   (time->string (seconds->utc-time seconds) "%D"))

 ;; utility fn.  breaks  ``attr=value;attr=value ... '' into alist.
 ;; version is a cookie version.  if version>0, we allow comma as the
 ;; delimiter as well as semicolon.
 (define (parse-av-pairs input version)
   (define attr-regexp
     (if (= version 0)

          (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"))) 
  ;; According to 
  ;;    http://www.codemarvels.com/2010/11/apache-rewriterule-set-a-cookie-on-localhost/

  ;;  Here are the 2 (often left out) requirements to set a cookie using
  ;;  httpd-F¢s rewrite rule (mod_rewrite), while working on localhost:-A
  ;;
  ;;  Use the IP 127.0.0.1 instead of localhost/machine-name as the
  ;;  domain; e.g. [CO=someCookie:someValue:127.0.0.1:2:/], which says
  ;;  create a cookie -Y´someCookie¡ with value ´someValue¡ for the
  ;;  domain ´127.0.0.1$B!m(B having a life time of 2 mins, for any path in
  ;;  the domain (path=/). (Obviously you will have to run the
  ;;  application with this value in the URL)
  ;;
  ;;  To make a session cookie, limit the flag statement to just three
  ;;  attributes: name, value and domain. e.g
  ;;  [CO=someCookie:someValue:127.0.0.1] %G–%@ Any further
  ;;  settings, apache writes an¡ expires¡ attribute for the set-cookie
  ;;  header, which makes the cookie a persistent one (not really
  ;;  persistent, as the expires value set is the current server time
  ;;  %G–%@ so you don-F-F¢t even get to see your cookie!)-A
  (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)))

    (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-cookie (get-environment-variable "HTTP_COOKIE")))
    (if http-cookie
        (session:extract-key-from-param self (string-split-fields  ";\\s+" http-cookie infix:) "session_key")
        )))

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

(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 "=([^=]+)$"))))
    (err:log "INFO: Looking for " key " in " params)
    (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)))
		(err:log "INFO: Found session key=" session-key)
		(sdat-set-session-key! self (list-ref match 1))
		session-key))
	     ((null? tail)
	      #f)
	     (else
	      (loop (car tail)
		    (cdr tail)))))))))