# $Id: html.itcl,v 1.22.2.1 2001/12/05 08:05:51 lightn Exp $ proc print_html_header_200 { chan contenttype lastmodified } { puts $chan "HTTP/1.0 200 OK" puts $chan [format "Date: %s GMT" [clock format [clock seconds] -format "%a, %d %b %Y %T" -gmt true]] if { $lastmodified != "" } { puts $chan [format "Last-Modified: %s GMT" [clock format $lastmodified -format "%a, %d %b %Y %T" -gmt true]] } puts $chan "Connection: close" puts $chan "Content-Type: $contenttype" puts $chan "" } proc print_html_header_304 { chan } { puts $chan "HTTP/1.0 304 Not Modified" puts $chan "Connection: close" puts $chan "" } proc print_html_header_401 { chan } { puts $chan "HTTP/1.0 401 Authorization Required" puts $chan "WWW-Authenticate: Basic realm=\"TiVo-web\"" puts $chan "Connection: close" puts $chan "" } proc print_html_header_404 { chan } { puts $chan "HTTP/1.0 404 Not Found" puts $chan "Connection: close" puts $chan "Content-Type: text/html; charset=iso-8859-1" puts $chan " 404 Not Found

Not Found

The requested URL was not found on this server. " } proc print_html_error { chan action error } { puts $chan "
INTERNAL SERVER ERROR"
    puts $chan $action
    puts $chan $error
    puts $chan "
" } proc html_start {title} { set ret "\n" append ret "\n" if {$title != ""} { append ret "$title\n" } append ret "\n" append ret "
$TT_HTTPD::NAME - v$TT_HTTPD::VERSION             
             
$TT_HTTPD::OPTIONS_MENU
" } proc html_end {} { return "" } proc html_link {link anchor} { return "$anchor" } proc img {attr img} { return "" } proc td {args} { if { [llength $args] > 1 } { return "[strim [lindex $args 1]]" } else { set str [strim $args] if { $str == "" } { return " " } else { return "$str" } } } proc h1 {str} { if { $str == "" } { return "

 

" } else { return "

$str

" } } proc h2 {str} { if { $str == "" } { return "

 

" } else { return "

$str

" } } proc tr {attrs args} { set str "" foreach arg $args { append str $arg } if { $str == "" } { set str " " } return "$str" } proc th {args} { if { [llength $args] > 1 } { return "[strim [lindex $args 1]]" } else { return "[strim $args]" } } proc html_table_start {tattr cap capattr} { set ret "" if {$cap != ""} { append ret "" } return $ret } proc html_table_end {} { return "
$cap
" } proc html_form_select {name values labels defaultval} { set str "" append str "" return $str } proc html_form_hidden {name value} { return "" } proc html_form_start {method action} { return "
" } proc html_form_end {} { return "
" } proc html_form_input {type name value} { return "" } proc html_form_text {lines cols name value} { if {$lines == 1} { return "" } else { return "" } } proc add_slashes {str} { regsub -all {([\[\"\;])} $str {\\\1} str return $str } proc url_decode {str} { regsub -all {\+} $str " " str set str [add_slashes $str] regsub -all {%([a-fA-F0-9][a-fA-F0-9])} $str {[format "%c" 0x\1]} str set str "return \"$str\"" eval $str } proc parse_post {data} { set env "" set data [url_decode $data] set data [add_slashes $data] while { [set j [string first "=" $data]] != -1 } { if { [set i [string first "&" $data]] == -1 } { set i [string length $data] } set key [string range $data 0 [expr $j - 1]] set value [string range $data [expr $j + 1] [expr $i - 1]] append env "set \"$key\" \"$value\";" set data [string range $data [expr $i + 1] end] } return $env } proc get_kvalue {keys values key} { set i [lsearch $keys $key] if { $i != -1 } { return [lindex $values $i] } else { return "" } } # For debugging purposes proc action_dumppost {chan path data} { puts $chan [html_start "Dump Post"] puts $chan "$data
" set parseddata [parse_post $data] set keys [lindex $parseddata 0] set values [lindex $parseddata 1] set numkeys [llength $keys] for {set i 0} {$i < $numkeys} {incr i} { set key [lindex $keys $i] set value [lindex $values $i] puts $chan "$key = $value
" } puts $chan [html_end] }