projects/relmon

changeset 0:8c5330f6e9e4

Initial revision
author Guido Berhoerster <guido+relmon@berhoerster.name>
date Sun Oct 19 20:44:39 2014 +0200 (2014-10-19)
parents
children cba4887feb2c
files relmon.tcl
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/relmon.tcl	Sun Oct 19 20:44:39 2014 +0200
     1.3 @@ -0,0 +1,1664 @@
     1.4 +#!/usr/bin/tclsh
     1.5 +#
     1.6 +# Copyright (C) 2011 Guido Berhoerster <guido+relmon@berhoerster.name>
     1.7 +#
     1.8 +# Permission is hereby granted, free of charge, to any person obtaining
     1.9 +# a copy of this software and associated documentation files (the
    1.10 +# "Software"), to deal in the Software without restriction, including
    1.11 +# without limitation the rights to use, copy, modify, merge, publish,
    1.12 +# distribute, sublicense, and/or sell copies of the Software, and to
    1.13 +# permit persons to whom the Software is furnished to do so, subject to
    1.14 +# the following conditions:
    1.15 +#
    1.16 +# The above copyright notice and this permission notice shall be included
    1.17 +# in all copies or substantial portions of the Software.
    1.18 +#
    1.19 +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
    1.20 +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
    1.21 +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
    1.22 +# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
    1.23 +# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
    1.24 +# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
    1.25 +# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    1.26 +
    1.27 +package require Tcl 8.5
    1.28 +package require http
    1.29 +package require tls
    1.30 +package require tdom
    1.31 +package require try
    1.32 +package require cmdline
    1.33 +package require control
    1.34 +package require html
    1.35 +package require htmlparse
    1.36 +package require json
    1.37 +package require json::write
    1.38 +package require logger
    1.39 +package require logger::utils
    1.40 +package require textutil::split
    1.41 +package require uri
    1.42 +package require uri::urn
    1.43 +
    1.44 +
    1.45 +namespace eval ::relmon {
    1.46 +    # version
    1.47 +    variable VERSION 1
    1.48 +}
    1.49 +
    1.50 +
    1.51 +namespace eval ::relmon::common {
    1.52 +    namespace export cmpVersions isUrlValid urlGetHost parseStateFile
    1.53 +}
    1.54 +
    1.55 +# implementation of the Debian version comparison algorithm described at
    1.56 +# http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version
    1.57 +proc ::relmon::common::cmpVersion {v1 v2} {
    1.58 +    set v1Len [string length $v1]
    1.59 +    set v2Len [string length $v2]
    1.60 +    set v1Pos 0
    1.61 +    set v2Pos 0
    1.62 +    while {($v1Pos < $v1Len) || ($v2Pos < $v2Len)} {
    1.63 +        set firstNumDiff 0
    1.64 +        # until reaching ASCII digits in both version strings compare character
    1.65 +        # values which are modified as so they are sorted in the following
    1.66 +        # order:
    1.67 +        # - "~"
    1.68 +        # - missing character or ASCII digits
    1.69 +        # - ASCII alphabet
    1.70 +        # - everything else in the order of their unicode value
    1.71 +        while {(($v1Pos < $v1Len) &&
    1.72 +                ![string match {[0123456789]} [string index $v1 $v1Pos]]) ||
    1.73 +                (($v2Pos < $v2Len) &&
    1.74 +                ![string match {[0123456789]} [string index $v2 $v2Pos]])} {
    1.75 +            foreach char [list [string index $v1 $v1Pos] \
    1.76 +                    [string index $v2 $v2Pos]] charValueName \
    1.77 +                    {v1CharValue v2CharValue} {
    1.78 +                if {$char eq "~"} {
    1.79 +                    set $charValueName -1
    1.80 +                } elseif {$char eq ""} {
    1.81 +                    set $charValueName 0
    1.82 +                } elseif {[string match {[0123456789]} $char]} {
    1.83 +                    set $charValueName 0
    1.84 +                } elseif {[string match -nocase {[abcdefghijklmnopqrstuvwxyz]} \
    1.85 +                        $char]} {
    1.86 +                    set $charValueName [scan $char "%c"]
    1.87 +                } else {
    1.88 +                    set $charValueName [expr {[scan $char "%c"] + 0x7f + 1}]
    1.89 +                }
    1.90 +            }
    1.91 +            if {$v1CharValue != $v2CharValue} {
    1.92 +                return [expr {$v1CharValue - $v2CharValue}]
    1.93 +            }
    1.94 +            incr v1Pos
    1.95 +            incr v2Pos
    1.96 +        }
    1.97 +
    1.98 +        # strip leading zeros
    1.99 +        while {[string index $v1 $v1Pos] eq "0"} {
   1.100 +            incr v1Pos
   1.101 +        }
   1.102 +        while {[string index $v2 $v2Pos] eq "0"} {
   1.103 +            incr v2Pos
   1.104 +        }
   1.105 +
   1.106 +        # process digits until reaching a non-digit
   1.107 +        while {[string match {[0123456789]} [string index $v1 $v1Pos]] &&
   1.108 +                [string match {[0123456789]} [string index $v2 $v2Pos]]} {
   1.109 +            # record the first difference between the two numbers
   1.110 +            if {$firstNumDiff == 0} {
   1.111 +                set firstNumDiff [expr {[string index $v1 $v1Pos] -
   1.112 +                        [string index $v2 $v2Pos]}]
   1.113 +            }
   1.114 +            incr v1Pos
   1.115 +            incr v2Pos
   1.116 +        }
   1.117 +
   1.118 +        # return if the number of one version has more digits than the other
   1.119 +        # since the one with more digits is the larger number
   1.120 +        if {[string match {[0123456789]} [string index $v1 $v1Pos]]} {
   1.121 +            return 1
   1.122 +        } elseif {[string match {[0123456789]} [string index $v2 $v2Pos]]} {
   1.123 +            return -1
   1.124 +        }
   1.125 +
   1.126 +        # return the difference if the digits differed above
   1.127 +        if {$firstNumDiff != 0} {
   1.128 +            return $firstNumDiff
   1.129 +        }
   1.130 +    }
   1.131 +
   1.132 +    return 0
   1.133 +}
   1.134 +
   1.135 +proc ::relmon::common::isUrlValid {url} {
   1.136 +    return [expr {![catch {dict create {*}[uri::split $url]} urlParts] &&
   1.137 +            ([dict get $urlParts "scheme"] in {"http" "https"}) &&
   1.138 +            ([dict get $urlParts "host"] ne "")}]
   1.139 +}
   1.140 +
   1.141 +proc ::relmon::common::urlGetHost {url} {
   1.142 +    return [expr {(![catch {dict create {*}[uri::split $url]} urlParts]) ?
   1.143 +                [dict get $urlParts "host"] : ""}]
   1.144 +}
   1.145 +
   1.146 +proc ::relmon::common::parseStateFile {stateFile} {
   1.147 +    try {
   1.148 +        set f [open $stateFile "r"]
   1.149 +    } trap {POSIX} {errorMsg errorOptions} {
   1.150 +        return -options $errorOptions \
   1.151 +                "failed to open state file \"$stateFile\": $errorMsg"
   1.152 +    }
   1.153 +    try {
   1.154 +        set state [json::json2dict [chan read $f]]
   1.155 +    } trap {POSIX} {errorMsg errorOptions} {
   1.156 +        return -options $errorOptions \
   1.157 +                "failed to read from state file \"$stateFile\": $errorMsg"
   1.158 +    } on error {errorMsg errorOptions} {
   1.159 +        # the json package does not set an error code
   1.160 +        dict set errorOptions "-errorcode" {RELMON JSON_PARSE_ERROR}
   1.161 +        return -options $errorOptions \
   1.162 +                "failed to parse state file \"$stateFile\": $errorMsg"
   1.163 +    } finally {
   1.164 +        close $f
   1.165 +    }
   1.166 +
   1.167 +    return $state
   1.168 +}
   1.169 +
   1.170 +
   1.171 +namespace eval ::relmon::update {
   1.172 +    # commandline option help text
   1.173 +    variable usage "usage: relmon update \[-dev\] \[-c max_connections\] \[-C\
   1.174 +            ca_dir\] \[-D delay\]\n\
   1.175 +            \                    \[-H max_host_connections\] \[-i\
   1.176 +            item\[,...\]\] \[-l logfile\]\n\
   1.177 +            \                    \[-r retries\] \[-t min_time\] watchlist\
   1.178 +            statefile"
   1.179 +
   1.180 +    # configuration options
   1.181 +    variable Config [dict create \
   1.182 +            "log_file" "" \
   1.183 +            "log_level" "notice" \
   1.184 +            "history_limit" 20 \
   1.185 +            "connection_limit" 16 \
   1.186 +            "host_connection_limit" 4 \
   1.187 +            "transfer_time_limit" 60000 \
   1.188 +            "retry_limit" 3 \
   1.189 +            "host_delay" 0 \
   1.190 +            "timestamp_filter" 0 \
   1.191 +            "error_filter" 0 \
   1.192 +            "item_filter" {} \
   1.193 +            "ca_dir" "" \
   1.194 +            "state_file" "" \
   1.195 +            "watchlist_file" ""]
   1.196 +
   1.197 +    # exit status
   1.198 +    variable ExitStatus
   1.199 +
   1.200 +    # transfer statistics
   1.201 +    variable Statistics [dict create \
   1.202 +            "start_time" 0 \
   1.203 +            "end_time" 0 \
   1.204 +            "requests" 0 \
   1.205 +            "items" 0]
   1.206 +
   1.207 +    # watchlist
   1.208 +    variable Watchlist
   1.209 +
   1.210 +    # ID of a delayed run of ManageTransfers
   1.211 +    variable ManageTransfersId ""
   1.212 +
   1.213 +    # queue of pending transfers
   1.214 +    variable Queue
   1.215 +
   1.216 +    # number of active connections per host
   1.217 +    variable HostConnections
   1.218 +
   1.219 +    # delays before opening a new connection to a host
   1.220 +    variable HostDelays
   1.221 +
   1.222 +    # active transfers
   1.223 +    variable ActiveTransfers
   1.224 +
   1.225 +    # buffer for tracking the state of unfinished items
   1.226 +    variable StateBuffer
   1.227 +
   1.228 +    # buffer needed by htmlparse::parse for constructing the preprocessed HTML
   1.229 +    # document
   1.230 +    variable PreprocessedHtmlBuffer
   1.231 +
   1.232 +    # logger handle
   1.233 +    variable Log
   1.234 +
   1.235 +    # logfile handle
   1.236 +    variable Lf
   1.237 +}
   1.238 +
   1.239 +proc ::relmon::update::OnError {message returnOptions} {
   1.240 +    # internal error, abort
   1.241 +    puts stderr [dict get $returnOptions "-errorinfo"]
   1.242 +
   1.243 +    exit 1
   1.244 +}
   1.245 +
   1.246 +proc ::relmon::update::CleanupBeforeExit {commandString operation} {
   1.247 +    variable Lf
   1.248 +
   1.249 +    # close logfile
   1.250 +    if {($Lf ne "") && ($Lf ni {stdin stderr})} {
   1.251 +        close $Lf
   1.252 +        set Lf ""
   1.253 +    }
   1.254 +
   1.255 +    return
   1.256 +}
   1.257 +
   1.258 +proc ::relmon::update::ParseWatchlist {watchlistFilename} {
   1.259 +    variable Watchlist
   1.260 +
   1.261 +    set lineno 0
   1.262 +    set f [open $watchlistFilename "r"]
   1.263 +    try {
   1.264 +        while {[chan gets $f line] != -1} {
   1.265 +            set fields [textutil::split::splitx [string trim $line] {[\t ]+}]
   1.266 +            incr lineno
   1.267 +
   1.268 +            if {([llength $fields] == 0) ||
   1.269 +                    ([string index [lindex $fields 0] 0] eq "#")} {
   1.270 +                # skip empty lines and comments
   1.271 +                continue
   1.272 +            } elseif {[llength $fields] < 3} {
   1.273 +                # a line consists of a name, base URL and at least one
   1.274 +                # version-matching pattern
   1.275 +                return -code error -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
   1.276 +                        "syntax error in \"$watchlistFilename\" line $lineno"
   1.277 +            }
   1.278 +
   1.279 +            set patterns [lassign $fields name baseUrl]
   1.280 +
   1.281 +            # validate URL
   1.282 +            if {![::relmon::common::isUrlValid $baseUrl]} {
   1.283 +                return -code error -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
   1.284 +                        "syntax error in \"$watchlistFilename\" line $lineno:\
   1.285 +                        invalid base URL"
   1.286 +            }
   1.287 +
   1.288 +            # process patterns
   1.289 +            set processedPatterns {}
   1.290 +            set patternIndex 0
   1.291 +            foreach pattern $patterns {
   1.292 +                incr patternIndex
   1.293 +
   1.294 +                # make trailing slashes optional except in the last
   1.295 +                # version-matching pattern
   1.296 +                if {($patternIndex != [llength $patterns]) &&
   1.297 +                        ([string index $pattern end] eq "/")} {
   1.298 +                    append pattern {?}
   1.299 +                }
   1.300 +
   1.301 +                # ensure patterns are anchored to the end of the line
   1.302 +                if {[string index $pattern end] ne "$"} {
   1.303 +                    append pattern {$}
   1.304 +                }
   1.305 +
   1.306 +                # actually validate the regular expression
   1.307 +                try {
   1.308 +                    set reInfo [regexp -about -- $pattern ""]
   1.309 +                } on error {errorMsg} {
   1.310 +                    return -code error \
   1.311 +                            -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
   1.312 +                            "error in \"$watchlistFilename\" line $lineno:\
   1.313 +                            $errorMsg"
   1.314 +                }
   1.315 +                lappend processedPatterns $pattern
   1.316 +            }
   1.317 +            if {[lindex $reInfo 0] < 1} {
   1.318 +                return -code error -errorcode {RELMON WATCHLIST_PARSE_ERRROR} \
   1.319 +                        "syntax error in \"$watchlistFilename\" line $lineno:\
   1.320 +                        the last regular expression must contain at least one
   1.321 +                        capturing group"
   1.322 +            }
   1.323 +
   1.324 +            dict set Watchlist $name "base_url" $baseUrl
   1.325 +            dict set Watchlist $name "patterns" $processedPatterns
   1.326 +        }
   1.327 +    } finally {
   1.328 +        close $f
   1.329 +    }
   1.330 +
   1.331 +    return
   1.332 +}
   1.333 +
   1.334 +proc ::relmon::update::ProcessHtmlElement {tag slash param textBehindTheTag} {
   1.335 +    variable PreprocessedHtmlBuffer
   1.336 +
   1.337 +    # copy every "<a>" element into PreprocessedHtmlBuffer
   1.338 +    if {($slash eq "") && ([string tolower $tag] eq "a")} {
   1.339 +        append PreprocessedHtmlBuffer "<$tag $param></$tag>"
   1.340 +    }
   1.341 +
   1.342 +    return
   1.343 +}
   1.344 +
   1.345 +proc ::relmon::update::PreprocessHtml {bodyDataName} {
   1.346 +    upvar 1 $bodyDataName bodyData
   1.347 +    variable PreprocessedHtmlBuffer
   1.348 +
   1.349 +    # preprocess the document with htmlparse by constructing a new document
   1.350 +    # consisting only of found "<a>" elements which then can be fed into tdom
   1.351 +    # again; this is useful if parsing via tdom fails; however, htmlparse
   1.352 +    # should only be used as a last resort because it is just too limited, it
   1.353 +    # gets easily confused within "<script>" elements and lacks attribute
   1.354 +    # parsing
   1.355 +    set PreprocessedHtmlBuffer "<html><body>"
   1.356 +    htmlparse::parse -cmd [namespace code ProcessHtmlElement] $bodyData
   1.357 +    append PreprocessedHtmlBuffer "</body></html>"
   1.358 +}
   1.359 +
   1.360 +proc ::relmon::update::ExtractUrls {bodyDataName contentType baseUrl
   1.361 +        rePattern} {
   1.362 +    upvar 1 $bodyDataName bodyData
   1.363 +    set extractedUrls {}
   1.364 +    set resultUrls [dict create]
   1.365 +    set bareContentType [string trim [lindex [split $contentType ";"] 0]]
   1.366 +    # extract all URLs or URL fragments
   1.367 +    switch -- $bareContentType {
   1.368 +        {text/html} -
   1.369 +        {application/xhtml+xml} {
   1.370 +            # HTML/XHTML
   1.371 +            # if tdom parsing has failed or not found any "<a>" element,
   1.372 +            # preprocess the document with htmlparse and try again
   1.373 +            if {[catch {dom parse -html $bodyData} doc] ||
   1.374 +                    ([set rootElement [$doc documentElement]] eq "") ||
   1.375 +                    ([llength [set aElements \
   1.376 +                    [$rootElement selectNodes {descendant::a}]]] == 0)} {
   1.377 +                try {
   1.378 +                    set doc [dom parse -html [PreprocessHtml bodyData]]
   1.379 +                } on error {errorMsg errorOptions} {
   1.380 +                    dict set errorOptions "-errorcode" \
   1.381 +                            {RELMON TDOM_PARSE_ERROR}
   1.382 +                    return -options $errorOptions $errorMsg
   1.383 +                }
   1.384 +                set rootElement [$doc documentElement]
   1.385 +                set aElements [$rootElement selectNodes {descendant::a}]
   1.386 +            }
   1.387 +            foreach node $aElements {
   1.388 +                set href [$node getAttribute "href" ""]
   1.389 +                if {$href ne ""} {
   1.390 +                    lappend extractedUrls $href
   1.391 +                }
   1.392 +            }
   1.393 +            $doc delete
   1.394 +        }
   1.395 +        {application/rss+xml} {
   1.396 +            # RSS 2.0
   1.397 +            try {
   1.398 +                set doc [dom parse $bodyData]
   1.399 +            } on error {errorMsg errorOptions} {
   1.400 +                dict set errorOptions "-errorcode" {RELMON TDOM_PARSE_ERROR}
   1.401 +                return -options $errorOptions $errorMsg
   1.402 +            }
   1.403 +            set rootElement [$doc documentElement]
   1.404 +            if {$rootElement ne ""} {
   1.405 +                foreach node [$rootElement selectNodes {descendant::link}] {
   1.406 +                    set linkText [$node text]
   1.407 +                    if {$linkText ne ""} {
   1.408 +                        lappend extractedUrls $linkText
   1.409 +                    }
   1.410 +                }
   1.411 +            }
   1.412 +            $doc delete
   1.413 +        }
   1.414 +        {application/atom+xml} {
   1.415 +            # Atom 1.0
   1.416 +            try {
   1.417 +                set doc [dom parse $bodyData]
   1.418 +            } on error {errorMsg errorOptions} {
   1.419 +                dict set errorOptions "-errorcode" {RELMON TDOM_PARSE_ERROR}
   1.420 +                return -options $errorOptions $errorMsg
   1.421 +            }
   1.422 +            set rootElement [$doc documentElement]
   1.423 +            if {$rootElement ne ""} {
   1.424 +                foreach node [$rootElement selectNodes {descendant::link}] {
   1.425 +                    set href [$node getAttribute "href" ""]
   1.426 +                    if {$href ne ""} {
   1.427 +                        lappend extractedUrls $href
   1.428 +                    }
   1.429 +                }
   1.430 +            }
   1.431 +            $doc delete
   1.432 +        }
   1.433 +        {text/plain} {
   1.434 +            # plain text
   1.435 +            foreach line [split $bodyData "\n"] {
   1.436 +                if {$line ne ""} {
   1.437 +                    lappend extractedUrls $line
   1.438 +                }
   1.439 +            }
   1.440 +        }
   1.441 +        default {
   1.442 +            return -code error \
   1.443 +                    -errorcode {RELMON UNSUPPORTED_CONTENT_TYPE_ERROR} \
   1.444 +                    "unsupported content type \"$contentType\""
   1.445 +        }
   1.446 +    }
   1.447 +    foreach url $extractedUrls {
   1.448 +        set normalizedUrl [uri::canonicalize [uri::resolve $baseUrl $url]]
   1.449 +        dict set resultUrls $normalizedUrl \
   1.450 +                [expr {[regexp -line -- $rePattern $normalizedUrl] ? 1 : 0}]
   1.451 +    }
   1.452 +
   1.453 +    return $resultUrls
   1.454 +}
   1.455 +
   1.456 +proc ::relmon::update::StateItemAppendError {name logMsg} {
   1.457 +    variable StateBuffer
   1.458 +
   1.459 +    dict update StateBuffer $name stateItem {
   1.460 +        dict lappend stateItem "errors" $logMsg
   1.461 +    }
   1.462 +
   1.463 +    return
   1.464 +}
   1.465 +
   1.466 +proc ::relmon::update::HandleSuccessfulTransfer {item httpHeaders
   1.467 +        httpBodyName} {
   1.468 +    upvar 1 $httpBodyName httpBody
   1.469 +    variable Log
   1.470 +    variable StateBuffer
   1.471 +    variable Queue
   1.472 +    variable Watchlist
   1.473 +
   1.474 +    set name [dict get $item "name"]
   1.475 +    set url [dict get $item "url"]
   1.476 +    if {[dict exists $httpHeaders "Content-Type"]} {
   1.477 +        set contentType [dict get $httpHeaders "Content-Type"]
   1.478 +    } else {
   1.479 +        set contentType ""
   1.480 +    }
   1.481 +    set patternIndex [dict get $item "pattern_index"]
   1.482 +    set pattern [lindex [dict get $Watchlist $name "patterns"] $patternIndex]
   1.483 +
   1.484 +    ${Log}::info "\"$name\": \"$url\": transfer finished"
   1.485 +
   1.486 +    # parse data
   1.487 +    try {
   1.488 +        set urls [ExtractUrls httpBody $contentType $url $pattern]
   1.489 +    } trap {RELMON} {errorMsg} {
   1.490 +        # continue on tdom parsing errors or when receiving documents with an
   1.491 +        # unsupported content type
   1.492 +        set urls [dict create]
   1.493 +        set warningMsg "\"$name\": \"$url\": failed to parse data: $errorMsg"
   1.494 +        ${Log}::warn $warningMsg
   1.495 +        StateItemAppendError $name $warningMsg
   1.496 +    }
   1.497 +
   1.498 +    if {$patternIndex < ([llength \
   1.499 +            [dict get $Watchlist $name "patterns"]] - 1)} {
   1.500 +        # if this is not the last, version-matching pattern, queue matched URLs
   1.501 +        dict for {newUrl matched} $urls {
   1.502 +            if {$matched} {
   1.503 +                if {![::relmon::common::isUrlValid $newUrl]} {
   1.504 +                    ${Log}::debug "\"$name\": \"$url\": ignoring matched but\
   1.505 +                            invalid URL \"$newUrl\""
   1.506 +                    continue
   1.507 +                }
   1.508 +
   1.509 +                ${Log}::debug "\"$name\": \"$url\": queuing \"$newUrl\""
   1.510 +
   1.511 +                dict lappend Queue [::relmon::common::urlGetHost $newUrl] \
   1.512 +                        [dict create "name" $name "url" $newUrl \
   1.513 +                        "pattern_index" [expr {$patternIndex + 1}] \
   1.514 +                        "num_redirects" 0 "num_retries" 0]
   1.515 +            } else {
   1.516 +                ${Log}::debug "\"$name\": \"$url\": ignoring \"$newUrl\""
   1.517 +            }
   1.518 +        }
   1.519 +    } else {
   1.520 +        # otherwise this branch has finished, try to extract the versions and
   1.521 +        # store them in the buffer
   1.522 +        dict for {finalUrl matched} $urls {
   1.523 +            if {$matched} {
   1.524 +                regexp -line -- $pattern $finalUrl -> version
   1.525 +                if {$version ne ""} {
   1.526 +                    ${Log}::debug "\"$name\": \"$url\": extracted version\
   1.527 +                            \"$version\" from \"$finalUrl\" found on\
   1.528 +                            \"$url\""
   1.529 +                    dict set StateBuffer $name "versions" $version $finalUrl
   1.530 +                } else {
   1.531 +                    ${og}::debug "\"$name\": \"$url\": could not extract a\
   1.532 +                            version from \"$finalUrl\""
   1.533 +                }
   1.534 +            } else {
   1.535 +                ${Log}::debug "\"$name\": \"$url\": ignoring \"$finalUrl\""
   1.536 +            }
   1.537 +        }
   1.538 +    }
   1.539 +
   1.540 +    return
   1.541 +}
   1.542 +
   1.543 +proc ::relmon::update::HandleRedirect {item httpCode httpHeaders} {
   1.544 +    variable Log
   1.545 +    variable Queue
   1.546 +
   1.547 +    set name [dict get $item "name"]
   1.548 +    set url [dict get $item "url"]
   1.549 +
   1.550 +    if {![dict exists $httpHeaders "Location"]} {
   1.551 +        # bail out in case of an invalid HTTP response
   1.552 +        set warningMsg "\"$name\": \"$url\": transfer failed: invalid HTTP\
   1.553 +                response"
   1.554 +        ${Log}::warn $warningMsg
   1.555 +        StateItemAppendError $name $warningMsg
   1.556 +        return
   1.557 +    }
   1.558 +    set location [dict get $httpHeaders "Location"]
   1.559 +
   1.560 +    # sanitize URL from Location header
   1.561 +    if {[uri::isrelative $location]} {
   1.562 +        set redirectUrl [uri::canonicalize [uri::resolve \
   1.563 +                $url $location]]
   1.564 +    } else {
   1.565 +        if {![::relmon::common::isUrlValid $location]} {
   1.566 +            # bail out in case of an invalid redirect URL
   1.567 +            set warningMsg "\"$name\": \"$url\": received invalid redirect URL\
   1.568 +                    \"$location\""
   1.569 +            ${Log}::warn $warningMsg
   1.570 +            StateItemAppendError $name $warningMsg
   1.571 +            return
   1.572 +        }
   1.573 +        set redirectUrl [uri::canonicalize $location]
   1.574 +    }
   1.575 +
   1.576 +    ${Log}::notice "\"$name\": \"$url\": received redirect to \"$redirectUrl\""
   1.577 +
   1.578 +    # handle up to 10 redirects by re-queuing the target URL
   1.579 +    if {[dict get $item "num_redirects"] < 10} {
   1.580 +        ${Log}::debug "\"$name\": \"$url\": queuing \"$redirectUrl\" due to\
   1.581 +                redirect"
   1.582 +
   1.583 +        dict lappend Queue [::relmon::common::urlGetHost $redirectUrl] \
   1.584 +                [dict replace $item "url" $redirectUrl \
   1.585 +                "num_redirects" [expr {[dict get $item "num_redirects"] + 1}] \
   1.586 +                "num_retries" 0]
   1.587 +    } else {
   1.588 +        set warningMsg "\"$name\": \"$url\": exceeded maximum number of\
   1.589 +                redirects"
   1.590 +        ${Log}::warn $warningMsg
   1.591 +        StateItemAppendError $name $warningMsg
   1.592 +    }
   1.593 +
   1.594 +    return
   1.595 +}
   1.596 +
   1.597 +proc ::relmon::update::HandleProtocolError {item httpCode} {
   1.598 +    variable Log
   1.599 +    set name [dict get $item "name"]
   1.600 +    set url [dict get $item "url"]
   1.601 +    set warningMsg "\"$name\": \"$url\": transfer failed: $httpCode"
   1.602 +    ${Log}::warn $warningMsg
   1.603 +    StateItemAppendError $name $warningMsg
   1.604 +    return
   1.605 +}
   1.606 +
   1.607 +proc ::relmon::update::HandleTimeoutReset {item} {
   1.608 +    variable Log
   1.609 +    variable Config
   1.610 +    variable Queue
   1.611 +    set name [dict get $item "name"]
   1.612 +    set url [dict get $item "url"]
   1.613 +
   1.614 +    # retry by re-queuing the target URL until reaching the limit
   1.615 +    if {[dict get $item "num_retries"] < [dict get $Config "retry_limit"]} {
   1.616 +        ${Log}::warn "\"$name\": \"$url\": connection timed out or was reset,\
   1.617 +                retrying"
   1.618 +        dict lappend Queue [::relmon::common::urlGetHost $url] \
   1.619 +                [dict replace $item \
   1.620 +                "num_retries" [expr {[dict get $item "num_retries"] + 1}]]
   1.621 +    } else {
   1.622 +        set warningMsg "\"$name\": \"$url\": exceeded maximum number of\
   1.623 +                retries"
   1.624 +        ${Log}::warn $warningMsg
   1.625 +        StateItemAppendError $name $warningMsg
   1.626 +    }
   1.627 +
   1.628 +    return
   1.629 +}
   1.630 +
   1.631 +proc ::relmon::update::HandleConnectionError {item errorMsg} {
   1.632 +    variable Log
   1.633 +    set name [dict get $item "name"]
   1.634 +    set url [dict get $item "url"]
   1.635 +    set warningMsg "\"$name\": \"$url\": transfer failed: $errorMsg"
   1.636 +    ${Log}::warn $warningMsg
   1.637 +    StateItemAppendError $name $warningMsg
   1.638 +    return
   1.639 +}
   1.640 +
   1.641 +proc ::relmon::update::OnTransferFinishedWrapper {token} {
   1.642 +    # ensure that exceptions get raised, by default http catches all errors and
   1.643 +    # silently ignores them, see https://core.tcl.tk/tcl/tktview?name=1414262
   1.644 +    if {[catch {OnTransferFinished $token} -> errorOptions]} {
   1.645 +        OnError [dict get $errorOptions "-errorinfo"] $errorOptions
   1.646 +    }
   1.647 +    return
   1.648 +}
   1.649 +
   1.650 +proc ::relmon::update::ManageTransfers {} {
   1.651 +    variable Config
   1.652 +    variable ManageTransfersId
   1.653 +    variable Queue
   1.654 +    variable HostConnections
   1.655 +    variable HostDelays
   1.656 +    variable ActiveTransfers
   1.657 +    variable ExitStatus
   1.658 +    variable Log
   1.659 +
   1.660 +    after cancel $ManageTransfersId
   1.661 +
   1.662 +    # try to initiate new transfers
   1.663 +    while {([dict size $ActiveTransfers] <
   1.664 +            [dict get $Config "connection_limit"]) &&
   1.665 +            ([dict size $Queue] > 0)} {
   1.666 +        # find URLs in the queue with a host for which we have not reached the
   1.667 +        # per-host connection limit yet and for which no delay is in effect
   1.668 +        set item {}
   1.669 +        dict for {host items} $Queue {
   1.670 +            set now [clock milliseconds]
   1.671 +
   1.672 +            if {![dict exists $HostConnections $host]} {
   1.673 +                dict set HostConnections $host 0
   1.674 +            }
   1.675 +
   1.676 +            if {![dict exists $HostDelays $host]} {
   1.677 +                dict set HostDelays $host $now
   1.678 +            }
   1.679 +
   1.680 +            if {([dict get $HostConnections $host] <
   1.681 +                    [dict get $Config "host_connection_limit"]) &&
   1.682 +                    ([dict get $HostDelays $host] <= $now)} {
   1.683 +                # pop item from the queue
   1.684 +                set items [lassign $items item]
   1.685 +                if {[llength $items] > 0} {
   1.686 +                    dict set Queue $host $items
   1.687 +                } else {
   1.688 +                    dict unset Queue $host
   1.689 +                }
   1.690 +
   1.691 +                dict incr HostConnections $host
   1.692 +                # set a random delay before the next connection to this host
   1.693 +                # can be made
   1.694 +                dict set HostDelays $host \
   1.695 +                        [expr {[clock milliseconds] + int((rand() + 0.5) *
   1.696 +                        [dict get $Config "host_delay"])}]
   1.697 +                break
   1.698 +            }
   1.699 +        }
   1.700 +        # if no item could be found, the per-host connection limit for all
   1.701 +        # queued URLs has been reached and no new transfers may be started
   1.702 +        # at this point
   1.703 +        if {$item eq {}} {
   1.704 +            break
   1.705 +        }
   1.706 +        # otherwise start a new transfer
   1.707 +        set url [dict get $item "url"]
   1.708 +        set name [dict get $item "name"]
   1.709 +        try {
   1.710 +            set token [http::geturl $url \
   1.711 +                    -timeout [dict get $Config "transfer_time_limit"] \
   1.712 +                    -command [namespace code OnTransferFinishedWrapper]]
   1.713 +        } on ok {} {
   1.714 +            dict set ActiveTransfers $token $item
   1.715 +
   1.716 +            ${Log}::info "\"$name\": \"$url\": starting transfer"
   1.717 +        } on error {errorMsg} {
   1.718 +            # an error occured during socket setup, e.g. a DNS lookup failure
   1.719 +            set warningMsg "\"$name\": \"$url\": transfer failed: $errorMsg"
   1.720 +            ${Log}::warn $warningMsg
   1.721 +            StateItemAppendError $name $warningMsg
   1.722 +        }
   1.723 +    }
   1.724 +
   1.725 +    # terminate the event loop if there are no remaining transfers
   1.726 +    if {([dict size $ActiveTransfers]) == 0 && ([dict size $Queue] == 0)} {
   1.727 +        set ExitStatus 0
   1.728 +        return
   1.729 +    }
   1.730 +
   1.731 +    # due to per-host connection limits and per-host delays the maximum number
   1.732 +    # of connections may not be reached although there are still items in the
   1.733 +    # queue, in this case schedule ManageTransfers again after the smallest of
   1.734 +    # the current per-host delays
   1.735 +    set delay 0
   1.736 +    if {([dict size $ActiveTransfers] <
   1.737 +            [dict get $Config "connection_limit"]) &&
   1.738 +            ([dict size $Queue] > 0)} {
   1.739 +        dict for {host items} $Queue {
   1.740 +            if {(![dict exists $HostConnections $host] ||
   1.741 +                    ([dict get $HostConnections $host] <
   1.742 +                    [dict get $Config "host_connection_limit"])) &&
   1.743 +                    ([dict exists $HostDelays $host] &&
   1.744 +                    ([dict get $HostDelays $host] > $now))} {
   1.745 +                set hostDelay [expr {[dict get $HostDelays $host] - $now + 1}]
   1.746 +                if {(($delay == 0) ||
   1.747 +                        ($hostDelay < $delay))} {
   1.748 +                    set delay $hostDelay
   1.749 +                }
   1.750 +            }
   1.751 +        }
   1.752 +        if {$delay > 0} {
   1.753 +            set ManageTransfersId \
   1.754 +                    [after $delay [namespace code ManageTransfers]]
   1.755 +        }
   1.756 +    }
   1.757 +
   1.758 +    return
   1.759 +}
   1.760 +
   1.761 +proc ::relmon::update::OnTransferFinished {token} {
   1.762 +    upvar #0 $token httpState
   1.763 +    variable Config
   1.764 +    variable HostConnections
   1.765 +    variable Queue
   1.766 +    variable ActiveTransfers
   1.767 +    variable Statistics
   1.768 +    variable StateBuffer
   1.769 +    variable State
   1.770 +    variable Log
   1.771 +
   1.772 +    set item [dict get $ActiveTransfers $token]
   1.773 +    set name [dict get $item "name"]
   1.774 +    set host [relmon::common::urlGetHost [dict get $item "url"]]
   1.775 +
   1.776 +    # update list of per-host connections, and number of remaining transfers
   1.777 +    # for this item
   1.778 +    dict unset ActiveTransfers $token
   1.779 +    dict incr HostConnections $host -1
   1.780 +
   1.781 +    switch -- $httpState(status) {
   1.782 +        {ok} {
   1.783 +            # normalize headers
   1.784 +            set httpHeaders [dict create]
   1.785 +            foreach {header value} $httpState(meta) {
   1.786 +                set words {}
   1.787 +                foreach word [split $header "-"] {
   1.788 +                    lappend words [string totitle $word]
   1.789 +                }
   1.790 +                dict set httpHeaders [join $words "-"] $value
   1.791 +            }
   1.792 +
   1.793 +            # dispatch based on HTTP status code
   1.794 +            set httpCode [http::ncode $token]
   1.795 +            switch -glob -- $httpCode {
   1.796 +                {30[12378]} {
   1.797 +                    HandleRedirect $item $httpCode $httpHeaders
   1.798 +                }
   1.799 +                {200} {
   1.800 +                    HandleSuccessfulTransfer $item $httpHeaders httpState(body)
   1.801 +                }
   1.802 +                default {
   1.803 +                    HandleProtocolError $item $httpState(http)
   1.804 +                }
   1.805 +            }
   1.806 +        }
   1.807 +        {eof} -
   1.808 +        {timeout} {
   1.809 +            # timeout or connection reset
   1.810 +            HandleTimeoutReset $item
   1.811 +        }
   1.812 +        {error} {
   1.813 +            # connection may have failed or been refused
   1.814 +            HandleConnectionError $item [lindex $httpState(error) 0]
   1.815 +        }
   1.816 +    }
   1.817 +
   1.818 +    # check if all transfers of this item are finished
   1.819 +    set itemFinished 1
   1.820 +    dict for {queueHost queueItems} $Queue {
   1.821 +        foreach queueItem $queueItems {
   1.822 +            if {[dict get $queueItem "name"] eq $name} {
   1.823 +                set itemFinished 0
   1.824 +            }
   1.825 +        }
   1.826 +    }
   1.827 +    dict for {activeToken activeItem} $ActiveTransfers {
   1.828 +        if {[dict get $activeItem "name"] eq $name} {
   1.829 +            set itemFinished 0
   1.830 +        }
   1.831 +    }
   1.832 +    if {$itemFinished} {
   1.833 +        set timestamp [clock milliseconds]
   1.834 +
   1.835 +        # create httpState item if it does not exist yet
   1.836 +        if {![dict exists $State $name]} {
   1.837 +            dict set State $name [dict create "versions" [dict create] \
   1.838 +                    "history" [list] "timestamp" 0 "errors" [list]]
   1.839 +        }
   1.840 +
   1.841 +        # if there are no versions, log an error message since something must
   1.842 +        # be wrong
   1.843 +        if {[llength [dict get $StateBuffer $name "versions"]] == 0} {
   1.844 +            set warningMsg "\"$name\": no versions found"
   1.845 +            ${Log}::warn $warningMsg
   1.846 +            StateItemAppendError $name $warningMsg
   1.847 +        }
   1.848 +
   1.849 +        # update httpState item
   1.850 +        dict set State $name "errors" [dict get $StateBuffer $name "errors"]
   1.851 +        dict set State $name "timestamp" $timestamp
   1.852 +        if {[llength [dict get $StateBuffer $name "errors"]] == 0} {
   1.853 +            # expire old history entries
   1.854 +            set history [lrange [dict get $State $name "history"] \
   1.855 +                    [expr {[llength [dict get $State $name "history"]] -
   1.856 +                    [dict get $Config "history_limit"] + 1}] end]
   1.857 +
   1.858 +            # add currently latest available version to history if it is either
   1.859 +            # newer than the previous one or if the previous one is no longer
   1.860 +            # available (e.g. if it has been removed or the watchlist pattern
   1.861 +            # has been changed)
   1.862 +            set prevLatestVersion [lindex $history end 0]
   1.863 +            set curLatestVersion [lindex \
   1.864 +                    [lsort -command ::relmon::common::cmpVersion \
   1.865 +                    [dict keys [dict get $StateBuffer $name "versions"]]] end]
   1.866 +            if {([::relmon::common::cmpVersion $curLatestVersion \
   1.867 +                    $prevLatestVersion] > 0) ||
   1.868 +                    ![dict exists $StateBuffer $name "versions" \
   1.869 +                    $prevLatestVersion]} {
   1.870 +                lappend history [list $curLatestVersion $timestamp]
   1.871 +                dict set State $name "history" $history
   1.872 +            }
   1.873 +            dict set State $name "versions" [dict get $StateBuffer $name \
   1.874 +                    "versions"]
   1.875 +        }
   1.876 +        dict unset StateBuffer $name
   1.877 +
   1.878 +        ${Log}::notice "progress: [dict size $StateBuffer]/[dict get \
   1.879 +                $Statistics "items"] items left"
   1.880 +    }
   1.881 +
   1.882 +    http::cleanup $token
   1.883 +
   1.884 +    ManageTransfers
   1.885 +
   1.886 +    return
   1.887 +}
   1.888 +
   1.889 +# control certificate verification and log errors during TLS handshake
   1.890 +proc ::relmon::update::OnTlsHandshake {type args} {
   1.891 +    variable Config
   1.892 +    variable Log
   1.893 +
   1.894 +    switch -- ${type} {
   1.895 +        {error} {
   1.896 +            lassign $args {} tlsErrorMsg
   1.897 +            ${Log}::error "TLS connection error: $tlsErrorMsg"
   1.898 +        }
   1.899 +        {verify} {
   1.900 +            lassign $args {} {} {} status tlsErrorMsg
   1.901 +            array set cert [lindex $args 2]
   1.902 +            if {$status == 0} {
   1.903 +                if {[dict get $Config "ca_dir"] eq ""} {
   1.904 +                    # do not verify certificates is ca-dir was not set
   1.905 +                    return 1
   1.906 +                } else {
   1.907 +                    set errorMsg "$tlsErrorMsg\nCertificate details:"
   1.908 +                    foreach {key description} {"serial" "Serial Number"
   1.909 +                            "issuer" "Issuer" "notBefore" "Not Valid Before"
   1.910 +                            "notAfter" "Not Valid After" "subject" "Subject"
   1.911 +                            "sha1_hash" "SHA1 Hash"} {
   1.912 +                        append errorMsg "\n$description: $cert($key)"
   1.913 +                    }
   1.914 +                    ${Log}::error "TLS connection error: $errorMsg"
   1.915 +                    return 0
   1.916 +                }
   1.917 +            }
   1.918 +        }
   1.919 +    }
   1.920 +}
   1.921 +
   1.922 +proc ::relmon::update::main {args} {
   1.923 +    variable Config
   1.924 +    variable usage
   1.925 +    variable Statistics
   1.926 +    variable Watchlist [dict create]
   1.927 +    variable Queue [dict create]
   1.928 +    variable HostConnections [dict create]
   1.929 +    variable HostDelays [dict create]
   1.930 +    variable ActiveTransfers [dict create]
   1.931 +    variable State
   1.932 +    variable StateBuffer [dict create]
   1.933 +    variable PreprocessedHtmlBuffer
   1.934 +    variable Log
   1.935 +    variable Lf ""
   1.936 +    variable ExitStatus
   1.937 +
   1.938 +    # parse commandline
   1.939 +    while {[set GetoptRet [cmdline::getopt args \
   1.940 +            {c.arg C.arg d D.arg e H.arg i.arg l.arg r.arg t.arg T.arg v} \
   1.941 +            OptArg OptVal]] == 1} {
   1.942 +        switch -glob -- $OptArg {
   1.943 +            {c} {
   1.944 +                if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
   1.945 +                    puts stderr "invalid value passed to \"-$OptArg\""
   1.946 +                    exit 1
   1.947 +                }
   1.948 +                dict set Config "host_connection_limit" $OptVal
   1.949 +            }
   1.950 +            {C} {
   1.951 +                if {![file isdirectory $OptVal]} {
   1.952 +                    puts stderr "directory \"$OptVal\" is not a directory"
   1.953 +                    exit 1
   1.954 +                } elseif {![file readable $OptVal] ||
   1.955 +                        ![file executable $OptVal]} {
   1.956 +                    puts stderr "directory \"$OptVal\" is not readable"
   1.957 +                    exit 1
   1.958 +                }
   1.959 +                dict set Config "ca_dir" $OptVal
   1.960 +            }
   1.961 +            {d} {
   1.962 +                dict set Config "log_level" "debug"
   1.963 +            }
   1.964 +            {D} {
   1.965 +                if {![string is digit -strict $OptVal] || ($OptVal < 0)} {
   1.966 +                    puts stderr "invalid value passed to \"-$OptArg\""
   1.967 +                    exit 1
   1.968 +                }
   1.969 +                dict set Config "host_delay" [expr {$OptVal * 1000}]
   1.970 +            }
   1.971 +            {e} {
   1.972 +                dict set Config "error_filter" 1
   1.973 +            }
   1.974 +            {H} {
   1.975 +                if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
   1.976 +                    puts stderr "invalid value passed to \"-$OptArg\""
   1.977 +                    exit 1
   1.978 +                }
   1.979 +                dict set Config "connection_limit" $OptVal
   1.980 +            }
   1.981 +            {i} {
   1.982 +                foreach item [split $OptVal " "] {
   1.983 +                    set item [string trim $item]
   1.984 +                    if {$item ne ""} {
   1.985 +                        dict lappend Config "item_filter" $item
   1.986 +                    }
   1.987 +                }
   1.988 +            }
   1.989 +            {l} {
   1.990 +                dict set Config "log_file" $OptVal
   1.991 +                set LogDir [file dirname $OptVal]
   1.992 +                if {![file writable $LogDir] || ![file executable $LogDir]} {
   1.993 +                    puts stderr "directory \"$LogDir\" is not writable"
   1.994 +                    exit 1
   1.995 +                }
   1.996 +            }
   1.997 +            {r} {
   1.998 +                if {![string is digit -strict $OptVal] || ($OptVal < 0)} {
   1.999 +                    puts stderr "invalid value passed to \"-$OptArg\""
  1.1000 +                    exit 1
  1.1001 +                }
  1.1002 +                dict set Config "retry_limit" $OptVal
  1.1003 +            }
  1.1004 +            {t} {
  1.1005 +                if {![string is digit -strict $OptVal] || ($OptVal < 0)} {
  1.1006 +                    puts stderr "invalid value passed to \"-$OptArg\""
  1.1007 +                    exit 1
  1.1008 +                }
  1.1009 +                dict set Config "timestamp_filter" [expr {$OptVal * 1000}]
  1.1010 +            }
  1.1011 +            {T} {
  1.1012 +                if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
  1.1013 +                    puts stderr "invalid value passed to \"-$OptArg\""
  1.1014 +                    exit 1
  1.1015 +                }
  1.1016 +                dict set Config "transfer_time_limit" [expr {$OptVal * 1000}]
  1.1017 +            }
  1.1018 +            {v} {
  1.1019 +                if {[dict get $Config "log_level"] ne "debug"} {
  1.1020 +                    dict set Config "log_level" "info"
  1.1021 +                }
  1.1022 +            }
  1.1023 +        }
  1.1024 +    }
  1.1025 +    set argc [llength $args]
  1.1026 +    if {$GetoptRet == -1} {
  1.1027 +        puts stderr "unknown command line option \"-$OptArg\""
  1.1028 +        puts stderr $usage
  1.1029 +        exit 1
  1.1030 +    }
  1.1031 +    if {$argc != 2} {
  1.1032 +        puts stderr $usage
  1.1033 +        exit 1
  1.1034 +    }
  1.1035 +    dict set Config "watchlist_file" [lindex $args 0]
  1.1036 +    if {![file readable [dict get $Config "watchlist_file"]]} {
  1.1037 +        puts stderr "watchlist file \"[dict get $Config "watchlist_file"]\"\
  1.1038 +                could not be read"
  1.1039 +        exit 1
  1.1040 +    }
  1.1041 +    set stateFile [lindex $args 1]
  1.1042 +    dict set Config "state_file" $stateFile
  1.1043 +    set StateDir [file dirname $stateFile]
  1.1044 +    if {![file writable $StateDir]} {
  1.1045 +        puts stderr "directory \"$StateDir\" is not writable"
  1.1046 +
  1.1047 +        exit 1
  1.1048 +    }
  1.1049 +
  1.1050 +    # install exit handler for closing the logfile, open the logfile and
  1.1051 +    # initialize logger
  1.1052 +    trace add execution exit enter CleanupBeforeExit
  1.1053 +    if {[dict get $Config "log_file"] ne ""} {
  1.1054 +        try {
  1.1055 +            set Lf [open [dict get $Config "log_file"] "w"]
  1.1056 +        } trap {POSIX} {errorMsg errorOptions} {
  1.1057 +            puts stderr "failed to open logfile\
  1.1058 +                    \"[dict get $Config "log_file"]\": $errorMsg"
  1.1059 +            exit 1
  1.1060 +        }
  1.1061 +    } else {
  1.1062 +        set Lf stderr
  1.1063 +    }
  1.1064 +    set Log [logger::init global]
  1.1065 +    if {[dict get $Config "log_level"] eq "debug"} {
  1.1066 +        set logFormat {%d \[%p\] \[%M\] %m}
  1.1067 +    } else {
  1.1068 +        set logFormat {%d \[%p\] %m}
  1.1069 +    }
  1.1070 +    logger::utils::applyAppender -appender fileAppend -appenderArgs \
  1.1071 +            [list -outputChannel $Lf -conversionPattern $logFormat] \
  1.1072 +            -serviceCmd $Log
  1.1073 +
  1.1074 +    # set default logging level
  1.1075 +    ${Log}::setlevel [dict get $Config "log_level"]
  1.1076 +
  1.1077 +    ${Log}::notice "relmon.tcl starting up"
  1.1078 +
  1.1079 +    # parse the watchlist
  1.1080 +    try {
  1.1081 +        ParseWatchlist [dict get $Config "watchlist_file"]
  1.1082 +    } trap {POSIX} {errorMsg errorOptions} - \
  1.1083 +    trap {RELMON} {errorMsg errorOptions} {
  1.1084 +        ${Log}::error $errorMsg
  1.1085 +        exit 1
  1.1086 +    }
  1.1087 +
  1.1088 +    # read the state file
  1.1089 +    try {
  1.1090 +        set State [::relmon::common::parseStateFile $stateFile]
  1.1091 +    } trap {POSIX ENOENT} {errorMsg} {
  1.1092 +        ${Log}::debug "state file \"$stateFile\" does not exist"
  1.1093 +        set State [dict create]
  1.1094 +    } trap {POSIX} {errorMsg} - \
  1.1095 +    trap {RELMON} {errorMsg} {
  1.1096 +        ${Log}::error $errorMsg
  1.1097 +        exit 1
  1.1098 +    }
  1.1099 +
  1.1100 +    # initialize queue and state buffer from the watchlist
  1.1101 +    dict set Statistics "start_time" [clock milliseconds]
  1.1102 +    dict for {name watchlistItem} $Watchlist {
  1.1103 +        # apply filters specified on the command line to watchlist items
  1.1104 +        if {([llength [dict get $Config "item_filter"]] > 0) &&
  1.1105 +                ($name ni [dict get $Config "item_filter"])} {
  1.1106 +            continue
  1.1107 +        }
  1.1108 +
  1.1109 +        if {[dict get $Config "error_filter"] &&
  1.1110 +                [dict exists $State $name "errors"] &&
  1.1111 +                ([llength [dict get $State $name "errors"]] == 0)} {
  1.1112 +            continue
  1.1113 +        }
  1.1114 +
  1.1115 +        if {[dict exists $State $name "timestamp"] &&
  1.1116 +                ([dict get $State $name "timestamp"] >
  1.1117 +                [dict get $Statistics "start_time"] -
  1.1118 +                [dict get $Config "timestamp_filter"])} {
  1.1119 +            continue
  1.1120 +        }
  1.1121 +
  1.1122 +        dict lappend Queue [::relmon::common::urlGetHost \
  1.1123 +                [dict get $watchlistItem "base_url"]] \
  1.1124 +                [dict create \
  1.1125 +                "name" $name \
  1.1126 +                "url" [dict get $watchlistItem "base_url"] \
  1.1127 +                "pattern_index" 0 \
  1.1128 +                "num_redirects" 0 \
  1.1129 +                "num_retries" 0]
  1.1130 +        dict incr Statistics "items"
  1.1131 +        dict set StateBuffer $name [dict create "versions" [dict create] \
  1.1132 +                "errors" [list]]
  1.1133 +    }
  1.1134 +
  1.1135 +    # configure http and tls
  1.1136 +    http::register https 443 [list tls::socket \
  1.1137 +            -cadir [dict get $Config "ca_dir"] -request 1 -require 1 \
  1.1138 +            -command [namespace code OnTlsHandshake] -ssl2 0 -ssl3 1 -tls1 1]
  1.1139 +    http::config -useragent "Mozilla/5.0 (Windows NT 6.1; rv:16.0)\
  1.1140 +            Gecko/20100101 Firefox/16.0 relmon/$relmon::VERSION"
  1.1141 +
  1.1142 +    # handle errors while in the event loop
  1.1143 +    interp bgerror {} [namespace code OnError]
  1.1144 +
  1.1145 +    # enter the main loop
  1.1146 +    after idle [namespace code ManageTransfers]
  1.1147 +    vwait [namespace which -variable ExitStatus]
  1.1148 +
  1.1149 +    dict set Statistics "end_time" [clock milliseconds]
  1.1150 +
  1.1151 +    # display statistics
  1.1152 +    ${Log}::notice "items checked: [dict get $Statistics "items"]"
  1.1153 +    ${Log}::notice "time elapsed: [expr {([dict get $Statistics "end_time"] -
  1.1154 +        [dict get $Statistics "start_time"]) / 1000}]s"
  1.1155 +
  1.1156 +    # serialize the new state
  1.1157 +    set JsonStateItems {}
  1.1158 +    dict for {item data} $State {
  1.1159 +        set versions {}
  1.1160 +        dict for {version url} [dict get $data "versions"] {
  1.1161 +            lappend versions $version [json::write string $url]
  1.1162 +        }
  1.1163 +        set history {}
  1.1164 +        foreach historyItem [dict get $data "history"] {
  1.1165 +            lassign $historyItem version timestamp
  1.1166 +            lappend history [json::write array [json::write string $version] \
  1.1167 +                    $timestamp]
  1.1168 +        }
  1.1169 +        set errors {}
  1.1170 +        foreach errorItem [dict get $data "errors"] {
  1.1171 +            lappend errors [json::write string $errorItem]
  1.1172 +        }
  1.1173 +        lappend JsonStateItems $item [json::write object \
  1.1174 +            "versions" [json::write object {*}$versions] \
  1.1175 +            "history" [json::write array {*}$history] \
  1.1176 +            "timestamp" [dict get $data "timestamp"] \
  1.1177 +            "errors" [json::write array {*}$errors]]
  1.1178 +    }
  1.1179 +    set JsonState [json::write object {*}$JsonStateItems]
  1.1180 +
  1.1181 +    # try to preserve permissions and ownership
  1.1182 +    try {
  1.1183 +        set stateFileAttributes [file attributes $stateFile]
  1.1184 +    } trap {POSIX ENOENT} {} {
  1.1185 +        set stateFileAttributes {}
  1.1186 +    } trap {POSIX} {errorMsg errorOptions} {
  1.1187 +        ${Log}::error "failed to stat \"$stateFile\": $errorMsg"
  1.1188 +    }
  1.1189 +    # write the new state to a temporary file
  1.1190 +    set tmpFile "$stateFile.[pid].tmp"
  1.1191 +    try {
  1.1192 +        set f [open $tmpFile {RDWR CREAT EXCL TRUNC} 0600]
  1.1193 +    } trap {POSIX} {errorMsg errorOptions} {
  1.1194 +        ${Log}::error "failed to open \"$tmpFile\": $errorMsg"
  1.1195 +
  1.1196 +        exit 1
  1.1197 +    }
  1.1198 +    try {
  1.1199 +        chan puts -nonewline $f $JsonState
  1.1200 +    } trap {POSIX} {errorMsg errorOptions} {
  1.1201 +        catch {file delete $tmpFile}
  1.1202 +
  1.1203 +        ${Log}::error "failed to write to \"$tmpFile\": $errorMsg"
  1.1204 +
  1.1205 +        exit 1
  1.1206 +    } finally {
  1.1207 +        close $f
  1.1208 +    }
  1.1209 +    # make a backup of the previous state file
  1.1210 +    try {
  1.1211 +        file copy -force $stateFile "$stateFile~"
  1.1212 +    } trap {POSIX ENOENT} {} {
  1.1213 +        # ignore non-existing file
  1.1214 +    } trap {POSIX} {errorMsg errorOptions} {
  1.1215 +        ${Log}::error "failed to create a backup of \"$statFile\":\
  1.1216 +                $errorMsg"
  1.1217 +    }
  1.1218 +    # rename the temporary file to the state file name
  1.1219 +    try {
  1.1220 +        file rename -force $tmpFile $stateFile
  1.1221 +    } trap {POSIX} {errorMsg errorOptions} {
  1.1222 +        catch {file delete $tmpFile}
  1.1223 +
  1.1224 +        ${Log}::error "failed to rename \"$tmpFile\" to \"$stateFile\":\
  1.1225 +                $errorMsg"
  1.1226 +
  1.1227 +        exit 1
  1.1228 +    }
  1.1229 +    # restore ownership and permissions
  1.1230 +    try {
  1.1231 +        file attributes $stateFile {*}$stateFileAttributes
  1.1232 +    } trap {POSIX} {errorMsg errorOptions} {
  1.1233 +        ${Log}::error "failed to set permissions and ownership on\
  1.1234 +                \"$stateFile\": $errorMsg"
  1.1235 +
  1.1236 +        exit 1
  1.1237 +    }
  1.1238 +
  1.1239 +    # clean up
  1.1240 +    ${Log}::delete
  1.1241 +
  1.1242 +    exit $ExitStatus
  1.1243 +}
  1.1244 +
  1.1245 +
  1.1246 +namespace eval ::relmon::show {
  1.1247 +    # commandline option help text
  1.1248 +    variable usage "usage: relmon show statefile name..."
  1.1249 +}
  1.1250 +
  1.1251 +proc ::relmon::show::GetItem {stateName name} {
  1.1252 +    upvar 1 $stateName state
  1.1253 +    set item [dict get $state $name]
  1.1254 +
  1.1255 +    # format state data as plain-text
  1.1256 +    set output ""
  1.1257 +    append output "Name: $name\n"
  1.1258 +    append output "Latest Version:\
  1.1259 +            [lindex [lindex [dict get $item "history"] end] 0]\n"
  1.1260 +    append output "Refreshed: [clock format \
  1.1261 +            [expr {[dict get $item "timestamp"] / 1000}] \
  1.1262 +            -format {%Y-%m-%dT%H:%M:%S%z}]\n"
  1.1263 +    append output "Versions:\n"
  1.1264 +    dict for {version url} [dict get $item "versions"] {
  1.1265 +        append output "\t$version $url\n"
  1.1266 +    }
  1.1267 +    append output "Errors:\n"
  1.1268 +    if {[dict get $item "errors"] eq ""} {
  1.1269 +        append output "\tNone\n"
  1.1270 +    } else {
  1.1271 +        foreach errorMsg [dict get $item "errors"] {
  1.1272 +            append output "\t[string map {\n \n\t} [string trim $errorMsg]]\n"
  1.1273 +        }
  1.1274 +    }
  1.1275 +    append output "History:\n"
  1.1276 +    foreach historyItem [dict get $item "history"] {
  1.1277 +        append output "\t[lindex $historyItem 0] [clock format \
  1.1278 +                [expr {[lindex $historyItem 1] / 1000}] \
  1.1279 +                -format {%Y-%m-%dT%H:%M:%S%z}]\n"
  1.1280 +    }
  1.1281 +    return $output
  1.1282 +}
  1.1283 +
  1.1284 +proc ::relmon::show::main {args} {
  1.1285 +    variable usage
  1.1286 +
  1.1287 +    # parse commandline
  1.1288 +    if {[cmdline::getopt args {} OptArg OptVal] == -1} {
  1.1289 +        puts stderr "unknown command line option \"-$OptArg\""
  1.1290 +        puts stderr $usage
  1.1291 +        exit 1
  1.1292 +    }
  1.1293 +    if {[llength $args] < 2} {
  1.1294 +        puts stderr $usage
  1.1295 +        exit 1
  1.1296 +    }
  1.1297 +    set stateFile [lindex $args 0]
  1.1298 +    set names [lrange $args 1 end]
  1.1299 +
  1.1300 +    try {
  1.1301 +        set state [::relmon::common::parseStateFile $stateFile]
  1.1302 +    } trap {POSIX} {errorMsg} - trap {RELMON} {errorMsg} {
  1.1303 +        puts stderr $errorMsg
  1.1304 +        exit 1
  1.1305 +    }
  1.1306 +
  1.1307 +    # show each item
  1.1308 +    foreach name $names {
  1.1309 +        puts -nonewline [GetItem state $name]
  1.1310 +    }
  1.1311 +
  1.1312 +    exit 0
  1.1313 +}
  1.1314 +
  1.1315 +
  1.1316 +namespace eval ::relmon::list {
  1.1317 +    # commandline option help text
  1.1318 +    variable usage "usage: relmon list \[-H\] \[-f html|parseable|text\]\
  1.1319 +            \[-F url\]\n\
  1.1320 +            \                  \[-n number_items\] statefile\n\
  1.1321 +            \      relmon list -f atom -F url \[-n number_items\] statefile"
  1.1322 +
  1.1323 +    # configuration options
  1.1324 +    variable Config [dict create \
  1.1325 +            "format" "text" \
  1.1326 +            "show_history" 0 \
  1.1327 +            "history_limit" 100 \
  1.1328 +            "feed_url" ""]
  1.1329 +}
  1.1330 +
  1.1331 +proc ::relmon::list::FormatText {stateName includeHistory historyLimit} {
  1.1332 +    upvar 1 $stateName state
  1.1333 +    set output ""
  1.1334 +    append output [format "%-35s %-15s %-24s %-3s\n" "Project" "Version" \
  1.1335 +            "Refreshed" "St."]
  1.1336 +    append output [string repeat "-" 80]
  1.1337 +    append output "\n"
  1.1338 +
  1.1339 +    set history {}
  1.1340 +    dict for {name item} $state {
  1.1341 +        foreach historyItem [dict get $item "history"] {
  1.1342 +            lappend history [list [lindex $historyItem 1] $name \
  1.1343 +                    [lindex $historyItem 0]]
  1.1344 +        }
  1.1345 +        set latestVersion [lindex [lindex [dict get $item "history"] end] 0]
  1.1346 +        set timestamp [clock format [expr {[dict get $item "timestamp"] /
  1.1347 +                1000}] -format {%Y-%m-%dT%H:%M:%S%z}]
  1.1348 +        set status [expr {[llength [dict get $item "errors"]] > 0 ? "E" : ""}]
  1.1349 +        append output [format "%-35s %15s %-24s %-1s\n" $name $latestVersion \
  1.1350 +                $timestamp $status]
  1.1351 +    }
  1.1352 +    if {$includeHistory} {
  1.1353 +        append output "\nHistory\n"
  1.1354 +        append output [string repeat "-" 80]
  1.1355 +        append output "\n"
  1.1356 +        set history [lsort -decreasing -integer -index 0 $history]
  1.1357 +        foreach historyItem [lrange $history 0 $historyLimit] {
  1.1358 +            append output [format "%-24s %-35s %15s\n" \
  1.1359 +                    [clock format [expr {[lindex $historyItem 0] / 1000}] \
  1.1360 +                    -format {%Y-%m-%dT%H:%M:%S%z}] [lindex $historyItem 1] \
  1.1361 +                    [lindex $historyItem 2]]
  1.1362 +        }
  1.1363 +    }
  1.1364 +
  1.1365 +    return $output
  1.1366 +}
  1.1367 +
  1.1368 +proc ::relmon::list::FormatParseable {stateName includeHistory historyLimit} {
  1.1369 +    upvar 1 $stateName state
  1.1370 +    set output ""
  1.1371 +    set history {}
  1.1372 +    dict for {name item} $state {
  1.1373 +        foreach historyItem [dict get $item "history"] {
  1.1374 +            lappend history [list [lindex $historyItem 1] $name \
  1.1375 +                    [lindex $historyItem 0]]
  1.1376 +        }
  1.1377 +        set latestVersion [lindex [lindex [dict get $item "history"] end] 0]
  1.1378 +        if {$latestVersion eq ""} {
  1.1379 +            set latestVersion -
  1.1380 +        }
  1.1381 +        set timestamp [clock format [expr {[dict get $item "timestamp"] /
  1.1382 +                1000}] -timezone :UTC -format {%Y-%m-%dT%H:%M:%SZ}]
  1.1383 +        set status [expr {[llength [dict get $item "errors"]] > 0 ? "ERROR" :
  1.1384 +                "OK"}]
  1.1385 +        append output [format "%s\t%s\t%s\t%s\n" $name $latestVersion \
  1.1386 +                $timestamp $status]
  1.1387 +    }
  1.1388 +    if {$includeHistory} {
  1.1389 +        append output "\n"
  1.1390 +        set history [lsort -decreasing -integer -index 0 $history]
  1.1391 +        foreach historyItem [lrange $history 0 $historyLimit] {
  1.1392 +            append output [format "%s\t%s\t%s\n" [clock format \
  1.1393 +                    [expr {[lindex $historyItem 0] / 1000}] -timezone :UTC \
  1.1394 +                    -format {%Y-%m-%dT%H:%M:%SZ}] [lindex $historyItem 1] \
  1.1395 +                    [lindex $historyItem 2]]
  1.1396 +        }
  1.1397 +    }
  1.1398 +    return $output
  1.1399 +}
  1.1400 +
  1.1401 +proc ::relmon::list::FormatHtml {stateName includeHistory historyLimit
  1.1402 +        feedUrl} {
  1.1403 +    upvar 1 $stateName state
  1.1404 +
  1.1405 +    set output "<html>\n"
  1.1406 +    append output "<head>\n"
  1.1407 +    append output "<title>Current Releases</title>\n"
  1.1408 +    if {$feedUrl ne ""} {
  1.1409 +        append output "<link type=\"application/atom+xml\" rel=\"alternate\"\
  1.1410 +                title=\"Release History\"\
  1.1411 +                href=\"[html::html_entities $feedUrl]\"/>\n"
  1.1412 +    }
  1.1413 +    append output "</head>\n"
  1.1414 +    append output "<body>\n"
  1.1415 +    append output "<h1>Current Releases</h1>\n<table>\n<tr>\n<th>Project</th>\
  1.1416 +            \n<th>Version</th>\n<th>Refreshed</th>\n<th>Status</th>\n</tr>\n"
  1.1417 +    set history {}
  1.1418 +    dict for {name item} $state {
  1.1419 +        foreach historyItem [dict get $item "history"] {
  1.1420 +            lappend history [list [lindex $historyItem 1] $name \
  1.1421 +                    [lindex $historyItem 0]]
  1.1422 +        }
  1.1423 +        set latestVersion [lindex [lindex [dict get $item "history"] end] 0]
  1.1424 +        set timestamp [clock format [expr {[dict get $item "timestamp"] /
  1.1425 +                1000}] -format {%Y-%m-%dT%H:%M:%S%z}]
  1.1426 +        set status [expr {[llength [dict get $item "errors"]] > 0 ? "Error" :
  1.1427 +                "OK"}]
  1.1428 +
  1.1429 +        append output "<tr>\n<td>[html::html_entities $name]</td>\n"
  1.1430 +        if {$latestVersion ne ""} {
  1.1431 +            if {[dict exists $item "versions" $latestVersion]} {
  1.1432 +                set url [dict get $item "versions" $latestVersion]
  1.1433 +                append output "<td><a\
  1.1434 +                        href=\"[html::html_entities $url]\"\
  1.1435 +                        title=\"[html::html_entities\
  1.1436 +                        "$name $latestVersion"]\">[html::html_entities \
  1.1437 +                        $latestVersion]</a></td>\n"
  1.1438 +            } else {
  1.1439 +                append output "<td>[html::html_entities \
  1.1440 +                        $latestVersion]</td>\n"
  1.1441 +            }
  1.1442 +        } else {
  1.1443 +            append output "<td></td>\n"
  1.1444 +        }
  1.1445 +        append output "<td>$timestamp</td>\n"
  1.1446 +        append output "<td>[html::html_entities $status]</td>\n</tr>\n"
  1.1447 +    }
  1.1448 +    append output "</table>\n"
  1.1449 +
  1.1450 +    if {$includeHistory} {
  1.1451 +        set history [lsort -decreasing -integer -index 0 $history]
  1.1452 +        append output "<h1>Release History</h1>\n<table>\n"
  1.1453 +        append output "<tr><th>Time</th><th>Project</th><th>Version</th></tr>\n"
  1.1454 +        foreach historyItem [lrange $history 0 $historyLimit] {
  1.1455 +            set timestamp [clock format [expr {[lindex $historyItem 0] /
  1.1456 +                    1000}] -format {%Y-%m-%dT%H:%M:%S%z}]
  1.1457 +            set name [lindex $historyItem 1]
  1.1458 +            set version [lindex $historyItem 2]
  1.1459 +            append output "<tr>\n<td>$timestamp</td>\n"
  1.1460 +            append output "<td>[html::html_entities $name]</td>\n"
  1.1461 +            append output "<td>[html::html_entities $version]</td></tr>\n"
  1.1462 +        }
  1.1463 +        append output "</table>\n"
  1.1464 +    }
  1.1465 +
  1.1466 +    append output "</body>\n</html>\n"
  1.1467 +
  1.1468 +    return $output
  1.1469 +}
  1.1470 +
  1.1471 +proc ::relmon::list::FormatAtom {stateName historyLimit feedUrl} {
  1.1472 +    upvar 1 $stateName state
  1.1473 +    set host [::relmon::common::urlGetHost $feedUrl]
  1.1474 +    set output "<?xml version=\"1.0\" encoding=\"utf-8\"?>\
  1.1475 +            \n<feed xmlns=\"http://www.w3.org/2005/Atom\">\n"
  1.1476 +    append output "<author><name>relmon</name></author>\n"
  1.1477 +    append output "<title>Release History</title>\n"
  1.1478 +    append output "<id>[html::html_entities $feedUrl]</id>\n"
  1.1479 +    set history {}
  1.1480 +    dict for {name item} $state {
  1.1481 +        foreach historyItem [dict get $item "history"] {
  1.1482 +            lappend history [list [lindex $historyItem 1] $name \
  1.1483 +                    [lindex $historyItem 0]]
  1.1484 +        }
  1.1485 +    }
  1.1486 +    set history [lsort -decreasing -integer -index 0 $history]
  1.1487 +    set updated [lindex [lindex $history end] 0]
  1.1488 +    if {$updated eq ""} {
  1.1489 +        set updated [clock seconds]
  1.1490 +    }
  1.1491 +    append output "<updated>[clock format $updated \
  1.1492 +            -format {%Y-%m-%dT%H:%M:%S%z}]</updated>\n"
  1.1493 +    foreach historyItem [lrange $history 0 $historyLimit] {
  1.1494 +        set name [lindex $historyItem 1]
  1.1495 +        set version [lindex $historyItem 2]
  1.1496 +        set timestamp [clock format [expr {[lindex $historyItem 0] / 1000}] \
  1.1497 +                -format {%Y-%m-%dT%H:%M:%S%z}]
  1.1498 +        set id "tag:$host,[clock format [lindex $historyItem 0] \
  1.1499 +                -format {%Y-%m-%d}]:[uri::urn::quote $name-$version]"
  1.1500 +        append output "<entry>\n"
  1.1501 +        append output "<id>[html::html_entities $id]</id>\n"
  1.1502 +        append output "<updated>$timestamp</updated>\n"
  1.1503 +        append output "<title>[html::html_entities "$name $version"]</title>"
  1.1504 +        append output "<content>[html::html_entities \
  1.1505 +                "$name $version"]</content>\n"
  1.1506 +        append output "</entry>\n"
  1.1507 +    }
  1.1508 +    append output "</feed>\n"
  1.1509 +    return $output
  1.1510 +}
  1.1511 +
  1.1512 +proc ::relmon::list::main {args} {
  1.1513 +    variable usage
  1.1514 +    variable Config
  1.1515 +
  1.1516 +    # parse commandline
  1.1517 +    while {[set GetoptRet [cmdline::getopt args {f.arg F.arg H n.arg} OptArg \
  1.1518 +            OptVal]] == 1} {
  1.1519 +        switch -glob -- $OptArg {
  1.1520 +            {f} {
  1.1521 +                if {$OptVal ni {atom html parseable text}} {
  1.1522 +                    puts stderr "invalid value passed to \"-$OptArg\""
  1.1523 +                    exit 1
  1.1524 +                }
  1.1525 +                dict set Config "format" $OptVal
  1.1526 +            }
  1.1527 +            {F} {
  1.1528 +                if {[catch {dict create {*}[uri::split $OptVal]} UrlParts] ||
  1.1529 +                        ([dict get $UrlParts "host"] eq "")} {
  1.1530 +                    puts stderr "invalid value passed to \"-$OptArg\""
  1.1531 +                    exit 1
  1.1532 +                }
  1.1533 +                dict set Config "feed_url" $OptVal
  1.1534 +            }
  1.1535 +            {H} {
  1.1536 +                dict set Config "show_history" 1
  1.1537 +            }
  1.1538 +            {n} {
  1.1539 +                if {![string is digit -strict $OptVal] || ($OptVal <= 0)} {
  1.1540 +                    puts stderr "invalid value passed to \"-$OptArg\""
  1.1541 +                    exit 1
  1.1542 +                }
  1.1543 +                dict set Config "history_limit" [expr {$OptVal - 1}]
  1.1544 +            }
  1.1545 +        }
  1.1546 +    }
  1.1547 +    set argc [llength $args]
  1.1548 +    if {$GetoptRet == -1} {
  1.1549 +        puts stderr "unknown command line option \"-$OptArg\""
  1.1550 +        puts stderr $usage
  1.1551 +        exit 1
  1.1552 +    }
  1.1553 +    if {$argc != 1} {
  1.1554 +        puts stderr $usage
  1.1555 +        exit 1
  1.1556 +    }
  1.1557 +    if {([dict get $Config "format"] eq "atom") &&
  1.1558 +            ([dict get $Config "feed_url"] eq "")} {
  1.1559 +        puts stderr "mandatory \"-F\" option is missing"
  1.1560 +        puts stderr $usage
  1.1561 +        exit 1
  1.1562 +    }
  1.1563 +    set StateFile [lindex $args 0]
  1.1564 +
  1.1565 +    # read the state file
  1.1566 +    try {
  1.1567 +        set State [::relmon::common::parseStateFile $StateFile]
  1.1568 +    } trap {POSIX} {errorMsg} - trap {RELMON} {errorMsg} {
  1.1569 +        puts stderr $errorMsg
  1.1570 +        exit 1
  1.1571 +    }
  1.1572 +
  1.1573 +    # call formatter
  1.1574 +    switch -- [dict get $Config "format"] {
  1.1575 +        {atom} {
  1.1576 +            puts -nonewline [FormatAtom State \
  1.1577 +                    [dict get $Config "history_limit"] \
  1.1578 +                    [dict get $Config "feed_url"]]
  1.1579 +        }
  1.1580 +        {html} {
  1.1581 +            puts -nonewline [FormatHtml State \
  1.1582 +                    [dict get $Config "show_history"] \
  1.1583 +                    [dict get $Config "history_limit"] \
  1.1584 +                    [dict get $Config "feed_url"]]
  1.1585 +        }
  1.1586 +        {parseable} {
  1.1587 +            puts -nonewline [FormatParseable State \
  1.1588 +                    [dict get $Config "show_history"] \
  1.1589 +                    [dict get $Config "history_limit"]]
  1.1590 +        }
  1.1591 +        {default} {
  1.1592 +            puts -nonewline [FormatText State \
  1.1593 +                    [dict get $Config "show_history"] \
  1.1594 +                    [dict get $Config "history_limit"]]
  1.1595 +        }
  1.1596 +    }
  1.1597 +
  1.1598 +    exit 0
  1.1599 +}
  1.1600 +
  1.1601 +
  1.1602 +namespace eval ::relmon::help {
  1.1603 +    # commandline option help text
  1.1604 +    variable usage "usage: relmon help \[subcommand\]"
  1.1605 +}
  1.1606 +
  1.1607 +proc ::relmon::help::main {args} {
  1.1608 +    variable usage
  1.1609 +
  1.1610 +    # parse commandline
  1.1611 +    if {[cmdline::getopt args {} OptArg OptVal] == -1} {
  1.1612 +        puts stderr "unknown command line option \"-$OptArg\""
  1.1613 +        puts stderr $usage
  1.1614 +        exit 1
  1.1615 +    }
  1.1616 +    set argc [llength $args]
  1.1617 +    if {$argc > 1} {
  1.1618 +        puts stderr $usage
  1.1619 +        exit 1
  1.1620 +    }
  1.1621 +    set subCommand [lindex $args 0]
  1.1622 +    if {$subCommand ne ""} {
  1.1623 +        if {[info procs ::relmon::${subCommand}::main] ne ""} {
  1.1624 +            puts stderr [set ::relmon::${subCommand}::usage]
  1.1625 +        } else {
  1.1626 +            puts stderr "unknown subcommand \"$subCommand\""
  1.1627 +            puts stderr $usage
  1.1628 +            exit 1
  1.1629 +        }
  1.1630 +    } else {
  1.1631 +        foreach subCommandNs [namespace children ::relmon] {
  1.1632 +            if {[info procs ${subCommandNs}::main] ne ""} {
  1.1633 +                puts stderr [set ${subCommandNs}::usage]
  1.1634 +            }
  1.1635 +        }
  1.1636 +    }
  1.1637 +    exit 0
  1.1638 +}
  1.1639 +
  1.1640 +
  1.1641 +proc ::relmon::main {args} {
  1.1642 +    variable usage
  1.1643 +    set subArgs [lassign $args subCommand]
  1.1644 +
  1.1645 +    # generate list of subcommands
  1.1646 +    set subCommands {}
  1.1647 +    foreach subCommandNs [namespace children ::relmon] {
  1.1648 +        if {[info procs ${subCommandNs}::main] ne ""} {
  1.1649 +            lappend subCommands [namespace tail $subCommandNs]
  1.1650 +        }
  1.1651 +    }
  1.1652 +    if {$subCommand ni $subCommands} {
  1.1653 +        if {$subCommand ne ""} {
  1.1654 +            puts stderr "unknown subcommand \"$subCommand\""
  1.1655 +        }
  1.1656 +        foreach command $subCommands {
  1.1657 +            puts stderr [set relmon::${command}::usage]
  1.1658 +        }
  1.1659 +        exit 1
  1.1660 +    }
  1.1661 +
  1.1662 +    # dispatch subcommand
  1.1663 +    relmon::${subCommand}::main {*}$subArgs
  1.1664 +}
  1.1665 +
  1.1666 +
  1.1667 +relmon::main {*}$argv