Overview
Comment:Added force-ssl
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 35d44094dedba48faf94e30eb2082ef6c435a76e
User & Date: kiatoaco on 2017-10-21 00:26:06
Other Links: manifest | tags
Context
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
2017-10-20
23:45
Honor HTTPS_SERVER cgi varible check-in: 5a8df0870a user: matt tags: trunk
Changes

Modified session.scm from [6e47371468] to [6feb50842f].

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

;; 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 35))
(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-pgconn               vec)    (vector-ref (vector-ref vec 2) 1))
(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))







|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

;; 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 36))
(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-pgconn               vec)    (vector-ref (vector-ref vec 2) 1))
(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))
59
60
61
62
63
64
65

66
67
68
69
70
71
72
(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-get-shared-hash          vec)    (vector-ref  vec 33))
(define (sdat-get-script               vec)    (vector-ref  vec 34))


(define (session:get-shared vec varname)
  (hash-table-ref/default (vector-ref vec 33) varname #f))

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







>







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
(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-get-shared-hash          vec)    (vector-ref  vec 33))
(define (sdat-get-script               vec)    (vector-ref  vec 34))
(define (sdat-get-force-ssl            vec)    (vector-ref  vec 35))

(define (session:get-shared vec varname)
  (hash-table-ref/default (vector-ref vec 33) varname #f))

(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))
98
99
100
101
102
103
104

105
106
107
108
109
110
111
(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 (sdat-set-shared-hash!         vec val)(vector-set! vec 33 val))
(define (sdat-set-script!              vec val)(vector-set! vec 34 val))


(define (session:set-shared! vec varname val)
  (hash-table-set! (vector-ref vec 33) varname val))

;; The global session
(define s:session (make-sdat))








>







99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
(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 (sdat-set-shared-hash!         vec val)(vector-set! vec 33 val))
(define (sdat-set-script!              vec val)(vector-set! vec 34 val))
(define (sdat-set-force-ssl!           vec val)(vector-set! vec 35 val))

(define (session:set-shared! vec varname val)
  (hash-table-set! (vector-ref vec 33) varname val))

;; The global session
(define s:session (make-sdat))

145
146
147
148
149
150
151
152

153
154
155
156
157
158
159
160

161
162
163
164
165
166
167
	 (logfile   (s:find-param 'logfile  configdat))
	 (dbtype    (s:find-param 'dbtype   configdat))
	 (dbinit    (s:find-param 'dbinit   configdat))
	 (domain    (s:find-param 'domain   configdat))
	 (twikidir  (s:find-param 'twikidir configdat))
	 (page-dir  (s:find-param 'page-dir-style configdat))
	 (debugmode (s:find-param 'debugmode configdat))
         (script    (s:find-param 'script    configdat)))

    (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))
    (if twikidir (sdat-set-twikidir! self twikidir))
    (if debugmode (sdat-set-debugmode! self debugmode))
    (if script    (sdat-set-script!    self script))

    (sdat-set-page-dir-style! self page-dir)
    ;; (print "configdat: ")(pp configdat)
    (if debugmode
	(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype 
		     " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
    )
  (sdat-set-shared-hash! self (make-hash-table))







|
>








>







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
	 (logfile   (s:find-param 'logfile  configdat))
	 (dbtype    (s:find-param 'dbtype   configdat))
	 (dbinit    (s:find-param 'dbinit   configdat))
	 (domain    (s:find-param 'domain   configdat))
	 (twikidir  (s:find-param 'twikidir configdat))
	 (page-dir  (s:find-param 'page-dir-style configdat))
	 (debugmode (s:find-param 'debugmode configdat))
         (script    (s:find-param 'script    configdat))
	 (force-ssl (s:find-param 'force-ssl configdat)))
    (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))
    (if twikidir (sdat-set-twikidir! self twikidir))
    (if debugmode (sdat-set-debugmode! self debugmode))
    (if script    (sdat-set-script!    self script))
    (if force-ssl (sdat-set-force-ssl! self force-ssl))
    (sdat-set-page-dir-style! self page-dir)
    ;; (print "configdat: ")(pp configdat)
    (if debugmode
	(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype 
		     " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
    )
  (sdat-set-shared-hash! self (make-hash-table))
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
			       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"))


	 (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)))
    ;; (session:log self "server=" server " script=" script " page=" page)
    (string-append (if https-host
		       "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"))
	 (header   (let ((cookie (sdat-get-session-cookie self)))
		     (if cookie
			 (cons (string-append "Set-Cookie: " (car cookie))







>
>
|











|
|
|







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
722
723
724
725
726
			       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"))
         (force-ssl    (sdat-get-force-ssl self))
	 (server       (or (sdat-get-domain self)
                           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)))
    ;; (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"))
	 (header   (let ((cookie (sdat-get-session-cookie self)))
		     (if cookie
			 (cons (string-append "Set-Cookie: " (car cookie))