Overview
Comment:Honor HTTPS_SERVER cgi varible
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5a8df0870a99df7a8f3cc52e9929391251dab5a2
User & Date: matt on 2017-10-20 23:45:28
Other Links: manifest | tags
Context
2017-10-21
00:26
Added force-ssl check-in: 35d44094de user: kiatoaco tags: trunk
2017-10-20
23:45
Honor HTTPS_SERVER cgi varible check-in: 5a8df0870a user: matt tags: trunk
2017-09-16
04:29
Added session:generate-random-string. check-in: 9fe02f8d12 user: matt tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified session.scm from [65e2ea7eb0] to [6e47371468].

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