Documentation Source Text

Check-in [ed6e0d08a7]
Login

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

Overview
Comment:Merge the test dashboard development line into trunk.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: ed6e0d08a7720f4ec9aae78c87d800d007664783e3742e66609ae6eb8008d2fa
User & Date: drh 2019-08-14 16:54:33
Context
2019-08-14
17:19
In dashboard output, group outcomes by platform. check-in: 76662698a8 user: drh tags: trunk
16:54
Merge the test dashboard development line into trunk. check-in: ed6e0d08a7 user: drh tags: trunk
2019-08-12
10:27
Minor improvements to dashboard. Closed-Leaf check-in: 44eb5d574e user: drh tags: test-dashboard
2019-08-07
21:59
Fix typo in comment. check-in: b0c5406903 user: mistachkin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added misc/dashboard.tcl.





























































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
148
149
150
151
152
153
154
155
156
157
158
159
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
185
186
187
188
189
190
191
192
193
194
195
196
197
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
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
#!/usr/bin/wapptclsh
#
package require wapp
if {![info exists env(FOSSIL_URI)]} {
  error "This script must be run as a Fossil CGI extension"
}
proc open-database {} {
  set self [wapp-param SCRIPT_FILENAME]
  set dir [file dir $self]
  set dbname [file dir $self]/-[file rootname [file tail $self]].db
  sqlite3 db $dbname
  db eval {
    CREATE TABLE IF NOT EXISTS outcome(
      testId TEXT PRIMARY KEY, -- large random hex key
      platformId TEXT,         -- references platform
      testName TEXT,           -- ex: th3.t05, releasetest.default
      status TEXT,             -- "pass", "fail", "running"
      mtime INT,               -- When this record received, seconds since 1970
      ipaddr TEXT,             -- received from this IP address
      elapsetm INT,            -- Time test took to run, seconds
      srchash TEXT,            -- SQLite source_id()
      srcdate TEXT,            -- SQLite version date, ISO8601
      toolhash TEXT,           -- Test script source_id()
      tooldate TEXT,           -- Test script version date, ISO8610
      expiretm INT,            -- When this record expires, seconds since 1970
      branch TEXT,             -- Branch name for SQLite code
      report TEXT,             -- Final test result text (maybe NULL)
      testcase BLOB            -- Testcase (probably NULL except failures)
    );
    CREATE TABLE IF NOT EXISTS platform(
      platformId TEXT PRIMARY KEY, -- large random hex key
      mtime INT,                   -- time of last change, sec since 1970
      ipaddr TEXT,                 -- IP address of last change
      name TEXT UNIQUE,            -- Short name
      ostype TEXT,                 -- 'linux','windows','mac','sparc'
      os TEXT,                     -- ex: 'Ubuntu 18.04', 'Windows 10'
      owner TEXT,                  -- ex: 'drh'
      location TEXT,               -- ex: 'Charlotte, NC'
      description TEXT             -- ex: 'Yoga laptop'
    );
  }
  db timeout 5000
}
proc common-header {{title {Test Dashboard}} {exlist {}} {newlist {}}} {
  wapp-trim {
     <div class='fossil-doc' data-title='%html($title)'>
     <div class='submenu'>
  }
  set base [wapp-param BASE_URL]
  set sub(Outcomes) olist
  set sub(Platforms) plist
  foreach {name link} $newlist {set sub($name) $link}
  foreach name [lsort [array names sub]] {
    set link $sub($name)
    if {$link ni $exlist} {
      wapp-trim {
        <a class='label' href='%unsafe($base/$link)'>%html($name)</a>
      }
    }
  }
  wapp-subst {</div>\n}
}
proc common-footer {} {
  wapp-subst {</div>\n}
}
proc wapp-page-env {} {
  wapp-allow-xorigin-params
  common-header {Wapp Environment}
  foreach key [array names ::env FOSSIL_*] {
    wapp-set-param $key $::env($key)
  }
  wapp-trim {<pre>%html([wapp-debug-env])</pre>}
  common-footer
}

