Wapp

# Design rules:
#
#   (1)  All identifiers in the global namespace begin with "wapp"
#
#   (2)  Indentifiers intended for internal use only begin with "wappInt"
#

# Add text to the end of the HTTP reply.  wapp and wapp-safe work the
# same.  The only difference is in how wapp-safety-check deals with these
# procs during analysis.
#
proc wapp {txt} {
  global wapp
  dict append wapp .reply $txt
}

# Add text to the page under construction.  Do no escaping on the text.

# Though occasionally necessary, the use of this interface should be minimized.
#
proc wapp-unsafe {txt} {
  global wapp
  dict append wapp .reply $txt
}


############################ Begin Deprecated Interfaces ######################
# Append text after escaping it for HTML.
#
# The following commands are the same:
#
#      wapp-escape-html TEXT
#      wapp-subst %html(TEXT)
#
proc wapp-escape-html {txt} {
  global wapp
  dict append wapp .reply [string map {& &amp; < &lt; > &gt;} $txt]
}

# Append text after escaping it for URL query parameters.
#
# The following commands are the same:
#
#      wapp-escape-url TEXT
#      wapp-subst %url(TEXT)
#
proc wapp-escape-url {txt} {
  global wapp
  dict append wapp .reply [wappInt-enc-url $txt]
}
########################### End Deprecated Interfaces #########################

# The argument should be in {...}.  Substitions of %html(...) encode ...
# escaped for safe insertion into HTML.  %url(...) substitions encode the
# argument for safe insertion into query parameters of URLs.  Backslash
# substitutions are also performed, but variable substitutions are not,
# except within %html() and %url().
#
proc wapp-subst {txt} {
  global wapp
  regsub -all {%(html|url|qp|string|unsafe)\(([^)]+)\)} $txt \
         {[wappInt-enc-\1 "\2"]} txt
  dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}

  global wapp
  regsub -all {\n\s+} [string trim $txt] \n txt
  regsub -all {%(html|url|qp|string|unsafe)\(([^)]+)\)} $txt \
         {[wappInt-enc-\1 "\2"]} txt
  dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}


# This is a helper routine for wappInt-enc-url and wappInt-enc-qp.  It returns
# an appropriate %HH encoding for the single character c.  If c is a unicode
# character, then this routine might return multiple bytes:  %HH%HH%HH
#
proc wappInt-%HHchar {c} {
  if {$c==" "} {return +}
  return [regsub -all .. [binary encode hex [encoding convertto utf-8 $c]] {%&}]

  regsub -all -- \
      {%([CDcd][A-Fa-f0-9])%([89ABab][A-Fa-f0-9])}                     \
      $str {[encoding convertfrom utf-8 [binary decode hex \1\2]]} str
  regsub -all -- {%([0-7][A-Fa-f0-9])} $str {\\u00\1} str
  return [subst -novar $str]
}

# Do URL encoding
#

# Reset the document back to an empty string.
#
proc wapp-reset {} {
  global wapp
  dict set wapp .reply {}
}

# Change the mime-type of the result document.

proc wapp-mimetype {x} {
  global wapp
  dict set wapp .mimetype $x
}

# Change the reply code.
#

# Redirect to a different web page
#
proc wapp-redirect {uri} {
  wapp-reply-code {307 Redirect}
  wapp-reply-extra Location $uri
}

# Return the value of a query parameter or environment variable.
#
proc wapp-param {name {dflt {}}} {
  global wapp
  if {![dict exists $wapp $name]} {return $dflt}
  return [dict get $wapp $name]
}

# Return the value of a query parameter or environment variable.
#
proc wapp-param-exists {name} {
  global wapp
  return [dict exists $wapp $name]
}

# Set the value of a parameter
#
proc wapp-set-param {name value} {
  global wapp
  dict set wapp $name $value
}

# Return all parameter names that match the GLOB pattern, or all

# Start up the wapp framework.  Parameters are a list passed as the
# single argument.
#
#    -server $PORT         Listen for HTTP requests on this TCP port $PORT
#
#    -scgi $PORT           Listen for SCGI requests on TCP port $PORT
#
#    -cgi                  Perform a single CGI request
#
# With no arguments, the behavior is called "auto".  In "auto" mode,
# if the GATEWAY_INTERFACE environment variable indicates CGI, then run
# as CGI.  Otherwise, start an HTTP server bound to the loopback address
# only, on an arbitrary TCP port, and automatically launch a web browser
# on that TCP port.











#
proc wapp-start {arglist} {
  global env
  set mode auto
  set port 0
  set n [llength $arglist]
  for {set i 0} {$i<$n} {incr i} {