-
Notifications
You must be signed in to change notification settings - Fork 0
/
sql.ss
100 lines (78 loc) · 3.39 KB
/
sql.ss
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
#lang racket
;; MongooseWeb Copyright (C) 2013 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(require (planet jaymccarthy/sqlite:5:1/sqlite))
(require "utils.ss")
(provide (all-defined-out))
;; tinyscheme
;(define db-select db-exec)
;; racket
(define (db-exec . args)
(with-handlers (((lambda (x) #t) (lambda (x) (msg "error:" x))))
(apply exec/ignore args)))
(define db-select select)
(define db-insert insert)
(define (db-status db) (errmsg db))
(define (time) (list (random) (random))) ; ahem
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; fix this mess
(define (db-open db-name setup-fn)
(cond
((file-exists? (string->path db-name))
(display "open existing db")(newline)
(let ((db (open (string->path db-name))))
;; upgrade
(setup-fn db "sync")
(setup-fn db "stream")
db))
(else
(display "making new db")(newline)
(let ((db (open (string->path db-name))))
;; todo, dynamically create these tables
(setup-fn db "sync")
(setup-fn db "stream")
db))))
;; helper to return first instance from a select
(define (select-first db str . args)
(let ((s (apply db-select (append (list db str) args))))
(if (or (null? s) (eq? s #t))
'()
(vector-ref (cadr s) 0))))
;; get a unique hash for this user (used for all the unique-ids)
(define (get-unique user)
(let ((t (time)))
(string-append
user "-" (number->string (car t)) ":" (number->string (cadr t)))))
;; tests...
(define (sql-test db)
(db-exec db "create table unittest ( id integer primary key autoincrement, name varchar(256), num int, r real )")
(define id (db-insert db "insert into unittest values (null, ?, ?, ?)" "hello" 23 1.1))
(asserteq "sql autoinc" (+ id 1) (db-insert db "insert into unittest values (null, ?, ?, ?)" "hello2" 26 2.3))
(let ((q (db-select db "select * from unittest")))
(assert "sql length" (> (length q) 2)))
(let ((q (db-select db "select * from unittest where id = ?" id)))
(asserteq "sql select one" (length q) 2)
(assert "sql select two" (vector? (car q)))
(asserteq "sql select 3" (vector-ref (cadr q) 2) 23)
(assert "sql select 4" (feq (vector-ref (cadr q) 3) 1.1)))
(db-exec db "update unittest set name=? where id = ?" "bob" id)
(let ((q (db-select db "select * from unittest where id = ?" id)))
(asserteq "sql update" (vector-ref (cadr q) 1) "bob"))
(db-exec db "update unittest set name=? where id = ?" "Robert'); DROP TABLE unittest;--" id)
(let ((q (db-select db "select * from unittest where id = ?" id)))
(asserteq "bobby tables sql injection" (vector-ref (cadr q) 1) "Robert'); DROP TABLE unittest;--"))
(asserteq "select first" (select-first db "select name from unittest where id = ?" (+ id 1))
"hello2")
)