# Show a list of test outcomes
#
proc wapp-page-olist {} {
  open-database
  common-header "Test Outcomes" olist
  set now [db one {SELECT datetime('now')}]
  wapp-trim {
    <p>Test Outcomes As Of %html($now)</p>
  }
  wapp-subst {<ul>\n}
  set last_srchash {}
  set inner_close {}
  db eval {SELECT status, testName, platform.name AS pname, srchash, srcdate,
                  datetime(srcdate) AS sdate,
                  datetime(max(outcome.mtime),'unixepoch') AS odate, report
             FROM outcome, platform
            WHERE outcome.mtime>CAST(strftime('%s','now','-1 month') AS INT)
              AND platform.platformId=outcome.platformId
            GROUP BY testName, srchash, outcome.platformId
            ORDER BY srcdate DESC, outcome.mtime DESC, status DESC} {
     if {$srchash!=$last_srchash} {
       wapp-trim {
         %unsafe($inner_close)
         <li><a href='https://sqlite.org/src/timeline?c=%html($srchash)'>
         %html%($sdate)% %html%([string range $srchash 0 16])%</a>
         <ol>
       }
       set inner_close </ol></li>
       set last_srchash $srchash
     }
     set clr black
     switch $status {
       fail {set clr red}
       running {set clr gray}
       ok -
       pass {set clr green}
     }
     wapp-trim {
       <li><span style='color:%html($clr);'>
       <b>%html($status)</b> - %html($testName at $pname)
       <small>(%html($odate))
     }
     if {[string length $report]} {
       wapp-trim {- %html($report)}
     }
     wapp-trim {</small></span></li>}
  }
  wapp-trim {
    %unsafe($inner_close)
    </ul>
  }
  wapp-trim {
    <script nonce='%html([wapp-param FOSSIL_NONCE])'>
      setTimeout(function(){location.reload();},1000*60);
    </script>
  }
  common-footer
}

# Make sure the Fossil user has the listed capability.
# Return 0 on success.  If the capability is missing,
# redirect to the login page and return 1.
#
proc check-capability {cap} {
  if {[string match *${cap}* $::env(FOSSIL_CAPABILITIES)]} {
    return 0
  }
  wapp-redirect $::env(FOSSIL_URI)/login?g=[wapp-param REQUEST_URI]
  return 1
}

# List all available platforms
#
proc wapp-page-plist {} {
  if {[check-capability i]} return
  common-header "Test Platforms" plist {{New Platform} padd}
  wapp-trim {
    <table class='sortable' border='1' cellspacing='0' cellpadding='2'\
     data-column-types='ttttx' data-init-sort='1'>
    <thead><tr>
      <th>Name
      <th>OS-Type
      <th>Owner
      <th>Description
      <th>&nbsp;
    </tr></thead>
    <tbody>
  }
  set base [wapp-param BASE_URL]
  open-database
  db eval {SELECT name, ostype, owner, description, rowid
             FROM platform ORDER BY 1} {
    wapp-trim {
      <tr>
      <td>%html($name)
      <td>%html($ostype)
      <td>%html($owner)
      <td>%html($description)
      <td><a href="%html($base)/pdetail/%html($rowid)">Details</a>
      </tr>
    }
  }
  wapp-trim {
    </tbody>
    </table>
    <script src='%url([wapp-param FOSSIL_URI])/builtin/sorttable.js'></script>
  }
  common-footer
}

