Overview
Comment: | Merged crypt branch |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
0e2bee049afa5d02a58cb05e70373745 |
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 | make a selection drop down ~~~~~~~~~~~~~~~~~~~~~~~~~~ In view.scm: | > | > > | | 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 "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 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 | ;; PURPOSE. ;;====================================================================== ;; dumbobj helpers ;;====================================================================== (declare (unit misc-stml)) (use regex) | > < < | 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 | (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))))) | | > < < < < | < < < < | 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 session.scm from [feaf3112af] to [2fc2bb77c1].
︙ | ︙ | |||
732 733 734 735 736 737 738 739 740 741 742 743 744 745 | (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)) (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)) | > > > > > > > > > | 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 | ;; 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) ;; 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)) | > > > > | 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 | ;; v ; => 9 ;; (+= v 3 4) ;; v ; => 16 ;; (+= v) ;; v ; => 16 ;; | > > > > > > > > > | | 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 ...) ;; (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 | ;; PURPOSE. (use test md5) (require-extension sqlite3) (import (prefix sqlite3 sqlite3:)) | | > | 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) (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 | ;; (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))) | | > | 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 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>") |
︙ | ︙ |