Wapp

  +  **wapp-clear-cookie** _NAME_  
     Erase the cookie _NAME_.

  +  **wapp-safety-check**  
     Examine all TCL procedures in the application and report errors about
     unsafe usage of "wapp".

  +  **wapp-cache-control** _CONTROL_  





     The _CONTROL_ argument should be one of "no-cache", "max-age=N", or




     "private,max-age=N", where N is an integer number of seconds.








The following additional interfaces are envisioned, but are not yet
implemented:

  +  **wapp-send-hex** _HEX_  
     Cause the HTTP reply to be binary that is constructed from the
     hexadecimal text in the _HEX_ argument.  Whitespace in _HEX_ is ignored.
     This command is useful for returning small images from a pure script
     input.  The "wapp-file-to-hex" command can be used at development time
     to generate appropriate _HEX_ for an image file.





  +  **wapp-etag** _ETAG_  
     Set the expiration tag for the web page.

  +  **wapp-send-file** _FILENAME_  
     Make the content of the file _FILENAME_ be the HTTP reply.

  +  **wapp-send-query** _DB_ _SQL_  

  +  **wapp-debug-port** _PORT_  
     For debugging use only: open a listening TCP socket on _PORT_ and run
     an interactive TCL shell on connections to that port.  This allows for
     interactive debugging of a running instance of the Wapp server.  This
     command is a no-op for short-lived CGI programs, obviously.  Also, this
     command should only be used during debugging, as otherwise it introduces
     a severe security vulnerability into the application.

The following interfaces are deprecated.  They currently exist for
compatibility but might disappear at any moment.

  +  **wapp-unsafe** _TEXT_  
     Add _TEXT_ to the web page under construction even though _TEXT_ does
     contain TCL variable and command substitutions.  The application developer
     must ensure that the variable and command substitutions does not allow
     XSS attacks.  Avoid using this command.  The use of "wapp-subst" is 
     preferred in most situations.

  +  **wapp-escape-html** _TEXT_  
     Add _TEXT_ to the web page under construction after first escaping any
     HTML markup contained with _TEXT_.  This command is equivalent to
     "wapp-subst {%html(_TEXT_)}".


  +  **wapp-escape-url** _TEXT_  
     Add _TEXT_ to the web page under construction after first escaping any
     characters so that the result is safe to include as the value of a
     query parameter on a URL.  This command is equivalent to
     "wapp-subst {%url(_TEXT_)}".

6.0 Limitations
---------------

Each Wapp process is single-threaded.
The fileevent command is used to allow accepting multiple simultaneous
HTTP requests.  However, as soon as a complete request is received, and

# Invoke as "tclsh test01.tcl" and then surf the website that pops up
# to verify the logic in wapp.
#
source wapp.tcl
proc wapp-default {} {
  global wapp
  set B [wapp-param BASE_URL]
  set R [wapp-param SCRIPT_NAME]
  wapp-cache-control max-age=15
  wapp "<h1>Hello, World!</h1>\n"
  wapp "<ol>"
  wapp-unsafe "<li><p><a href='$R/env'>Wapp Environment</a></p>\n"
  wapp-subst {<li><p><a href='%html($B)/fullenv'>Full Environment</a>\n}
  set crazy [lsort [dict keys $wapp]]
  wapp-subst {<li><p><a href='%html($B)/env?keys=%url($crazy)'>}
  wapp "Environment with crazy URL</a>\n"

# Add extra entries to the reply header
#
proc wapp-reply-extra {name value} {
  global wapp
  dict lappend wapp .reply-extra $name $value
}

# Specifies how the web-page under construction should be cached.
# The argument should be one of:
#
#    no-cache
#    max-age=N             (for some integer number of seconds, N)
#    private,max-age=N
#
proc wapp-cache-control {x} {
  wapp-reply-extra Cache-Control $x
}

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

  }

  # Transmit the HTTP reply
  #
  if {$chan=="stdout"} {
    puts $chan "Status: [dict get $wapp .reply-code]\r"
  } else {
    puts $chan "HTTP/1.1 [dict get $wapp .reply-code]\r"
    puts $chan "Server: wapp\r"
    puts $chan "Content-Length: [string length [dict get $wapp .reply]]\r"
    puts $chan "Connection: close\r"
  }
  if {[dict exists $wapp .reply-extra]} {
    foreach {name value} [dict get $wapp .reply-extra] {
      puts $chan "$name: $value\r"
    }
  }
  set mimetype [dict get $wapp .mimetype]