cqnTKHvp

1package require sqlite3
2package require anticrisis_http
3namespace import anticrisis::*
4
5namespace eval ::userdb {}
6
7proc userdb::open {filename} {
8    sqlite3 ::db $filename
9}
10
11proc userdb::close {} {
12    # optional: recommended analysis settings
13    db eval {pragma analysis_limit=100}
14    db eval {pragma optimize}
15    db close
16}
17
18proc userdb::ensure {filename} {
19    if {[info commands db] eq ""} {::userdb::open $filename}
20}
21
22proc userdb::create {filename} {
23    ensure $filename
24
25    # optional: recommended security settings
26    db config trusted_schema off
27    db config enable_view off
28    db config enable_trigger off
29    db config defensive 1
30    db config dqs_dml 0
31    db config dqs_ddl 0
32
33    # recommended: enable write-ahead log for performance
34    db eval {pragma journal_mode=WAL}
35
36    db eval {drop table if exists users}
37    db eval {create table users(username text primary key not null, 
38                                plainpass text not null)}
39}
40
41proc userdb::now {}  {db eval {select datetime('now')}}
42proc userdb::uuid {} {db eval {select lower(hex(randomblob(15)))}}
43
44proc userdb::create_user {username plainpass} {
45    db eval {insert into users values(:username, :plainpass)}
46}
47
48proc userdb::valid_plainpass {username checkpass} {
49    set res [db eval {select plainpass from users where username=:username}]
50    return [expr {$res eq $checkpass}]
51}
52
53# ---------------------------------------------------------------------------
54
55set dbfile "test-userdb.sqlite"
56
57userdb::create $dbfile
58
59namespace eval web {
60    variable target
61}
62
63proc web::create_user {} {
64    set random_name [userdb::uuid]
65    set random_pass [userdb::uuid]
66    userdb::create_user $random_name $random_pass
67    list 200 "Created user $random_name with pass $random_pass" "text/plain"
68}
69
70proc web::check_password {} {
71    set random_name [userdb::uuid]
72    set random_pass [userdb::uuid]
73    set result [userdb::valid_plainpass $random_name $random_pass]
74    list 200 "Checked user $random_name pass $random_pass: $result" "text/plain"
75}
76
77proc web::default {} {
78    list 200 "Try paths /create or /check" "text/plain"
79}
80
81proc web::handle_get {} {
82    variable target
83    switch $target {
84        /create {create_user}
85        /check  {check_password}
86        default {default}
87    }
88}
89
90http configure -get web::handle_get -reqtargetvar web::target {*}$argv
91
92puts "Listening on http://[http configure -host]:[http configure -port]"
93http run
94