Overview
Comment:Ensure force-ssl is initiallized to #f
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: cb3c5f25327df8ac97fea306c9516eea9dbde395
User & Date: matt on 2017-11-10 21:26:36
Other Links: manifest | tags
Context
2021-03-20
04:26
Merged stml2 to trunk Leaf check-in: 2737ed086f user: matt tags: trunk
2018-07-29
22:04
first steps in refactoring to a module check-in: 8b66fa08e7 user: matt tags: stml2
2017-11-10
21:26
Ensure force-ssl is initiallized to #f check-in: cb3c5f2532 user: matt tags: trunk
2017-10-21
00:26
Added force-ssl check-in: 35d44094de user: kiatoaco tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified session.scm from [6feb50842f] to [2b15eaba58].

︙
137
138
139
140
141
142
143

144
145
146
147
148
149
150

137
138
139
140
141
142
143
144
145
146
147
148
149
150
151








+








  (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
  (sdat-set-script!             self #f)
  (sdat-set-force-ssl!          self #f)
  (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))
︙
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
722
723

698
699
700
701
702
703
704


705
706

707
708
709
710
711
712
713
714
715
716

717
718
719
720
721
722
723
724








-
-
+

-
+
+








-
+








	  (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"))
         (force-ssl    (sdat-get-force-ssl self))
	 (server       (or (sdat-get-domain self)
                           https-host ;; Assuming HTTPS_HOST is only set if available
	 (server       (or https-host ;; Assuming HTTPS_HOST is only set if available
			   (get-environment-variable "HTTP_HOST")
			   (get-environment-variable "SERVER_NAME")))
			   (get-environment-variable "SERVER_NAME")
			   (sdat-get-domain self)))
         (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)))
    ;; (session:log self "server=" server " script=" script " page=" page)
    (session:log self "server=" server " script=" script " page=" page)
    (string-append (if (or https-host force-ssl)
		      "https://"
		      "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"))
︙