# Show the details of a single platform entry
#
proc wapp-page-pdetail {} {
  if {[check-capability i]} return
  set id 0
  scan [wapp-param PATH_TAIL] %d id
  open-database
  set seen 0
  db eval {SELECT *, datetime(mtime,'unixepoch') AS ctime
           FROM platform WHERE rowid=$id} {set seen 1; break}
  if {!$seen} {
    common-header "Platform Not Found"
    wapp-subst {<h1>No such platform: %html($id)</h1>\n}
    common-footer
    return
  }
  common-header "Details For Platform $name"
  set u [wapp-param BASE_URL]
  wapp-trim {
    <table class="label-value">
    <tr><th>Name:</td><td>%html($name)</td>
    <tr><th>OS-Type:</td><td>%html($ostype)</td>
    <tr><th>OS:</td><td>%html($os)</td>
    <tr><th>Location:</td><td>%html($location)</td>
    <tr><th>Description:</td><td>%html($description)</td>
    <tr><th>Owner:</td><td>%html($owner)</td>
    <tr><th>Date:</td><td>%html($ctime)</td>
    <tr><th><tt>dashconfig</tt>:</td><td>%html($u $platformId)</td>
    <table>
  }
  common-footer
}

# Add a new platform entry
#
proc wapp-page-padd {} {
  if {[check-capability i]} return
  open-database
  set nm [wapp-param nm]
  set ostype [wapp-param ostype linux]
  set os [wapp-param os]
  set ds [wapp-param ds]
  set loc [wapp-param loc]
  common-header "Define A New Platform"
  if {$nm!=""} {
    db eval BEGIN
    if {[db exists {SELECT 1 FROM platform WHERE name=$nm}]} {
      wapp-trim {
        <p class='generalError'>
        The platform name "%html($nm)" is already used.  Choose another.
        </p>
      }
    } else {
      set ipaddr [wapp-param REMOTE_ADDR]
      set owner [wapp-param FOSSIL_USER]
      db eval {
        INSERT INTO platform(platformId,mtime,ipaddr,name,ostype,
                             os,owner,location,description)
        VALUES(lower(hex(randomblob(20))),strftime('%s','now'),
               $ipaddr,$nm,$ostype,$os,$owner,$loc,$ds)
      }
      set redir [wapp-param BASE_URL]/pdetail/[db last_insert_rowid]
      db eval COMMIT
      db close
      wapp-redirect $redir
      return
    }
    db eval COMMIT
    db close
  }
  wapp-trim {
    <form method="POST">
    <table class="label-value">
    <tr><th>Name:</th>
    <td><input type='text' size='15' name='nm' value='%html($nm)'></td></tr>
    <tr><th>Class:</th>
    <td><select name='ostype' size='1'>
  }
  foreach x {linux mac windows other} {
    wapp-subst {<option value='%html($x)'}
    if {$x==$ostype} {
      wapp-subst { selected='selected'}
    }
    wapp-subst {>%html($x)</option>\n}
  }
  wapp-trim {
    <tr><th>OS:</th>
    <td><input type='text size='20' name='os' value='%html($os)'></td></tr>
    <tr><th>Location:</th>
    <td><input type='text size='40' name='loc' value='%html($loc)'></td></tr>
    <tr><th>Description:</th>
    <td><input type='text size='40' name='ds' value='%html($ds)'></td></tr>
    <tr><th></th><td><input type='submit' value='Create'></td></tr>
    </table>
    </form>
  }
  common-footer
}

set UPLOAD_DEBUG 1

# Report an upload failure
#
proc upload-failure {code reason} {
  global UPLOAD_DEBUG
  if {$UPLOAD_DEBUG} {
    puts stderr "***** upload failed: $reason"
  }
  wapp-reply-code $code
  wapp-mimetype text/plain
  wapp-subst {%unsafe($reason)}
}

