Checklist

Check-in [7b0c5b9f45]
Login

Check-in [7b0c5b9f45]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Omit all use of the global ::wapp dict
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7b0c5b9f45717c4229c3339e118d67aa4f3bd4de
User & Date: drh 2018-01-30 19:09:09.670
Context
2018-01-30
20:39
Add a warning to the login page if the client is not sending Referer headers. check-in: 1e0662e9e3 user: drh tags: trunk
19:09
Omit all use of the global ::wapp dict check-in: 7b0c5b9f45 user: drh tags: trunk
18:01
Clean up legacy files and create a README.md file at the top-level. check-in: a165137c40 user: drh tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to checklist.tcl.
︙︙
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

proc wapp-default {} {
  wapp-page-listing
}

# List all available checklists.
#
proc wapp-page-listing {} {
  global wapp DATADIR
  wapp-subst {<h1>Available Checklists</h1>\n}
  wapp-subst {<ol>\n}
  foreach dbfile [lsort -decreasing [glob -nocomplain $DATADIR/*.db]] {
    set name [file rootname [file tail $dbfile]]
    set url [dict get $wapp BASE_URL]/$name/index
    wapp-subst {<li><a href='%url($url)'>%html($name)</a>\n}
  }
  wapp-subst {</ol>\n}
}

# Show the CGI environment for testing purposes.
#
proc wapp-page-env {} {
  global wapp
  wapp-subst {<h1>Environment</h1>\n}
  wapp-subst {<pre>\n}
  foreach var [lsort [dict keys $wapp]] {
    if {[string index $var 0]=="."} continue
    wapp-subst {%html($var = [list [dict get $wapp $var]])\n}
  }
  wapp-subst {</pre>\n}
}

# Check user permissions by looking at the login/password in the
# checklist-login cookie.  Set the following environment variables:
#
#     CKLIST_USER      Name of the user.  Empty string if not logged in
#     CKLIST_WRITE     True if the user is allowed to make updates








|




|








<

|
<
<
<
<
<








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

proc wapp-default {} {
  wapp-page-listing
}

# List all available checklists.
#
proc wapp-page-listing {} {
  global DATADIR
  wapp-subst {<h1>Available Checklists</h1>\n}
  wapp-subst {<ol>\n}
  foreach dbfile [lsort -decreasing [glob -nocomplain $DATADIR/*.db]] {
    set name [file rootname [file tail $dbfile]]
    set url [wapp-param BASE_URL]/$name/index
    wapp-subst {<li><a href='%url($url)'>%html($name)</a>\n}
  }
  wapp-subst {</ol>\n}
}

# Show the CGI environment for testing purposes.
#
proc wapp-page-env {} {

  wapp-subst {<h1>Environment</h1>\n}
  wapp-subst {<pre>%html([wapp-debug-env])</pre>\n}





}

# Check user permissions by looking at the login/password in the
# checklist-login cookie.  Set the following environment variables:
#
#     CKLIST_USER      Name of the user.  Empty string if not logged in
#     CKLIST_WRITE     True if the user is allowed to make updates
︙︙
77
78
79
80
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

      set user $u
      if {[db exists {SELECT 1 FROM config WHERE name=('admin-'||$u)}]} {
        set admin 1
      }
    }
    break;
  }
  global wapp
  dict set wapp CKLIST_ADMIN $admin
  dict set wapp CKLIST_WRITE $write
  dict set wapp CKLIST_USER $user
}

# Print the common header shown on all pages
#
# Return 1 to abort.  Return 0 to continue with page generation.
#
proc checklist-common-header {} {
  global wapp
  if {![dict exists $wapp OBJECT]} {
    wapp-redirect listing
    return 1
  }
  set dbfile [dict get $wapp OBJECT]
  sqlite3 db $dbfile -create 0
  db eval BEGIN
  set title [db one {SELECT value FROM config WHERE name='title'}]
  wapp-trim {
    <html>
    <head>
    <link rel="stylesheet" href="style.css" type="text/css" media="screen">
    </head>
    <body>
    <h1>%html($title)</h1>
  }
  dict set wapp CKLIST_WRITE 0
  set admin 0
  set write 0
  set user {}
  if {[dict exists $wapp checklist-login]} {
    set user nobody
    set pswd none
    foreach {user pswd} [split [dict get $wapp checklist-login] ,] break
    if {[db exists {SELECT 1 FROM config
                     WHERE name=('user-'||$user)
                       AND hex(value)=$pswd}]} {
      set write 1
      if {[db exists {SELECT 1 FROM config WHERE name=('admin-'||$user)}]} {
        set admin 1
      }
    }
  }
  checklist-verify-login
  wapp-subst {<div class="mainmenu">\n}
  set this [wapp-param PATH_HEAD]
  if {$this!="index"} {
    wapp-subst {<a href='index'>checklist</a>\n}
  }
  set write [wapp-param CKLIST_WRITE 0]
  if {$write==0 && $this!="login"} {
    wapp-subst {<a href='login'>login</a>\n}
  }
  if {$write==1 && $this!="logout"} {
    wapp-subst {<a href='logout'>%html($user)-logout</a>\n}
  }
  set admin [wapp-param CKLIST_ADMIN 0]
  if {$admin} {
    if {$this!="sql"} {
      wapp-subst {<a href='sql'>sql</a>\n}
    }
    if {$this!="cklistedit"} {








<
|
|
|







<
|



<











<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<











|








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
101
102

















103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

      set user $u
      if {[db exists {SELECT 1 FROM config WHERE name=('admin-'||$u)}]} {
        set admin 1
      }
    }
    break;
  }

  wapp-set-param CKLIST_ADMIN $admin
  wapp-set-param CKLIST_WRITE $write
  wapp-set-param CKLIST_USER $user
}

# Print the common header shown on all pages
#
# Return 1 to abort.  Return 0 to continue with page generation.
#
proc checklist-common-header {} {

  if {![wapp-param-exists OBJECT] || [set dbfile [wapp-param OBJECT]]==""} {
    wapp-redirect listing
    return 1
  }

  sqlite3 db $dbfile -create 0
  db eval BEGIN
  set title [db one {SELECT value FROM config WHERE name='title'}]
  wapp-trim {
    <html>
    <head>
    <link rel="stylesheet" href="style.css" type="text/css" media="screen">
    </head>
    <body>
    <h1>%html($title)</h1>
  }

















  checklist-verify-login
  wapp-subst {<div class="mainmenu">\n}
  set this [wapp-param PATH_HEAD]
  if {$this!="index"} {
    wapp-subst {<a href='index'>checklist</a>\n}
  }
  set write [wapp-param CKLIST_WRITE 0]
  if {$write==0 && $this!="login"} {
    wapp-subst {<a href='login'>login</a>\n}
  }
  if {$write==1 && $this!="logout"} {
    wapp-subst {<a href='logout'>%html([wapp-param CKLIST_USER])-logout</a>\n}
  }
  set admin [wapp-param CKLIST_ADMIN 0]
  if {$admin} {
    if {$this!="sql"} {
      wapp-subst {<a href='sql'>sql</a>\n}
    }
    if {$this!="cklistedit"} {
︙︙
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184

  wapp-subst {</body></html>}
  catch {db close}
}

# Draw the login screen
#
proc wapp-page-login {} {
  global wapp
  if {[checklist-common-header]} return
  if {[string match https:* [wapp-param BASE_URL]]==0
       && [wapp-param REMOTE_ADDR]!="127.0.0.1"} {
    wapp-subst {<p class="error">Login via HTTPS only</p>}
    checklist-common-footer
    return
  }
  if {[dict exists $wapp u] && [dict exists $wapp p]} {
    set u [dict get $wapp u]
    set p [dict get $wapp p]
    set px [db one {SELECT hex($p)}]
    set ok [db exists {SELECT 1 FROM config
                        WHERE name=('user-'||$u)
                          AND hex(value)=$px}]
    if {$ok} {
      wapp-set-cookie checklist-login $u,$px
      wapp-redirect index








<







|
|
|








134
135
136
137
138
139
140

141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

  wapp-subst {</body></html>}
  catch {db close}
}

# Draw the login screen
#
proc wapp-page-login {} {

  if {[checklist-common-header]} return
  if {[string match https:* [wapp-param BASE_URL]]==0
       && [wapp-param REMOTE_ADDR]!="127.0.0.1"} {
    wapp-subst {<p class="error">Login via HTTPS only</p>}
    checklist-common-footer
    return
  }
  if {[wapp-param-exists u] && [wapp-param-exists p]} {
    set u [wapp-param u]
    set p [wapp-param p]
    set px [db one {SELECT hex($p)}]
    set ok [db exists {SELECT 1 FROM config
                        WHERE name=('user-'||$u)
                          AND hex(value)=$px}]
    if {$ok} {
      wapp-set-cookie checklist-login $u,$px
      wapp-redirect index
︙︙
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236

  }
  checklist-common-footer
}

# Draw the logout screen
#
proc wapp-page-logout {} {
  global wapp
  if {[checklist-common-header]} return
  if {![dict get $wapp CKLIST_WRITE] || [dict exists $wapp logout]} {
    wapp-clear-cookie checklist-login
    wapp-redirect index
    return
  }
  if {[dict exists $wapp cancel]} {
    wapp-redirect index
    return
  }
  set u [wapp-param CKLIST_USER]
  wapp-trim {
    <form method='POST' action='logout'>
    <input type='submit' name='logout' value='%html($u) Logout'>
    <input type='submit' name='cancel' value='Cancel'>
    </form>
  }
  checklist-common-footer
}

# Show the main checklist page
#
proc wapp-page-index {} {
  global wapp
  if {[checklist-common-header]} return
  set level 0
  db eval {SELECT seq, printf('%016llx',itemid) AS itemid, txt
           FROM checklist ORDER BY seq} {
    if {$seq%100==0} {
      set newlevel 1
    } else {








<

|




|
















<








171
172
173
174
175
176
177

178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

201
202
203
204
205
206
207

  }
  checklist-common-footer
}

# Draw the logout screen
#
proc wapp-page-logout {} {

  if {[checklist-common-header]} return
  if {![wapp-param CKLIST_WRITE] || [wapp-param-exists logout]} {
    wapp-clear-cookie checklist-login
    wapp-redirect index
    return
  }
  if {[wapp-param-exists cancel]} {
    wapp-redirect index
    return
  }
  set u [wapp-param CKLIST_USER]
  wapp-trim {
    <form method='POST' action='logout'>
    <input type='submit' name='logout' value='%html($u) Logout'>
    <input type='submit' name='cancel' value='Cancel'>
    </form>
  }
  checklist-common-footer
}

# Show the main checklist page
#
proc wapp-page-index {} {

  if {[checklist-common-header]} return
  set level 0
  db eval {SELECT seq, printf('%016llx',itemid) AS itemid, txt
           FROM checklist ORDER BY seq} {
    if {$seq%100==0} {
      set newlevel 1
    } else {
︙︙
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

  }
    
  # The cklistUser object is JSON that contains information about the
  # login user and the capabilities of the login user, which is the
  # javascript code needs to know in order to activate various features.
  #
  wapp-subst {<script id='cklistUser' type='application/json'>}
  if {![dict get $wapp CKLIST_WRITE]} {
    wapp-subst {{"user":"","canWrite":0,"isAdmin":0}}
  } else {
    set u [dict get $wapp CKLIST_USER]
    set ia [dict get $wapp CKLIST_ADMIN]
    wapp-subst {{"user":"%string($u)","canWrite":1,"isAdmin":%qp($ia)}}
  }
  wapp-subst {</script>\n}

  wapp-subst {<script src='cklist.js'></script>\n}
  checklist-common-footer
}








|


|
|








265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

  }
    
  # The cklistUser object is JSON that contains information about the
  # login user and the capabilities of the login user, which is the
  # javascript code needs to know in order to activate various features.
  #
  wapp-subst {<script id='cklistUser' type='application/json'>}
  if {![wapp-param CKLIST_WRITE]} {
    wapp-subst {{"user":"","canWrite":0,"isAdmin":0}}
  } else {
    set u [wapp-param CKLIST_USER]
    set ia [wapp-param CKLIST_ADMIN]
    wapp-subst {{"user":"%string($u)","canWrite":1,"isAdmin":%qp($ia)}}
  }
  wapp-subst {</script>\n}

  wapp-subst {<script src='cklist.js'></script>\n}
  checklist-common-footer
}
︙︙
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525

# then return only the status to that one checklist item.  Otherwise,
# return the status of all checklist items.
#
# The update and itemid parameters come in as hex.  They must be
# converted to decimal before being used for queries.
#
proc wapp-page-jstat {} {
  global wapp
  if {![dict exists $wapp OBJECT]} {
    wapp-redirect listing
    return
  }
  wapp-mimetype text/json
  set dbfile [dict get $wapp OBJECT]
  sqlite3 db $dbfile
  db eval BEGIN
  set update [wapp-param update]
  if {$update!=""} {
    checklist-verify-login
    if {[wapp-param CKLIST_WRITE 0] && [scan $update %x update]==1} {
      set status [wapp-param status]








<
|




<








476
477
478
479
480
481
482

483
484
485
486
487

488
489
490
491
492
493
494

# then return only the status to that one checklist item.  Otherwise,
# return the status of all checklist items.
#
# The update and itemid parameters come in as hex.  They must be
# converted to decimal before being used for queries.
#
proc wapp-page-jstat {} {

  if {![wapp-param-exists OBJECT] || [set dbfile [wapp-param OBJECT]]==""} {
    wapp-redirect listing
    return
  }
  wapp-mimetype text/json

  sqlite3 db $dbfile
  db eval BEGIN
  set update [wapp-param update]
  if {$update!=""} {
    checklist-verify-login
    if {[wapp-param CKLIST_WRITE 0] && [scan $update %x update]==1} {
      set status [wapp-param status]
︙︙
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583

}

# The /history page returns an HTML table that shows the history of
# changes to a single checklist item.
#
#
proc wapp-page-history {} {
  global wapp
  set dbfile [wapp-param OBJECT]
  set itemid [wapp-param itemid]
  if {$dbfile=="" || $itemid=="" || [scan $itemid %x itemid]!=1} return
  wapp-mimetype text/text
  sqlite3 db $dbfile
  db eval BEGIN
  wapp-subst {<table border="0" cellspacing="4">\n}








<








538
539
540
541
542
543
544

545
546
547
548
549
550
551

}

# The /history page returns an HTML table that shows the history of
# changes to a single checklist item.
#
#
proc wapp-page-history {} {

  set dbfile [wapp-param OBJECT]
  set itemid [wapp-param itemid]
  if {$dbfile=="" || $itemid=="" || [scan $itemid %x itemid]!=1} return
  wapp-mimetype text/text
  sqlite3 db $dbfile
  db eval BEGIN
  wapp-subst {<table border="0" cellspacing="4">\n}
︙︙
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614

}


# The /sql page for doing arbitrary SQL on the database.
# This page is accessible to the administrator only.
#
proc wapp-page-sql {} {
  global wapp
  if {[checklist-common-header]} return
  if {![wapp-param CKLIST_ADMIN 0]} {
    wapp-redirect index
    return
  }
  set sql [string trimright [wapp-param sql]]
  wapp-trim {








<








568
569
570
571
572
573
574

575
576
577
578
579
580
581

}


# The /sql page for doing arbitrary SQL on the database.
# This page is accessible to the administrator only.
#
proc wapp-page-sql {} {

  if {[checklist-common-header]} return
  if {![wapp-param CKLIST_ADMIN 0]} {
    wapp-redirect index
    return
  }
  set sql [string trimright [wapp-param sql]]
  wapp-trim {
︙︙
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714

  }
}

# The /cklistedit page allows the administrator to edit the items on
# the checklist.
#
proc wapp-page-cklistedit {} {
  global wapp
  if {[checklist-common-header]} return
  if {![wapp-param CKLIST_ADMIN 0]} {
    wapp-redirect index
    return
  }
  set cklist [string trim [wapp-param cklist]]
  if {$cklist!=""} {








<








667
668
669
670
671
672
673

674
675
676
677
678
679
680

  }
}

# The /cklistedit page allows the administrator to edit the items on
# the checklist.
#
proc wapp-page-cklistedit {} {

  if {[checklist-common-header]} return
  if {![wapp-param CKLIST_ADMIN 0]} {
    wapp-redirect index
    return
  }
  set cklist [string trim [wapp-param cklist]]
  if {$cklist!=""} {
︙︙
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762

# the OBJECT and shifts a new method name out of PATH_INFO and into
# PATH_HEAD for dispatch.
#
# If the first element of PATH_INFO is not a valid checklist database name,
# then change PATH_HEAD to be the database listing method.
#
proc wapp-before-dispatch-hook {} {
  global wapp DATADIR
  set dbname [dict get $wapp PATH_HEAD]
  dict set wapp ROOT_URL [dict get $wapp BASE_URL]
  if {[file readable $DATADIR/$dbname.db]} {
    # an appropriate database has been found
    dict set wapp OBJECT $DATADIR/$dbname.db
    if {[regexp {^([^/]+)(.*)$} [dict get $wapp PATH_TAIL] all head tail]} {
      dict set wapp PATH_HEAD $head
      dict set wapp PATH_TAIL [string trimleft $tail /]
      dict append wapp SELF_URL /$head
    } else {
      dict set wapp PATH_HEAD {}
      dict set wapp PATH_TAIL {}
    }
  } else {
    # Not a valid database.  Change the method to list all available
    # databases.
    dict set wapp OBJECT {}
    if {$dbname!="env"} {dict set wapp PATH_HEAD listing}
  }
}

# Start up the web-server
wapp-start $::argv








|
|
|


|
|
|
|
|

|
|




|
|






698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728

# the OBJECT and shifts a new method name out of PATH_INFO and into
# PATH_HEAD for dispatch.
#
# If the first element of PATH_INFO is not a valid checklist database name,
# then change PATH_HEAD to be the database listing method.
#
proc wapp-before-dispatch-hook {} {
  global DATADIR
  set dbname [wapp-param PATH_HEAD]
  wapp-set-param ROOT_URL [wapp-param BASE_URL]
  if {[file readable $DATADIR/$dbname.db]} {
    # an appropriate database has been found
    wapp-set-param OBJECT $DATADIR/$dbname.db
    if {[regexp {^([^/]+)(.*)$} [wapp-param PATH_TAIL] all head tail]} {
      wapp-set-param PATH_HEAD $head
      wapp-set-param PATH_TAIL [string trimleft $tail /]
      wapp-set-param SELF_URL /$head
    } else {
      wapp-set-param PATH_HEAD {}
      wapp-set-param PATH_TAIL {}
    }
  } else {
    # Not a valid database.  Change the method to list all available
    # databases.
    wapp-set-param OBJECT {}
    if {$dbname!="env"} {wapp-set-param PATH_HEAD listing}
  }
}

# Start up the web-server
wapp-start $::argv