Overview
Comment:Replace external openssl call with "crypt" egg.

The OpenSSL call was using the old UNIX crypt DES password hashing, which is very weak. Crypt will default to a more sensible mechanism (Blowfish, but in the future could transparently switch).

Old passwords will continue to work, because the crypt egg detects DES salts and happily hashes them. When creating new passwords, they will be hashed using the modern algorithm.

The OpenSSL call passed the password to the shell, so an onlooker on the server could see it in plaintext. It also neglected to escape the password for the shell, resulting in a command injection vulnerability.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | crypt
Files: files | file ages | folders
SHA1: 1b5a5d3a6ea7e2126741587d8beeddc22285274b
User & Date: sjamaan on 2016-10-20 17:53:01
Other Links: branch diff | manifest | tags
Context
2016-11-08
06:18
Added escape of \n \r as option to session:apply-type-preference Leaf check-in: 7592869969 user: matt tags: crypt
2016-10-20
17:53
Replace external openssl call with "crypt" egg.

The OpenSSL call was using the old UNIX crypt DES password hashing, which is very weak. Crypt will default to a more sensible mechanism (Blowfish, but in the future could transparently switch).

Old passwords will continue to work, because the crypt egg detects DES salts and happily hashes them. When creating new passwords, they will be hashed using the modern algorithm.

The OpenSSL call passed the password to the shell, so an onlooker on the server could see it in plaintext. It also neglected to escape the password for the shell, resulting in a command injection vulnerability. check-in: 1b5a5d3a6e user: sjamaan tags: crypt

2016-09-25
17:10
Added conversion to s:session-var-get. WARNING: Need to use 'raw in many cases check-in: 445ea184ae user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified misc-stml.scm from [1a4eccad68] to [fb9cd24234].

︙︙
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24

;;  PURPOSE.

;;======================================================================
;; dumbobj helpers
;;======================================================================

(declare (unit misc-stml))

(use regex)
(use dbi)
(import (prefix dbi dbi:))

;; given a list of symbols give the count of the matching symbol
;; l => '(a b c)  (dumobj:indx a 'b) => 1
(define (s:get-fieldnum lst field-name)
  (let loop ((head (car lst))
             (tail (cdr lst))
             (fnum 0))








>

<
<








8
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23

;;  PURPOSE.

;;======================================================================
;; dumbobj helpers
;;======================================================================

(declare (unit misc-stml))
(use (prefix crypt c:))
(use regex)



;; given a list of symbols give the count of the matching symbol
;; l => '(a b c)  (dumobj:indx a 'b) => 1
(define (s:get-fieldnum lst field-name)
  (let loop ((head (car lst))
             (tail (cdr lst))
             (fnum 0))
︙︙
125
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)))))

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








|
>


<
<
<
<
|
<
<
<
<








124
125
126
127
128
129
130
131
132
133
134




135




136
137
138
139
140
141
142

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

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





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

Modified tests/test.scm from [2d90dc1820] to [7deafec480].

︙︙
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108

          ;; (print "loading " l)
          (load l)
          (loop (read-line fh)))))
  (close-input-port fh))

;; Should have poll:poll defined now.
(test "Make a random string" 2 (string-length (session:make-rand-string 2)))
(test "Create a encrypted password" "abQ9KY.KfrYrc" (s:crypt-passwd "foo" "ab"))


(test "s:any->string on a hash-table" "#<hash-table>" (s:any->string (make-hash-table)))

(define select-list
  '((a b c)(d (e f g)(h i j #t))))
(define result '("<SELECT name=\"efg\">" 
		 ((("<OPTION label=\"a\" value=\"b\">c</OPTION>") 








|
>








94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

          ;; (print "loading " l)
          (load l)
          (loop (read-line fh)))))
  (close-input-port fh))

;; Should have poll:poll defined now.
(test "Make a random string" 2 (string-length (session:make-rand-string 2)))
(test "Create an encrypted password using DES (backwards compat)" "abQ9KY.KfrYrc" (s:crypt-passwd "foo" "ab"))
(test "Create an encrypted password using Blowfish" "$2a$12$GyoKHX/UOxMLGtwdSTr7EOF9KQzlyyyRqFTKx1YvLA3sMukbV4WBC" (s:crypt-passwd "foo" "$2a$12$GyoKHX/UOxMLGtwdSTr7EO"))

(test "s:any->string on a hash-table" "#<hash-table>" (s:any->string (make-hash-table)))

(define select-list
  '((a b c)(d (e f g)(h i j #t))))
(define result '("<SELECT name=\"efg\">" 
		 ((("<OPTION label=\"a\" value=\"b\">c</OPTION>")
︙︙