# Receive an outcome upload
#
proc wapp-page-upload {} {
  global UPLOAD_DEBUG
  if {$UPLOAD_DEBUG} {
    puts stderr "****************** upload ************************"
    foreach key [lsort [wapp-param-list]] {
      if {[string index $key 0]=="."} continue
      if {$key=="CONTENT" 
          && [string match text/* [wapp-param CONTENT_TYPE]]==0} continue
      puts stderr "$key = [list [wapp-param $key]]"
    }
  }
  set rc [catch {wapp-page-upload-unsafe} msg]
  if {$rc && $UPLOAD_DEBUG} {
    puts stderr "ERROR: $msg"
  }
}
proc wapp-page-upload-unsafe {} {
  if {[wapp-param CONTENT_TYPE]!="application/x-sqlite"} {
    upload-failure 400 {wrong content type}
    return
  }
  sqlite3 memdb :memory:
  memdb deserialize [wapp-param CONTENT]
  if {[memdb one {PRAGMA quick_check}]!="ok"} {
    memdb close
    upload-failure 400 {corrupt payload}
    return
  }
  memdb eval {SELECT k, v FROM up} {
    set data($k) $v
  }
  memdb close
  foreach key {testId platformId testName status branch} {
    if {![info exists data($key)]} {
      upload-failure 400 "missing parameter: $key"
      return
    }
  }
  open-database
  if {![db exists {SELECT 1 FROM platform
                    WHERE platformId=$data(platformId)}]} {
    upload-failure 401 "unauthorized"
    return
  }
  set ipaddr [wapp-param REMOTE_ADDR]
  db eval {
    REPLACE INTO outcome(testId, platformId, testName, status,
                         mtime, ipaddr, elapsetm, srchash, srcdate,
                         toolhash, tooldate, expiretm, branch, report,
                         testcase)
    VALUES($data(testid),$data(platformId),$data(testName),$data(status),
           strftime('%s','now'),$ipaddr,$data(elapsetm),
           $data(srchash), $data(srcdate), $data(toolhash), $data(tooldate),
           strftime('%s','now')+$data(ttl), $data(branch), $data(report),
           $data(testcase));
  }
  db close
  wapp-mimetype text/plain
  wapp-subst {Ok}
}


proc wapp-default {} {
  wapp-page-olist
}
wapp-start {}

Added misc/dashlib.tcl.





































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
#
# This is TCL library for uploading a test outcome to the testing dashboard.
# Test scripts can "source" this library and then invoke its methods in order
# to report test success and/or failure to the dashboard.
#
# Requirements:
#
#    *  SQLite needs to be loaded into the TCL interpreter
#
#    *  A recent "fossil" command needs to be available to "exec".
#
#    *  A platform configuration file needs to be configured.  The
#       platform configuration is a file named "./dashconfig" or
#       "~/.dashconfig" (searched in that order) that is a single
#       line of two fields, the URL of the dashboard server and the
#       platform code.
#
# Usage:
#
# The test script must invoke "dashboard-init" exactly once in order
# to initialize the uplink library.
#
# Each test scenario run by the script must be given its own name.
# Call it $testName.  For each test scenario, the script must run:
#
#     dashboard-config $testName $key1 $value1 $key2 $value2 ...
#
# The dashboard-config command can be run multiple times.  Duplicate
# keys silently overwrite.  The following keys are supported:
#
#     srchash       (REQUIRED) The SHA3 hash of the SQLite version under test
#
#     srcdate       (REQUIRED) Dates of the SQLite version under test in the
#                   ISO8601 format:  "YYYY-MM-DD HH:MM:SS"
#
#     branch        (REQUIRED) The branch from which srchash is taken
#
#     toolhash      (optional) SHA3 hash of the system doing the testing
#
#     tooldate      (optional) ISO8601 date corresponding to toolhash
#
#     elapsetm      (optional) Number of seconds for which the test ran
#
#     expire        (optional) This report should expire after this many
#                   seconds.  Used for "running" reports to indicate that
#                   the script expects to update the report later.
#
#     report        (optional) Output from the test run.  This should be
#                   abbreviated to show the final test results, or perhaps
#                   some error diagnostics in the event of a failure.  While
#                   very large reports are accepted, it is best to keep them
#                   small by removing extraneous text prior to upload.
#
#     testcase      (optional) The testcase that provoked a failure in
#                   a fuzz-testing scenario
#
# Note in particular that srchash and srcdate must be set!
#
# After the scenario is configured, invoke one of the following to upload
# the report to the dashboard:
#
#     dashboard-running $testName
#     dashboard-pass $testName
#     dashboard-fail $testName
#
# The dashboard-running command can be invoked multiple times.  After
# dashboard-pass or dashboard-fail, however, the scenario is finish and
# cannot be reused without reconfiguring it from scratch.
#
proc dashboard-init {} {
  upvar #0 dashboard-global G
  set miss {}
  foreach x {./dashconfig ~/.dashconfig} {
    set x [file normalize $x]
    if {[file readable $x]} {
      set fd [open $x rb]
      foreach {url platformId} [read $fd] break
      close $fd
      break
    } else {
      lappend miss $x
    }
  }
  if {![info exists url]} {
    return "cannot find the dashboard upload configuration any of: $miss"
  }
  if {[catch {package require sqlite3}]} {
    return "cannot load the sqlite3 package"
  }
  set G(url) $url
  set G(platformId) $platformId
  set G(trace) 0
  package require sqlite3
  sqlite3 dashboard-db :memory:
  dashboard-db eval {PRAGMA page_size=512}
  dashboard-db eval {CREATE TABLE up(k,v)}
  return {}
}
proc dashboard-remote {} {
  upvar #0 dashboard-global G
  if {[info exists G(url)]} {return $G(url)}
  return {}
}
proc dashboard-uuid {} {
  return [dashboard-db eval {SELECT lower(hex(randomblob(20)))}]
}
proc dashboard-config {name args} {
  upvar #0 dashboard-data-$name D dashboard-global G
  if {![info exists G(url)]} return
  foreach {key value} $args {
    set D($key) $value
  }
  if {![info exists D(testId)]} {
    set D(testId) [dashboard-uuid]
  }
}
proc dashboard-unconfig {name} {
  upvar #0 dashboard-data-$name D
  unset -nocomplain D
}
proc dashboard-trace {bool} {
  upvar #0 dashboard-global G
  set G(trace) $bool
}
proc dashboard-send {name} {
  upvar #0 dashboard-data-$name D dashboard-global G
  if {![info exists G(url)]} return
  if {![info exists D]} {
    error "no such testcase: $name"
  }
  if {$G(trace)} {
    puts "DASHBOARD-TRACE: send $name"
  }
  dashboard-db eval {DELETE FROM up}
  set D(platformId) $G(platformId)
  set D(testName) $name
  foreach key [array names D] {
    set val $D($key)
    dashboard-db eval {INSERT INTO up VALUES($key,$val)}
  }
  set uid [dashboard-uuid]
  set fup dashboard-uplink-$uid.db
  set fdown dashboard-downlink-$uid.txt
  dashboard-db eval {VACUUM}
  dashboard-db backup $fup
  dashboard-db eval {DELETE FROM up}
  set cmd "exec fossil test-httpmsg $G(url)/upload $fup \
                  --mimetype application/x-sqlite >$fdown"
  set rc [catch $cmd msg]
  if {$G(trace)} {
    puts "DASHBOARD-TRACE: $cmd"
    if {$rc} {
      puts "DASHBOARD-TRACE: upload failed: $msg"
    }
  }
  if {$rc} {
    puts stderr "dashboard uplink to $G(url) failed"
    puts stderr "error-message: \"$msg\""
    puts stderr "uplink-command: $cmd"
  } else {
    file delete $fup
    file delete $fdown
  }
}
proc dashboard-running {name} {
  dashboard-config $name status running
  dashboard-send $name
}
proc dashboard-pass {name} {
  dashboard-config $name status pass
  dashboard-send $name
  dashboard-unconfig $name
}
proc dashboard-fail {name} {
  dashboard-config $name status fail
  dashboard-send $name
  dashboard-unconfig $name
}