Mercurial > projects > relmon

annotate relmon.tcl @ 0:8c5330f6e9e4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author Guido Berhoerster <guido+relmon@berhoerster.name>
date Sun, 19 Oct 2014 20:44:39 +0200
parents
children cba4887feb2c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1 #!/usr/bin/tclsh
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
2 #
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
3 # Copyright (C) 2011 Guido Berhoerster <guido+relmon@berhoerster.name>
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
4 #
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
5 # Permission is hereby granted, free of charge, to any person obtaining
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
6 # a copy of this software and associated documentation files (the
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
7 # "Software"), to deal in the Software without restriction, including
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
8 # without limitation the rights to use, copy, modify, merge, publish,
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
9 # distribute, sublicense, and/or sell copies of the Software, and to
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
10 # permit persons to whom the Software is furnished to do so, subject to
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
11 # the following conditions:
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
12 #
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
13 # The above copyright notice and this permission notice shall be included
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
14 # in all copies or substantial portions of the Software.
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
15 #
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
16 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
17 # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
18 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
19 # IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
20 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
21 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
22 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
23
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
24 package require Tcl 8.5
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
25 package require http
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
26 package require tls
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
27 package require tdom
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
28 package require try
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
29 package require cmdline
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
30 package require control
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
31 package require html
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
32 package require htmlparse
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
33 package require json
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
34 package require json::write
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
35 package require logger
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
36 package require logger::utils
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
37 package require textutil::split
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
38 package require uri
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
39 package require uri::urn
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
40
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
41
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
42 namespace eval ::relmon {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
43 # version
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
44 variable VERSION 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
45 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
46
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
47
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
48 namespace eval ::relmon::common {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
49 namespace export cmpVersions isUrlValid urlGetHost parseStateFile
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
50 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
51
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
52 # implementation of the Debian version comparison algorithm described at
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
53 # http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
54 proc ::relmon::common::cmpVersion {v1 v2} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
55 set v1Len [string length $v1]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
56 set v2Len [string length $v2]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
57 set v1Pos 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
58 set v2Pos 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
59 while {($v1Pos < $v1Len) || ($v2Pos < $v2Len)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
60 set firstNumDiff 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
61 # until reaching ASCII digits in both version strings compare character
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
62 # values which are modified as so they are sorted in the following
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
63 # order:
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
64 # - "~"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
65 # - missing character or ASCII digits
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
66 # - ASCII alphabet
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
67 # - everything else in the order of their unicode value
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
68 while {(($v1Pos < $v1Len) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
69 ![string match {[0123456789]} [string index $v1 $v1Pos]]) ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
70 (($v2Pos < $v2Len) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
71 ![string match {[0123456789]} [string index $v2 $v2Pos]])} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
72 foreach char [list [string index $v1 $v1Pos] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
73 [string index $v2 $v2Pos]] charValueName \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
74 {v1CharValue v2CharValue} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
75 if {$char eq "~"} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
76 set $charValueName -1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
77 } elseif {$char eq ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
78 set $charValueName 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
79 } elseif {[string match {[0123456789]} $char]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
80 set $charValueName 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
81 } elseif {[string match -nocase {[abcdefghijklmnopqrstuvwxyz]} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
82 $char]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
83 set $charValueName [scan $char "%c"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
84 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
85 set $charValueName [expr {[scan $char "%c"] + 0x7f + 1}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
86 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
87 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
88 if {$v1CharValue != $v2CharValue} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
89 return [expr {$v1CharValue - $v2CharValue}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
90 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
91 incr v1Pos
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
92 incr v2Pos
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
93 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
94
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
95 # strip leading zeros
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
96 while {[string index $v1 $v1Pos] eq "0"} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
97 incr v1Pos
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
98 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
99 while {[string index $v2 $v2Pos] eq "0"} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
100 incr v2Pos
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
101 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
102
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
103 # process digits until reaching a non-digit
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
104 while {[string match {[0123456789]} [string index $v1 $v1Pos]] &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
105 [string match {[0123456789]} [string index $v2 $v2Pos]]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
106 # record the first difference between the two numbers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
107 if {$firstNumDiff == 0} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
108 set firstNumDiff [expr {[string index $v1 $v1Pos] -
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
109 [string index $v2 $v2Pos]}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
110 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
111 incr v1Pos
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
112 incr v2Pos
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
113 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
114
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
115 # return if the number of one version has more digits than the other
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
116 # since the one with more digits is the larger number
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
117 if {[string match {[0123456789]} [string index $v1 $v1Pos]]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
118 return 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
119 } elseif {[string match {[0123456789]} [string index $v2 $v2Pos]]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
120 return -1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
121 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
122
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
123 # return the difference if the digits differed above
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
124 if {$firstNumDiff != 0} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
125 return $firstNumDiff
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
126 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
127 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
128
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
129 return 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
130 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
131
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
132 proc ::relmon::common::isUrlValid {url} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
133 return [expr {![catch {dict create {*}[uri::split $url]} urlParts] &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
134 ([dict get $urlParts "scheme"] in {"http" "https"}) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
135 ([dict get $urlParts "host"] ne "")}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
136 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
137
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
138 proc ::relmon::common::urlGetHost {url} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
139 return [expr {(![catch {dict create {*}[uri::split $url]} urlParts]) ?
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
140 [dict get $urlParts "host"] : ""}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
141 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
142
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
143 proc ::relmon::common::parseStateFile {stateFile} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
144 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
145 set f [open $stateFile "r"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
146 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
147 return -options $errorOptions \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
148 "failed to open state file \"$stateFile\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
149 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
150 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
151 set state [json::json2dict [chan read $f]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
152 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
153 return -options $errorOptions \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
154 "failed to read from state file \"$stateFile\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
155 } on error {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
156 # the json package does not set an error code
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
157 dict set errorOptions "-errorcode" {RELMON JSON_PARSE_ERROR}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
158 return -options $errorOptions \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
159 "failed to parse state file \"$stateFile\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
160 } finally {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
161 close $f
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
162 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
163
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
164 return $state
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
165 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
166
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
167
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
168 namespace eval ::relmon::update {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
169 # commandline option help text
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
170 variable usage "usage: relmon update \[-dev\] \[-c max_connections\] \[-C\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
171 ca_dir\] \[-D delay\]\n\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
172 \ \[-H max_host_connections\] \[-i\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
173 item\[,...\]\] \[-l logfile\]\n\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
174 \ \[-r retries\] \[-t min_time\] watchlist\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
175 statefile"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
176
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
177 # configuration options
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
178 variable Config [dict create \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
179 "log_file" "" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
180 "log_level" "notice" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
181 "history_limit" 20 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
182 "connection_limit" 16 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
183 "host_connection_limit" 4 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
184 "transfer_time_limit" 60000 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
185 "retry_limit" 3 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
186 "host_delay" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
187 "timestamp_filter" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
188 "error_filter" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
189 "item_filter" {} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
190 "ca_dir" "" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
191 "state_file" "" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
192 "watchlist_file" ""]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
193
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
194 # exit status
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
195 variable ExitStatus
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
196
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
197 # transfer statistics
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
198 variable Statistics [dict create \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
199 "start_time" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
200 "end_time" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
201 "requests" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
202 "items" 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
203
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
204 # watchlist
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
205 variable Watchlist
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
206
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
207 # ID of a delayed run of ManageTransfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
208 variable ManageTransfersId ""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
209
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
210 # queue of pending transfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
211 variable Queue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
212
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
213 # number of active connections per host
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
214 variable HostConnections
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
215
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
216 # delays before opening a new connection to a host
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
217 variable HostDelays
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
218
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
219 # active transfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
220 variable ActiveTransfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
221
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
222 # buffer for tracking the state of unfinished items
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
223 variable StateBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
224
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
225 # buffer needed by htmlparse::parse for constructing the preprocessed HTML
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
226 # document
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
227 variable PreprocessedHtmlBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
228
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
229 # logger handle
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
230 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
231
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
232 # logfile handle
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
233 variable Lf
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
234 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
235
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
236 proc ::relmon::update::OnError {message returnOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
237 # internal error, abort
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
238 puts stderr [dict get $returnOptions "-errorinfo"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
239
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
240 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
241 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
242
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
243 proc ::relmon::update::CleanupBeforeExit {commandString operation} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
244 variable Lf
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
245
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
246 # close logfile
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
247 if {($Lf ne "") && ($Lf ni {stdin stderr})} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
248 close $Lf
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
249 set Lf ""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
250 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
251
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
252 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
253 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
254
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
255 proc ::relmon::update::ParseWatchlist {watchlistFilename} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
256 variable Watchlist
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
257
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
258 set lineno 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
259 set f [open $watchlistFilename "r"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
260 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
261 while {[chan gets $f line] != -1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
262 set fields [textutil::split::splitx [string trim $line] {[\t ]+}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
263 incr lineno
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
264
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
265 if {([llength $fields] == 0) ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
266 ([string index [lindex $fields 0] 0] eq "#")} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
267 # skip empty lines and comments
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
268 continue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
269 } elseif {[llength $fields] < 3} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
270 # a line consists of a name, base URL and at least one
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
271 # version-matching pattern
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
272 return -code error -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
273 "syntax error in \"$watchlistFilename\" line $lineno"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
274 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
275
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
276 set patterns [lassign $fields name baseUrl]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
277
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
278 # validate URL
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
279 if {![::relmon::common::isUrlValid $baseUrl]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
280 return -code error -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
281 "syntax error in \"$watchlistFilename\" line $lineno:\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
282 invalid base URL"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
283 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
284
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
285 # process patterns
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
286 set processedPatterns {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
287 set patternIndex 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
288 foreach pattern $patterns {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
289 incr patternIndex
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
290
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
291 # make trailing slashes optional except in the last
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
292 # version-matching pattern
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
293 if {($patternIndex != [llength $patterns]) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
294 ([string index $pattern end] eq "/")} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
295 append pattern {?}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
296 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
297
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
298 # ensure patterns are anchored to the end of the line
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
299 if {[string index $pattern end] ne "$"} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
300 append pattern {$}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
301 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
302
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
303 # actually validate the regular expression
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
304 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
305 set reInfo [regexp -about -- $pattern ""]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
306 } on error {errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
307 return -code error \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
308 -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
309 "error in \"$watchlistFilename\" line $lineno:\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
310 $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
311 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
312 lappend processedPatterns $pattern
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
313 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
314 if {[lindex $reInfo 0] < 1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
315 return -code error -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
316 "syntax error in \"$watchlistFilename\" line $lineno:\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
317 the last regular expression must contain at least one
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
318 capturing group"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
319 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
320
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
321 dict set Watchlist $name "base_url" $baseUrl
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
322 dict set Watchlist $name "patterns" $processedPatterns
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
323 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
324 } finally {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
325 close $f
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
326 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
327
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
328 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
329 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
330
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
331 proc ::relmon::update::ProcessHtmlElement {tag slash param textBehindTheTag} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
332 variable PreprocessedHtmlBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
333
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
334 # copy every "<a>" element into PreprocessedHtmlBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
335 if {($slash eq "") && ([string tolower $tag] eq "a")} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
336 append PreprocessedHtmlBuffer "<$tag $param></$tag>"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
337 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
338
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
339 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
340 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
341
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
342 proc ::relmon::update::PreprocessHtml {bodyDataName} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
343 upvar 1 $bodyDataName bodyData
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
344 variable PreprocessedHtmlBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
345
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
346 # preprocess the document with htmlparse by constructing a new document
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
347 # consisting only of found "<a>" elements which then can be fed into tdom
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
348 # again; this is useful if parsing via tdom fails; however, htmlparse
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
349 # should only be used as a last resort because it is just too limited, it
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
350 # gets easily confused within "<script>" elements and lacks attribute
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
351 # parsing
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
352 set PreprocessedHtmlBuffer "<html><body>"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
353 htmlparse::parse -cmd [namespace code ProcessHtmlElement] $bodyData
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
354 append PreprocessedHtmlBuffer "</body></html>"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
355 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
356
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
357 proc ::relmon::update::ExtractUrls {bodyDataName contentType baseUrl
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
358 rePattern} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
359 upvar 1 $bodyDataName bodyData
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
360 set extractedUrls {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
361 set resultUrls [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
362 set bareContentType [string trim [lindex [split $contentType ";"] 0]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
363 # extract all URLs or URL fragments
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
364 switch -- $bareContentType {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
365 {text/html} -
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
366 {application/xhtml+xml} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
367 # HTML/XHTML
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
368 # if tdom parsing has failed or not found any "<a>" element,
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
369 # preprocess the document with htmlparse and try again
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
370 if {[catch {dom parse -html $bodyData} doc] ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
371 ([set rootElement [$doc documentElement]] eq "") ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
372 ([llength [set aElements \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
373 [$rootElement selectNodes {descendant::a}]]] == 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
374 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
375 set doc [dom parse -html [PreprocessHtml bodyData]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
376 } on error {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
377 dict set errorOptions "-errorcode" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
378 {RELMON TDOM_PARSE_ERROR}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
379 return -options $errorOptions $errorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
380 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
381 set rootElement [$doc documentElement]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
382 set aElements [$rootElement selectNodes {descendant::a}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
383 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
384 foreach node $aElements {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
385 set href [$node getAttribute "href" ""]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
386 if {$href ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
387 lappend extractedUrls $href
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
388 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
389 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
390 $doc delete
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
391 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
392 {application/rss+xml} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
393 # RSS 2.0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
394 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
395 set doc [dom parse $bodyData]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
396 } on error {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
397 dict set errorOptions "-errorcode" {RELMON TDOM_PARSE_ERROR}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
398 return -options $errorOptions $errorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
399 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
400 set rootElement [$doc documentElement]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
401 if {$rootElement ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
402 foreach node [$rootElement selectNodes {descendant::link}] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
403 set linkText [$node text]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
404 if {$linkText ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
405 lappend extractedUrls $linkText
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
406 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
407 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
408 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
409 $doc delete
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
410 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
411 {application/atom+xml} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
412 # Atom 1.0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
413 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
414 set doc [dom parse $bodyData]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
415 } on error {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
416 dict set errorOptions "-errorcode" {RELMON TDOM_PARSE_ERROR}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
417 return -options $errorOptions $errorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
418 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
419 set rootElement [$doc documentElement]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
420 if {$rootElement ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
421 foreach node [$rootElement selectNodes {descendant::link}] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
422 set href [$node getAttribute "href" ""]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
423 if {$href ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
424 lappend extractedUrls $href
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
425 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
426 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
427 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
428 $doc delete
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
429 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
430 {text/plain} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
431 # plain text
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
432 foreach line [split $bodyData "\n"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
433 if {$line ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
434 lappend extractedUrls $line
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
435 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
436 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
437 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
438 default {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
439 return -code error \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
440 -errorcode {RELMON UNSUPPORTED_CONTENT_TYPE_ERROR} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
441 "unsupported content type \"$contentType\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
442 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
443 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
444 foreach url $extractedUrls {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
445 set normalizedUrl [uri::canonicalize [uri::resolve $baseUrl $url]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
446 dict set resultUrls $normalizedUrl \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
447 [expr {[regexp -line -- $rePattern $normalizedUrl] ? 1 : 0}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
448 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
449
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
450 return $resultUrls
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
451 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
452
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
453 proc ::relmon::update::StateItemAppendError {name logMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
454 variable StateBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
455
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
456 dict update StateBuffer $name stateItem {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
457 dict lappend stateItem "errors" $logMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
458 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
459
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
460 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
461 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
462
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
463 proc ::relmon::update::HandleSuccessfulTransfer {item httpHeaders
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
464 httpBodyName} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
465 upvar 1 $httpBodyName httpBody
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
466 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
467 variable StateBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
468 variable Queue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
469 variable Watchlist
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
470
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
471 set name [dict get $item "name"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
472 set url [dict get $item "url"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
473 if {[dict exists $httpHeaders "Content-Type"]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
474 set contentType [dict get $httpHeaders "Content-Type"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
475 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
476 set contentType ""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
477 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
478 set patternIndex [dict get $item "pattern_index"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
479 set pattern [lindex [dict get $Watchlist $name "patterns"] $patternIndex]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
480
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
481 ${Log}::info "\"$name\": \"$url\": transfer finished"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
482
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
483 # parse data
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
484 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
485 set urls [ExtractUrls httpBody $contentType $url $pattern]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
486 } trap {RELMON} {errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
487 # continue on tdom parsing errors or when receiving documents with an
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
488 # unsupported content type
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
489 set urls [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
490 set warningMsg "\"$name\": \"$url\": failed to parse data: $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
491 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
492 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
493 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
494
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
495 if {$patternIndex < ([llength \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
496 [dict get $Watchlist $name "patterns"]] - 1)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
497 # if this is not the last, version-matching pattern, queue matched URLs
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
498 dict for {newUrl matched} $urls {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
499 if {$matched} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
500 if {![::relmon::common::isUrlValid $newUrl]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
501 ${Log}::debug "\"$name\": \"$url\": ignoring matched but\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
502 invalid URL \"$newUrl\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
503 continue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
504 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
505
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
506 ${Log}::debug "\"$name\": \"$url\": queuing \"$newUrl\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
507
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
508 dict lappend Queue [::relmon::common::urlGetHost $newUrl] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
509 [dict create "name" $name "url" $newUrl \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
510 "pattern_index" [expr {$patternIndex + 1}] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
511 "num_redirects" 0 "num_retries" 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
512 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
513 ${Log}::debug "\"$name\": \"$url\": ignoring \"$newUrl\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
514 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
515 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
516 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
517 # otherwise this branch has finished, try to extract the versions and
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
518 # store them in the buffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
519 dict for {finalUrl matched} $urls {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
520 if {$matched} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
521 regexp -line -- $pattern $finalUrl -> version
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
522 if {$version ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
523 ${Log}::debug "\"$name\": \"$url\": extracted version\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
524 \"$version\" from \"$finalUrl\" found on\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
525 \"$url\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
526 dict set StateBuffer $name "versions" $version $finalUrl
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
527 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
528 ${og}::debug "\"$name\": \"$url\": could not extract a\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
529 version from \"$finalUrl\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
530 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
531 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
532 ${Log}::debug "\"$name\": \"$url\": ignoring \"$finalUrl\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
533 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
534 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
535 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
536
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
537 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
538 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
539
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
540 proc ::relmon::update::HandleRedirect {item httpCode httpHeaders} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
541 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
542 variable Queue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
543
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
544 set name [dict get $item "name"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
545 set url [dict get $item "url"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
546
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
547 if {![dict exists $httpHeaders "Location"]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
548 # bail out in case of an invalid HTTP response
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
549 set warningMsg "\"$name\": \"$url\": transfer failed: invalid HTTP\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
550 response"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
551 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
552 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
553 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
554 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
555 set location [dict get $httpHeaders "Location"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
556
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
557 # sanitize URL from Location header
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
558 if {[uri::isrelative $location]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
559 set redirectUrl [uri::canonicalize [uri::resolve \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
560 $url $location]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
561 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
562 if {![::relmon::common::isUrlValid $location]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
563 # bail out in case of an invalid redirect URL
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
564 set warningMsg "\"$name\": \"$url\": received invalid redirect URL\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
565 \"$location\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
566 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
567 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
568 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
569 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
570 set redirectUrl [uri::canonicalize $location]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
571 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
572
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
573 ${Log}::notice "\"$name\": \"$url\": received redirect to \"$redirectUrl\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
574
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
575 # handle up to 10 redirects by re-queuing the target URL
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
576 if {[dict get $item "num_redirects"] < 10} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
577 ${Log}::debug "\"$name\": \"$url\": queuing \"$redirectUrl\" due to\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
578 redirect"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
579
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
580 dict lappend Queue [::relmon::common::urlGetHost $redirectUrl] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
581 [dict replace $item "url" $redirectUrl \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
582 "num_redirects" [expr {[dict get $item "num_redirects"] + 1}] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
583 "num_retries" 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
584 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
585 set warningMsg "\"$name\": \"$url\": exceeded maximum number of\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
586 redirects"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
587 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
588 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
589 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
590
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
591 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
592 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
593
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
594 proc ::relmon::update::HandleProtocolError {item httpCode} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
595 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
596 set name [dict get $item "name"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
597 set url [dict get $item "url"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
598 set warningMsg "\"$name\": \"$url\": transfer failed: $httpCode"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
599 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
600 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
601 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
602 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
603
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
604 proc ::relmon::update::HandleTimeoutReset {item} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
605 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
606 variable Config
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
607 variable Queue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
608 set name [dict get $item "name"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
609 set url [dict get $item "url"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
610
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
611 # retry by re-queuing the target URL until reaching the limit
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
612 if {[dict get $item "num_retries"] < [dict get $Config "retry_limit"]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
613 ${Log}::warn "\"$name\": \"$url\": connection timed out or was reset,\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
614 retrying"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
615 dict lappend Queue [::relmon::common::urlGetHost $url] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
616 [dict replace $item \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
617 "num_retries" [expr {[dict get $item "num_retries"] + 1}]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
618 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
619 set warningMsg "\"$name\": \"$url\": exceeded maximum number of\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
620 retries"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
621 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
622 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
623 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
624
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
625 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
626 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
627
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
628 proc ::relmon::update::HandleConnectionError {item errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
629 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
630 set name [dict get $item "name"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
631 set url [dict get $item "url"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
632 set warningMsg "\"$name\": \"$url\": transfer failed: $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
633 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
634 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
635 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
636 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
637
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
638 proc ::relmon::update::OnTransferFinishedWrapper {token} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
639 # ensure that exceptions get raised, by default http catches all errors and
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
640 # silently ignores them, see https://core.tcl.tk/tcl/tktview?name=1414262
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
641 if {[catch {OnTransferFinished $token} -> errorOptions]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
642 OnError [dict get $errorOptions "-errorinfo"] $errorOptions
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
643 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
644 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
645 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
646
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
647 proc ::relmon::update::ManageTransfers {} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
648 variable Config
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
649 variable ManageTransfersId
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
650 variable Queue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
651 variable HostConnections
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
652 variable HostDelays
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
653 variable ActiveTransfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
654 variable ExitStatus
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
655 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
656
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
657 after cancel $ManageTransfersId
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
658
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
659 # try to initiate new transfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
660 while {([dict size $ActiveTransfers] <
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
661 [dict get $Config "connection_limit"]) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
662 ([dict size $Queue] > 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
663 # find URLs in the queue with a host for which we have not reached the
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
664 # per-host connection limit yet and for which no delay is in effect
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
665 set item {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
666 dict for {host items} $Queue {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
667 set now [clock milliseconds]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
668
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
669 if {![dict exists $HostConnections $host]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
670 dict set HostConnections $host 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
671 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
672
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
673 if {![dict exists $HostDelays $host]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
674 dict set HostDelays $host $now
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
675 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
676
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
677 if {([dict get $HostConnections $host] <
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
678 [dict get $Config "host_connection_limit"]) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
679 ([dict get $HostDelays $host] <= $now)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
680 # pop item from the queue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
681 set items [lassign $items item]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
682 if {[llength $items] > 0} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
683 dict set Queue $host $items
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
684 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
685 dict unset Queue $host
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
686 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
687
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
688 dict incr HostConnections $host
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
689 # set a random delay before the next connection to this host
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
690 # can be made
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
691 dict set HostDelays $host \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
692 [expr {[clock milliseconds] + int((rand() + 0.5) *
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
693 [dict get $Config "host_delay"])}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
694 break
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
695 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
696 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
697 # if no item could be found, the per-host connection limit for all
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
698 # queued URLs has been reached and no new transfers may be started
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
699 # at this point
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
700 if {$item eq {}} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
701 break
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
702 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
703 # otherwise start a new transfer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
704 set url [dict get $item "url"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
705 set name [dict get $item "name"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
706 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
707 set token [http::geturl $url \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
708 -timeout [dict get $Config "transfer_time_limit"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
709 -command [namespace code OnTransferFinishedWrapper]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
710 } on ok {} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
711 dict set ActiveTransfers $token $item
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
712
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
713 ${Log}::info "\"$name\": \"$url\": starting transfer"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
714 } on error {errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
715 # an error occured during socket setup, e.g. a DNS lookup failure
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
716 set warningMsg "\"$name\": \"$url\": transfer failed: $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
717 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
718 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
719 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
720 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
721
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
722 # terminate the event loop if there are no remaining transfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
723 if {([dict size $ActiveTransfers]) == 0 && ([dict size $Queue] == 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
724 set ExitStatus 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
725 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
726 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
727
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
728 # due to per-host connection limits and per-host delays the maximum number
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
729 # of connections may not be reached although there are still items in the
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
730 # queue, in this case schedule ManageTransfers again after the smallest of
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
731 # the current per-host delays
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
732 set delay 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
733 if {([dict size $ActiveTransfers] <
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
734 [dict get $Config "connection_limit"]) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
735 ([dict size $Queue] > 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
736 dict for {host items} $Queue {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
737 if {(![dict exists $HostConnections $host] ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
738 ([dict get $HostConnections $host] <
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
739 [dict get $Config "host_connection_limit"])) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
740 ([dict exists $HostDelays $host] &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
741 ([dict get $HostDelays $host] > $now))} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
742 set hostDelay [expr {[dict get $HostDelays $host] - $now + 1}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
743 if {(($delay == 0) ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
744 ($hostDelay < $delay))} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
745 set delay $hostDelay
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
746 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
747 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
748 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
749 if {$delay > 0} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
750 set ManageTransfersId \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
751 [after $delay [namespace code ManageTransfers]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
752 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
753 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
754
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
755 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
756 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
757
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
758 proc ::relmon::update::OnTransferFinished {token} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
759 upvar #0 $token httpState
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
760 variable Config
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
761 variable HostConnections
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
762 variable Queue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
763 variable ActiveTransfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
764 variable Statistics
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
765 variable StateBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
766 variable State
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
767 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
768
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
769 set item [dict get $ActiveTransfers $token]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
770 set name [dict get $item "name"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
771 set host [relmon::common::urlGetHost [dict get $item "url"]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
772
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
773 # update list of per-host connections, and number of remaining transfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
774 # for this item
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
775 dict unset ActiveTransfers $token
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
776 dict incr HostConnections $host -1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
777
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
778 switch -- $httpState(status) {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
779 {ok} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
780 # normalize headers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
781 set httpHeaders [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
782 foreach {header value} $httpState(meta) {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
783 set words {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
784 foreach word [split $header "-"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
785 lappend words [string totitle $word]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
786 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
787 dict set httpHeaders [join $words "-"] $value
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
788 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
789
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
790 # dispatch based on HTTP status code
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
791 set httpCode [http::ncode $token]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
792 switch -glob -- $httpCode {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
793 {30[12378]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
794 HandleRedirect $item $httpCode $httpHeaders
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
795 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
796 {200} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
797 HandleSuccessfulTransfer $item $httpHeaders httpState(body)
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
798 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
799 default {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
800 HandleProtocolError $item $httpState(http)
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
801 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
802 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
803 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
804 {eof} -
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
805 {timeout} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
806 # timeout or connection reset
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
807 HandleTimeoutReset $item
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
808 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
809 {error} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
810 # connection may have failed or been refused
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
811 HandleConnectionError $item [lindex $httpState(error) 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
812 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
813 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
814
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
815 # check if all transfers of this item are finished
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
816 set itemFinished 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
817 dict for {queueHost queueItems} $Queue {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
818 foreach queueItem $queueItems {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
819 if {[dict get $queueItem "name"] eq $name} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
820 set itemFinished 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
821 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
822 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
823 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
824 dict for {activeToken activeItem} $ActiveTransfers {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
825 if {[dict get $activeItem "name"] eq $name} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
826 set itemFinished 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
827 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
828 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
829 if {$itemFinished} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
830 set timestamp [clock milliseconds]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
831
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
832 # create httpState item if it does not exist yet
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
833 if {![dict exists $State $name]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
834 dict set State $name [dict create "versions" [dict create] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
835 "history" [list] "timestamp" 0 "errors" [list]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
836 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
837
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
838 # if there are no versions, log an error message since something must
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
839 # be wrong
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
840 if {[llength [dict get $StateBuffer $name "versions"]] == 0} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
841 set warningMsg "\"$name\": no versions found"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
842 ${Log}::warn $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
843 StateItemAppendError $name $warningMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
844 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
845
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
846 # update httpState item
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
847 dict set State $name "errors" [dict get $StateBuffer $name "errors"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
848 dict set State $name "timestamp" $timestamp
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
849 if {[llength [dict get $StateBuffer $name "errors"]] == 0} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
850 # expire old history entries
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
851 set history [lrange [dict get $State $name "history"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
852 [expr {[llength [dict get $State $name "history"]] -
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
853 [dict get $Config "history_limit"] + 1}] end]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
854
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
855 # add currently latest available version to history if it is either
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
856 # newer than the previous one or if the previous one is no longer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
857 # available (e.g. if it has been removed or the watchlist pattern
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
858 # has been changed)
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
859 set prevLatestVersion [lindex $history end 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
860 set curLatestVersion [lindex \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
861 [lsort -command ::relmon::common::cmpVersion \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
862 [dict keys [dict get $StateBuffer $name "versions"]]] end]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
863 if {([::relmon::common::cmpVersion $curLatestVersion \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
864 $prevLatestVersion] > 0) ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
865 ![dict exists $StateBuffer $name "versions" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
866 $prevLatestVersion]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
867 lappend history [list $curLatestVersion $timestamp]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
868 dict set State $name "history" $history
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
869 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
870 dict set State $name "versions" [dict get $StateBuffer $name \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
871 "versions"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
872 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
873 dict unset StateBuffer $name
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
874
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
875 ${Log}::notice "progress: [dict size $StateBuffer]/[dict get \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
876 $Statistics "items"] items left"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
877 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
878
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
879 http::cleanup $token
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
880
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
881 ManageTransfers
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
882
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
883 return
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
884 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
885
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
886 # control certificate verification and log errors during TLS handshake
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
887 proc ::relmon::update::OnTlsHandshake {type args} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
888 variable Config
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
889 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
890
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
891 switch -- ${type} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
892 {error} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
893 lassign $args {} tlsErrorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
894 ${Log}::error "TLS connection error: $tlsErrorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
895 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
896 {verify} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
897 lassign $args {} {} {} status tlsErrorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
898 array set cert [lindex $args 2]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
899 if {$status == 0} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
900 if {[dict get $Config "ca_dir"] eq ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
901 # do not verify certificates is ca-dir was not set
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
902 return 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
903 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
904 set errorMsg "$tlsErrorMsg\nCertificate details:"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
905 foreach {key description} {"serial" "Serial Number"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
906 "issuer" "Issuer" "notBefore" "Not Valid Before"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
907 "notAfter" "Not Valid After" "subject" "Subject"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
908 "sha1_hash" "SHA1 Hash"} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
909 append errorMsg "\n$description: $cert($key)"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
910 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
911 ${Log}::error "TLS connection error: $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
912 return 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
913 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
914 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
915 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
916 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
917 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
918
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
919 proc ::relmon::update::main {args} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
920 variable Config
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
921 variable usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
922 variable Statistics
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
923 variable Watchlist [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
924 variable Queue [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
925 variable HostConnections [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
926 variable HostDelays [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
927 variable ActiveTransfers [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
928 variable State
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
929 variable StateBuffer [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
930 variable PreprocessedHtmlBuffer
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
931 variable Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
932 variable Lf ""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
933 variable ExitStatus
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
934
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
935 # parse commandline
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
936 while {[set GetoptRet [cmdline::getopt args \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
937 {c.arg C.arg d D.arg e H.arg i.arg l.arg r.arg t.arg T.arg v} \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
938 OptArg OptVal]] == 1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
939 switch -glob -- $OptArg {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
940 {c} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
941 if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
942 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
943 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
944 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
945 dict set Config "host_connection_limit" $OptVal
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
946 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
947 {C} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
948 if {![file isdirectory $OptVal]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
949 puts stderr "directory \"$OptVal\" is not a directory"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
950 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
951 } elseif {![file readable $OptVal] ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
952 ![file executable $OptVal]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
953 puts stderr "directory \"$OptVal\" is not readable"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
954 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
955 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
956 dict set Config "ca_dir" $OptVal
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
957 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
958 {d} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
959 dict set Config "log_level" "debug"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
960 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
961 {D} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
962 if {![string is digit -strict $OptVal] || ($OptVal < 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
963 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
964 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
965 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
966 dict set Config "host_delay" [expr {$OptVal * 1000}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
967 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
968 {e} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
969 dict set Config "error_filter" 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
970 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
971 {H} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
972 if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
973 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
974 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
975 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
976 dict set Config "connection_limit" $OptVal
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
977 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
978 {i} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
979 foreach item [split $OptVal " "] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
980 set item [string trim $item]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
981 if {$item ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
982 dict lappend Config "item_filter" $item
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
983 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
984 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
985 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
986 {l} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
987 dict set Config "log_file" $OptVal
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
988 set LogDir [file dirname $OptVal]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
989 if {![file writable $LogDir] || ![file executable $LogDir]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
990 puts stderr "directory \"$LogDir\" is not writable"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
991 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
992 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
993 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
994 {r} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
995 if {![string is digit -strict $OptVal] || ($OptVal < 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
996 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
997 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
998 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
999 dict set Config "retry_limit" $OptVal
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1000 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1001 {t} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1002 if {![string is digit -strict $OptVal] || ($OptVal < 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1003 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1004 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1005 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1006 dict set Config "timestamp_filter" [expr {$OptVal * 1000}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1007 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1008 {T} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1009 if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1010 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1011 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1012 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1013 dict set Config "transfer_time_limit" [expr {$OptVal * 1000}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1014 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1015 {v} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1016 if {[dict get $Config "log_level"] ne "debug"} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1017 dict set Config "log_level" "info"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1018 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1019 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1020 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1021 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1022 set argc [llength $args]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1023 if {$GetoptRet == -1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1024 puts stderr "unknown command line option \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1025 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1026 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1027 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1028 if {$argc != 2} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1029 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1030 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1031 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1032 dict set Config "watchlist_file" [lindex $args 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1033 if {![file readable [dict get $Config "watchlist_file"]]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1034 puts stderr "watchlist file \"[dict get $Config "watchlist_file"]\"\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1035 could not be read"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1036 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1037 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1038 set stateFile [lindex $args 1]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1039 dict set Config "state_file" $stateFile
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1040 set StateDir [file dirname $stateFile]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1041 if {![file writable $StateDir]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1042 puts stderr "directory \"$StateDir\" is not writable"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1043
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1044 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1045 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1046
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1047 # install exit handler for closing the logfile, open the logfile and
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1048 # initialize logger
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1049 trace add execution exit enter CleanupBeforeExit
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1050 if {[dict get $Config "log_file"] ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1051 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1052 set Lf [open [dict get $Config "log_file"] "w"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1053 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1054 puts stderr "failed to open logfile\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1055 \"[dict get $Config "log_file"]\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1056 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1057 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1058 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1059 set Lf stderr
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1060 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1061 set Log [logger::init global]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1062 if {[dict get $Config "log_level"] eq "debug"} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1063 set logFormat {%d \[%p\] \[%M\] %m}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1064 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1065 set logFormat {%d \[%p\] %m}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1066 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1067 logger::utils::applyAppender -appender fileAppend -appenderArgs \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1068 [list -outputChannel $Lf -conversionPattern $logFormat] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1069 -serviceCmd $Log
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1070
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1071 # set default logging level
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1072 ${Log}::setlevel [dict get $Config "log_level"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1073
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1074 ${Log}::notice "relmon.tcl starting up"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1075
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1076 # parse the watchlist
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1077 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1078 ParseWatchlist [dict get $Config "watchlist_file"]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1079 } trap {POSIX} {errorMsg errorOptions} - \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1080 trap {RELMON} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1081 ${Log}::error $errorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1082 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1083 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1084
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1085 # read the state file
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1086 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1087 set State [::relmon::common::parseStateFile $stateFile]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1088 } trap {POSIX ENOENT} {errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1089 ${Log}::debug "state file \"$stateFile\" does not exist"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1090 set State [dict create]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1091 } trap {POSIX} {errorMsg} - \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1092 trap {RELMON} {errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1093 ${Log}::error $errorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1094 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1095 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1096
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1097 # initialize queue and state buffer from the watchlist
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1098 dict set Statistics "start_time" [clock milliseconds]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1099 dict for {name watchlistItem} $Watchlist {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1100 # apply filters specified on the command line to watchlist items
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1101 if {([llength [dict get $Config "item_filter"]] > 0) &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1102 ($name ni [dict get $Config "item_filter"])} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1103 continue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1104 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1105
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1106 if {[dict get $Config "error_filter"] &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1107 [dict exists $State $name "errors"] &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1108 ([llength [dict get $State $name "errors"]] == 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1109 continue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1110 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1111
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1112 if {[dict exists $State $name "timestamp"] &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1113 ([dict get $State $name "timestamp"] >
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1114 [dict get $Statistics "start_time"] -
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1115 [dict get $Config "timestamp_filter"])} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1116 continue
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1117 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1118
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1119 dict lappend Queue [::relmon::common::urlGetHost \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1120 [dict get $watchlistItem "base_url"]] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1121 [dict create \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1122 "name" $name \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1123 "url" [dict get $watchlistItem "base_url"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1124 "pattern_index" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1125 "num_redirects" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1126 "num_retries" 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1127 dict incr Statistics "items"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1128 dict set StateBuffer $name [dict create "versions" [dict create] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1129 "errors" [list]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1130 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1131
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1132 # configure http and tls
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1133 http::register https 443 [list tls::socket \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1134 -cadir [dict get $Config "ca_dir"] -request 1 -require 1 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1135 -command [namespace code OnTlsHandshake] -ssl2 0 -ssl3 1 -tls1 1]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1136 http::config -useragent "Mozilla/5.0 (Windows NT 6.1; rv:16.0)\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1137 Gecko/20100101 Firefox/16.0 relmon/$relmon::VERSION"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1138
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1139 # handle errors while in the event loop
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1140 interp bgerror {} [namespace code OnError]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1141
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1142 # enter the main loop
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1143 after idle [namespace code ManageTransfers]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1144 vwait [namespace which -variable ExitStatus]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1145
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1146 dict set Statistics "end_time" [clock milliseconds]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1147
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1148 # display statistics
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1149 ${Log}::notice "items checked: [dict get $Statistics "items"]"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1150 ${Log}::notice "time elapsed: [expr {([dict get $Statistics "end_time"] -
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1151 [dict get $Statistics "start_time"]) / 1000}]s"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1152
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1153 # serialize the new state
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1154 set JsonStateItems {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1155 dict for {item data} $State {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1156 set versions {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1157 dict for {version url} [dict get $data "versions"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1158 lappend versions $version [json::write string $url]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1159 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1160 set history {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1161 foreach historyItem [dict get $data "history"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1162 lassign $historyItem version timestamp
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1163 lappend history [json::write array [json::write string $version] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1164 $timestamp]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1165 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1166 set errors {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1167 foreach errorItem [dict get $data "errors"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1168 lappend errors [json::write string $errorItem]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1169 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1170 lappend JsonStateItems $item [json::write object \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1171 "versions" [json::write object {*}$versions] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1172 "history" [json::write array {*}$history] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1173 "timestamp" [dict get $data "timestamp"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1174 "errors" [json::write array {*}$errors]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1175 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1176 set JsonState [json::write object {*}$JsonStateItems]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1177
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1178 # try to preserve permissions and ownership
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1179 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1180 set stateFileAttributes [file attributes $stateFile]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1181 } trap {POSIX ENOENT} {} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1182 set stateFileAttributes {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1183 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1184 ${Log}::error "failed to stat \"$stateFile\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1185 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1186 # write the new state to a temporary file
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1187 set tmpFile "$stateFile.[pid].tmp"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1188 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1189 set f [open $tmpFile {RDWR CREAT EXCL TRUNC} 0600]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1190 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1191 ${Log}::error "failed to open \"$tmpFile\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1192
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1193 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1194 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1195 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1196 chan puts -nonewline $f $JsonState
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1197 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1198 catch {file delete $tmpFile}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1199
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1200 ${Log}::error "failed to write to \"$tmpFile\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1201
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1202 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1203 } finally {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1204 close $f
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1205 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1206 # make a backup of the previous state file
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1207 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1208 file copy -force $stateFile "$stateFile~"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1209 } trap {POSIX ENOENT} {} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1210 # ignore non-existing file
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1211 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1212 ${Log}::error "failed to create a backup of \"$statFile\":\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1213 $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1214 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1215 # rename the temporary file to the state file name
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1216 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1217 file rename -force $tmpFile $stateFile
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1218 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1219 catch {file delete $tmpFile}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1220
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1221 ${Log}::error "failed to rename \"$tmpFile\" to \"$stateFile\":\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1222 $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1223
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1224 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1225 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1226 # restore ownership and permissions
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1227 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1228 file attributes $stateFile {*}$stateFileAttributes
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1229 } trap {POSIX} {errorMsg errorOptions} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1230 ${Log}::error "failed to set permissions and ownership on\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1231 \"$stateFile\": $errorMsg"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1232
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1233 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1234 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1235
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1236 # clean up
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1237 ${Log}::delete
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1238
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1239 exit $ExitStatus
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1240 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1241
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1242
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1243 namespace eval ::relmon::show {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1244 # commandline option help text
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1245 variable usage "usage: relmon show statefile name..."
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1246 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1247
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1248 proc ::relmon::show::GetItem {stateName name} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1249 upvar 1 $stateName state
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1250 set item [dict get $state $name]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1251
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1252 # format state data as plain-text
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1253 set output ""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1254 append output "Name: $name\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1255 append output "Latest Version:\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1256 [lindex [lindex [dict get $item "history"] end] 0]\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1257 append output "Refreshed: [clock format \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1258 [expr {[dict get $item "timestamp"] / 1000}] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1259 -format {%Y-%m-%dT%H:%M:%S%z}]\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1260 append output "Versions:\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1261 dict for {version url} [dict get $item "versions"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1262 append output "\t$version $url\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1263 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1264 append output "Errors:\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1265 if {[dict get $item "errors"] eq ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1266 append output "\tNone\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1267 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1268 foreach errorMsg [dict get $item "errors"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1269 append output "\t[string map {\n \n\t} [string trim $errorMsg]]\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1270 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1271 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1272 append output "History:\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1273 foreach historyItem [dict get $item "history"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1274 append output "\t[lindex $historyItem 0] [clock format \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1275 [expr {[lindex $historyItem 1] / 1000}] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1276 -format {%Y-%m-%dT%H:%M:%S%z}]\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1277 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1278 return $output
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1279 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1280
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1281 proc ::relmon::show::main {args} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1282 variable usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1283
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1284 # parse commandline
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1285 if {[cmdline::getopt args {} OptArg OptVal] == -1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1286 puts stderr "unknown command line option \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1287 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1288 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1289 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1290 if {[llength $args] < 2} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1291 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1292 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1293 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1294 set stateFile [lindex $args 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1295 set names [lrange $args 1 end]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1296
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1297 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1298 set state [::relmon::common::parseStateFile $stateFile]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1299 } trap {POSIX} {errorMsg} - trap {RELMON} {errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1300 puts stderr $errorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1301 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1302 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1303
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1304 # show each item
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1305 foreach name $names {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1306 puts -nonewline [GetItem state $name]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1307 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1308
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1309 exit 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1310 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1311
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1312
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1313 namespace eval ::relmon::list {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1314 # commandline option help text
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1315 variable usage "usage: relmon list \[-H\] \[-f html|parseable|text\]\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1316 \[-F url\]\n\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1317 \ \[-n number_items\] statefile\n\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1318 \ relmon list -f atom -F url \[-n number_items\] statefile"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1319
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1320 # configuration options
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1321 variable Config [dict create \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1322 "format" "text" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1323 "show_history" 0 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1324 "history_limit" 100 \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1325 "feed_url" ""]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1326 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1327
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1328 proc ::relmon::list::FormatText {stateName includeHistory historyLimit} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1329 upvar 1 $stateName state
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1330 set output ""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1331 append output [format "%-35s %-15s %-24s %-3s\n" "Project" "Version" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1332 "Refreshed" "St."]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1333 append output [string repeat "-" 80]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1334 append output "\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1335
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1336 set history {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1337 dict for {name item} $state {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1338 foreach historyItem [dict get $item "history"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1339 lappend history [list [lindex $historyItem 1] $name \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1340 [lindex $historyItem 0]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1341 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1342 set latestVersion [lindex [lindex [dict get $item "history"] end] 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1343 set timestamp [clock format [expr {[dict get $item "timestamp"] /
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1344 1000}] -format {%Y-%m-%dT%H:%M:%S%z}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1345 set status [expr {[llength [dict get $item "errors"]] > 0 ? "E" : ""}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1346 append output [format "%-35s %15s %-24s %-1s\n" $name $latestVersion \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1347 $timestamp $status]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1348 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1349 if {$includeHistory} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1350 append output "\nHistory\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1351 append output [string repeat "-" 80]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1352 append output "\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1353 set history [lsort -decreasing -integer -index 0 $history]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1354 foreach historyItem [lrange $history 0 $historyLimit] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1355 append output [format "%-24s %-35s %15s\n" \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1356 [clock format [expr {[lindex $historyItem 0] / 1000}] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1357 -format {%Y-%m-%dT%H:%M:%S%z}] [lindex $historyItem 1] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1358 [lindex $historyItem 2]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1359 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1360 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1361
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1362 return $output
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1363 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1364
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1365 proc ::relmon::list::FormatParseable {stateName includeHistory historyLimit} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1366 upvar 1 $stateName state
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1367 set output ""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1368 set history {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1369 dict for {name item} $state {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1370 foreach historyItem [dict get $item "history"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1371 lappend history [list [lindex $historyItem 1] $name \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1372 [lindex $historyItem 0]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1373 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1374 set latestVersion [lindex [lindex [dict get $item "history"] end] 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1375 if {$latestVersion eq ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1376 set latestVersion -
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1377 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1378 set timestamp [clock format [expr {[dict get $item "timestamp"] /
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1379 1000}] -timezone :UTC -format {%Y-%m-%dT%H:%M:%SZ}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1380 set status [expr {[llength [dict get $item "errors"]] > 0 ? "ERROR" :
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1381 "OK"}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1382 append output [format "%s\t%s\t%s\t%s\n" $name $latestVersion \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1383 $timestamp $status]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1384 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1385 if {$includeHistory} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1386 append output "\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1387 set history [lsort -decreasing -integer -index 0 $history]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1388 foreach historyItem [lrange $history 0 $historyLimit] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1389 append output [format "%s\t%s\t%s\n" [clock format \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1390 [expr {[lindex $historyItem 0] / 1000}] -timezone :UTC \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1391 -format {%Y-%m-%dT%H:%M:%SZ}] [lindex $historyItem 1] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1392 [lindex $historyItem 2]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1393 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1394 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1395 return $output
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1396 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1397
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1398 proc ::relmon::list::FormatHtml {stateName includeHistory historyLimit
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1399 feedUrl} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1400 upvar 1 $stateName state
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1401
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1402 set output "<html>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1403 append output "<head>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1404 append output "<title>Current Releases</title>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1405 if {$feedUrl ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1406 append output "<link type=\"application/atom+xml\" rel=\"alternate\"\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1407 title=\"Release History\"\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1408 href=\"[html::html_entities $feedUrl]\"/>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1409 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1410 append output "</head>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1411 append output "<body>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1412 append output "<h1>Current Releases</h1>\n<table>\n<tr>\n<th>Project</th>\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1413 \n<th>Version</th>\n<th>Refreshed</th>\n<th>Status</th>\n</tr>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1414 set history {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1415 dict for {name item} $state {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1416 foreach historyItem [dict get $item "history"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1417 lappend history [list [lindex $historyItem 1] $name \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1418 [lindex $historyItem 0]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1419 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1420 set latestVersion [lindex [lindex [dict get $item "history"] end] 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1421 set timestamp [clock format [expr {[dict get $item "timestamp"] /
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1422 1000}] -format {%Y-%m-%dT%H:%M:%S%z}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1423 set status [expr {[llength [dict get $item "errors"]] > 0 ? "Error" :
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1424 "OK"}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1425
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1426 append output "<tr>\n<td>[html::html_entities $name]</td>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1427 if {$latestVersion ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1428 if {[dict exists $item "versions" $latestVersion]} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1429 set url [dict get $item "versions" $latestVersion]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1430 append output "<td><a\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1431 href=\"[html::html_entities $url]\"\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1432 title=\"[html::html_entities\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1433 "$name $latestVersion"]\">[html::html_entities \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1434 $latestVersion]</a></td>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1435 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1436 append output "<td>[html::html_entities \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1437 $latestVersion]</td>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1438 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1439 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1440 append output "<td></td>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1441 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1442 append output "<td>$timestamp</td>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1443 append output "<td>[html::html_entities $status]</td>\n</tr>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1444 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1445 append output "</table>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1446
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1447 if {$includeHistory} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1448 set history [lsort -decreasing -integer -index 0 $history]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1449 append output "<h1>Release History</h1>\n<table>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1450 append output "<tr><th>Time</th><th>Project</th><th>Version</th></tr>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1451 foreach historyItem [lrange $history 0 $historyLimit] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1452 set timestamp [clock format [expr {[lindex $historyItem 0] /
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1453 1000}] -format {%Y-%m-%dT%H:%M:%S%z}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1454 set name [lindex $historyItem 1]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1455 set version [lindex $historyItem 2]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1456 append output "<tr>\n<td>$timestamp</td>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1457 append output "<td>[html::html_entities $name]</td>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1458 append output "<td>[html::html_entities $version]</td></tr>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1459 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1460 append output "</table>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1461 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1462
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1463 append output "</body>\n</html>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1464
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1465 return $output
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1466 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1467
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1468 proc ::relmon::list::FormatAtom {stateName historyLimit feedUrl} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1469 upvar 1 $stateName state
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1470 set host [::relmon::common::urlGetHost $feedUrl]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1471 set output "<?xml version=\"1.0\" encoding=\"utf-8\"?>\
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1472 \n<feed xmlns=\"http://www.w3.org/2005/Atom\">\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1473 append output "<author><name>relmon</name></author>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1474 append output "<title>Release History</title>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1475 append output "<id>[html::html_entities $feedUrl]</id>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1476 set history {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1477 dict for {name item} $state {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1478 foreach historyItem [dict get $item "history"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1479 lappend history [list [lindex $historyItem 1] $name \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1480 [lindex $historyItem 0]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1481 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1482 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1483 set history [lsort -decreasing -integer -index 0 $history]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1484 set updated [lindex [lindex $history end] 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1485 if {$updated eq ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1486 set updated [clock seconds]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1487 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1488 append output "<updated>[clock format $updated \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1489 -format {%Y-%m-%dT%H:%M:%S%z}]</updated>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1490 foreach historyItem [lrange $history 0 $historyLimit] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1491 set name [lindex $historyItem 1]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1492 set version [lindex $historyItem 2]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1493 set timestamp [clock format [expr {[lindex $historyItem 0] / 1000}] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1494 -format {%Y-%m-%dT%H:%M:%S%z}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1495 set id "tag:$host,[clock format [lindex $historyItem 0] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1496 -format {%Y-%m-%d}]:[uri::urn::quote $name-$version]"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1497 append output "<entry>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1498 append output "<id>[html::html_entities $id]</id>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1499 append output "<updated>$timestamp</updated>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1500 append output "<title>[html::html_entities "$name $version"]</title>"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1501 append output "<content>[html::html_entities \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1502 "$name $version"]</content>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1503 append output "</entry>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1504 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1505 append output "</feed>\n"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1506 return $output
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1507 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1508
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1509 proc ::relmon::list::main {args} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1510 variable usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1511 variable Config
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1512
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1513 # parse commandline
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1514 while {[set GetoptRet [cmdline::getopt args {f.arg F.arg H n.arg} OptArg \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1515 OptVal]] == 1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1516 switch -glob -- $OptArg {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1517 {f} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1518 if {$OptVal ni {atom html parseable text}} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1519 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1520 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1521 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1522 dict set Config "format" $OptVal
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1523 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1524 {F} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1525 if {[catch {dict create {*}[uri::split $OptVal]} UrlParts] ||
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1526 ([dict get $UrlParts "host"] eq "")} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1527 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1528 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1529 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1530 dict set Config "feed_url" $OptVal
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1531 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1532 {H} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1533 dict set Config "show_history" 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1534 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1535 {n} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1536 if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1537 puts stderr "invalid value passed to \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1538 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1539 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1540 dict set Config "history_limit" [expr {$OptVal - 1}]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1541 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1542 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1543 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1544 set argc [llength $args]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1545 if {$GetoptRet == -1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1546 puts stderr "unknown command line option \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1547 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1548 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1549 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1550 if {$argc != 1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1551 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1552 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1553 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1554 if {([dict get $Config "format"] eq "atom") &&
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1555 ([dict get $Config "feed_url"] eq "")} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1556 puts stderr "mandatory \"-F\" option is missing"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1557 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1558 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1559 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1560 set StateFile [lindex $args 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1561
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1562 # read the state file
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1563 try {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1564 set State [::relmon::common::parseStateFile $StateFile]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1565 } trap {POSIX} {errorMsg} - trap {RELMON} {errorMsg} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1566 puts stderr $errorMsg
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1567 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1568 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1569
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1570 # call formatter
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1571 switch -- [dict get $Config "format"] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1572 {atom} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1573 puts -nonewline [FormatAtom State \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1574 [dict get $Config "history_limit"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1575 [dict get $Config "feed_url"]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1576 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1577 {html} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1578 puts -nonewline [FormatHtml State \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1579 [dict get $Config "show_history"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1580 [dict get $Config "history_limit"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1581 [dict get $Config "feed_url"]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1582 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1583 {parseable} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1584 puts -nonewline [FormatParseable State \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1585 [dict get $Config "show_history"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1586 [dict get $Config "history_limit"]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1587 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1588 {default} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1589 puts -nonewline [FormatText State \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1590 [dict get $Config "show_history"] \
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1591 [dict get $Config "history_limit"]]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1592 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1593 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1594
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1595 exit 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1596 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1597
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1598
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1599 namespace eval ::relmon::help {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1600 # commandline option help text
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1601 variable usage "usage: relmon help \[subcommand\]"
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1602 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1603
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1604 proc ::relmon::help::main {args} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1605 variable usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1606
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1607 # parse commandline
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1608 if {[cmdline::getopt args {} OptArg OptVal] == -1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1609 puts stderr "unknown command line option \"-$OptArg\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1610 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1611 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1612 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1613 set argc [llength $args]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1614 if {$argc > 1} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1615 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1616 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1617 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1618 set subCommand [lindex $args 0]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1619 if {$subCommand ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1620 if {[info procs ::relmon::${subCommand}::main] ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1621 puts stderr [set ::relmon::${subCommand}::usage]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1622 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1623 puts stderr "unknown subcommand \"$subCommand\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1624 puts stderr $usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1625 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1626 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1627 } else {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1628 foreach subCommandNs [namespace children ::relmon] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1629 if {[info procs ${subCommandNs}::main] ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1630 puts stderr [set ${subCommandNs}::usage]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1631 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1632 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1633 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1634 exit 0
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1635 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1636
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1637
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1638 proc ::relmon::main {args} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1639 variable usage
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1640 set subArgs [lassign $args subCommand]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1641
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1642 # generate list of subcommands
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1643 set subCommands {}
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1644 foreach subCommandNs [namespace children ::relmon] {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1645 if {[info procs ${subCommandNs}::main] ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1646 lappend subCommands [namespace tail $subCommandNs]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1647 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1648 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1649 if {$subCommand ni $subCommands} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1650 if {$subCommand ne ""} {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1651 puts stderr "unknown subcommand \"$subCommand\""
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1652 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1653 foreach command $subCommands {
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1654 puts stderr [set relmon::${command}::usage]
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1655 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1656 exit 1
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1657 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1658
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1659 # dispatch subcommand
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1660 relmon::${subCommand}::main {*}$subArgs
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1661 }
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1662
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1663
8c5330f6e9e4 Initial revision
Guido Berhoerster <guido+relmon@berhoerster.name>
parents:
diff changeset
1664 relmon::main {*}$argv