Overview
Comment:Added session:generate-random-string.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 9fe02f8d12100f4c278bf81d9a194d6a0bd7fd5d
User & Date: matt on 2017-09-16 04:29:33
Other Links: manifest | tags
Context
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
2017-03-31
02:47
Replaced use of regex with substring-index for form parsing. Former use was quite broken treating incoming data as the regex. check-in: 0d4c0dc2fe user: matt tags: trunk, 2017-ww40
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified misc-stml.scm from [512a2ac1ef] to [116e590e88].

︙
126
127
128
129
130
131
132











133
134
135
136
137
138
139

126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150








+
+
+
+
+
+
+
+
+
+
+









(define (session:make-rand-string len)
  (let loop ((res "")
             (n   1))
    (if (> n len) res
        (loop (string-append res (session:get-rand-char))
              (+ n 1)))))

;; maybe replace above make-rand-string with this someday?
;;
(define (session:generic-make-rand-string len seed-string)
  (let ((num-chars (string-length seed-string)))
    (let loop ((res "")
	       (n   1))
      (let ((char-num (random num-chars)))
	(if (> n len) res
	    (loop (string-append res (substring seed-string char-num (+ char-num 1)))
		  (+ n 1)))))))

;; Rely on crypt egg's default settings being secure enough, accept
;; backwards-compatible OpenSSL crypt passwords too.
;;
(define (s:crypt-passwd pw s)
  (c:crypt pw (or s (c:crypt-gensalt))))
︙
151
152
153
154
155
156
157

158
159
160
161
162
163
164

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176








+








  (s:cgi-out (cons "Content-type: text/html; charset=iso-8859-1\n\n"
		   (s:html (s:head 
			    (s:title err)
			    (s:body
			     (s:h1 "ERROR")
			     (s:p err)))))))

;; BUG: The regex implements a rule, but what rule? AH! usaztempe, get rid of this? No, this also looks for &key=value ...
(define (s:validate-uri)
  (let ((uri (get-environment-variable "REQUEST_URI"))
	(qrs (get-environment-variable "QUERY_STRING")))
    (if (not uri)
	(set! uri qrs))
    (if uri
	(string-match
︙