Wapp

#!/usr/bin/make

CC = gcc -O0 -framework CoreFoundation
TCLLIB = /Users/drh/tcl/lib/libtcl8.7.a -lm -lz -lpthread -ldl
TCLINC = /Users/drh/tcl/include
TCLSH = /Users/drh/tcl/bin/tclsh8.7

all: wapptclsh

wapptclsh: wapptclsh.c
	$(CC) -I. -I$(TCLINC) -o $@ wapptclsh.c $(TCLLIB)

wapptclsh.c:	wapptclsh.c.in wapp.tcl wapptclsh.tcl tclsqlite3.c mkccode.tcl
	$(TCLSH) mkccode.tcl wapptclsh.c.in >$@

clean:	
	rm wapptclsh wapptclsh.c

Information about each HTTP request is encoded in the global ::wapp
dict variable.  The following sample program shows the information
available in ::wapp.

>
    package require wapp
    proc wapp-default {} {

      wapp-subst {<h1>Hello, World!</h1>\n}
      set B [wapp-param BASE_URL]
      wapp-subst {<p>See the <a href='%html($B)/env'>Wapp }
      wapp-subst {Environment</a></p>\n}
    }
    proc wapp-page-env {} {
      global wapp
      wapp-subst {<h1>Wapp Environment</h1>\n<pre>\n}
      foreach var [lsort [dict keys $wapp]] {

     Add _TEXT_ to the web page output currently under construction.  _TEXT_
     must not contain any TCL variable or command substitutions.

  +  **wapp-subst** _TEXT_  
     The _TEXT_ argument should be enclosed in {...} to prevent substitutions.
     The "wapp-subst" command itself will do all necessary backslash
     substitutions.  Command and variable substitutions only occur within
     "%html(...)", "%url(...)", "%qp(...)", "%string(...)", and
     "%unsafe(...)".  The substitutions are escaped (except in the case of
     "%unsafe(...)") so that the result is safe for inclusion within the
     body of an HTML document, a URL, a query parameter, or a javascript
     string literal, respectively.

  +  **wapp-mimetype** _MIMETYPE_  
     Set the MIME-type for the generated web page.  The default is "text/html".

  +  **wapp-reply-code** _CODE_
     Set the reply-code for the HTTP request.  The default is "200 Ok".

  +  **wapp-redirect** _TARGET-URL_  
     Cause an HTTP redirect to the specified URL.

  +  **wapp-reset**  
     Reset the web page under construction back to an empty string.

  +  **wapp-set-cookie** _NAME_ _VALUE_  
     Cause the cookie _NAME_ to be set to _VALUE_.

  +  **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-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_)}".


The following additional interfaces are envisioned, but are not yet

# 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 "<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\n"
  wapp-subst {<li><p><a href='%html($B)/lint'>Lint</a>\n}
  wapp-subst {<li><p><a href='%html($B)/errorout'>Deliberate error</a>\n}
  wapp-subst {<li><p><a href='%html($B)/encodings'>Encoding checks</a>\n}
  wapp-subst {<li><p><a href='%html($B)/redirect'>Redirect to env</a>\n}
  set x "%string(...)"
  set v abc'def\"ghi\\jkl
  wapp-subst {<li>%html($x) substitution test: "%string($v)"\n}
  wapp "</ol>"
  if {[dict exists $wapp showenv]} {
    wapp-page-env
  }
}
proc wapp-page-redirect {} {
  wapp-redirect env
}
proc wapp-page-env {} {
  global wapp
  wapp-set-cookie env-cookie simple
  wapp "<h1>Wapp Environment</h1>\n"
  wapp-unsafe "<form method='GET' action='[wapp-param SELF_URL]'>\n"
  wapp "<input type='checkbox' name='showhdr'"
  if {[dict exists $wapp showhdr]} {
    wapp " checked"
  }
  wapp "> Show Header\n"
  wapp "<input type='submit' value='Go'>\n"
  wapp "</form>"
  wapp "<pre>\n"
  foreach var [lsort [dict keys $wapp]] {
    if {[string index $var 0]=="." &&
         ($var!=".header" || ![dict exists $wapp showhdr])} continue
    wapp-escape-html "$var = [list [dict get $wapp $var]]\n"
  }
  wapp "</pre>"
  wapp-unsafe "<p><a href='[wapp-param BASE_URL]/'>Home</a></p>\n"
}
proc wapp-page-fullenv {} {
  global wapp
  wapp-set-cookie env-cookie full
  wapp "<h1>Wapp Full Environment</h1>\n"
  wapp-unsafe "<form method='POST' action='[wapp-param SELF_URL]'>\n"
  wapp "<input type='checkbox' name='var1'"
  if {[dict exists $wapp showhdr]} {
    wapp " checked"
  }
  wapp "> Var1\n"
  wapp "<input type='submit' name='s1' value='Go'>\n"
  wapp "<input type='hidden' name='hidden-parameter-1' "

# 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]]
}

# There must be a wappInt-enc-NAME routine for each possible substitution
# in wapp-subst.  Thus there are routines for "html", "url", "qp", and "unsafe".
#
#    wappInt-enc-html           Escape text so that it is safe to use in the
#                               body of an HTML document.
#
#    wappInt-enc-url            Escape text so that it is safe to pass as an
#                               argument to href= and src= attributes in HTML.
#
#    wappInt-enc-qp             Escape text so that it is safe to use as the
#                               value of a query parameter in a URL or in
#                               post data or in a cookie.
#
#    wappInt-enc-string         Escape ", ', and \ for using inside of a
#                               javascript string literal.
#
#    wappInt-enc-unsafe         Perform no encoding at all.  Unsafe.
#
proc wappInt-enc-html {txt} {
  return [string map {& &amp; < &lt; > &gt;} $txt]
}
proc wappInt-enc-unsafe {txt} {

    set s [subst -novar -noback $s]
  }
  if {[regsub -all {[{}]} $s {[wappInt-%HHchar \\&]} s]} {
    set s [subst -novar -noback $s]
  }
  return $s
}
proc wappInt-enc-string {s} {
  return [string map {\\ \\\\ \" \\\" ' \\'} $s]
}

# 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 +}

# Redirect to a different web page
#
proc wapp-redirect {uri} {
  wapp-reply-code {302 found}
  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]
}

# Examine the bodys of all procedures in this program looking for
# unsafe calls to "wapp".  Return a text string containing warnings.
# Return an empty string if all is ok.
#
# This routine is advisory only.  It misses some constructs that are
# dangerous and flags others that are safe.