Artifact 7deafec4802d0f5a5757ac4dc3ebf3bf6d54128a:

• File tests/test.scm — part of check-in [1b5a5d3a6e] at 2016-10-20 17:53:01 on branch crypt — 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. (user: sjamaan, size: 8378) [annotate] [blame] [check-ins using]

#!/usr/local/bin/csi -q 

;; Copyright 2007-2008, 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.

(use test md5)

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

(require-library dbi)

(load "./requirements.scm")
(load "./cookie.scm")
(load "./misc-stml.scm")
(load "./formdat.scm")
(load "./stml.scm")
(load "./session.scm")
(load "./sqltbl.scm")
(load "./html-filter.scm")
(load "./keystore.scm")

;; Test the primitive dbi interface

(system "rm -f tests/test.db")
(define db (dbi:open 'sqlite3 '((dbname . "tests/test.db"))))
(dbi:exec db "CREATE TABLE foo(id INTEGER PRIMARY KEY,name TEXT);")
(dbi:exec db "INSERT INTO foo(name) VALUES(?);" "Matt")
(dbi:for-each-row 
 (lambda (tuple)
   (print (vector-ref tuple 0) " " (vector-ref tuple 1)))
 db "SELECT * FROM foo;")
(test "dbi:get-one" "Matt" (dbi:get-one db "SELECT name FROM foo WHERE name='Matt';"))

;; keystore
(dbi:exec db "CREATE TABLE metadata (id INTEGER PRIMARY KEY,key TEXT,value TEXT);")

