691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
|
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
|
+
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
|
(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* ((https-host (get-environment-variable "HTTPS_HOST"))
(let* ((server (or (get-environment-variable "HTTPS_HOST") ;; Assuming HTTPS_HOST is only set if available
(get-environment-variable "HTTP_HOST")
(get-environment-variable "SERVER_NAME")))
(server (or https-host ;; Assuming HTTPS_HOST is only set if available
(get-environment-variable "HTTP_HOST")
(get-environment-variable "SERVER_NAME")))
(force-script (sdat-get-script self))
(script (or force-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)))
(script (or force-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 (if https-host
"https://"
"http://")
(string-append "http://" server "/" script "/" page "?" paramstr))) ;; "/sn=" session-key)))
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)
|