#! /bin/env tclsh
package require mime
package require {ycl parse http util}
namespace import [yclprefix]::parse::http::util::quoted-string
namespace import [yclprefix]::parse::http::util::token
proc chunkheader line {
regexp {([0-9a-fA-F]*)(;.*$|$)} $line -> size extensions
return [list $size $extensions]
}
proc docontent {type patterns} {
foreach pattern $patterns {
if {[string match $pattern $type]} {
return 1
}
}
return 0
}
proc mediatype field {
set params [lassign [lmap x [split $field {;}] {
string trim $x
}] name]
lappend res {*}[split $name /]
if {[llength $res] > 2} {
error [list {malformed media type} $field]
}
# RFC 7231 3.1.1.1
foreach param $params {
if {![regexp {^([^=]*)=(.*)$} $param -> name value]} {
error [list {malformed media type parameter} $param]
}
if {[string match \"* $value]} {
set value [quoted-string $value[set value {}]]
} else {
set value [token $value]
}
lappend res $name $value
}
return $res
}
proc statusline line {
if {![regexp {(\S+)\s+(\S+)\s+(.*)$} $line \
-> r_httpvers r_status r_reason]} {
return -code error [list {bad status line} $line]
}
return [dict create version $r_httpvers status $r_status reason $r_reason]
}
proc tlschan {host port args} {
package require tls 1.6.7
set chan [::tls::socket -servername $host {*}$args $host $port]
return $chan
}
proc uriupdate {uri dict} {
set uri2 [uri::split $uri]
if {[dict get $uri2 host] eq {}} {
foreach key {path query fragment} {
dict set dict $key [dict get $uri2 $key]
}
} else {
set dict [dict merge $dict[set dict {}] $uri2]
}
return $dict
}