(keystore:set! db "SCHEMA-VERSION" 1.2)
(test "Keystore get" "1.2"  (keystore:get  db "SCHEMA-VERSION"))
(keystore:del! db "SCHEMA-VERSION") 
(test "Keystore get deleted" #f (keystore:get db "SCHEMA-VERSION"))

(system "rm -f tests/test.db")

;; create a session to work with")
(setenv "REQUEST_URI" "/stmlrun?action=test.test")
(setenv "SCRIPT_NAME" "/cgi-bin/stmlrun")
(setenv "PATH_INFO" "/test")
(setenv "QUERY_STRING" "action=test.test")
(setenv "SERVER_NAME" "localhost")
(setenv "REQUEST_METHOD" "GET")

(load "./setup.scm")

(s:validate-inputs)

;; test session variables

(session:get-vars s:session)
(define nada "andnndhhshaas")
(s:session-var-set! "nick" nada)
(test "Session var set/get" nada  (s:session-var-get "nick"))
(print "got here")
(session:save-vars s:session)
(session:get-vars  s:session)
(test "Session var set/get after save/get" nada (s:session-var-get "nick"))
(session:del! s:session "*sessionvars*" "nick")
(test "Session var del"                    #f   (s:session-var-get "nick"))
(session:save-vars s:session)
(session:get-vars s:session)
(s:session-var-set! "nick" nada)
(session:save-vars s:session)

;; (test "Session var del"                    #f   (s:session-var-get "nick"))

;; test person

(load "./tests/models/test.scm")

(print "Session key is " (sdat-get-session-key s:session))

(test "Delete session" #t (s:delete-session))

(let ((fh (open-input-pipe "ls ./tests/pages/*/control.scm")))
  (let loop ((l (read-line fh)))
    (if (not (eof-object? l))
        (begin
          ;; (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>") 
		   ("<OPTGROUP label=d" 
		    ("<OPTION label=\"e\" value=\"f\">g</OPTION>")
		    ("<OPTION  selected label=\"h\" value=\"i\">j</OPTION>") 
		    "</OPTGROUP>")))
		 "</SELECT>"))

(test "Select list" result (s:select select-list 'name "efg"))

;; Test modules

(test "misc:non-zero-string \"\"" #f (misc:non-zero-string ""))
(test "misc:non-zero-string #f" #f (misc:non-zero-string #f))
(test "misc:non-zero-string 'blah" #f (misc:non-zero-string 'blah))

;; forms
(define form #f)
(test "make <formdat>" #t (let ((f (make-formdat:formdat)))
			    (set! form f)
			    #t))
(test "formdat: set!/get" "Yep!" (begin
				   (formdat:set! form "blah" "Yep!")
				   (formdat:get  form "blah")))

(test "s:string->pgint"   123 (s:any->pgint "123"))
(test "s:illegal-pgint (legal)"        #f (s:illegal-pgint 1011))
(test "s:illegal-pgint (illegal big)"   1 (s:illegal-pgint  9999999999))
(test "s:illegalpgint (illegal small)" -1 (s:illegal-pgint -9999999999))

;; The twiki module

;; clean up
(system "rm -rf twikis/*")
(load "modules/twiki/twiki-mod.scm")
(define keys (list "blah" 1 'nada))
(test "twiki:keys->key"  "blah 1 nada" (twiki:keys->key keys))
(define key (twiki:keys->key keys))

(define *tdb* #f)
(test "twiki:open-db"   #t (let ((db (twiki:open-db key)))
			     (set! *tdb* db)
			     (if *tdb* #t #f)))
(define wiki (make-twiki:wiki))
(twiki:wiki-set-wid! wiki 1)
(twiki:wiki-set-name! wiki "main")
(twiki:wiki-set-perms! wiki '(r w))

(test "twiki:dat->html" '("Hello" "<BR>") (twiki:dat->html "Hello" wiki))
(test "twiki:keys->fname" '("twikis/Ymxha/CAxIG/5hZGE" "YmxhaCAxIG5hZGE_") ;; ("twikis/d99a2de9/6808493b/23770f70" "d99a2de96808493b23770f70c76dffe4")
      (twiki:key->fname key))

(test "twiki:name->wid"     1     (twiki:name->wid *tdb* "main"))
(test "twiki:get-tiddlers-by-num" '() (twiki:get-tiddlers-by-num  *tdb* 0 (list 1 2 3)))
(test "twiki:get-tiddlers-by-name" '() (twiki:get-tiddlers-by-name *tdb* 0 "MainMenu"))
(test "twiki:get-tiddlers"  '()  (twiki:get-tiddlers *tdb* 0 (list "MainMenu")))
(test "twiki:get-tiddlers"  '()  (twiki:get-tiddlers *tdb* 0 (list "MainMenu" "AnotherOne")))
(test "twiki:wiki" "<TABLE>"     (car (twiki:wiki "main" (list "blah" 1 'nada))))
(test "twiki:view"  "<DIV class=\"node\">" (car (twiki:view "" "" 0 (twiki:tiddler-make) wiki)))

(test "s:td"              '("<TD>" (()) "</TD>") (s:td '()))
;; (test "twiki:get-tiddlers-by-name" '() (twiki:get-tiddlers-by-name 1 "fred"))
(test "twiki:tiddler-name->id" 1 (twiki:tiddler-name->id *tdb* "MainMenu"))
(test "s:set! a var to #f"     ""
      (begin (s:set! "BLAH" #f)
	     (s:get "BLAH"))) ;; don't know if this one makes sense. Setting to #f should really delete the value
(test "twiki:save-dat"           2        (twiki:save-dat *tdb* "dat" 0))
(test "twiki:get-dat"            "dat"    (twiki:get-dat *tdb* 2))
(test "twiki:get-dat"            #f       (twiki:get-dat *tdb* 5))
;; (test "twiki:get-dat"      #f    (twiki:get-dat *tdb* #f))
(test "twiki:save-tiddler"       #t       (twiki:save-tiddler *tdb* "heading" "body" "tags" key 0))
;; (test "twiki:save-curr-tiddler"  #f       (twiki:save-curr-tiddler *tdb* 1))
(test "twiki:edit-twiddler"      #t       (list? (twiki:edit-tiddler *tdb* key 0 0)))
(test "twiki:maint_area"         "<DIV>"  (car (twiki:maint_area *tdb* 1 key wiki)))
(test "twiki:pic_mgmt"           "<DIV>"  (car (twiki:pic_mgmt *tdb* 1 key)))

;; get a blob jpg to process
(define inp2 (open-input-file "tests/kiatoa.png"))
(define dat  (string->blob (read-string #f inp2)))
(close-input-port inp2)


(test "twiki:save-pic"           #t       (twiki:save-pic *tdb* (list "mypic.jpg" "image/jpeg" dat) 0)) ;; (string->blob "testing eh!")))) 
;; (test "twiki:save-pic-from-form" #f       (twiki:save-pic-from-form *tdb* 1))

;; more tests on dats

(define dat #f)
(let ((inp (open-input-file "tests/kiatoa.png")))
  (set! dat (read-string #f inp))
  (close-input-port inp))
(use md5)
(define dat-md5 (md5:digest dat))
(test "twiki:save-dat (binary)" 4        (twiki:save-dat *tdb* dat 1))
(test "twiki:get-dat (binary)"  dat-md5  (let ((d (twiki:get-dat *tdb* 4)))
					   (md5:digest d)))
;; forms
;; (define inp (open-input-file "tests/example.post.in"))
;; (define dat (read-string #f inp))
;; (define datstr (open-input-string dat))

;; binary inputs
(define inp (open-input-file "tests/example.post.binary.in"))
(define dat #f)

(test "formdat:load-all-port multipart" #t (let ((idat (formdat:load-all-port inp)))
				   (set! dat idat)
				   #t))
(test "formdat:keys" '(picture-name input-picture "" submit-picture) (formdat:keys dat))

(define inp (open-input-file "tests/example.post.in"))
(test "formdat:load-all-port single part" #t (let ((idat (formdat:load-all-port inp)))
				   (set! dat idat)
				   #t))
(test "formdat:keys" '(email-address form-name password) (formdat:keys dat))

(close-input-port inp)