* Version 2.11.6

  * Add /tls1, /tls1_1, /tls1_2 and /dtls1 to the definition of a
    server to use different ways to connect using ssl, for example
    {server.com/tls1} will attempt to connect to server.com at the ssl
    imap port (port 993) and establish a connection using TLSv1. These
    flags can be used in conjunction with the /ssl flag, the ssl flag is
    redundant. Conversely, however, the /ssl flag does not imply any of
    these flags; the /ssl flag means SSLv3 or, if not available, SSLv2 in
    the SSL port.

  * WebAlpine: add _GNU_SOURCE to make pubcookie build.

  * On my way to make 'make dist' and 'make distcheck' actually work.

1 files changed, 2659 insertions, 0 deletions

diff --git a/web/src/cgi.tcl-1.10/cgi.tcl b/web/src/cgi.tcl-1.10/cgi.tcl
new file mode 100644
index 00000000..81667179
--- /dev/null
+++ b/web/src/cgi.tcl-1.10/cgi.tcl
@@ -0,0 +1,2659 @@
+##################################################
+#
+# cgi.tcl - routines for writing CGI scripts in Tcl
+# Author: Don Libes <libes@nist.gov>, January '95
+#
+# These routines implement the code described in the paper
+# "Writing CGI scripts in Tcl" which appeared in the Tcl '96 conference.
+# Please read the paper before using this code.  The paper is:
+# http://expect.nist.gov/doc/cgi.pdf
+#
+##################################################
+
+##################################################
+# http header support
+##################################################
+
+proc cgi_http_head {args} {
+    global _cgi env errorInfo
+
+    if {[info exists _cgi(http_head_done)]} return
+
+    set _cgi(http_head_in_progress) 1
+
+    if {0 == [llength $args]} {
+	cgi_content_type
+    } else {
+	if {[catch {uplevel 1 [lindex $args 0]} errMsg]} {
+	    set savedInfo $errorInfo
+	    cgi_content_type
+	}
+    }
+    cgi_puts ""
+
+    unset _cgi(http_head_in_progress)
+    set _cgi(http_head_done) 1
+
+    if {[info exists savedInfo]} {
+	error $errMsg $savedInfo
+    }
+}
+
+# avoid generating http head if not in CGI environment
+# to allow generation of pure HTML files
+proc _cgi_http_head_implicit {} {
+    global env
+
+    if {[info exists env(REQUEST_METHOD)]} cgi_http_head
+}
+
+proc cgi_status {num str} {
+    global _cgi
+
+    if {[info exists _cgi(http_status_done)]} return
+    set _cgi(http_status_done) 1
+    cgi_puts "Status: $num $str"
+}
+
+# If these are called manually, they automatically generate the extra newline
+
+proc cgi_content_type {args} {
+    global _cgi
+
+    if {0==[llength $args]} {
+	set t text/html
+    } else {
+	set t [lindex $args 0]
+	if {[regexp ^multipart/ $t]} {
+	    set _cgi(multipart) 1
+	}
+    }
+
+    if {[info exists _cgi(http_head_in_progress)]} {
+	cgi_puts "Content-type: $t"
+    } else {
+	cgi_http_head [list cgi_content_type $t]
+    }
+}
+
+proc cgi_redirect {t} {
+    global _cgi
+
+    if {[info exists _cgi(http_head_in_progress)]} {
+	cgi_status 302 Redirected
+	cgi_puts "Uri: $t"
+	cgi_puts "Location: $t"
+    } else {
+	cgi_http_head {
+	    cgi_redirect $t
+	}
+    }
+}
+
+# deprecated, use cgi_redirect
+proc cgi_location {t} {
+    global _cgi
+
+    if {[info exists _cgi(http_head_in_progress)]} {
+	cgi_puts "Location: $t"
+    } else {
+	cgi_http_head "cgi_location $t"
+    }
+}
+
+proc cgi_target {t} {
+    global _cgi
+
+    if {![info exists _cgi(http_head_in_progress)]} {
+	error "cgi_target must be set from within cgi_http_head."
+    }
+    cgi_puts "Window-target: $t"
+}
+
+# Make client retrieve url in this many seconds ("client pull").
+# With no 2nd arg, current url is retrieved.
+proc cgi_refresh {seconds {url ""}} {
+    global _cgi
+
+    if {![info exists _cgi(http_head_in_progress)]} {
+	error "cgi_refresh must be set from within cgi_http_head.  Try using cgi_http_equiv instead."
+    }
+    cgi_put "Refresh: $seconds"
+
+    if {0!=[string compare $url ""]} {
+	cgi_put "; $url"
+    }
+    cgi_puts ""
+}
+
+# Example: cgi_pragma no-cache
+proc cgi_pragma {arg} {
+    global _cgi
+
+    if {![info exists _cgi(http_head_in_progress)]} {
+	error "cgi_pragma must be set from within cgi_http_head."
+    }
+    cgi_puts "Pragma: $arg"
+}
+
+##################################################
+# support for debugging or other crucial things we need immediately
+##################################################
+
+proc cgi_comment	{args}	{}	;# need this asap
+
+proc cgi_html_comment	{args}	{
+    regsub -all {>} $args {\&gt;} args
+    cgi_put "<!--[_cgi_list_to_string $args] -->"
+}
+
+set _cgi(debug) -off
+proc cgi_debug {args} {
+    global _cgi
+
+    set old $_cgi(debug)
+    set arg [lindex $args 0]
+    if {$arg == "-on"} {
+	set _cgi(debug) -on
+	set args [lrange $args 1 end]
+    } elseif {$arg == "-off"} {
+	set _cgi(debug) -off
+	set args [lrange $args 1 end]
+    } elseif {[regexp "^-t" $arg]} {
+	set temp 1
+	set _cgi(debug) -on
+	set args [lrange $args 1 end]
+    } elseif {[regexp "^-noprint$" $arg]} {
+	set noprint 1
+	set args [lrange $args 1 end]
+    }
+
+    set arg [lindex $args 0]
+    if {$arg == "--"} {
+	set args [lrange $args 1 end]
+    }
+
+    if {[llength $args]} {
+	if {$_cgi(debug) == "-on"} {
+
+	    _cgi_close_tag
+	    # force http head and open html, head, body
+	    catch {
+		if {[info exists noprint]} {
+		    uplevel 1 [lindex $args 0]
+		} else {
+		    cgi_html {
+			cgi_head {
+			    cgi_title "debugging before complete HTML head"
+			}
+			# force body open and leave open
+			_cgi_body_start
+			uplevel 1 [lindex $args 0]
+			# bop back out to catch, so we don't close body
+			error "ignore"
+		    }
+		}
+	    }
+	}
+    }
+
+    if {[info exists temp]} {
+	set _cgi(debug) $old
+    }
+    return $old
+}
+
+proc cgi_uid_check {user} {
+    global env
+
+    # leave in so old scripts don't blow up
+    if {[regexp "^-off$" $user]} return
+
+    if {[info exists env(USER)]} {
+	set whoami $env(USER)
+    } elseif {0==[catch {exec whoami} whoami]} {
+	# "who am i" on some Linux hosts returns "" so try whoami first
+    } elseif {0==[catch {exec who am i} whoami]} {
+	# skip over "host!"
+	regexp "(.*!)?(\[^ \t]*)" $whoami dummy dummy whoami
+    } elseif {0==[catch {package require registry}]} {
+	set whoami [registry get HKEY_LOCAL_MACHINE\\Network\\Logon username]
+    } else {
+	set whoami $user  ;# give up and let go
+    }
+    if {$whoami != "$user"} {
+	error "Warning: This CGI script expects to run with uid \"$user\".  However, this script is running as \"$whoami\"."
+    }
+}
+
+# print out elements of an array
+# like Tcl's parray, but formatted for browser
+proc cgi_parray {a {pattern *}} {
+    upvar 1 $a array
+    if {![array exists array]} {
+	error "\"$a\" isn't an array"
+    }
+
+    set maxl 0
+    foreach name [lsort [array names array $pattern]] {
+	if {[string length $name] > $maxl} {
+	    set maxl [string length $name]
+	}
+    }
+    cgi_preformatted {
+	set maxl [expr {$maxl + [string length $a] + 2}]
+	foreach name [lsort [array names array $pattern]] {
+	    set nameString [format %s(%s) $a $name]
+	    cgi_puts [cgi_quote_html [format "%-*s = %s" $maxl $nameString $array($name)]]
+	}
+    }
+}
+
+proc cgi_eval {cmd} {
+    global env _cgi
+
+    # put cmd somewhere that uplevel can find it
+    set _cgi(body) $cmd
+
+    uplevel 1 {
+	global env _cgi errorInfo
+
+	if {1==[catch $_cgi(body) errMsg]} {
+	    # error occurred, handle it
+	    set _cgi(errorInfo) $errorInfo
+
+	    if {![info exists env(REQUEST_METHOD)]} {
+		puts stderr $_cgi(errorInfo)
+		return
+	    }
+	    # the following code is all to force browsers into a state
+	    # such that diagnostics can be reliably shown
+
+	    # close irrelevant things
+	    _cgi_close_procs
+	    # force http head and open html, head, body
+	    cgi_html {
+		cgi_body {
+		    if {[info exists _cgi(client_error)]} {
+			cgi_h3 "Client Error"
+			cgi_p "$errMsg  Report this to your system administrator or browser vendor."
+		    } else {
+			cgi_put [cgi_anchor_name cgierror]
+			cgi_h3 "An internal error was detected in the service\
+				software.  The diagnostics are being emailed to\
+				the service system administrator ($_cgi(admin_email))."
+
+			if {$_cgi(debug) == "-on"} {
+			    cgi_puts "Heck, since you're debugging, I'll show you the\
+				    errors right here:"
+			    # suppress formatting
+			    cgi_preformatted {
+				cgi_puts [cgi_quote_html $_cgi(errorInfo)]
+			    }
+			} else {
+			    cgi_mail_start $_cgi(admin_email)
+			    cgi_mail_add "Subject: [cgi_name] CGI problem"
+			    cgi_mail_add
+			    cgi_mail_add "CGI environment:"
+			    cgi_mail_add "REQUEST_METHOD: $env(REQUEST_METHOD)"
+			    cgi_mail_add "SCRIPT_NAME: $env(SCRIPT_NAME)"
+			    # this next few things probably don't need
+			    # a catch but I'm not positive
+			    catch {cgi_mail_add "HTTP_USER_AGENT: $env(HTTP_USER_AGENT)"}
+			    catch {cgi_mail_add "HTTP_REFERER: $env(HTTP_REFERER)"}
+			    catch {cgi_mail_add "HTTP_HOST: $env(HTTP_HOST)"}
+			    catch {cgi_mail_add "REMOTE_HOST: $env(REMOTE_HOST)"}
+			    catch {cgi_mail_add "REMOTE_ADDR: $env(REMOTE_ADDR)"}
+			    cgi_mail_add "cgi.tcl version: 1.10.0"
+			    cgi_mail_add "input:"
+			    catch {cgi_mail_add $_cgi(input)}
+			    cgi_mail_add "cookie:"
+			    catch {cgi_mail_add $env(HTTP_COOKIE)}
+			    cgi_mail_add "errorInfo:"
+			    cgi_mail_add "$_cgi(errorInfo)"
+			    cgi_mail_end
+			}
+		    }
+		} ;# end cgi_body
+	    } ;# end cgi_html
+	} ;# end catch
+    } ;# end uplevel
+}
+
+# return true if cgi_eval caught an error
+proc cgi_error_occurred {} {
+    global _cgi
+
+    return [info exists _cgi(errorInfo)]
+}
+
+##################################################
+# CGI URL creation
+##################################################
+
+# declare location of root of CGI files
+# this allows all CGI references to be relative in the source
+# making it easy to move everything in the future
+# If you have multiple roots, just don't call this.
+proc cgi_root {args} {
+    global _cgi
+
+    if {[llength $args]} {
+	set _cgi(root) [lindex $args 0]
+    } else {
+	set _cgi(root)
+    }
+}
+
+# make a URL for a CGI script
+proc cgi_cgi {args} {
+    global _cgi
+
+    set root $_cgi(root)
+    if {0!=[string compare $root ""]} {
+	if {![regexp "/$" $root]} {
+		append root "/"
+	}
+    }
+		
+    set suffix [cgi_suffix]
+
+    set arg [lindex $args 0]
+    if {0==[string compare $arg "-suffix"]} {
+	set suffix [lindex $args 1]
+	set args [lrange $args 2 end]
+    }
+
+    if {[llength $args]==1} {
+	return $root[lindex $args 0]$suffix
+    } else {
+	return $root[lindex $args 0]$suffix?[join [lrange $args 1 end] &]
+    }
+}
+
+proc cgi_suffix {args} {
+    global _cgi
+    if {[llength $args] > 0} {
+	set _cgi(suffix) [lindex $args 0]
+    }
+    if {![info exists _cgi(suffix)]} {
+	return .cgi
+    } else {
+	return $_cgi(suffix)
+    }
+}
+
+proc cgi_cgi_set {variable value} {
+    regsub -all {%}  $value "%25" value
+    regsub -all {&}  $value "%26" value
+    regsub -all {\+} $value "%2b" value
+    regsub -all { }  $value "+"   value
+    regsub -all {=}  $value "%3d" value
+    regsub -all {#}  $value "%23" value
+    regsub -all {/}  $value "%2f" value   ;# Added...
+    return $variable=$value
+}
+
+##################################################
+# URL dictionary support
+##################################################
+
+proc cgi_link {args} {
+    global _cgi_link
+
+    set tag [lindex $args 0]
+    switch -- [llength $args] {
+	1 {
+	    set label $_cgi_link($tag,label)
+	} 2 {
+	    set label [lindex $args end]
+	} default {
+	    set _cgi_link($tag,label) [set label [lindex $args 1]]
+	    set _cgi_link($tag,url) [lrange $args 2 end]
+	}
+    }
+
+    return [eval cgi_url [list $label] $_cgi_link($tag,url)]
+}
+
+# same as above but for images
+# note: uses different namespace
+proc cgi_imglink {args} {
+    global _cgi_imglink
+
+    set tag [lindex $args 0]
+    if {[llength $args] >= 2} {
+	set _cgi_imglink($tag) [eval cgi_img [lrange $args 1 end]]
+    }
+    return $_cgi_imglink($tag)
+}
+
+proc cgi_link_label {tag} {
+    global _cgi_link
+    return $_cgi_link($tag,label)
+}
+
+proc cgi_link_url {tag} {
+    global _cgi_link
+    return $_cgi_link($tag,url)
+}
+
+##################################################
+# hyperlink support
+##################################################
+
+# construct a hyperlink labeled "display"
+# last arg is the link destination
+# any other args are passed through into <a> display
+proc cgi_url {display args} {
+    global _cgi
+
+    set buf "<a href=\"[lindex $args 0]\""
+    foreach a [lrange $args 1 end] {
+	if {[regexp $_cgi(attr,regexp) $a dummy attr str]} {
+	    append buf " $attr=\"$str\""
+	} else {
+	    append buf " $a"
+	}
+    }
+    return "$buf>$display</a>"
+}
+
+# generate an image reference (<img ...>)
+# first arg is image url
+# other args are passed through into <img> tag
+proc cgi_img {args} {
+    global _cgi
+
+    set buf "<img src=\"[lindex $args 0]\""
+    foreach a [lrange $args 1 end] {
+	if {[regexp "^(alt|lowsrc|usemap)=(.*)" $a dummy attr str]} {
+	    append buf " $attr=[cgi_dquote_html $str]"
+	} elseif {[regexp $_cgi(attr,regexp) $a dummy attr str]} {
+	    append buf " $attr=\"$str\""
+	} else {
+	    append buf " $a"
+	}
+    }
+    return "$buf />"
+}
+
+# names an anchor so that it can be linked to
+proc cgi_anchor_name {name} {
+    return "<a name=\"$name\"/>"
+}
+
+proc cgi_base {args} {
+    global _cgi
+
+    cgi_put "<base"
+    foreach a $args {
+	if {[regexp "^href=(.*)" $a dummy str]} {
+	    cgi_put " href=[cgi_dquote_html $str]"
+	} elseif {[regexp $_cgi(attr,regexp) $a dummy attr str]} {
+	    cgi_put " $attr=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_puts " />"
+}
+
+##################################################
+# quoting support
+##################################################
+
+if {[info tclversion] >= 8.2} {
+    proc cgi_unquote_input buf {
+	# rewrite "+" back to space
+	# protect \ from quoting another \ and throwing off other things
+	# replace line delimiters with newlines
+	set buf [string map -nocase [list + { } "\\" "\\\\" %0d%0a \n] $buf]
+
+	# prepare to process all %-escapes
+	regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {\\u00\1} buf
+
+	# process \u unicode mapped chars
+	encoding convertfrom $::_cgi(queryencoding) \
+		 [subst -novar -nocommand $buf]
+    }
+} elseif {[info tclversion] >= 8.1} {
+    proc cgi_unquote_input buf {
+	# rewrite "+" back to space
+	regsub -all {\+} $buf { } buf
+	# protect \ from quoting another \ and throwing off other things
+	regsub -all {\\} $buf {\\\\} buf
+
+	# replace line delimiters with newlines
+	regsub -all -nocase "%0d%0a" $buf "\n" buf
+
+	# prepare to process all %-escapes
+	regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {\\u00\1} buf
+	# process \u unicode mapped chars
+	return [subst -novar -nocommand $buf]
+    }
+} else {
+    proc cgi_unquote_input {buf} {
+	# rewrite "+" back to space
+	regsub -all {\+} $buf { } buf
+	# protect \ from quoting another \ and throwing off other things first
+	# protect $ from doing variable expansion
+	# protect [ from doing evaluation
+	# protect " from terminating string
+	regsub -all {([\\["$])} $buf {\\\1} buf
+	
+	# replace line delimiters with newlines
+	regsub -all -nocase "%0d%0a" $buf "\n" buf
+	# Mosaic sends just %0A.  This is handled in the next command.
+
+	# prepare to process all %-escapes 
+	regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {[format %c 0x\1]} buf
+	# process %-escapes and undo all protection
+	eval return \"$buf\"
+    }
+}
+
+# return string but with html-special characters escaped,
+# necessary if you want to send unknown text to an html-formatted page.
+proc cgi_quote_html {s} {
+    regsub -all {&}	$s {\&amp;}	s	;# must be first!
+    regsub -all {"}	$s {\&quot;}	s
+    regsub -all {<}	$s {\&lt;}	s
+    regsub -all {>}	$s {\&gt;}	s
+    return $s
+}
+
+proc cgi_dquote_html {s} {
+    return \"[cgi_quote_html $s]\"
+}
+
+# return string quoted appropriately to appear in a url
+proc cgi_quote_url {in} {
+    regsub -all {%}  $in "%25" in
+    regsub -all {\+} $in "%2b" in
+    regsub -all { }  $in "%20" in
+    regsub -all {"}  $in "%22" in
+    regsub -all {\?} $in "%3f" in
+    return $in
+}
+
+##################################################
+# short or single paragraph support
+##################################################
+
+proc cgi_br {args} {
+    cgi_put "<br"
+    if {[llength $args]} {
+	cgi_put "[_cgi_list_to_string $args]"
+    }
+    cgi_put " />"
+}
+
+# generate cgi_h1 and others
+for {set _cgi(tmp) 1} {$_cgi(tmp)<8} {incr _cgi(tmp)} {
+    proc cgi_h$_cgi(tmp) {{args}} "eval cgi_h $_cgi(tmp) \$args"
+}
+proc cgi_h {num args} {
+    cgi_put "<h$num"
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+	set args [lrange $args end end]
+    }
+    cgi_put ">[lindex $args 0]</h$num>"
+}
+
+proc cgi_p {args} {
+    cgi_put "<p"
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+	set args [lrange $args end end]
+    }
+    cgi_put ">[lindex $args 0]</p>"
+}
+
+proc cgi_address      {s} {cgi_put <address>$s</address>}
+proc cgi_blockquote   {s} {cgi_puts <blockquote>$s</blockquote>}
+
+##################################################
+# long or multiple paragraph support
+##################################################
+
+# Shorthand for <div align=center>.  We used to use <center> tags but that
+# is now officially unsupported.
+proc cgi_center	{cmd}	{
+    uplevel 1 "cgi_division align=center [list $cmd]"
+}
+
+proc cgi_division {args} {
+    cgi_put "<div"
+    _cgi_close_proc_push "cgi_put </div>"
+
+    if {[llength $args]} {
+	cgi_put "[_cgi_lrange $args 0 [expr {[llength $args]-2}]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+proc cgi_preformatted {args} {
+    cgi_put "<pre"
+    _cgi_close_proc_push "cgi_put </pre>"
+
+    if {[llength $args]} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+##################################################
+# list support
+##################################################
+
+proc cgi_li {args} {
+    cgi_put <li
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">[lindex $args end]</li>"
+}
+
+proc cgi_number_list {args} {
+    cgi_put "<ol"
+    _cgi_close_proc_push "cgi_put </ol>"
+
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+
+    _cgi_close_proc
+}
+
+proc cgi_bullet_list {args} {
+    cgi_put "<ul"
+    _cgi_close_proc_push "cgi_put </ul>"
+
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+
+    _cgi_close_proc
+}
+
+# Following two are normally used from within definition lists
+# but are actually paragraph types on their own.
+proc cgi_term            {s} {cgi_put <dt>$s</dt>}
+proc cgi_term_definition {s} {cgi_put <dd>$s</dd>}
+
+proc cgi_definition_list {cmd} {
+    cgi_put "<dl>"
+    _cgi_close_proc_push "cgi_put </dl>"
+
+    uplevel 1 $cmd
+    _cgi_close_proc
+}
+
+proc cgi_menu_list {cmd} {
+    cgi_put "<menu>"
+    _cgi_close_proc_push "cgi_put </menu>"
+
+    uplevel 1 $cmd
+    _cgi_close_proc
+}
+proc cgi_directory_list {cmd} {
+    cgi_put "<dir>"
+    _cgi_close_proc_push "cgi_put </dir>"
+
+    uplevel 1 $cmd
+    _cgi_close_proc
+}
+
+##################################################
+# text support
+##################################################
+
+proc cgi_put	    {s} {cgi_puts -nonewline $s}
+
+# some common special characters
+proc cgi_lt	     {}  {return "&lt;"}
+proc cgi_gt	     {}  {return "&gt;"}
+proc cgi_amp	     {}  {return "&amp;"}
+proc cgi_quote	     {}  {return "&quot;"}
+proc cgi_enspace     {}  {return "&ensp;"}
+proc cgi_emspace     {}  {return "&emsp;"}
+proc cgi_nbspace     {}  {return "&#160;"} ;# nonbreaking space
+proc cgi_tm	     {}  {return "&#174;"} ;# registered trademark
+proc cgi_copyright   {}  {return "&#169;"}
+proc cgi_isochar     {n} {return "&#$n;"}
+proc cgi_breakable   {}  {return "<wbr />"}
+
+proc cgi_unbreakable_string {s} {return "<nobr>$s</nobr>"}
+proc cgi_unbreakable {cmd} {
+    cgi_put "<nobr>"
+    _cgi_close_proc_push "cgi_put </nobr>"
+    uplevel 1 $cmd
+    _cgi_close_proc
+}
+
+proc cgi_nl          {args} {
+    set buf "<br"
+    if {[llength $args]} {
+	append buf "[_cgi_list_to_string $args]"
+    }
+    return "$buf />"
+}
+
+proc cgi_bold	    {s} {return "<b>$s</b>"}
+proc cgi_italic     {s} {return "<i>$s</i>"}
+proc cgi_underline  {s} {return "<u>$s</u>"}
+proc cgi_strikeout  {s} {return "<s>$s</s>"}
+proc cgi_subscript  {s} {return "<sub>$s</sub>"}
+proc cgi_superscript {s} {return "<sup>$s</sup>"}
+proc cgi_typewriter {s} {return "<tt>$s</tt>"}
+proc cgi_blink	    {s} {return "<blink>$s</blink>"}
+proc cgi_emphasis   {s} {return "<em>$s</em>"}
+proc cgi_strong	    {s} {return "<strong>$s</strong>"}
+proc cgi_cite	    {s} {return "<cite>$s</cite>"}
+proc cgi_sample     {s} {return "<samp>$s</samp>"}
+proc cgi_keyboard   {s} {return "<kbd>$s</kbd>"}
+proc cgi_variable   {s} {return "<var>$s</var>"}
+proc cgi_definition {s} {return "<dfn>$s</dfn>"}
+proc cgi_big	    {s} {return "<big>$s</big>"}
+proc cgi_small	    {s} {return "<small>$s</small>"}
+
+proc cgi_basefont   {size} {cgi_put "<basefont size=$size />"}
+
+proc cgi_font {args} {
+    global _cgi
+
+    set buf "<font"
+    foreach a [lrange $args 0 [expr [llength $args]-2]] {
+	if {[regexp $_cgi(attr,regexp) $a dummy attr str]} {
+	    append buf " $attr=\"$str\""
+	} else {
+	    append buf " $a"
+	}
+    }
+    return "$buf>[lindex $args end]</font>"
+}
+
+# take a cgi func and have it return what would normally print
+# This command is reentrant (that's why it's so complex).
+proc cgi_buffer {cmd} {
+    global _cgi
+
+    if {0==[info exists _cgi(returnIndex)]} {
+	set _cgi(returnIndex) 0
+    }
+
+    rename cgi_puts cgi_puts$_cgi(returnIndex)
+    incr _cgi(returnIndex)
+    set _cgi(return[set _cgi(returnIndex)]) ""
+
+    proc cgi_puts args {
+	global _cgi
+	upvar #0 _cgi(return[set _cgi(returnIndex)]) buffer
+
+	append buffer [lindex $args end]
+	if {[llength $args] == 1} {
+	    append buffer $_cgi(buffer_nl)
+	}
+    }
+
+    # must restore things before allowing the eval to fail
+    # so catch here and rethrow later
+    if {[catch {uplevel 1 $cmd} errMsg]} {
+	global errorInfo
+	set savedInfo $errorInfo
+    }
+
+    # not necessary to put remainder of code in close_proc_push since it's
+    # all buffered anyway and hasn't yet put browser into a funky state.
+
+    set buffer $_cgi(return[set _cgi(returnIndex)])
+
+    incr _cgi(returnIndex) -1
+    rename cgi_puts ""
+    rename cgi_puts$_cgi(returnIndex) cgi_puts
+
+    if {[info exists savedInfo]} {
+	error $errMsg $savedInfo
+    }
+    return $buffer
+}
+
+set _cgi(buffer_nl) "\n"
+proc cgi_buffer_nl {nl} {
+    global _cgi
+
+    set old $_cgi(buffer_nl)
+    set _cgi(buffer_nl) $nl
+    return $old
+}
+
+##################################################
+# html and tags that can appear in html top-level
+##################################################
+
+proc cgi_html {args} {
+    set html [lindex $args end]
+    set argc [llength $args]
+    if {$argc > 1} {
+	eval _cgi_html_start [lrange $args 0 [expr {$argc-2}]]
+    } else {
+	_cgi_html_start
+    }
+    uplevel 1 $html
+    _cgi_html_end
+}
+
+proc _cgi_html_start {args} {
+    global _cgi
+    
+    if {[info exists _cgi(html_in_progress)]} return
+    _cgi_http_head_implicit
+
+    set _cgi(html_in_progress) 1
+    cgi_doctype
+
+    append buf "<html"
+    foreach a $args {
+	if {[regexp $_cgi(attr,regexp) $a dummy attr str]} {
+	    append buf " $attr=\"$str\""
+	} else {
+	    append buf " $a"
+	}
+    }
+    cgi_puts "$buf>"
+}
+
+proc _cgi_html_end {} {
+    global _cgi
+    unset _cgi(html_in_progress)
+    set _cgi(html_done) 1
+    cgi_puts "</html>"
+}
+
+# force closure of all tags and exit without going through normal returns.
+# Very useful if you want to call exit from a deeply stacked CGI script
+# and still have the HTML be correct.
+proc cgi_exit {} {
+    _cgi_close_procs
+    cgi_html {cgi_body {}}
+    exit
+}
+
+##################################################
+# head support
+##################################################
+
+proc cgi_head {{head {}}} {
+    global _cgi
+
+    if {[info exists _cgi(head_done)]} {
+	return
+    }
+
+    # allow us to be recalled so that we can display errors
+    if {0 == [info exists _cgi(head_in_progress)]} {
+	_cgi_http_head_implicit
+	set _cgi(head_in_progress) 1
+	cgi_puts "<head>"
+    }
+
+    # prevent cgi_html (during error handling) from generating html tags
+    set _cgi(html_in_progress) 1
+    # don't actually generate html tags since there's nothing to clean
+    # them up
+
+    if {0 == [string length $head]} {
+	if {[catch {cgi_title}]} {
+	    set head "cgi_title untitled"
+	}
+    }
+    uplevel 1 $head
+    if {![info exists _cgi(head_suppress_tag)]} {
+	cgi_puts "</head>"
+    } else {
+	unset _cgi(head_suppress_tag)
+    }
+
+    set _cgi(head_done) 1
+
+    # debugging can unset this in the uplevel above
+    catch {unset _cgi(head_in_progress)}
+}
+
+# with one arg: set, print, and return title
+# with no args: return title
+proc cgi_title {args} {
+    global _cgi
+
+    set title [lindex $args 0]
+
+    if {[llength $args]} {
+	_cgi_http_head_implicit
+
+	# we could just generate <head></head> tags, but head-level commands
+	# might follow so just suppress the head tags entirely
+	if {![info exists _cgi(head_in_progress)]} {
+	    set _cgi(head_in_progress) 1
+	    set _cgi(head_suppress_tag) 1
+	}
+
+	set _cgi(title) $title
+	cgi_puts "<title>$title</title>"
+    }
+    return $_cgi(title)
+}
+
+# This tag can only be called from with cgi_head.
+# example: cgi_http_equiv Refresh 1
+# There's really no reason to call this since it can be done directly
+# from cgi_http_head.
+proc cgi_http_equiv {type contents} {
+    _cgi_http_head_implicit
+    cgi_puts "<meta http-equiv=\"$type\" content=[cgi_dquote_html $contents]/>"
+}
+
+# Do whatever you want with meta tags.
+# Example: <meta name="author" content="Don Libes">
+proc cgi_meta {args} {
+    cgi_put "<meta"
+    foreach a $args {
+	if {[regexp "^(name|content|http-equiv)=(.*)" $a dummy attr str]} {
+	    cgi_put " $attr=[cgi_dquote_html $str]"
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_puts " />"
+}
+
+proc cgi_relationship {rel href args} {
+    cgi_puts "<link rel=$rel href=\"$href\""
+    foreach a $args {
+	if {[regexp "^title=(.*)" $a dummy str]} {
+	    cgi_put " title=[cgi_dquote_html $str]"
+	} elseif {[regexp "^type=(.*)" $a dummy str]} {
+	    cgi_put " type=[cgi_dquote_html $str]"
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_puts "/>"
+}
+
+proc cgi_name {args} {
+    global _cgi
+
+    if {[llength $args]} {
+	set _cgi(name) [lindex $args 0]
+    }
+    return $_cgi(name)
+}
+
+##################################################
+# body and other top-level support
+##################################################
+
+proc cgi_body {args} {
+    global errorInfo errorCode _cgi
+
+    # allow user to "return" from the body without missing _cgi_body_end
+    if {1==[catch {
+	eval _cgi_body_start [lrange $args 0 [expr [llength $args]-2]]
+	uplevel 1 [lindex $args end]
+    } errMsg]} {
+	set savedInfo $errorInfo
+	set savedCode $errorCode
+	error $errMsg $savedInfo $savedCode
+    }
+    _cgi_body_end
+}
+
+proc _cgi_body_start {args} {
+    global _cgi
+    if {[info exists _cgi(body_in_progress)]} return
+
+    cgi_head
+
+    set _cgi(body_in_progress) 1
+
+    cgi_put "<body"
+    foreach a "$args $_cgi(body_args)" {
+	if {[regexp "^(background|bgcolor|text|link|vlink|alink|onLoad|onUnload)=(.*)" $a dummy attr str]} {
+	    cgi_put " $attr=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_puts ">"
+
+    cgi_debug {
+	global env
+	catch {cgi_puts "Input: <pre>$_cgi(input)</pre>"}
+	catch {cgi_puts "Cookie: <pre>$env(HTTP_COOKIE)</pre>"}
+    }
+
+    if {![info exists _cgi(errorInfo)]} {
+	uplevel 2 app_body_start
+    }
+}
+
+proc _cgi_body_end {} {
+    global _cgi
+    if {![info exists _cgi(errorInfo)]} {
+	uplevel 2 app_body_end
+    }
+    unset _cgi(body_in_progress)
+    cgi_puts "</body>"
+
+    if {[info exists _cgi(multipart)]} {
+	unset _cgi(http_head_done)
+	catch {unset _cgi(http_status_done)}
+	unset _cgi(head_done)
+	catch {unset _cgi(head_suppress_tag)}
+    }
+}
+
+proc cgi_body_args {args} {
+    global _cgi
+
+    set _cgi(body_args) $args
+}
+
+proc cgi_script {args} {
+    cgi_puts "<script[_cgi_lrange $args 0 [expr [llength $args]-2]]>"
+    _cgi_close_proc_push "cgi_puts </script>"
+
+    uplevel 1 [lindex $args end]
+
+    _cgi_close_proc
+}
+
+proc cgi_javascript {args} {
+    cgi_puts "<script[_cgi_lrange $args 0 [expr [llength $args]-2]]>"
+    cgi_puts "<!--- Hide script from browsers that don't understand JavaScript"
+    _cgi_close_proc_push {cgi_puts "// End hiding -->\n</script>"}
+
+    uplevel 1 [lindex $args end]
+
+    _cgi_close_proc
+}
+
+proc cgi_noscript {args} {
+    cgi_puts "<noscript[_cgi_lrange $args 0 [expr [llength $args]-2]]>"
+    _cgi_close_proc_push {cgi_puts "</noscript>"}
+
+    uplevel 1 [lindex $args end]
+
+    _cgi_close_proc
+}
+
+proc cgi_applet {args} {
+    cgi_puts "<applet[_cgi_lrange $args 0 [expr [llength $args]-2]]>"
+    _cgi_close_proc_push "cgi_puts </applet>"
+
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+proc cgi_param {nameval} {
+    regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value
+
+    if {$q != "="} {
+	set value ""
+    }
+    cgi_puts "<param name=\"$name\" value=[cgi_dquote_html $value]/>"
+}
+
+# record any proc's that must be called prior to displaying an error
+proc _cgi_close_proc_push {p} {
+    global _cgi
+    if {![info exists _cgi(close_proc)]} {
+	set _cgi(close_proc) ""
+    }
+    set _cgi(close_proc) "$p; $_cgi(close_proc)"
+}
+
+proc _cgi_close_proc_pop {} {
+    global _cgi
+    regexp "^(\[^;]*);(.*)" $_cgi(close_proc) dummy lastproc _cgi(close_proc)
+    return $lastproc
+}
+
+# generic proc to close whatever is on the top of the stack
+proc _cgi_close_proc {} {
+    eval [_cgi_close_proc_pop]
+}
+
+proc _cgi_close_procs {} {
+    global _cgi
+
+    _cgi_close_tag
+    if {[info exists _cgi(close_proc)]} {
+	uplevel #0 $_cgi(close_proc)
+    }
+}
+
+proc _cgi_close_tag {} {
+    global _cgi
+
+    if {[info exists _cgi(tag_in_progress)]} {
+	cgi_put ">"
+	unset _cgi(tag_in_progress)
+    }
+}
+
+##################################################
+# hr support
+##################################################
+
+proc cgi_hr {args} {
+    set buf "<hr"
+    foreach a $args {
+	if {[regexp "^width=(.*)" $a dummy str]} {
+	    append buf " width=\"$str\""
+	} else {
+	    append buf " $a"
+	}
+    }
+    cgi_put "$buf />"
+}
+
+##################################################
+# form & isindex
+##################################################
+
+proc cgi_form {action args} {
+    global _cgi
+
+    _cgi_form_multiple_check
+    set _cgi(form_in_progress) 1
+
+    _cgi_close_proc_push _cgi_form_end
+    cgi_put "<form action="
+    if {[regexp {^[a-z]*:} $action]} {
+	cgi_put "\"$action\""
+    } else {
+	cgi_put "\"[cgi_cgi $action]\""
+    }
+    set method "method=post"
+    foreach a [lrange $args 0 [expr [llength $args]-2]] {
+	if {[regexp "^method=" $a]} {
+	    set method $a
+	} elseif {[regexp "^(target|onReset|onSubmit)=(.*)" $a dummy attr str]} {
+	    cgi_put " $attr=\"$str\""
+	} elseif {[regexp "^enctype=(.*)" $a dummy str]} {
+	    cgi_put " enctype=\"$str\""
+	    set _cgi(form,enctype) $str
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put " $method>"
+    uplevel 1 [lindex $args end]
+    catch {unset _cgi(form,enctype)}
+    _cgi_close_proc
+}
+
+proc _cgi_form_end {} {
+    global _cgi
+    unset _cgi(form_in_progress)
+    cgi_put "</form>"
+}
+
+proc _cgi_form_multiple_check {} {
+    global _cgi
+    if {[info exists _cgi(form_in_progress)]} {
+	error "Cannot create form (or isindex) with form already in progress."
+    }
+}
+
+proc cgi_isindex {args} {
+    _cgi_form_multiple_check
+
+    cgi_put "<isindex"
+    foreach a $args {
+	if {[regexp "^href=(.*)" $a dummy str]} {
+	    cgi_put " href=\"$str\""
+	} elseif {[regexp "^prompt=(.*)" $a dummy str]} {
+	    cgi_put " prompt=[cgi_dquote_html $str]"
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+##################################################
+# argument handling
+##################################################
+
+proc cgi_input {{fakeinput {}} {fakecookie {}}} {
+    global env _cgi _cgi_uservar _cgi_cookie _cgi_cookie_shadowed
+
+    set _cgi(uservars) {}
+    set _cgi(uservars,autolist) {}
+
+    if {[info exists env(CONTENT_TYPE)] && [regexp ^multipart/form-data $env(CONTENT_TYPE)]} {
+	if {![info exists env(REQUEST_METHOD)]} {
+	    # running by hand
+	    set fid [open $fakeinput]
+	} else {
+	    set fid stdin
+	}
+	if {([info tclversion] >= 8.1) || [catch exp_version] || [info exists _cgi(no_binary_upload)]} {
+	    _cgi_input_multipart $fid
+	} else {
+	    _cgi_input_multipart_binary $fid
+	}
+    } else {
+	if {![info exists env(REQUEST_METHOD)]} {
+	    set input $fakeinput
+	    set env(HTTP_COOKIE) $fakecookie
+	} elseif { $env(REQUEST_METHOD) == "GET" } {
+	    set input ""
+	    catch {set input $env(QUERY_STRING)} ;# doesn't have to be set
+	} elseif { $env(REQUEST_METHOD) == "HEAD" } {
+	    set input ""
+	} elseif {![info exists env(CONTENT_LENGTH)]} {
+	    set _cgi(client_error) 1
+	    error "Your browser failed to generate the content-length during a POST method."
+	} else {
+	    set length $env(CONTENT_LENGTH)
+	    if {0!=[string compare $length "-1"]} {
+		set input [read stdin $env(CONTENT_LENGTH)]		
+	    } else {
+		set _cgi(client_error) 1
+		error "Your browser generated a content-length of -1 during a POST method."
+	    }
+	    if {[info tclversion] >= 8.1} {
+                # guess query encoding from Content-Type header
+                if {[info exists env(CONTENT_TYPE)] \
+                    && [regexp -nocase -- {charset=([^[:space:]]+)} $env(CONTENT_TYPE) m cs]} {
+                    if {[regexp -nocase -- {iso-?8859-([[:digit:]]+)} $cs m d]} {
+                        set _cgi(queryencoding) "iso8859-$d"
+                    } elseif {[regexp -nocase -- {windows-([[:digit:]]+)} $cs m d]} {
+                        set _cgi(queryencoding) "cp$d"
+                    } elseif {0==[string compare -nocase $cs "utf-8"]} {
+                        set _cgi(queryencoding) "utf-8"
+                    } elseif {0==[string compare -nocase $cs "utf-16"]} {
+                        set _cgi(queryencoding) "unicode"
+                    }
+                } else {
+                    set _cgi(queryencoding) [encoding system]
+                }
+            }
+	}
+	# save input for possible diagnostics later
+	set _cgi(input) $input
+
+	set pairs [split $input &]
+	foreach pair $pairs {
+	    if {0 == [regexp "^(\[^=]*)=(.*)$" $pair dummy varname val]} {
+		# if no match, unquote and leave it at that
+		# this is typical of <isindex>-style queries
+		set varname anonymous
+		set val $pair
+	    }
+
+	    set varname [cgi_unquote_input $varname]
+	    set val [cgi_unquote_input $val]
+	    _cgi_set_uservar $varname $val
+	}
+    }
+
+    # O'Reilly's web server incorrectly uses COOKIE
+    catch {set env(HTTP_COOKIE) $env(COOKIE)}
+    if {![info exists env(HTTP_COOKIE)]} return
+    foreach pair [split $env(HTTP_COOKIE) ";"] {
+	# pairs are actually split by "; ", sigh
+	set pair [string trimleft $pair " "]
+	# spec is not clear but seems to allow = unencoded
+	# only sensible interpretation is to assume no = in var names
+	# appears MS IE can omit "=val"
+	set val ""
+	regexp (\[^=]*)=?(.*) $pair dummy varname val
+
+	set varname [cgi_unquote_input $varname]
+	set val [cgi_unquote_input $val]
+
+	if {[info exists _cgi_cookie($varname)]} {
+	    lappend _cgi_cookie_shadowed($varname) $val
+	} else {
+	    set _cgi_cookie($varname) $val
+	}
+    }
+}
+
+proc _cgi_input_multipart {fin} {
+    global env _cgi _cgi_uservar _cgi_userfile
+
+    cgi_debug -noprint {
+	# save file for debugging purposes
+	set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]]
+	# explicitly flush all writes to fout, because sometimes the writer
+	# can hang and we won't get to the termination code
+	set dbg_fout [open $dbg_filename w $_cgi(tmpperms)]
+	set _cgi(input) $dbg_filename
+	catch {fconfigure $dbg_fout -translation binary}
+    }
+
+    # figure out boundary
+    if {0==[regexp boundary=(.*) $env(CONTENT_TYPE) dummy boundary]} {
+	set _cgi(client_error) 1
+	error "Your browser failed to generate a \"boundary=\" line in a multipart response (CONTENT_TYPE: $env(CONTENT_TYPE)).  Please upgrade (or fix) your browser."
+    }
+
+    # make boundary into a legal regsub pattern by protecting #
+    # legal boundary characters include ()+.? (among others)
+    regsub -all "\\(" $boundary "\\(" boundary
+    regsub -all "\\)" $boundary "\\)" boundary
+    regsub -all "\\+" $boundary "\\+" boundary
+    regsub -all "\\." $boundary "\\." boundary
+    regsub -all "\\?" $boundary "\\?" boundary
+
+    set boundary --$boundary
+
+    # don't corrupt or modify uploads yet allow Tcl 7.4 to work
+    catch {fconfigure $fin -translation binary}
+
+    # get first boundary line
+    gets $fin buf
+    if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout}
+
+    set _cgi(file,filecount) 0
+
+    while {1} {
+	# process Content-Disposition:
+	if {-1 == [gets $fin buf]} break
+	if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout}
+	catch {unset filename}
+	regexp {name="([^"]*)"} $buf dummy varname
+	if {0==[info exists varname]} {
+	    # lynx violates spec and doesn't use quotes, so try again but
+	    # assume space is delimiter
+	    regexp {name=([^ ]*)} $buf dummy varname
+	    if {0==[info exists varname]} {
+		set _cgi(client_error) 1
+		error "In response to a request for a multipart form, your browser generated a part header without a name field.  Please upgrade (or fix) your browser."
+	    }
+	}	    
+	# Lame-o encoding (on Netscape at least) doesn't escape field
+	# delimiters (like quotes)!!  Since all we've ever seen is filename=
+	# at end of line, assuming nothing follows.  Sigh.
+	regexp {filename="(.*)"} $buf dummy filename
+
+	# Skip remaining headers until blank line.
+	# Content-Type: can appear here.
+	set conttype ""
+	while {1} {
+	    if {-1 == [gets $fin buf]} break
+	    if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout}
+	    if {0==[string compare $buf "\r"]} break
+	    regexp -nocase "^Content-Type:\[ \t]+(.*)\r" $buf x conttype
+	}
+
+	if {[info exists filename]} {
+	    if {$_cgi(file,filecount) > $_cgi(file,filelimit)} {
+		error "Too many files submitted.  Max files allowed: $_cgi(file,filelimit)"
+	    }
+
+	    # read the part into a file
+	    set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]]
+	    set fout [open $foutname w $_cgi(tmpperms)]
+	    # "catch" permits this to work with Tcl 7.4
+	    catch {fconfigure $fout -translation binary}
+	    _cgi_set_uservar $varname [list $foutname $filename $conttype]
+	    set _cgi_userfile($varname) [list $foutname $filename $conttype]
+
+	    #
+	    # Look for a boundary line preceded by \r\n.
+	    #
+	    # To do this, we buffer line terminators that might
+	    # be the start of the special \r\n$boundary sequence.
+	    # The buffer is called "leftover" and is just inserted
+	    # into the front of the next output (assuming it's
+	    # not a boundary line).
+
+	    set leftover ""
+	    while {1} {
+		if {-1 == [gets $fin buf]} break
+		if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout}
+
+		if {0 == [string compare "\r\n" $leftover]} {
+		    if {[regexp ^[set boundary](--)?\r?$ $buf dummy dashdash]} {
+			if {$dashdash == "--"} {set eof 1}
+			break
+		    }
+		}
+		if {[regexp (.*)\r$ $buf x data]} {
+		    puts -nonewline $fout $leftover$data
+		    set leftover "\r\n"
+		} else {
+		    puts -nonewline $fout $leftover$buf
+		    set leftover "\n"
+		}
+ 		if {[file size $foutname] > $_cgi(file,charlimit)} {
+		    error "File size exceeded.  Max file size allowed: $_cgi(file,charlimit)"
+		}
+	    }
+
+	    close $fout
+	    unset fout
+	} else {
+	    # read the part into a variable
+	    set val ""
+	    set blanks 0
+	    while {1} {
+		if {-1 == [gets $fin buf]} break
+		if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout}
+		if {[regexp ^[set boundary](--)?\r?$ $buf dummy dashdash]} {
+		    if {$dashdash == "--"} {set eof 1}
+		    break
+		}
+		if {0!=[string compare $val ""]} {
+		    append val \n
+		}
+		regexp (.*)\r$ $buf dummy buf
+		if {[info exists blanks]} {
+		    if {0!=[string compare $buf ""]} {
+			if {$blanks} {
+			    append val [string repeat \n [incr blanks]]
+			}
+			unset blanks
+		    } else {
+			incr blanks
+		    }
+		}
+		append val $buf
+	    }
+	    _cgi_set_uservar $varname $val
+	}
+        if {[info exists eof]} break
+    }
+    if {[info exists dbg_fout]} {close $dbg_fout}
+}
+
+proc _cgi_input_multipart_binary {fin} {
+    global env _cgi _cgi_uservar _cgi_userfile
+
+    log_user 0
+    set timeout -1
+
+    cgi_debug -noprint {
+	# save file for debugging purposes
+	set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]]
+	set _cgi(input) $dbg_filename
+	spawn -open [open $dbg_filename w $_cgi(tmpperms)]
+	set dbg_sid $spawn_id
+    }
+    spawn -open $fin
+    set fin_sid $spawn_id
+    remove_nulls 0
+
+    if {0} {
+	# dump input to screen
+	cgi_debug {
+	    puts "<xmp>"
+	    expect {
+		-i $fin_sid
+		-re ^\r {puts -nonewline "CR"; exp_continue}
+		-re ^\n {puts "NL"; exp_continue}
+		-re . {puts -nonewline $expect_out(buffer); exp_continue}
+	    }
+	    puts "</xmp>"
+	    exit
+	}
+    }
+
+    # figure out boundary
+    if {0==[regexp boundary=(.*) $env(CONTENT_TYPE) dummy boundary]} {
+	set _cgi(client_error) 1
+	error "Your browser failed to generate a \"boundary=\" definition in a multipart response (CONTENT_TYPE: $env(CONTENT_TYPE)).  Please upgrade (or fix) your browser."
+    }
+
+    # make boundary into a legal regsub pattern by protecting #
+    # legal boundary characters include ()+.? (among others)
+    regsub -all "\\(" $boundary "\\(" boundary
+    regsub -all "\\)" $boundary "\\)" boundary
+    regsub -all "\\+" $boundary "\\+" boundary
+    regsub -all "\\." $boundary "\\." boundary
+    regsub -all "\\?" $boundary "\\?" boundary
+
+    set boundary --$boundary
+    set linepat "(\[^\r]*)\r\n"
+
+    # get first boundary line
+    expect {
+	-i $fin_sid
+	-re $linepat {
+	    set buf $expect_out(1,string)
+	    if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n}
+	}
+	eof {
+	    set _cgi(client_error) 1
+	    error "Your browser failed to provide an initial boundary ($boundary) in a multipart response.  Please upgrade (or fix) your browser."
+	}
+    }
+
+    set _cgi(file,filecount) 0
+
+    while {1} {
+	# process Content-Disposition:
+	expect {
+	    -i $fin_sid
+	    -re $linepat {
+		set buf $expect_out(1,string)
+		if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n}
+	    }
+	    eof break
+	}
+	catch {unset filename}
+	regexp {name="([^"]*)"} $buf dummy varname
+	if {0==[info exists varname]} {
+	    set _cgi(client_error) 1
+	    error "In response to a request for a multipart form, your browser generated a part header without a name field.  Please upgrade (or fix) your browser."
+	}	    
+
+	# Lame-o encoding (on Netscape at least) doesn't escape field
+	# delimiters (like quotes)!!  Since all we've ever seen is filename=
+	# at end of line, assuming nothing follows.  Sigh.
+	regexp {filename="(.*)"} $buf dummy filename
+
+	# Skip remaining headers until blank line.
+	# Content-Type: can appear here.
+	set conttype ""
+	expect {
+	    -i $fin_sid
+	    -re $linepat {
+		set buf $expect_out(1,string)
+		if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n}
+		if {0!=[string compare $buf ""]} exp_continue
+		regexp -nocase "^Content-Type:\[ \t]+(.*)\r" $buf x conttype
+	    }
+	    eof break
+	}
+
+	if {[info exists filename]} {
+	    if {$_cgi(file,filecount) > $_cgi(file,filelimit)} {
+		error "Too many files submitted.  Max files allowed: $_cgi(file,filelimit)"
+	    }
+
+	    # read the part into a file
+	    set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]]
+	    spawn -open [open $foutname w $_cgi(tmpperms)]
+	    set fout_sid $spawn_id
+
+	    _cgi_set_uservar $varname [list $foutname $filename $conttype]
+	    set _cgi_userfile($varname) [list $foutname $filename $conttype]
+
+	    # This is tricky stuff - be very careful changing anything here!
+	    # In theory, all we have to is record everything up to
+	    # \r\n$boundary\r\n.  Unfortunately, we can't simply wait on
+	    # such a pattern because the input can overflow any possible
+	    # buffer we might choose.  We can't simply catch buffer_full
+	    # because the boundary might straddle a buffer.  I doubt that
+	    # doing my own buffering would be any faster than taking the
+	    # approach I've done here.
+	    #
+	    # The code below basically implements a simple scanner that
+	    # keeps track of whether it's seen crlfs or pieces of them.
+	    # The idea is that we look for crlf pairs, separated by
+	    # things that aren't crlfs (or pieces of them).  As we encounter
+	    # things that aren't crlfs (or pieces of them), or when we decide
+	    # they can't be, we mark them for output and resume scanning for
+	    # new pairs.
+	    #
+	    # The scanner runs tolerably fast because the [...]+ pattern picks
+	    # up most things.  The \r and \n are ^-anchored so the pattern
+	    # match is pretty fast and these don't happen that often so the
+	    # huge \n action is executed rarely (once per line on text files).
+	    # The null pattern is, of course, only used when everything
+	    # else fails.
+
+	    # crlf	== "\r\n" if we've seen one, else == ""
+	    # cr	== "\r" if we JUST saw one, else == ""
+	    #           Yes, strange, but so much more efficient
+	    #		that I'm willing to sacrifice readability, sigh.
+	    # buf	accumulated data between crlf pairs
+
+	    set buf ""
+	    set cr ""
+	    set crlf ""
+
+	    expect {
+		-i $fin_sid
+		-re "^\r" {
+		    if {$cr == "\r"} {
+			append buf "\r"
+		    }
+		    set cr \r
+		    exp_continue
+		} -re "^\n" {
+		    if {$cr == "\r"} {
+			if {$crlf == "\r\n"} {
+			    # do boundary test
+			    if {[regexp ^[set boundary](--)?$ $buf dummy dashdash]} {
+				if {$dashdash == "--"} {
+				    set eof 1
+				}
+			    } else {
+				# boundary test failed
+				if {[info exists dbg_sid]} {send -i $dbg_sid -- \r\n$buf}
+				send -i $fout_sid \r\n$buf ; set buf ""
+				set cr ""
+				exp_continue
+			    }
+			} else {
+			    set crlf "\r\n"
+			    set cr ""
+			    if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf}
+			    send -i $fout_sid -- $buf ; set buf ""
+			    exp_continue
+			}
+		    } else {
+			if {[info exists dbg_sid]} {send -i $dbg_sid -- $crlf$buf\n}
+			send -i $fout_sid -- $crlf$buf\n ; set buf ""
+			set crlf ""
+			exp_continue
+		    }
+		} -re "\[^\r\n]+" {
+		    if {$cr == "\r"} {
+			set buf $crlf$buf\r$expect_out(buffer)
+			set crlf ""
+			set cr ""
+		    } else {
+			append buf $expect_out(buffer)
+		    }
+		    exp_continue
+		} null {
+		    if {[info exists dbg_sid]} {
+			send -i $dbg_sid -- $crlf$buf$cr
+			send -i $dbg_sid -null
+		    }
+		    send -i $fout_sid -- $crlf$buf$cr ; set buf ""
+		    send -i $fout_sid -null
+		    set cr ""
+		    set crlf ""
+		    exp_continue
+		} eof {
+		    set _cgi(client_error) 1
+		    error "Your browser failed to provide an ending boundary ($boundary) in a multipart response.  Please upgrade (or fix) your browser."
+		}
+	    }
+	    exp_close -i $fout_sid    ;# implicitly closes fout
+	    exp_wait -i $fout_sid
+	    unset fout_sid
+	} else {
+	    # read the part into a variable
+	    set val ""
+	    expect {
+		-i $fin_sid
+		-re $linepat {
+		    set buf $expect_out(1,string)
+		    if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n}
+		    if {[regexp ^[set boundary](--)?$ $buf dummy dashdash]} {
+			if {$dashdash == "--"} {set eof 1}
+		    } else {
+			regexp (.*)\r$ $buf dummy buf
+			if {0!=[string compare $val ""]} {
+			    append val \n
+			}
+			append val $buf
+			exp_continue
+		    }
+		}
+	    }
+	    _cgi_set_uservar $varname $val
+	}	    
+        if {[info exists eof]} break
+    }
+    if {[info exists fout]} {
+	exp_close -i $dbg_sid
+	exp_wait -i $dbg_sid
+    }
+
+    # no need to close fin, fin_sid, or dbg_sid
+}
+
+# internal routine for defining user variables
+proc _cgi_set_uservar {varname val} {
+    global _cgi _cgi_uservar
+
+    set exists [info exists _cgi_uservar($varname)]
+    set isList $exists
+    # anything we've seen before and is being set yet again necessarily
+    # has to be (or become a list)
+
+    if {!$exists} {
+	lappend _cgi(uservars) $varname
+    }
+
+    if {[regexp List$ $varname]} {
+	set isList 1
+    } elseif {$exists} {
+	# vars that we've seen before but aren't marked as lists
+	# need to be "listified" so we can do appends later
+	if {-1 == [lsearch $_cgi(uservars,autolist) $varname]} {
+	    # remember that we've listified it
+	    lappend _cgi(uservars,autolist) $varname
+	    set _cgi_uservar($varname) [list $_cgi_uservar($varname)]
+	}
+    }
+    if {$isList} {
+	lappend _cgi_uservar($varname) $val
+    } else {
+	set _cgi_uservar($varname) $val
+    }
+}
+
+# export named variable
+proc cgi_export {nameval} {
+    regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value
+
+    if {$q != "="} {
+	set value [uplevel 1 set [list $name]]
+    }
+
+    cgi_put "<input type=hidden name=\"$name\" value=[cgi_dquote_html $value]/>"
+}
+
+proc cgi_export_cookie {name args} {
+    upvar 1 $name x
+    eval cgi_cookie_set [list $name=$x] $args
+}
+
+# return list of variables available for import
+# Explicit list is used to keep items in order originally found in form.
+proc cgi_import_list {} {
+    global _cgi
+
+    return $_cgi(uservars)
+}
+
+# import named variable
+proc cgi_import {name} {
+    global _cgi_uservar
+    upvar 1 $name var
+
+    set var $_cgi_uservar($name)
+}
+
+proc cgi_import_as {name tclvar} {
+    global _cgi_uservar
+    upvar 1 $tclvar var
+
+    set var $_cgi_uservar($name)
+}
+
+# like cgi_import but if not available, try cookie
+proc cgi_import_cookie {name} {
+    global _cgi_uservar
+    upvar 1 $name var
+
+    if {0==[catch {set var $_cgi_uservar($name)}]} return
+    set var [cgi_cookie_get $name]
+}
+
+# like cgi_import but if not available, try cookie
+proc cgi_import_cookie_as {name tclvar} {
+    global _cgi_uservar
+    upvar 1 $tclvar var
+
+    if {0==[catch {set var $_cgi_uservar($name)}]} return
+    set var [cgi_cookie_get $name]
+}
+
+proc cgi_import_file {type name} {
+    global _cgi_userfile
+    upvar 1 $name var
+
+    set var $_cgi_userfile($name)
+    switch -- $type {
+	"-server" {
+	    lindex $var 0
+	} "-client" {
+	    lindex $var 1
+	} "-type" {
+	    lindex $var 2
+	}
+    }
+}
+
+# deprecated, use cgi_import_file
+proc cgi_import_filename {type name} {
+    global _cgi_userfile
+    upvar 1 $name var
+
+    set var $_cgi_userfile($name)
+    if {$type == "-server" || $type == "-local"} {
+	# -local is deprecated
+	lindex $var 0
+    } else {
+	lindex $var 1
+    }
+}
+
+# set the urlencoding
+proc cgi_urlencoding {{encoding ""}} {
+    global _cgi 
+    
+    set result [expr {[info exists _cgi(queryencoding)]
+                      ? $_cgi(queryencoding)
+                      : ""}]
+
+    # check if the encoding is available 
+    if {[info tclversion] >= 8.1
+        && [lsearch -exact [encoding names] $encoding] != -1 } {	
+        set _cgi(queryencoding) $encoding
+    }
+
+    return $result
+}
+
+##################################################
+# button support
+##################################################
+
+# not sure about arg handling, do we need to support "name="?
+proc cgi_button {value args} {
+    cgi_put "<input type=button value=[cgi_dquote_html $value]"
+    foreach a $args {
+	if {[regexp "^onClick=(.*)" $a dummy str]} {
+	    cgi_put " onClick=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+# Derive a button from a link predefined by cgi_link
+proc cgi_button_link {args} {
+    global _cgi_link
+
+    set tag [lindex $args 0]
+    if {[llength $args] == 2} {
+	set label [lindex $args end]
+    } else {
+	set label $_cgi_link($tag,label)
+    }
+    
+    cgi_button $label onClick=$_cgi_link($tag,url)
+}
+
+proc cgi_submit_button {{nameval {=Submit Query}} args} {
+    regexp "(\[^=]*)=(.*)" $nameval dummy name value
+    cgi_put "<input type=submit"
+    if {0!=[string compare "" $name]} {
+	cgi_put " name=\"$name\""
+    }
+    cgi_put " value=[cgi_dquote_html $value]"
+    foreach a $args {
+	if {[regexp "^onClick=(.*)" $a dummy str]} {
+	    cgi_put " onClick=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+
+proc cgi_reset_button {{value Reset} args} {
+    cgi_put "<input type=reset value=[cgi_dquote_html $value]"
+
+    foreach a $args {
+	if {[regexp "^onClick=(.*)" $a dummy str]} {
+	    cgi_put " onClick=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+proc cgi_radio_button {nameval args} {
+    regexp "(\[^=]*)=(.*)" $nameval dummy name value
+
+    cgi_put "<input type=radio name=\"$name\" value=[cgi_dquote_html $value]"
+
+    foreach a $args {
+	if {[regexp "^checked_if_equal=(.*)" $a dummy default]} {
+	    if {0==[string compare $default $value]} {
+		cgi_put " checked"
+	    }
+	} elseif {[regexp "^checked=(.*)" $a dummy checked]} {
+	    # test explicitly to avoid forcing user eval
+	    if {$checked} {
+		cgi_put " checked"
+	    }
+	} elseif {[regexp "^onClick=(.*)" $a dummy str]} {
+	    cgi_put " onClick=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+proc cgi_image_button {nameval args} {
+    regexp "(\[^=]*)=(.*)" $nameval dummy name value
+    cgi_put "<input type=image"
+    if {0!=[string compare "" $name]} {
+	cgi_put " name=\"$name\""
+    }
+    cgi_put " src=\"$value\""
+    foreach a $args {
+	if {[regexp "^onClick=(.*)" $a dummy str]} {
+	    cgi_put " onClick=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+# map/area implement client-side image maps
+proc cgi_map {name cmd} {
+    cgi_put "<map name=\"$name\">"
+    _cgi_close_proc_push "cgi_put </map>"
+
+    uplevel 1 $cmd
+    _cgi_close_proc
+}
+
+proc cgi_area {args} {
+    cgi_put "<area"
+    foreach a $args {
+	if {[regexp "^(coords|shape|href|target|onMouseOut|alt)=(.*)" $a dummy attr str]} {
+	    cgi_put " $attr=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+##################################################
+# checkbox support
+##################################################
+
+proc cgi_checkbox {nameval args} {
+    regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value
+    cgi_put "<input type=checkbox name=\"$name\""
+
+    if {0!=[string compare "" $value]} {
+	cgi_put " value=[cgi_dquote_html $value]"
+    }
+
+    foreach a $args {
+	if {[regexp "^checked_if_equal=(.*)" $a dummy default]} {
+	    if {0==[string compare $default $value]} {
+		cgi_put " checked"
+	    }
+	} elseif {[regexp "^checked=(.*)" $a dummy checked]} {
+	    # test explicitly to avoid forcing user eval
+	    if {$checked} {
+		cgi_put " checked"
+	    }
+	} elseif {[regexp "^onClick=(.*)" $a dummy str]} {
+	    cgi_put " onClick=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+##################################################
+# textentry support
+##################################################
+
+proc cgi_text {nameval args} {
+    regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value
+
+    cgi_put "<input name=\"$name\""
+
+    if {$q != "="} {
+	set value [uplevel 1 set [list $name]]
+    }
+    cgi_put " value=[cgi_dquote_html $value]"
+
+    foreach a $args {
+	if {[regexp "^on(Select|Focus|Blur|Change)=(.*)" $a dummy event str]} {
+	    cgi_put " on$event=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put "/>"
+}
+
+##################################################
+# textarea support
+##################################################
+
+proc cgi_textarea {nameval args} {
+    regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value
+
+    cgi_put "<textarea name=\"$name\""
+    foreach a $args {
+	if {[regexp "^on(Select|Focus|Blur|Change)=(.*)" $a dummy event str]} {
+	    cgi_put " on$event=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_put ">"
+
+    if {$q != "="} {
+	set value [uplevel 1 set [list $name]]
+    }
+    cgi_put "[cgi_quote_html $value]</textarea>"
+}
+
+##################################################
+# file upload support
+##################################################
+
+# for this to work, pass enctype=multipart/form-data to cgi_form
+proc cgi_file_button {name args} {
+    global _cgi
+    if {[info exists _cgi(formtype)] && ("multipart/form-data" != $_cgi(form,enctype))} {
+	error "cgi_file_button requires that cgi_form have the argument enctype=multipart/form-data"
+    }
+    cgi_put "<input type=file name=\"$name\"[_cgi_list_to_string $args]/>"
+}
+
+# establish a per-file limit for uploads
+
+proc cgi_file_limit {files chars} {
+    global _cgi
+
+    set _cgi(file,filelimit) $files
+    set _cgi(file,charlimit) $chars
+}
+
+##################################################
+# select support
+##################################################
+
+proc cgi_select {name args} {
+    cgi_put "<select name=\"$name\""
+    _cgi_close_proc_push "cgi_put </select>"
+    foreach a [lrange $args 0 [expr [llength $args]-2]] {
+	if {[regexp "^on(Focus|Blur|Change)=(.*)" $a dummy event str]} {
+	    cgi_put " on$event=\"$str\""
+	} else {
+	    if {0==[string compare multiple $a]} {
+		;# sanity check
+		if {![regexp "List$" $name]} {
+		    cgi_puts ">" ;# prevent error from being absorbed
+		    error "When selecting multiple options, select variable \
+			    must end in \"List\" to allow the value to be \
+			    recognized as a list when it is processed later."
+		}
+	    }
+	    cgi_put " $a"
+	}
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+proc cgi_option {o args} {
+    cgi_put "<option"
+    set value $o
+    set selected 0
+    foreach a $args {
+	if {[regexp "^selected_if_equal=(.*)" $a dummy selected_if_equal]} {
+	} elseif {[regexp "^value=(.*)" $a dummy value]} {
+	    cgi_put " value=[cgi_dquote_html $value]"
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    if {[info exists selected_if_equal]} {
+	if {0 == [string compare $selected_if_equal $value]} {
+	    cgi_put " selected"
+	}
+    }
+    cgi_puts ">[cgi_quote_html $o]</option>"
+}
+
+##################################################
+# plug-in support
+##################################################
+
+proc cgi_embed {src wh args} {
+    regexp (.*)x(.*) $wh dummy width height
+    cgi_put "<embed src=[cgi_dquote_html $src] width=\"$width\" height=\"$height\""
+    foreach a $args {
+	if {[regexp "^palette=(.*)" $a dummy str]} {
+	    cgi_put " palette=\"$str\""
+	} elseif {[regexp -- "-quote" $a]} {
+	    set quote 1
+	} else {
+	    if {[info exists quote]} {
+		regexp "(\[^=]*)=(.*)" $a dummy var val
+		cgi_put " var=[cgi_dquote_html $var]"
+	    } else {
+		cgi_put " $a"
+	    }
+	}
+    }
+    cgi_put "/>"
+}
+
+##################################################
+# mail support
+##################################################
+
+# mail to/from the service itself
+proc cgi_mail_addr {args} {
+    global _cgi
+
+    if {[llength $args]} {
+	set _cgi(email) [lindex $args 0]
+    }
+    return $_cgi(email)
+}
+
+proc cgi_mail_start {to} {
+    global _cgi
+
+    set _cgi(mailfile) [file join $_cgi(tmpdir) cgimail.[pid]]
+    set _cgi(mailfid) [open $_cgi(mailfile) w+]
+    set _cgi(mailto) $to
+
+    # mail is actually sent by "nobody".  To force bounce messages
+    # back to us, override the default return-path.
+    cgi_mail_add "Return-Path: <$_cgi(email)>"
+    cgi_mail_add "From: [cgi_name] <$_cgi(email)>"
+    cgi_mail_add "To: $to"
+}
+
+# add another line to outgoing mail
+# if no arg, add a blank line
+proc cgi_mail_add {{arg {}}} {
+    global _cgi
+
+    puts $_cgi(mailfid) $arg
+}	
+
+# end the outgoing mail and send it
+proc cgi_mail_end {} {
+    global _cgi
+
+    flush $_cgi(mailfid)
+
+    foreach sendmail in $_cgi(sendmail) {
+	if {[file executable $sendmail]} {
+	    exec $sendmail -t -odb < $_cgi(mailfile)
+	    # Explanation:
+	    # -t   means: pick up recipient from body
+	    # -odb means: deliver in background
+	    # note: bogus local address cause sendmail to fail immediately
+	    set sent 1
+	}
+    }
+
+    if {0==[info exists sent]} {
+	# fallback for sites without sendmail
+
+	if {0==[info exists _cgi(mail_relay)]} {
+	    regexp "@(.*)" $_cgi(mailto) dummy _cgi(mail_relay)
+	}
+
+	set s [socket $_cgi(mail_relay) 25]
+	gets $s answer
+	if {[lindex $answer 0] != 220} {error $answer} 
+
+	puts $s "HELO [info host]";flush $s
+	gets $s answer
+	if {[lindex $answer 0] != 250} {error $answer}  
+
+	puts $s "MAIL FROM:<$_cgi(email)>";flush $s
+	gets $s answer
+	if {[lindex $answer 0] != 250} {error $answer}  
+
+	puts $s "RCPT TO:<$_cgi(mailto)>";flush $s
+	gets $s answer
+	if {[lindex $answer 0] != 250} {error $answer}  
+
+	puts $s DATA;flush $s
+	gets $s answer
+	if {[lindex $answer 0] != 354} {error $answer}  
+
+	seek $_cgi(mailfid) 0 start
+	puts $s [read $_cgi(mailfid)];flush $s
+	puts $s .;flush $s
+	gets $s answer
+	if {[lindex $answer 0] != 250} {error $answer}  
+
+	close $s
+    }
+    close $_cgi(mailfid)
+    file delete -force $_cgi(mailfile)
+}
+
+proc cgi_mail_relay {host} {
+    global _cgi
+
+    set _cgi(mail_relay) $host
+}
+
+proc cgi_sendmail {path} {
+    global _cgi
+
+    set _cgi(sendmail) $path
+}
+
+##################################################
+# cookie support
+##################################################
+
+# calls to cookie_set look like this:
+#   cgi_cookie_set user=don domain=nist.gov expires=never
+#   cgi_cookie_set user=don domain=nist.gov expires=now
+#   cgi_cookie_set user=don domain=nist.gov expires=...actual date...
+
+proc cgi_cookie_set {nameval args} {
+    global _cgi
+
+    if {![info exists _cgi(http_head_in_progress)]} {
+	error "Cookies must be set from within cgi_http_head."
+    }
+    cgi_puts -nonewline "Set-Cookie: [cgi_cookie_encode $nameval];"
+
+    foreach a $args {
+	if {[regexp "^expires=(.*)" $a dummy expiration]} {
+	    if {0==[string compare $expiration "never"]} {
+		set expiration "Friday, 11-Jan-2038 23:59:59 GMT"
+	    } elseif {0==[string compare $expiration "now"]} {
+		set expiration "Friday, 31-Dec-1990 23:59:59 GMT"
+	    }
+	    cgi_puts -nonewline " expires=$expiration;"
+	} elseif {[regexp "^(domain|path)=(.*)" $a dummy attr str]} {
+	    cgi_puts -nonewline " $attr=[cgi_cookie_encode $str];"
+	} elseif {[regexp "^secure$" $a]} {
+	    cgi_puts -nonewline " secure;"
+	}
+    }
+    cgi_puts ""
+}
+
+# return list of cookies available for import
+proc cgi_cookie_list {} {
+    global _cgi_cookie
+
+    array names _cgi_cookie
+}
+
+proc cgi_cookie_get {args} {
+    global _cgi_cookie
+
+    set all 0
+
+    set flag [lindex $args 0]
+    if {$flag == "-all"} {
+	set args [lrange $args 1 end]
+	set all 1
+    }
+    set name [lindex $args 0]
+
+    if {$all} {
+	global _cgi_cookie_shadowed
+
+	if {[info exists _cgi_cookie_shadowed($name)]} {
+	    return [concat $_cgi_cookie($name) $_cgi_cookie_shadowed($name)]
+	} else {
+	    return [concat $_cgi_cookie($name)]
+	}
+    }
+    return $_cgi_cookie($name)
+}
+
+proc cgi_cookie_encode {in} {
+    regsub -all " " $in "+" in
+    regsub -all "%" $in "%25" in   ;# must preceed other subs that produce %
+    regsub -all ";" $in "%3B" in
+    regsub -all "," $in "%2C" in
+    regsub -all "\n" $in "%0D%0A" in
+    return $in
+}
+
+##################################################
+# table support
+##################################################
+
+proc cgi_table {args} {
+    cgi_put "<table"
+    _cgi_close_proc_push "cgi_put </table>"
+
+    if {[llength $args]} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+proc cgi_caption {args} {
+    cgi_put "<caption"
+    _cgi_close_proc_push "cgi_put </caption>"
+
+    if {[llength $args]} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+proc cgi_table_row {args} {
+    cgi_put "<tr"
+    _cgi_close_proc_push "cgi_put </tr>"
+    if {[llength $args]} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+# like table_row but without eval
+proc cgi_tr {args} {
+    cgi_put <tr
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    foreach i [lindex $args end] {
+	cgi_td $i
+    }
+    cgi_put </tr>
+}
+
+proc cgi_table_head {args} {
+    cgi_put "<th"
+    _cgi_close_proc_push "cgi_put </th>"
+
+    if {[llength $args]} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+# like table_head but without eval
+proc cgi_th {args} {
+    cgi_put "<th"
+
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">[lindex $args end]</th>"
+}
+
+proc cgi_table_data {args} {
+    cgi_put "<td"
+    _cgi_close_proc_push "cgi_put </td>"
+
+    if {[llength $args]} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+# like table_data but without eval
+proc cgi_td {args} {
+    cgi_put "<td"
+
+    if {[llength $args] > 1} {
+	cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]"
+    }
+    cgi_put ">[lindex $args end]</td>"
+}
+
+##################################################
+# stylesheets - not yet documented
+##################################################
+
+proc cgi_stylesheet {href} {
+    cgi_puts "<link rel=stylesheet href=\"$href\" type=\"text/css\"/>"
+}
+
+proc cgi_span {args} {
+    set buf "<span"
+    foreach a [lrange $args 0 [expr [llength $args]-2]] {
+	if {[regexp "style=(.*)" $a dummy str]} {
+	    append buf " style=\"$str\""
+	} elseif {[regexp "class=(.*)" $a dummy str]} {
+	    append buf " class=\"$str\""
+	} else {
+	    append buf " $a"
+	}
+    }
+    return "$buf>[lindex $args end]</span>"
+}
+
+##################################################
+# frames
+##################################################
+
+proc cgi_frameset {args} {
+    cgi_head ;# force it out, just in case none
+
+    cgi_put "<frameset"
+    _cgi_close_proc_push "cgi_puts </frameset>"
+
+    foreach a [lrange $args 0 [expr [llength $args]-2]] {
+	if {[regexp "^(rows|cols|onUnload|onLoad|onBlur)=(.*)" $a dummy attr str]} {
+	    cgi_put " $attr=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_puts ">"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+proc cgi_frame {namesrc args} {
+    cgi_put "<frame"
+
+    regexp "(\[^=]*)(=?)(.*)" $namesrc dummy name q src
+
+    if {$name != ""} {
+	cgi_put " name=\"$name\""
+    }
+
+    if {$src != ""} {
+	cgi_put " src=\"$src\""
+    }
+
+    foreach a $args {
+	if {[regexp "^(marginwidth|marginheight|scrolling|onFocus)=(.*)" $a dummy attr str]} {
+	    cgi_put " $attr=\"$str\""
+	} else {
+	    cgi_put " $a"
+	}
+    }
+    cgi_puts "/>"
+}
+
+proc cgi_noframes {args} {
+    cgi_puts "<noframes>"
+    _cgi_close_proc_push "cgi_puts </noframes>"
+    uplevel 1 [lindex $args end]
+    _cgi_close_proc
+}
+
+##################################################
+# admin support
+##################################################
+
+# mail address of the administrator
+proc cgi_admin_mail_addr {args} {
+    global _cgi
+
+    if {[llength $args]} {
+	set _cgi(admin_email) [lindex $args 0]
+    }
+    return $_cgi(admin_email)
+}
+
+##################################################
+# if possible, make each cmd available without cgi_ prefix
+##################################################
+
+if {[info tclversion] >= 7.5} {
+    foreach _cgi(old) [info procs cgi_*] {
+	regexp "^cgi_(.*)" $_cgi(old) _cgi(dummy) _cgi(new)
+	if {[llength [info commands $_cgi(new)]]} continue
+	interp alias {} $_cgi(new) {} $_cgi(old)
+    }
+} else {
+    foreach _cgi(old) [info procs cgi_*] {
+	regexp "^cgi_(.*)" $_cgi(old) _cgi(dummy) _cgi(new)
+	if {[llength [info commands $_cgi(new)]]} continue
+	proc $_cgi(new) {args} "uplevel 1 $_cgi(old) \$args"
+    }
+}
+
+##################################################
+# internal utilities
+##################################################
+
+# undo Tcl's quoting due to list protection
+# This leaves a space at the beginning if the string is non-null
+# but this is always desirable in the HTML context in which it is called
+# and the resulting HTML looks more readable.
+# (It makes the Tcl callers a little less readable - however, there aren't
+# more than a handful and they're all right here, so we'll live with it.)
+proc _cgi_list_to_string {list} {
+    set string ""
+    foreach l $list {
+	append string " $l"
+    }
+    # remove first space if possible
+    # regexp "^ ?(.*)" $string dummy string
+    return $string
+}
+
+# do lrange but return as string
+# needed for stuff like: cgi_puts "[_cgi_lrange $args ...]
+# Like _cgi_list_to_string, also returns string with initial blank if non-null
+proc _cgi_lrange {list i1 i2} {
+    _cgi_list_to_string [lrange $list $i1 $i2]
+}
+
+##################################################
+# temporary file procedures
+##################################################
+
+# set appropriate temporary file modes
+proc cgi_tmpfile_permissions {{mode ""}} {
+    global _cgi
+
+    if {[string length $mode]} {
+	set _cgi(tmpperms) $mode
+    }
+
+    return $_cgi(tmpperms)
+}
+
+##################################################
+# user-defined procedures
+##################################################
+
+# User-defined procedure called immediately after <body>
+# Good mechanism for controlling things such as if all of your pages
+# start with the same graphic or other boilerplate.
+proc app_body_start {} {}
+
+# User-defined procedure called just before </body>
+# Good place to generate signature lines, last-updated-by, etc.
+proc app_body_end {} {}
+
+proc cgi_puts {args} {
+    eval puts $args
+}
+
+# User-defined procedure to generate DOCTYPE declaration
+proc cgi_doctype {} {}
+
+##################################################
+# do some initialization
+##################################################
+
+# cgi_init initializes to a known state.
+
+proc cgi_init {} {
+    global _cgi
+    unset _cgi
+
+    # set explicitly for speed
+    set _cgi(debug) -off
+    set _cgi(buffer_nl) "\n"
+
+    cgi_name ""
+    cgi_root ""
+    cgi_body_args ""
+    cgi_file_limit 10 100000000
+
+    if {[info tclversion] >= 8.1} {
+	# set initial urlencoding
+	if { [lsearch -exact [encoding names] "utf-8"] != -1} {
+	    cgi_urlencoding "utf-8"
+	} else {
+	    cgi_urlencoding [encoding system]
+	}
+    }
+
+    # email addr of person responsible for this service
+    cgi_admin_mail_addr "root"	;# you should override this!
+
+    # most services won't have an actual email addr
+    cgi_mail_addr "CGI script - do not reply"
+}
+cgi_init
+
+# deduce tmp directory
+switch $tcl_platform(platform) {
+    unix {
+	set _cgi(tmpdir) /tmp
+	set _cgi(tmpperms)	0644
+	set _cgi(sendmail) [list /usr/lib/sendmail /usr/sbin/sendmail]
+    } macintosh {
+	set _cgi(tmpdir) [pwd]
+	set _cgi(tmpperms)	{}
+	set _cgi(sendmail) {}
+    } default {
+	set _cgi(tmpdir) [pwd]
+	catch {set _cgi(tmpdir) $env(TMP)}
+	catch {set _cgi(tmpdir) $env(TEMP)}
+	set _cgi(tmpperms)	{}
+	set _cgi(sendmail) {}
+    }
+}
+
+# regexp for matching attr=val
+set _cgi(attr,regexp) "^(\[^=]*)=(\[^\"].*)"
+
+package provide cgi 1.10.0