Overview
Comment:Converted to using openssl for crypt. Added type checks to password compare to fix empty password compare failing
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | selfcontained
Files: files | file ages | folders
SHA1: 1936d7e2b4fe8a1c175bc8e2e863f4f2c7e6fbd3
User & Date: matt on 2014-09-03 05:46:33
Other Links: branch diff | manifest | tags
Context
2014-09-03
06:14
Added message to Makefile to hint that fpic is needed check-in: 15ba418938 user: kiatoaco tags: selfcontained
05:46
Converted to using openssl for crypt. Added type checks to password compare to fix empty password compare failing check-in: 1936d7e2b4 user: matt tags: selfcontained
2014-04-17
06:26
Added method to get all input keys. Made get from forms be liberal and take either string or symbol check-in: a7378b56d4 user: matt tags: selfcontained
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified misc-stml.scm from [805de087f1] to [9494e07667].

︙︙
129
130
131
132
133
134
135
136


137
138
139
140
141
142
143



144
145
146
147
148
149
150
151


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


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



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








|
>
>







>
>
>
|








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

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