129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
-
+
+
+
+
+
+
-
+
|
;; openssl passwd -crypt -salt xx password
;;
(define (s:crypt-passwd pw s)
(let* ((salt (if s s (session:make-rand-string 2)))
(inp (open-input-pipe
;;(string-append "echo " pw " | mkpasswd -S " salt " -s")))
(conc "mkpasswd " pw " " salt)))
;; (conc "mkpasswd " pw " " salt)
(conc "openssl passwd -crypt -salt " salt " " pw)
))
(res (read-line inp)))
(close-input-port inp)
res))
(define (s:password-match? password crypted)
(let* ((salt (substring crypted 0 2))
(pcrypted (s:crypt-passwd password salt)))
(s:log "INFO: pcrypted=" pcrypted " crypted=" crypted)
(and (string? password)
(string? pcrypted)
(string=? pcrypted crypted)))
(string=? pcrypted crypted))))
;; (read-line (open-input-pipe "echo foo | mkpasswd -S ab -s"))
(define (s:error-page . err)
(s:cgi-out (cons "Content-type: text/html; charset=iso-8859-1\n\n"
(s:html (s:head
(s:title err)
|
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
+
-
-
-
-
-
+
+
+
+
+
|
(res '()))
(if (eof-object? l)
(s:log res)
(loop (read-line p)(cons (list l "<BR>") res)))))
#t))))
(define (s:validate-inputs)
(if (not (s:validate-uri))
(if (not (s:validate-uri))(begin (s:error-page "Bad URI" (let ((ref (get-environment-variable "HTTP_REFERER")))
(if ref
(list "referred from" ref)
"")))
(exit))))
(begin (s:error-page "Bad URI" (let ((ref (get-environment-variable "HTTP_REFERER")))
(if ref
(list "referred from" ref)
"")))
(exit))))
;; anything except a list is converted to a string!!!
(define (s:any->string val)
(cond
((string? val) val)
((number? val) (number->string val))
((symbol? val) (symbol->string val))
|