Overview
Comment: | Added force-ssl |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
35d44094dedba48faf94e30eb2082ef6 |
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 | ;; 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 | | | 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 | (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)) | | > > | 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 | 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")) | > > | | | | | 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)) |
︙ | ︙ |