Overview
Comment:Merged crypt branch
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0e2bee049afa5d02a58cb05e7037374567861485
User & Date: matt on 2016-11-08 06:20:34
Other Links: manifest | tags
Context
2016-11-08
06:44
Added missing use dbi in misc-stml.scm check-in: 17ef0caa4a user: matt tags: trunk
06:20
Merged crypt branch check-in: 0e2bee049a user: matt tags: trunk
06:18
Added escape of \n \r as option to session:apply-type-preference Leaf check-in: 7592869969 user: matt 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

Modified doc/howto.txt from [a12cd32804] to [08742b584b].

81
82
83
84
85
86
87

88



89
90
91
92
93
94
95
96

97
98
99
100
101
102
103
81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106







+
-
+
+
+







-
+









make a selection drop down
~~~~~~~~~~~~~~~~~~~~~~~~~~

In view.scm: 

;;                                   Label   Value visible-str selected
(s:select '(("World" 0)("Country" 1)("State" 2 #t)("Town/City" 3)) 'name 'scope)
(s:select '(("World" 0)("Country" 1)("State" 2     "The state" #t       )("Town/City" 3)) 'name 'scope)

Visible str will be shown if provided. Selected will set that entry to pre-selected.

In control.scm:

(let ((scope     (s:get-input 'scope))
      (scope-num (s:get-input 'scope 'number))) ;; 'number, 'raw or 'escaped
  ....

The optional third entry sets that item as selected if true
The optional fourth entry sets that item as selected if true

Simple error reporting
~~~~~~~~~~~~~~~~~~~~~~

In control.scm:
(s:set-err "You must provide an email address")

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

;; openssl passwd -crypt -salt xx password
;; Rely on crypt egg's default settings being secure enough, accept
;; backwards-compatible OpenSSL crypt passwords too.
;;
(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)
  (c:crypt pw (or s (c:crypt-gensalt))))
               ))
         (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)

Modified session.scm from [feaf3112af] to [2fc2bb77c1].

732
733
734
735
736
737
738









739
740
741
742
743
744
745
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754







+
+
+
+
+
+
+
+
+







		      (cdr params))))
    (case dtype
      ((raw)     res)
      ((number)  (if (string? res)(string->number res) #f))
      ((escaped) (if (string? res)
		     (s:html-filter->string res tags)
		     res))
      ((escaped-nl) (if (string? res) ;; escape \n and \r
			(string-intersperse
			 (string-split
			  (string-intersperse
			   (string-split (s:html-filter->string res tags) "\n")
			   "\\n")
			  "\r")
			 "\\r")
			res))
      (else      (if (string? res)
		     (s:html-filter->string res '())
		     res)))))

(define (session:get-param self key type-params)
  ;; (session:log s:session "params=" (slot-ref s:session 'params))
  (let* ((params (sdat-get-params self))

Modified setup.scm from [90e6633a2e] to [f8cd7b3789].

1
2
3
4
5
6
7
8
9
10
11
12
13




14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24













+
+
+
+







;; Copyright 2007-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

(declare (unit setup))
(declare (uses session))
(require-extension srfi-69)
(require-extension regex)

;; macros in sugar don't work, have to load in all files or use compiled mode?
;;
;; (include "sugar.scm")

;; use this for getting data from page to page when scope and evals
;; get in the way
(define s:local-vars (make-hash-table))

(define (s:local-set! k v)
  (hash-table-set! s:local-vars k v))

Modified sugar.scm from [8c9838f5ec] to [b784df1be7].

85
86
87
88
89
90
91




92





93

94
95
96
97
98
99
100
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109







+
+
+
+

+
+
+
+
+
-
+







;;   v ; => 9
;;   (+= v 3 4)
;;   v ; => 16
;;   (+= v)
;;   v ; => 16
;; 

(define-simple-syntax (s:if-param varname first ...)
  (if (s:get varname)
      first
      ...))

(define-simple-syntax (s:if-sessionvar varname first ...)
  (if (s:session-var-get varname)
      first
      ...))

;; (define-macro (s:if-param varname . dat)
;; (define-macro (s:if-param varname ...)
;;   (match dat
;; 	 (()    '())
;; 	 ((a)    `(if (s:get ,varname) ,a '()))
;; 	 ((a b)  `(if (s:get ,varname) ,a ,b))))
;; 
;; (define-macro (s:if-sessionvar varname . dat)
;;   (match dat

Modified tests/test.scm from [2d90dc1820] to [5b953a7034].

10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
25







-
+
+







;;  PURPOSE.

(use test md5)

(require-extension sqlite3)
(import (prefix sqlite3 sqlite3:))

(require-library dbi)
;; (require-library dbi)
(use (prefix dbi dbi:))

(load "./requirements.scm")
(load "./cookie.scm")
(load "./misc-stml.scm")
(load "./formdat.scm")
(load "./stml.scm")
(load "./session.scm")
94
95
96
97
98
99
100
101


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

102
103
104
105
106
107
108
109
110







-
+
+







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