Wapp

     Set _POLICY_ to "off" to completely disable the CSP mechanism.  Or
     specify some other policy suitable for the needs of the application.

  +  **wapp-debug-env**  
     This routine returns text that describes all of the Wapp parameters.
     Use it to get a parameter dump for troubleshooting purposes.

  +  **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.

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.

     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-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_  

    regsub {^\$HOME\y} $path $HOME path
    set in2 [open $path rb]
    puts "/* INCLUDE $path */"
    if {$instr} {
      while {1} {
        set line [gets $in2]
        if {[eof $in2]} break
        if {[regexp {^\s*#} $line]} {
          set x [string map {*/ *\\057} $line]
          puts "/* $x */"
        } else {
          set x [string map "\\\\ \\\\\\\\ \\\" \\\\\"" $line]
          puts "\"$x\\n\""
        }
      }
    } else {
      puts [read $in2]
    }
    puts "/* END $path */"
    close $in2
    continue

  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"
  }
  # Deliberately unsafe calls to wapp-subst and wapp-trim, added here
  # to test wapp-safety-check
  #
  wapp-subst "> Var1\n"
  wapp-trim "<input type='submit' name='s1' value='Go'>\n"
  wapp "<input type='hidden' name='hidden-parameter-1' "
  wapp "value='the long value / of ?$ hidden-1..<hi>'>\n"
  wapp "</form>"
  wapp "<pre>\n"
  foreach var [lsort [dict keys $wapp]] {
    if {$var==".reply"} continue
    wapp-escape-html "$var = [list [dict get $wapp $var]]\n\n"

  }
  wapp-subst {</table>}
}
# Deliberately generate an error to test error handling.
proc wapp-page-errorout {} {
  wapp "<h1>Intentially generate an error</h1>\n"
  wapp "<p>This test should be ignored by the error handler\n"
  # The following line deliberately throws an error to test the
  # error recovering logic within Wapp
  wapp $noSuchVariable
  wapp "This is a $test of wapp-safety-check"
  wapp "This is another [test of] wapp-safety-check"
  wapp "<p>After the error\n"
}
proc wapp-page-csptest {} {
  wapp-allow-xorigin-params
  if {[wapp-param-exists csp]} {
    wapp-content-security-policy [wapp-param csp]
  }

# 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 "unsafe" in general, there are uses for this kind of thing.
# For example, if you want to return the complete, unmodified content of
# a file:
#
#         set fd [open content.html rb]
#         wapp-unsafe [read $fd]
#         close $fd
#
# You could do the same thing using ordinary "wapp" instead of "wapp-unsafe".
# The difference is that wapp-safety-check will complain about the misuse
# of "wapp", but it assumes that the person who write "wapp-unsafe" understands
# the risks.
#
# 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)
#

    dict unset wapp .csp
  } else {
    dict set wapp .csp $val
  }
}

# Examine the bodys of all procedures in this program looking for
# unsafe calls to various Wapp interfaces.  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.
#
proc wapp-safety-check {} {
  set res {}
  foreach p [info procs] {
    set ln 0
    foreach x [split [info body $p] \n] {
      incr ln
      if {[regexp {^[ \t]*wapp[ \t]+([^\n]+)} $x all tail]
       && [string index $tail 0]!="\173"
       && [regexp {[[$]} $tail]
      } {
        append res "$p:$ln: unsafe \"wapp\" call: \"[string trim $x]\"\n"
      }
      if {[regexp {^[ \t]*wapp-(subst|trim)[ \t]+[^\173]} $x all cx]} {
        append res "$p:$ln: unsafe \"wapp-$cx\" call: \"[string trim $x]\"\n"
      }
    }
  }
  return $res
}

# Return a string that descripts the current environment.  Applications

      -trace {
        proc wappInt-trace {} {
          set q [wapp-param QUERY_STRING]
          set uri [wapp-param BASE_URL][wapp-param PATH_INFO]
          if {$q!=""} {append uri ?$q}
          puts $uri
        }
      }
      -lint {
        set res [wapp-safety-check]
        if {$res!=""} {
          puts "Potential problems in this code:"
          puts $res
          exit 1
        } else {
          exit
        }
      }
      -D*=* {
        if {[regexp {^.D([^=]+)=(.*)$} $term all var val]} {
          set ::$var $val
        }
      }
      default {