Documentation Source Text

Check-in [c773092c19]
Login

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

Overview
Comment:Updates to the dashboard.tcl app and its client-side library. First working code.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | test-dashboard
Files: files | file ages | folders
SHA3-256: c773092c19e77430b63a5bf3c7a5bdb1141cb9d67299b4467e26f281b9ea1d13
User & Date: drh 2019-08-07 16:43:40.120
Context
2019-08-07
17:46
The "outcomes" page on the dashboard automatically reloads every 5 minutes. (check-in: 448a7b73d2 user: drh tags: test-dashboard)
16:43
Updates to the dashboard.tcl app and its client-side library. First working code. (check-in: c773092c19 user: drh tags: test-dashboard)
2019-08-05
11:51
Show a table of outcomes in the dashboard.tcl app. (check-in: 1f66b2f1a9 user: drh tags: test-dashboard)
Changes
Unified Diff Ignore Whitespace Patch
Changes to misc/dashboard.tcl.
79
80
81
82
83
84
85
86
87
88
89

90
91
92
93
94
95
96
97
  set cnt [db one {SELECT count(*) FROM outcome}]
  common-header "Test Outcomes" olist
  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(outcome.mtime,'unixepoch') AS odate
             FROM outcome, platform
            WHERE outcome.mtime>CAST(strftime('%s','now','-1 month') AS INT)
              AND platform.platformId=outcome.platformId

            ORDER BY srcdate DESC, outcome.mtime 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>
       }







|



>
|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
  set cnt [db one {SELECT count(*) FROM outcome}]
  common-header "Test Outcomes" olist
  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
             FROM outcome, platform
            WHERE outcome.mtime>CAST(strftime('%s','now','-1 month') AS INT)
              AND platform.platformId=outcome.platformId
            GROUP BY testName, srchash
            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>
       }
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
    <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
}



# Report an upload failure
#
proc upload-failure {code reason} {




  wapp-reply-code $code
  wapp-mimetype text/plain
  wapp-subst {%unsafe($reason)}
}

# Receive an outcome upload
#
proc wapp-page-upload {} {

  if {1} {
    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]]"
    }
  }






  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"} {







>
>




>
>
>
>








>
|








>
>
>
>
>
>







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
    <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"} {
Changes to misc/dashlib.tcl.
28
29
30
31
32
33
34


35
36
37
38
39
40
41
# 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"


#
#     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
#







>
>







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
# 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
#
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
#     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 {} {
  sqlite3 dashboard-db :memory:
  dashboard-db eval {PRAGMA page_size=512}
  dashboard-db eval {CREATE TABLE up(k,v)}
}
proc dashboard-uuid {} {
  return [dashboard-db eval {SELECT lower(hex(randomblob(20)))}]
}
proc dashboard-config {name args} {
  upvar #0 dashboard-data-$name D
  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 D
}
proc dashboard-send {name} {
  upvar #0 dashboard-data-$name D
  if {![info exists D]} {
    error "no such testcase: $name"
  }
  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]} {
    error "cannot find the dashboard upload configuration any of: $miss"
  }














  for {set cnt 1} {[info command dashdb-$cnt]!=""} {incr cnt} {}
































  dashboard-db eval {DELETE FROM up}


  foreach key [array names D] {
    set val $D($key)
    dashboard-db eval {INSERT INTO up VALUES($key,$val)}
  }
  dashboard-db eval {INSERT INTO up VALUES('platformId',$platformId)}
  set uid [dashboard-uuid]
  set fup dashboard-uplink-$uid.db
  set fdown dashboard-downlink-$uid.txt
  dashboard-db eval {VACUUM INTO $fup}

  dashboard-db eval {DELETE FROM up}
  set cmd "exec fossil test-httpmsg $url/upload $fup \
                  --mimetype application/x-sqlite >$fdown"
  set rc [catch $cmd msg]











  file delete $fup
  file delete $fdown
  if {$rc} {
    error "uplink failed with \"$msg\""
  }
}
proc dashboard-running {name} {
  dashboard-config $name status running
  dashboard-send $name
}
proc dashboard-pass {name} {







<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<













|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>




<



|
>

|


>
>
>
>
>
>
>
>
>
>
>
|
|
<
<







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
#     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} {