/ Hex Artifact Content
Login
SQLite training in Houston TX on 2019-11-05 (details)
Part of the 2019 Tcl Conference

Artifact b440cd8cf57953d3a49e7ee81e6a18f18efdaf113b69f7d8482b0710a64566ec:


0000: 23 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 20  # Copyright (c) 
0010: 32 30 31 37 20 44 2e 20 52 69 63 68 61 72 64 20  2017 D. Richard 
0020: 48 69 70 70 0a 23 20 0a 23 20 54 68 69 73 20 70  Hipp.# .# This p
0030: 72 6f 67 72 61 6d 20 69 73 20 66 72 65 65 20 73  rogram is free s
0040: 6f 66 74 77 61 72 65 3b 20 79 6f 75 20 63 61 6e  oftware; you can
0050: 20 72 65 64 69 73 74 72 69 62 75 74 65 20 69 74   redistribute it
0060: 20 61 6e 64 2f 6f 72 0a 23 20 6d 6f 64 69 66 79   and/or.# modify
0070: 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 65   it under the te
0080: 72 6d 73 20 6f 66 20 74 68 65 20 53 69 6d 70 6c  rms of the Simpl
0090: 69 66 69 65 64 20 42 53 44 20 4c 69 63 65 6e 73  ified BSD Licens
00a0: 65 20 28 61 6c 73 6f 0a 23 20 6b 6e 6f 77 6e 20  e (also.# known 
00b0: 61 73 20 74 68 65 20 22 32 2d 43 6c 61 75 73 65  as the "2-Clause
00c0: 20 4c 69 63 65 6e 73 65 22 20 6f 72 20 22 46 72   License" or "Fr
00d0: 65 65 42 53 44 20 4c 69 63 65 6e 73 65 22 2e 29  eeBSD License".)
00e0: 0a 23 0a 23 20 54 68 69 73 20 70 72 6f 67 72 61  .#.# This progra
00f0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64  m is distributed
0100: 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61   in the hope tha
0110: 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65  t it will be use
0120: 66 75 6c 2c 0a 23 20 62 75 74 20 77 69 74 68 6f  ful,.# but witho
0130: 75 74 20 61 6e 79 20 77 61 72 72 61 6e 74 79 3b  ut any warranty;
0140: 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68   without even th
0150: 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 61 6e  e implied warran
0160: 74 79 20 6f 66 0a 23 20 6d 65 72 63 68 61 6e 74  ty of.# merchant
0170: 61 62 69 6c 69 74 79 20 6f 72 20 66 69 74 6e 65  ability or fitne
0180: 73 73 20 66 6f 72 20 61 20 70 61 72 74 69 63 75  ss for a particu
0190: 6c 61 72 20 70 75 72 70 6f 73 65 2e 0a 23 0a 23  lar purpose..#.#
01a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
01b0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
01c0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
01d0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
01e0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 23 0a 23 20  -----------.#.# 
01f0: 44 65 73 69 67 6e 20 72 75 6c 65 73 3a 0a 23 0a  Design rules:.#.
0200: 23 20 20 20 28 31 29 20 20 41 6c 6c 20 69 64 65  #   (1)  All ide
0210: 6e 74 69 66 69 65 72 73 20 69 6e 20 74 68 65 20  ntifiers in the 
0220: 67 6c 6f 62 61 6c 20 6e 61 6d 65 73 70 61 63 65  global namespace
0230: 20 62 65 67 69 6e 20 77 69 74 68 20 22 77 61 70   begin with "wap
0240: 70 22 0a 23 0a 23 20 20 20 28 32 29 20 20 49 6e  p".#.#   (2)  In
0250: 64 65 6e 74 69 66 69 65 72 73 20 69 6e 74 65 6e  dentifiers inten
0260: 64 65 64 20 66 6f 72 20 69 6e 74 65 72 6e 61 6c  ded for internal
0270: 20 75 73 65 20 6f 6e 6c 79 20 62 65 67 69 6e 20   use only begin 
0280: 77 69 74 68 20 22 77 61 70 70 49 6e 74 22 0a 23  with "wappInt".#
0290: 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65  .package require
02a0: 20 54 63 6c 20 38 2e 36 0a 0a 23 20 41 64 64 20   Tcl 8.6..# Add 
02b0: 74 65 78 74 20 74 6f 20 74 68 65 20 65 6e 64 20  text to the end 
02c0: 6f 66 20 74 68 65 20 48 54 54 50 20 72 65 70 6c  of the HTTP repl
02d0: 79 2e 20 20 4e 6f 20 69 6e 74 65 72 70 72 65 74  y.  No interpret
02e0: 61 74 69 6f 6e 20 6f 72 20 74 72 61 6e 73 66 6f  ation or transfo
02f0: 72 6d 61 74 69 6f 6e 0a 23 20 6f 66 20 74 68 65  rmation.# of the
0300: 20 74 65 78 74 20 69 73 20 70 65 72 66 6f 72 6d   text is perform
0310: 73 2e 20 20 54 68 65 20 61 72 67 75 6d 65 6e 74  s.  The argument
0320: 20 73 68 6f 75 6c 64 20 62 65 20 65 6e 63 6c 6f   should be enclo
0330: 73 65 64 20 77 69 74 68 69 6e 20 7b 2e 2e 2e 7d  sed within {...}
0340: 0a 23 0a 70 72 6f 63 20 77 61 70 70 20 7b 74 78  .#.proc wapp {tx
0350: 74 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 77 61  t} {.  global wa
0360: 70 70 0a 20 20 64 69 63 74 20 61 70 70 65 6e 64  pp.  dict append
0370: 20 77 61 70 70 20 2e 72 65 70 6c 79 20 24 74 78   wapp .reply $tx
0380: 74 0a 7d 0a 0a 23 20 41 64 64 20 74 65 78 74 20  t.}..# Add text 
0390: 74 6f 20 74 68 65 20 70 61 67 65 20 75 6e 64 65  to the page unde
03a0: 72 20 63 6f 6e 73 74 72 75 63 74 69 6f 6e 2e 20  r construction. 
03b0: 20 44 6f 20 6e 6f 20 65 73 63 61 70 69 6e 67 20   Do no escaping 
03c0: 6f 6e 20 74 68 65 20 74 65 78 74 2e 0a 23 0a 23  on the text..#.#
03d0: 20 54 68 6f 75 67 68 20 22 75 6e 73 61 66 65 22   Though "unsafe"
03e0: 20 69 6e 20 67 65 6e 65 72 61 6c 2c 20 74 68 65   in general, the
03f0: 72 65 20 61 72 65 20 75 73 65 73 20 66 6f 72 20  re are uses for 
0400: 74 68 69 73 20 6b 69 6e 64 20 6f 66 20 74 68 69  this kind of thi
0410: 6e 67 2e 0a 23 20 46 6f 72 20 65 78 61 6d 70 6c  ng..# For exampl
0420: 65 2c 20 69 66 20 79 6f 75 20 77 61 6e 74 20 74  e, if you want t
0430: 6f 20 72 65 74 75 72 6e 20 74 68 65 20 63 6f 6d  o return the com
0440: 70 6c 65 74 65 2c 20 75 6e 6d 6f 64 69 66 69 65  plete, unmodifie
0450: 64 20 63 6f 6e 74 65 6e 74 20 6f 66 0a 23 20 61  d content of.# a
0460: 20 66 69 6c 65 3a 0a 23 0a 23 20 20 20 20 20 20   file:.#.#      
0470: 20 20 20 73 65 74 20 66 64 20 5b 6f 70 65 6e 20     set fd [open 
0480: 63 6f 6e 74 65 6e 74 2e 68 74 6d 6c 20 72 62 5d  content.html rb]
0490: 0a 23 20 20 20 20 20 20 20 20 20 77 61 70 70 2d  .#         wapp-
04a0: 75 6e 73 61 66 65 20 5b 72 65 61 64 20 24 66 64  unsafe [read $fd
04b0: 5d 0a 23 20 20 20 20 20 20 20 20 20 63 6c 6f 73  ].#         clos
04c0: 65 20 24 66 64 0a 23 0a 23 20 59 6f 75 20 63 6f  e $fd.#.# You co
04d0: 75 6c 64 20 64 6f 20 74 68 65 20 73 61 6d 65 20  uld do the same 
04e0: 74 68 69 6e 67 20 75 73 69 6e 67 20 6f 72 64 69  thing using ordi
04f0: 6e 61 72 79 20 22 77 61 70 70 22 20 69 6e 73 74  nary "wapp" inst
0500: 65 61 64 20 6f 66 20 22 77 61 70 70 2d 75 6e 73  ead of "wapp-uns
0510: 61 66 65 22 2e 0a 23 20 54 68 65 20 64 69 66 66  afe"..# The diff
0520: 65 72 65 6e 63 65 20 69 73 20 74 68 61 74 20 77  erence is that w
0530: 61 70 70 2d 73 61 66 65 74 79 2d 63 68 65 63 6b  app-safety-check
0540: 20 77 69 6c 6c 20 63 6f 6d 70 6c 61 69 6e 20 61   will complain a
0550: 62 6f 75 74 20 74 68 65 20 6d 69 73 75 73 65 0a  bout the misuse.
0560: 23 20 6f 66 20 22 77 61 70 70 22 2c 20 62 75 74  # of "wapp", but
0570: 20 69 74 20 61 73 73 75 6d 65 73 20 74 68 61 74   it assumes that
0580: 20 74 68 65 20 70 65 72 73 6f 6e 20 77 68 6f 20   the person who 
0590: 77 72 69 74 65 20 22 77 61 70 70 2d 75 6e 73 61  write "wapp-unsa
05a0: 66 65 22 20 75 6e 64 65 72 73 74 61 6e 64 73 0a  fe" understands.
05b0: 23 20 74 68 65 20 72 69 73 6b 73 2e 0a 23 0a 23  # the risks..#.#
05c0: 20 54 68 6f 75 67 68 20 6f 63 63 61 73 69 6f 6e   Though occasion
05d0: 61 6c 6c 79 20 6e 65 63 65 73 73 61 72 79 2c 20  ally necessary, 
05e0: 74 68 65 20 75 73 65 20 6f 66 20 74 68 69 73 20  the use of this 
05f0: 69 6e 74 65 72 66 61 63 65 20 73 68 6f 75 6c 64  interface should
0600: 20 62 65 20 6d 69 6e 69 6d 69 7a 65 64 2e 0a 23   be minimized..#
0610: 0a 70 72 6f 63 20 77 61 70 70 2d 75 6e 73 61 66  .proc wapp-unsaf
0620: 65 20 7b 74 78 74 7d 20 7b 0a 20 20 67 6c 6f 62  e {txt} {.  glob
0630: 61 6c 20 77 61 70 70 0a 20 20 64 69 63 74 20 61  al wapp.  dict a
0640: 70 70 65 6e 64 20 77 61 70 70 20 2e 72 65 70 6c  ppend wapp .repl
0650: 79 20 24 74 78 74 0a 7d 0a 0a 23 20 41 64 64 20  y $txt.}..# Add 
0660: 74 65 78 74 20 74 6f 20 74 68 65 20 65 6e 64 20  text to the end 
0670: 6f 66 20 74 68 65 20 72 65 70 6c 79 20 75 6e 64  of the reply und
0680: 65 72 20 63 6f 6e 73 74 72 75 63 74 69 6f 6e 2e  er construction.
0690: 20 20 54 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 0a    The following.
06a0: 23 20 73 75 62 73 74 69 74 75 74 69 6f 6e 73 20  # substitutions 
06b0: 61 72 65 20 6d 61 64 65 3a 0a 23 0a 23 20 20 20  are made:.#.#   
06c0: 20 20 25 68 74 6d 6c 28 2e 2e 2e 29 20 20 20 20    %html(...)    
06d0: 20 20 20 20 20 20 45 73 63 61 70 65 20 74 65 78        Escape tex
06e0: 74 20 66 6f 72 20 69 6e 63 6c 75 73 69 6f 6e 20  t for inclusion 
06f0: 69 6e 20 48 54 4d 4c 0a 23 20 20 20 20 20 25 75  in HTML.#     %u
0700: 72 6c 28 2e 2e 2e 29 20 20 20 20 20 20 20 20 20  rl(...)         
0710: 20 20 45 73 63 61 70 65 20 74 65 78 74 20 66 6f    Escape text fo
0720: 72 20 75 73 65 20 61 73 20 61 20 55 52 4c 0a 23  r use as a URL.#
0730: 20 20 20 20 20 25 71 70 28 2e 2e 2e 29 20 20 20       %qp(...)   
0740: 20 20 20 20 20 20 20 20 20 45 73 63 61 70 65 20           Escape 
0750: 74 65 78 74 20 66 6f 72 20 75 73 65 20 61 73 20  text for use as 
0760: 61 20 55 52 49 20 71 75 65 72 79 20 70 61 72 61  a URI query para
0770: 6d 65 74 65 72 0a 23 20 20 20 20 20 25 73 74 72  meter.#     %str
0780: 69 6e 67 28 2e 2e 2e 29 20 20 20 20 20 20 20 20  ing(...)        
0790: 45 73 63 61 70 65 20 74 65 78 74 20 66 6f 72 20  Escape text for 
07a0: 75 73 65 20 77 69 74 68 69 6e 20 61 20 4a 53 4f  use within a JSO
07b0: 4e 20 73 74 72 69 6e 67 0a 23 20 20 20 20 20 25  N string.#     %
07c0: 75 6e 73 61 66 65 28 2e 2e 2e 29 20 20 20 20 20  unsafe(...)     
07d0: 20 20 20 4e 6f 20 74 72 61 6e 73 66 6f 72 6d 61     No transforma
07e0: 74 69 6f 6e 73 20 6f 66 20 74 68 65 20 74 65 78  tions of the tex
07f0: 74 0a 23 0a 23 20 54 68 65 20 73 75 62 73 74 69  t.#.# The substi
0800: 74 75 74 69 6f 6e 73 20 61 62 6f 76 65 20 74 65  tutions above te
0810: 72 6d 69 6e 61 74 65 20 61 74 20 74 68 65 20 66  rminate at the f
0820: 69 72 73 74 20 22 29 22 20 63 68 61 72 61 63 74  irst ")" charact
0830: 65 72 2e 20 20 49 66 20 74 68 65 0a 23 20 74 65  er.  If the.# te
0840: 78 74 20 6f 66 20 74 68 65 20 54 43 4c 20 73 74  xt of the TCL st
0850: 72 69 6e 67 20 69 6e 20 2e 2e 2e 20 63 6f 6e 74  ring in ... cont
0860: 61 69 6e 73 20 22 29 22 20 63 68 61 72 61 63 74  ains ")" charact
0870: 65 72 73 20 69 74 73 65 6c 66 2c 20 75 73 65 20  ers itself, use 
0880: 69 6e 73 74 65 61 64 3a 0a 23 0a 23 20 20 20 20  instead:.#.#    
0890: 20 25 68 74 6d 6c 25 28 2e 2e 2e 29 25 0a 23 20   %html%(...)%.# 
08a0: 20 20 20 20 25 75 72 6c 25 28 2e 2e 2e 29 25 0a      %url%(...)%.
08b0: 23 20 20 20 20 20 25 71 70 25 28 2e 2e 2e 29 25  #     %qp%(...)%
08c0: 0a 23 20 20 20 20 20 25 73 74 72 69 6e 67 25 28  .#     %string%(
08d0: 2e 2e 2e 29 25 0a 23 20 20 20 20 20 25 75 6e 73  ...)%.#     %uns
08e0: 61 66 65 25 28 2e 2e 2e 29 25 0a 23 0a 23 20 49  afe%(...)%.#.# I
08f0: 6e 20 6f 74 68 65 72 20 77 6f 72 64 73 2c 20 75  n other words, u
0900: 73 65 20 22 25 28 2e 2e 2e 29 25 22 20 69 6e 73  se "%(...)%" ins
0910: 74 65 61 64 20 6f 66 20 22 28 2e 2e 2e 29 22 20  tead of "(...)" 
0920: 74 6f 20 69 6e 63 6c 75 64 65 20 74 68 65 20 54  to include the T
0930: 43 4c 20 73 74 72 69 6e 67 0a 23 20 74 6f 20 73  CL string.# to s
0940: 75 62 73 74 69 74 75 74 65 2e 0a 23 0a 23 20 54  ubstitute..#.# T
0950: 68 65 20 25 75 6e 73 61 66 65 20 73 75 62 73 74  he %unsafe subst
0960: 69 74 75 74 69 6f 6e 20 73 68 6f 75 6c 64 20 62  itution should b
0970: 65 20 61 76 6f 69 64 65 64 20 77 68 65 6e 65 76  e avoided whenev
0980: 65 72 20 70 6f 73 73 69 62 6c 65 2c 20 6f 62 76  er possible, obv
0990: 69 6f 75 73 6c 79 2e 0a 23 20 49 6e 20 61 64 64  iously..# In add
09a0: 69 74 69 6f 6e 20 74 6f 20 74 68 65 20 73 75 62  ition to the sub
09b0: 73 74 69 74 75 74 69 6f 6e 73 20 61 62 6f 76 65  stitutions above
09c0: 2c 20 74 68 65 20 74 65 78 74 20 61 6c 73 6f 20  , the text also 
09d0: 64 6f 65 73 20 62 61 63 6b 73 6c 61 73 68 0a 23  does backslash.#
09e0: 20 65 73 63 61 70 65 73 2e 0a 23 0a 23 20 54 68   escapes..#.# Th
09f0: 65 20 77 61 70 70 2d 74 72 69 6d 20 70 72 6f 63  e wapp-trim proc
0a00: 20 77 6f 72 6b 73 20 74 68 65 20 73 61 6d 65 20   works the same 
0a10: 61 73 20 77 61 70 70 2d 73 75 62 73 74 20 65 78  as wapp-subst ex
0a20: 63 65 70 74 20 74 68 61 74 20 69 74 20 61 6c 73  cept that it als
0a30: 6f 20 72 65 6d 6f 76 65 73 0a 23 20 77 68 69 74  o removes.# whit
0a40: 65 73 70 61 63 65 20 66 72 6f 6d 20 74 68 65 20  espace from the 
0a50: 6c 65 66 74 20 6d 61 72 67 69 6e 2c 20 73 6f 20  left margin, so 
0a60: 74 68 61 74 20 74 68 65 20 67 65 6e 65 72 61 74  that the generat
0a70: 65 64 20 48 54 4d 4c 2f 43 53 53 2f 4a 61 76 61  ed HTML/CSS/Java
0a80: 73 63 72 69 70 74 0a 23 20 64 6f 65 73 20 6e 6f  script.# does no
0a90: 74 20 61 70 70 65 61 72 20 74 6f 20 62 65 20 69  t appear to be i
0aa0: 6e 64 65 6e 74 65 64 20 77 68 65 6e 20 64 65 6c  ndented when del
0ab0: 69 76 65 72 65 64 20 74 6f 20 74 68 65 20 63 6c  ivered to the cl
0ac0: 69 65 6e 74 20 77 65 62 20 62 72 6f 77 73 65 72  ient web browser
0ad0: 2e 0a 23 0a 69 66 20 7b 24 74 63 6c 5f 76 65 72  ..#.if {$tcl_ver
0ae0: 73 69 6f 6e 3e 3d 38 2e 37 7d 20 7b 0a 20 20 70  sion>=8.7} {.  p
0af0: 72 6f 63 20 77 61 70 70 2d 73 75 62 73 74 20 7b  roc wapp-subst {
0b00: 74 78 74 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61  txt} {.    globa
0b10: 6c 20 77 61 70 70 0a 20 20 20 20 72 65 67 73 75  l wapp.    regsu
0b20: 62 20 2d 61 6c 6c 20 2d 63 6f 6d 6d 61 6e 64 20  b -all -command 
0b30: 5c 0a 20 20 20 20 20 20 20 7b 25 28 68 74 6d 6c  \.       {%(html
0b40: 7c 75 72 6c 7c 71 70 7c 73 74 72 69 6e 67 7c 75  |url|qp|string|u
0b50: 6e 73 61 66 65 29 7b 31 2c 31 7d 3f 28 7c 25 29  nsafe){1,1}?(|%)
0b60: 5c 28 28 2e 2b 29 5c 29 5c 32 7d 20 24 74 78 74  \((.+)\)\2} $txt
0b70: 20 77 61 70 70 49 6e 74 2d 65 6e 63 20 74 78 74   wappInt-enc txt
0b80: 0a 20 20 20 20 64 69 63 74 20 61 70 70 65 6e 64  .    dict append
0b90: 20 77 61 70 70 20 2e 72 65 70 6c 79 20 5b 73 75   wapp .reply [su
0ba0: 62 73 74 20 2d 6e 6f 76 61 72 69 61 62 6c 65 73  bst -novariables
0bb0: 20 2d 6e 6f 63 6f 6d 6d 61 6e 64 20 24 74 78 74   -nocommand $txt
0bc0: 5d 0a 20 20 7d 0a 20 20 70 72 6f 63 20 77 61 70  ].  }.  proc wap
0bd0: 70 2d 74 72 69 6d 20 7b 74 78 74 7d 20 7b 0a 20  p-trim {txt} {. 
0be0: 20 20 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20     global wapp. 
0bf0: 20 20 20 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b     regsub -all {
0c00: 5c 6e 5c 73 2b 7d 20 5b 73 74 72 69 6e 67 20 74  \n\s+} [string t
0c10: 72 69 6d 20 24 74 78 74 5d 20 5c 6e 20 74 78 74  rim $txt] \n txt
0c20: 0a 20 20 20 20 72 65 67 73 75 62 20 2d 61 6c 6c  .    regsub -all
0c30: 20 2d 63 6f 6d 6d 61 6e 64 20 5c 0a 20 20 20 20   -command \.    
0c40: 20 20 20 7b 25 28 68 74 6d 6c 7c 75 72 6c 7c 71     {%(html|url|q
0c50: 70 7c 73 74 72 69 6e 67 7c 75 6e 73 61 66 65 29  p|string|unsafe)
0c60: 7b 31 2c 31 7d 3f 28 7c 25 29 5c 28 28 2e 2b 29  {1,1}?(|%)\((.+)
0c70: 5c 29 5c 32 7d 20 24 74 78 74 20 77 61 70 70 49  \)\2} $txt wappI
0c80: 6e 74 2d 65 6e 63 20 74 78 74 0a 20 20 20 20 64  nt-enc txt.    d
0c90: 69 63 74 20 61 70 70 65 6e 64 20 77 61 70 70 20  ict append wapp 
0ca0: 2e 72 65 70 6c 79 20 5b 73 75 62 73 74 20 2d 6e  .reply [subst -n
0cb0: 6f 76 61 72 69 61 62 6c 65 73 20 2d 6e 6f 63 6f  ovariables -noco
0cc0: 6d 6d 61 6e 64 20 24 74 78 74 5d 0a 20 20 7d 0a  mmand $txt].  }.
0cd0: 20 20 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 65    proc wappInt-e
0ce0: 6e 63 20 7b 61 6c 6c 20 6d 6f 64 65 20 6e 75 31  nc {all mode nu1
0cf0: 20 74 78 74 7d 20 7b 0a 20 20 20 20 72 65 74 75   txt} {.    retu
0d00: 72 6e 20 5b 75 70 6c 65 76 65 6c 20 32 20 22 77  rn [uplevel 2 "w
0d10: 61 70 70 49 6e 74 2d 65 6e 63 2d 24 6d 6f 64 65  appInt-enc-$mode
0d20: 20 5c 22 24 74 78 74 5c 22 22 5d 0a 20 20 7d 0a   \"$txt\""].  }.
0d30: 7d 20 65 6c 73 65 20 7b 0a 20 20 70 72 6f 63 20  } else {.  proc 
0d40: 77 61 70 70 2d 73 75 62 73 74 20 7b 74 78 74 7d  wapp-subst {txt}
0d50: 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 77 61   {.    global wa
0d60: 70 70 0a 20 20 20 20 72 65 67 73 75 62 20 2d 61  pp.    regsub -a
0d70: 6c 6c 20 7b 25 28 68 74 6d 6c 7c 75 72 6c 7c 71  ll {%(html|url|q
0d80: 70 7c 73 74 72 69 6e 67 7c 75 6e 73 61 66 65 29  p|string|unsafe)
0d90: 7b 31 2c 31 7d 3f 28 7c 25 29 5c 28 28 2e 2b 29  {1,1}?(|%)\((.+)
0da0: 5c 29 5c 32 7d 20 24 74 78 74 20 5c 0a 20 20 20  \)\2} $txt \.   
0db0: 20 20 20 20 20 20 20 20 7b 5b 77 61 70 70 49 6e          {[wappIn
0dc0: 74 2d 65 6e 63 2d 5c 31 20 22 5c 33 22 5d 7d 20  t-enc-\1 "\3"]} 
0dd0: 74 78 74 0a 20 20 20 20 64 69 63 74 20 61 70 70  txt.    dict app
0de0: 65 6e 64 20 77 61 70 70 20 2e 72 65 70 6c 79 20  end wapp .reply 
0df0: 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74  [uplevel 1 [list
0e00: 20 73 75 62 73 74 20 2d 6e 6f 76 61 72 69 61 62   subst -novariab
0e10: 6c 65 73 20 24 74 78 74 5d 5d 0a 20 20 7d 0a 20  les $txt]].  }. 
0e20: 20 70 72 6f 63 20 77 61 70 70 2d 74 72 69 6d 20   proc wapp-trim 
0e30: 7b 74 78 74 7d 20 7b 0a 20 20 20 20 67 6c 6f 62  {txt} {.    glob
0e40: 61 6c 20 77 61 70 70 0a 20 20 20 20 72 65 67 73  al wapp.    regs
0e50: 75 62 20 2d 61 6c 6c 20 7b 5c 6e 5c 73 2b 7d 20  ub -all {\n\s+} 
0e60: 5b 73 74 72 69 6e 67 20 74 72 69 6d 20 24 74 78  [string trim $tx
0e70: 74 5d 20 5c 6e 20 74 78 74 0a 20 20 20 20 72 65  t] \n txt.    re
0e80: 67 73 75 62 20 2d 61 6c 6c 20 7b 25 28 68 74 6d  gsub -all {%(htm
0e90: 6c 7c 75 72 6c 7c 71 70 7c 73 74 72 69 6e 67 7c  l|url|qp|string|
0ea0: 75 6e 73 61 66 65 29 7b 31 2c 31 7d 3f 28 7c 25  unsafe){1,1}?(|%
0eb0: 29 5c 28 28 2e 2b 29 5c 29 5c 32 7d 20 24 74 78  )\((.+)\)\2} $tx
0ec0: 74 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 7b  t \.           {
0ed0: 5b 77 61 70 70 49 6e 74 2d 65 6e 63 2d 5c 31 20  [wappInt-enc-\1 
0ee0: 22 5c 33 22 5d 7d 20 74 78 74 0a 20 20 20 20 64  "\3"]} txt.    d
0ef0: 69 63 74 20 61 70 70 65 6e 64 20 77 61 70 70 20  ict append wapp 
0f00: 2e 72 65 70 6c 79 20 5b 75 70 6c 65 76 65 6c 20  .reply [uplevel 
0f10: 31 20 5b 6c 69 73 74 20 73 75 62 73 74 20 2d 6e  1 [list subst -n
0f20: 6f 76 61 72 69 61 62 6c 65 73 20 24 74 78 74 5d  ovariables $txt]
0f30: 5d 0a 20 20 7d 0a 7d 0a 0a 23 20 54 68 65 72 65  ].  }.}..# There
0f40: 20 6d 75 73 74 20 62 65 20 61 20 77 61 70 70 49   must be a wappI
0f50: 6e 74 2d 65 6e 63 2d 4e 41 4d 45 20 72 6f 75 74  nt-enc-NAME rout
0f60: 69 6e 65 20 66 6f 72 20 65 61 63 68 20 70 6f 73  ine for each pos
0f70: 73 69 62 6c 65 20 73 75 62 73 74 69 74 75 74 69  sible substituti
0f80: 6f 6e 0a 23 20 69 6e 20 77 61 70 70 2d 73 75 62  on.# in wapp-sub
0f90: 73 74 2e 20 20 54 68 75 73 20 74 68 65 72 65 20  st.  Thus there 
0fa0: 61 72 65 20 72 6f 75 74 69 6e 65 73 20 66 6f 72  are routines for
0fb0: 20 22 68 74 6d 6c 22 2c 20 22 75 72 6c 22 2c 20   "html", "url", 
0fc0: 22 71 70 22 2c 20 61 6e 64 20 22 75 6e 73 61 66  "qp", and "unsaf
0fd0: 65 22 2e 0a 23 0a 23 20 20 20 20 77 61 70 70 49  e"..#.#    wappI
0fe0: 6e 74 2d 65 6e 63 2d 68 74 6d 6c 20 20 20 20 20  nt-enc-html     
0ff0: 20 20 20 20 20 20 45 73 63 61 70 65 20 74 65 78        Escape tex
1000: 74 20 73 6f 20 74 68 61 74 20 69 74 20 69 73 20  t so that it is 
1010: 73 61 66 65 20 74 6f 20 75 73 65 20 69 6e 20 74  safe to use in t
1020: 68 65 0a 23 20 20 20 20 20 20 20 20 20 20 20 20  he.#            
1030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1040: 20 20 20 62 6f 64 79 20 6f 66 20 61 6e 20 48 54     body of an HT
1050: 4d 4c 20 64 6f 63 75 6d 65 6e 74 2e 0a 23 0a 23  ML document..#.#
1060: 20 20 20 20 77 61 70 70 49 6e 74 2d 65 6e 63 2d      wappInt-enc-
1070: 75 72 6c 20 20 20 20 20 20 20 20 20 20 20 20 45  url            E
1080: 73 63 61 70 65 20 74 65 78 74 20 73 6f 20 74 68  scape text so th
1090: 61 74 20 69 74 20 69 73 20 73 61 66 65 20 74 6f  at it is safe to
10a0: 20 70 61 73 73 20 61 73 20 61 6e 0a 23 20 20 20   pass as an.#   
10b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10c0: 20 20 20 20 20 20 20 20 20 20 20 20 61 72 67 75              argu
10d0: 6d 65 6e 74 20 74 6f 20 68 72 65 66 3d 20 61 6e  ment to href= an
10e0: 64 20 73 72 63 3d 20 61 74 74 72 69 62 75 74 65  d src= attribute
10f0: 73 20 69 6e 20 48 54 4d 4c 2e 0a 23 0a 23 20 20  s in HTML..#.#  
1100: 20 20 77 61 70 70 49 6e 74 2d 65 6e 63 2d 71 70    wappInt-enc-qp
1110: 20 20 20 20 20 20 20 20 20 20 20 20 20 45 73 63               Esc
1120: 61 70 65 20 74 65 78 74 20 73 6f 20 74 68 61 74  ape text so that
1130: 20 69 74 20 69 73 20 73 61 66 65 20 74 6f 20 75   it is safe to u
1140: 73 65 20 61 73 20 74 68 65 0a 23 20 20 20 20 20  se as the.#     
1150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1160: 20 20 20 20 20 20 20 20 20 20 76 61 6c 75 65 20            value 
1170: 6f 66 20 61 20 71 75 65 72 79 20 70 61 72 61 6d  of a query param
1180: 65 74 65 72 20 69 6e 20 61 20 55 52 4c 20 6f 72  eter in a URL or
1190: 20 69 6e 0a 23 20 20 20 20 20 20 20 20 20 20 20   in.#           
11a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
11b0: 20 20 20 20 70 6f 73 74 20 64 61 74 61 20 6f 72      post data or
11c0: 20 69 6e 20 61 20 63 6f 6f 6b 69 65 2e 0a 23 0a   in a cookie..#.
11d0: 23 20 20 20 20 77 61 70 70 49 6e 74 2d 65 6e 63  #    wappInt-enc
11e0: 2d 73 74 72 69 6e 67 20 20 20 20 20 20 20 20 20  -string         
11f0: 45 73 63 61 70 65 20 22 2c 20 27 2c 20 5c 2c 20  Escape ", ', \, 
1200: 61 6e 64 20 3c 20 66 6f 72 20 75 73 69 6e 67 20  and < for using 
1210: 69 6e 73 69 64 65 20 6f 66 20 61 0a 23 20 20 20  inside of a.#   
1220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1230: 20 20 20 20 20 20 20 20 20 20 20 20 6a 61 76 61              java
1240: 73 63 72 69 70 74 20 73 74 72 69 6e 67 20 6c 69  script string li
1250: 74 65 72 61 6c 2e 20 20 54 68 65 20 3c 20 63 68  teral.  The < ch
1260: 61 72 61 63 74 65 72 0a 23 20 20 20 20 20 20 20  aracter.#       
1270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1280: 20 20 20 20 20 20 20 20 69 73 20 65 73 63 61 70          is escap
1290: 65 64 20 74 6f 20 70 72 65 76 65 6e 74 20 22 3c  ed to prevent "<
12a0: 2f 73 63 72 69 70 74 3e 22 20 66 72 6f 6d 20 63  /script>" from c
12b0: 61 75 73 69 6e 67 0a 23 20 20 20 20 20 20 20 20  ausing.#        
12c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
12d0: 20 20 20 20 20 20 20 70 72 6f 62 6c 65 6d 73 20         problems 
12e0: 69 6e 20 65 6d 62 65 64 64 65 64 20 6a 61 76 61  in embedded java
12f0: 73 63 72 69 70 74 2e 0a 23 0a 23 20 20 20 20 77  script..#.#    w
1300: 61 70 70 49 6e 74 2d 65 6e 63 2d 75 6e 73 61 66  appInt-enc-unsaf
1310: 65 20 20 20 20 20 20 20 20 20 50 65 72 66 6f 72  e         Perfor
1320: 6d 20 6e 6f 20 65 6e 63 6f 64 69 6e 67 20 61 74  m no encoding at
1330: 20 61 6c 6c 2e 20 20 55 6e 73 61 66 65 2e 0a 23   all.  Unsafe..#
1340: 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 65 6e  .proc wappInt-en
1350: 63 2d 68 74 6d 6c 20 7b 74 78 74 7d 20 7b 0a 20  c-html {txt} {. 
1360: 20 72 65 74 75 72 6e 20 5b 73 74 72 69 6e 67 20   return [string 
1370: 6d 61 70 20 7b 26 20 26 61 6d 70 3b 20 3c 20 26  map {& &amp; < &
1380: 6c 74 3b 20 3e 20 26 67 74 3b 20 5c 22 20 26 71  lt; > &gt; \" &q
1390: 75 6f 74 3b 20 5c 5c 20 26 23 39 32 3b 7d 20 24  uot; \\ &#92;} $
13a0: 74 78 74 5d 0a 7d 0a 70 72 6f 63 20 77 61 70 70  txt].}.proc wapp
13b0: 49 6e 74 2d 65 6e 63 2d 75 6e 73 61 66 65 20 7b  Int-enc-unsafe {
13c0: 74 78 74 7d 20 7b 0a 20 20 72 65 74 75 72 6e 20  txt} {.  return 
13d0: 24 74 78 74 0a 7d 0a 70 72 6f 63 20 77 61 70 70  $txt.}.proc wapp
13e0: 49 6e 74 2d 65 6e 63 2d 75 72 6c 20 7b 73 7d 20  Int-enc-url {s} 
13f0: 7b 0a 20 20 69 66 20 7b 5b 72 65 67 73 75 62 20  {.  if {[regsub 
1400: 2d 61 6c 6c 20 7b 5b 5e 2d 7b 7d 40 7e 3f 3d 23  -all {[^-{}@~?=#
1410: 5f 2e 3a 2f 61 2d 7a 41 2d 5a 30 2d 39 5d 7d 20  _.:/a-zA-Z0-9]} 
1420: 24 73 20 7b 5b 77 61 70 70 49 6e 74 2d 25 48 48  $s {[wappInt-%HH
1430: 63 68 61 72 20 7b 26 7d 5d 7d 20 73 5d 7d 20 7b  char {&}]} s]} {
1440: 0a 20 20 20 20 73 65 74 20 73 20 5b 73 75 62 73  .    set s [subs
1450: 74 20 2d 6e 6f 76 61 72 20 2d 6e 6f 62 61 63 6b  t -novar -noback
1460: 20 24 73 5d 0a 20 20 7d 0a 20 20 69 66 20 7b 5b   $s].  }.  if {[
1470: 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b 5b 7b 7d  regsub -all {[{}
1480: 5d 7d 20 24 73 20 7b 5b 77 61 70 70 49 6e 74 2d  ]} $s {[wappInt-
1490: 25 48 48 63 68 61 72 20 5c 5c 26 5d 7d 20 73 5d  %HHchar \\&]} s]
14a0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 73  } {.    set s [s
14b0: 75 62 73 74 20 2d 6e 6f 76 61 72 20 2d 6e 6f 62  ubst -novar -nob
14c0: 61 63 6b 20 24 73 5d 0a 20 20 7d 0a 20 20 72 65  ack $s].  }.  re
14d0: 74 75 72 6e 20 24 73 0a 7d 0a 70 72 6f 63 20 77  turn $s.}.proc w
14e0: 61 70 70 49 6e 74 2d 65 6e 63 2d 71 70 20 7b 73  appInt-enc-qp {s
14f0: 7d 20 7b 0a 20 20 69 66 20 7b 5b 72 65 67 73 75  } {.  if {[regsu
1500: 62 20 2d 61 6c 6c 20 7b 5b 5e 2d 7b 7d 5f 2e 61  b -all {[^-{}_.a
1510: 2d 7a 41 2d 5a 30 2d 39 5d 7d 20 24 73 20 7b 5b  -zA-Z0-9]} $s {[
1520: 77 61 70 70 49 6e 74 2d 25 48 48 63 68 61 72 20  wappInt-%HHchar 
1530: 7b 26 7d 5d 7d 20 73 5d 7d 20 7b 0a 20 20 20 20  {&}]} s]} {.    
1540: 73 65 74 20 73 20 5b 73 75 62 73 74 20 2d 6e 6f  set s [subst -no
1550: 76 61 72 20 2d 6e 6f 62 61 63 6b 20 24 73 5d 0a  var -noback $s].
1560: 20 20 7d 0a 20 20 69 66 20 7b 5b 72 65 67 73 75    }.  if {[regsu
1570: 62 20 2d 61 6c 6c 20 7b 5b 7b 7d 5d 7d 20 24 73  b -all {[{}]} $s
1580: 20 7b 5b 77 61 70 70 49 6e 74 2d 25 48 48 63 68   {[wappInt-%HHch
1590: 61 72 20 5c 5c 26 5d 7d 20 73 5d 7d 20 7b 0a 20  ar \\&]} s]} {. 
15a0: 20 20 20 73 65 74 20 73 20 5b 73 75 62 73 74 20     set s [subst 
15b0: 2d 6e 6f 76 61 72 20 2d 6e 6f 62 61 63 6b 20 24  -novar -noback $
15c0: 73 5d 0a 20 20 7d 0a 20 20 72 65 74 75 72 6e 20  s].  }.  return 
15d0: 24 73 0a 7d 0a 70 72 6f 63 20 77 61 70 70 49 6e  $s.}.proc wappIn
15e0: 74 2d 65 6e 63 2d 73 74 72 69 6e 67 20 7b 73 7d  t-enc-string {s}
15f0: 20 7b 0a 20 20 72 65 74 75 72 6e 20 5b 73 74 72   {.  return [str
1600: 69 6e 67 20 6d 61 70 20 7b 5c 5c 20 5c 5c 5c 5c  ing map {\\ \\\\
1610: 20 5c 22 20 5c 5c 5c 22 20 27 20 5c 5c 27 20 3c   \" \\\" ' \\' <
1620: 20 5c 5c 75 30 30 33 63 7d 20 24 73 5d 0a 7d 0a   \\u003c} $s].}.
1630: 0a 23 20 54 68 69 73 20 69 73 20 61 20 68 65 6c  .# This is a hel
1640: 70 65 72 20 72 6f 75 74 69 6e 65 20 66 6f 72 20  per routine for 
1650: 77 61 70 70 49 6e 74 2d 65 6e 63 2d 75 72 6c 20  wappInt-enc-url 
1660: 61 6e 64 20 77 61 70 70 49 6e 74 2d 65 6e 63 2d  and wappInt-enc-
1670: 71 70 2e 20 20 49 74 20 72 65 74 75 72 6e 73 0a  qp.  It returns.
1680: 23 20 61 6e 20 61 70 70 72 6f 70 72 69 61 74 65  # an appropriate
1690: 20 25 48 48 20 65 6e 63 6f 64 69 6e 67 20 66 6f   %HH encoding fo
16a0: 72 20 74 68 65 20 73 69 6e 67 6c 65 20 63 68 61  r the single cha
16b0: 72 61 63 74 65 72 20 63 2e 20 20 49 66 20 63 20  racter c.  If c 
16c0: 69 73 20 61 20 75 6e 69 63 6f 64 65 0a 23 20 63  is a unicode.# c
16d0: 68 61 72 61 63 74 65 72 2c 20 74 68 65 6e 20 74  haracter, then t
16e0: 68 69 73 20 72 6f 75 74 69 6e 65 20 6d 69 67 68  his routine migh
16f0: 74 20 72 65 74 75 72 6e 20 6d 75 6c 74 69 70 6c  t return multipl
1700: 65 20 62 79 74 65 73 3a 20 20 25 48 48 25 48 48  e bytes:  %HH%HH
1710: 25 48 48 0a 23 0a 70 72 6f 63 20 77 61 70 70 49  %HH.#.proc wappI
1720: 6e 74 2d 25 48 48 63 68 61 72 20 7b 63 7d 20 7b  nt-%HHchar {c} {
1730: 0a 20 20 69 66 20 7b 24 63 3d 3d 22 20 22 7d 20  .  if {$c==" "} 
1740: 7b 72 65 74 75 72 6e 20 2b 7d 0a 20 20 72 65 74  {return +}.  ret
1750: 75 72 6e 20 5b 72 65 67 73 75 62 20 2d 61 6c 6c  urn [regsub -all
1760: 20 2e 2e 20 5b 62 69 6e 61 72 79 20 65 6e 63 6f   .. [binary enco
1770: 64 65 20 68 65 78 20 5b 65 6e 63 6f 64 69 6e 67  de hex [encoding
1780: 20 63 6f 6e 76 65 72 74 74 6f 20 75 74 66 2d 38   convertto utf-8
1790: 20 24 63 5d 5d 20 7b 25 26 7d 5d 0a 7d 0a 0a 0a   $c]] {%&}].}...
17a0: 23 20 55 6e 64 6f 20 74 68 65 20 77 77 77 2d 75  # Undo the www-u
17b0: 72 6c 2d 65 6e 63 6f 64 65 64 20 66 6f 72 6d 61  rl-encoded forma
17c0: 74 2e 0a 23 0a 23 20 48 54 3a 20 54 68 69 73 20  t..#.# HT: This 
17d0: 63 6f 64 65 20 73 74 6f 6c 65 6e 20 66 72 6f 6d  code stolen from
17e0: 20 6e 63 67 69 2e 74 63 6c 0a 23 0a 70 72 6f 63   ncgi.tcl.#.proc
17f0: 20 77 61 70 70 49 6e 74 2d 64 65 63 6f 64 65 2d   wappInt-decode-
1800: 75 72 6c 20 7b 73 74 72 7d 20 7b 0a 20 20 73 65  url {str} {.  se
1810: 74 20 73 74 72 20 5b 73 74 72 69 6e 67 20 6d 61  t str [string ma
1820: 70 20 5b 6c 69 73 74 20 2b 20 7b 20 7d 20 22 5c  p [list + { } "\
1830: 5c 22 20 22 5c 5c 5c 5c 22 20 5c 5b 20 5c 5c 5c  \" "\\\\" \[ \\\
1840: 5b 20 5c 5d 20 5c 5c 5c 5d 5d 20 24 73 74 72 5d  [ \] \\\]] $str]
1850: 0a 20 20 72 65 67 73 75 62 20 2d 61 6c 6c 20 2d  .  regsub -all -
1860: 2d 20 5c 0a 20 20 20 20 20 20 7b 25 28 5b 45 65  - \.      {%([Ee
1870: 5d 5b 41 2d 46 61 2d 66 30 2d 39 5d 29 25 28 5b  ][A-Fa-f0-9])%([
1880: 38 39 41 42 61 62 5d 5b 41 2d 46 61 2d 66 30 2d  89ABab][A-Fa-f0-
1890: 39 5d 29 25 28 5b 38 39 41 42 61 62 5d 5b 41 2d  9])%([89ABab][A-
18a0: 46 61 2d 66 30 2d 39 5d 29 7d 20 5c 0a 20 20 20  Fa-f0-9])} \.   
18b0: 20 20 20 24 73 74 72 20 7b 5b 65 6e 63 6f 64 69     $str {[encodi
18c0: 6e 67 20 63 6f 6e 76 65 72 74 66 72 6f 6d 20 75  ng convertfrom u
18d0: 74 66 2d 38 20 5b 62 69 6e 61 72 79 20 64 65 63  tf-8 [binary dec
18e0: 6f 64 65 20 68 65 78 20 5c 31 5c 32 5c 33 5d 5d  ode hex \1\2\3]]
18f0: 7d 20 73 74 72 0a 20 20 72 65 67 73 75 62 20 2d  } str.  regsub -
1900: 61 6c 6c 20 2d 2d 20 5c 0a 20 20 20 20 20 20 7b  all -- \.      {
1910: 25 28 5b 43 44 63 64 5d 5b 41 2d 46 61 2d 66 30  %([CDcd][A-Fa-f0
1920: 2d 39 5d 29 25 28 5b 38 39 41 42 61 62 5d 5b 41  -9])%([89ABab][A
1930: 2d 46 61 2d 66 30 2d 39 5d 29 7d 20 20 20 20 20  -Fa-f0-9])}     
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1950: 5c 0a 20 20 20 20 20 20 24 73 74 72 20 7b 5b 65  \.      $str {[e
1960: 6e 63 6f 64 69 6e 67 20 63 6f 6e 76 65 72 74 66  ncoding convertf
1970: 72 6f 6d 20 75 74 66 2d 38 20 5b 62 69 6e 61 72  rom utf-8 [binar
1980: 79 20 64 65 63 6f 64 65 20 68 65 78 20 5c 31 5c  y decode hex \1\
1990: 32 5d 5d 7d 20 73 74 72 0a 20 20 72 65 67 73 75  2]]} str.  regsu
19a0: 62 20 2d 61 6c 6c 20 2d 2d 20 7b 25 28 5b 30 2d  b -all -- {%([0-
19b0: 37 5d 5b 41 2d 46 61 2d 66 30 2d 39 5d 29 7d 20  7][A-Fa-f0-9])} 
19c0: 24 73 74 72 20 7b 5c 5c 75 30 30 5c 31 7d 20 73  $str {\\u00\1} s
19d0: 74 72 0a 20 20 72 65 74 75 72 6e 20 5b 73 75 62  tr.  return [sub
19e0: 73 74 20 2d 6e 6f 76 61 72 20 24 73 74 72 5d 0a  st -novar $str].
19f0: 7d 0a 0a 23 20 52 65 73 65 74 20 74 68 65 20 64  }..# Reset the d
1a00: 6f 63 75 6d 65 6e 74 20 62 61 63 6b 20 74 6f 20  ocument back to 
1a10: 61 6e 20 65 6d 70 74 79 20 73 74 72 69 6e 67 2e  an empty string.
1a20: 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d 72 65 73  .#.proc wapp-res
1a30: 65 74 20 7b 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c  et {} {.  global
1a40: 20 77 61 70 70 0a 20 20 64 69 63 74 20 73 65 74   wapp.  dict set
1a50: 20 77 61 70 70 20 2e 72 65 70 6c 79 20 7b 7d 0a   wapp .reply {}.
1a60: 7d 0a 0a 23 20 43 68 61 6e 67 65 20 74 68 65 20  }..# Change the 
1a70: 6d 69 6d 65 2d 74 79 70 65 20 6f 66 20 74 68 65  mime-type of the
1a80: 20 72 65 73 75 6c 74 20 64 6f 63 75 6d 65 6e 74   result document
1a90: 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d 6d 69  ..#.proc wapp-mi
1aa0: 6d 65 74 79 70 65 20 7b 78 7d 20 7b 0a 20 20 67  metype {x} {.  g
1ab0: 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 64 69 63  lobal wapp.  dic
1ac0: 74 20 73 65 74 20 77 61 70 70 20 2e 6d 69 6d 65  t set wapp .mime
1ad0: 74 79 70 65 20 24 78 0a 7d 0a 0a 23 20 43 68 61  type $x.}..# Cha
1ae0: 6e 67 65 20 74 68 65 20 72 65 70 6c 79 20 63 6f  nge the reply co
1af0: 64 65 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d  de..#.proc wapp-
1b00: 72 65 70 6c 79 2d 63 6f 64 65 20 7b 78 7d 20 7b  reply-code {x} {
1b10: 0a 20 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20  .  global wapp. 
1b20: 20 64 69 63 74 20 73 65 74 20 77 61 70 70 20 2e   dict set wapp .
1b30: 72 65 70 6c 79 2d 63 6f 64 65 20 24 78 0a 7d 0a  reply-code $x.}.
1b40: 0a 23 20 53 65 74 20 61 20 63 6f 6f 6b 69 65 0a  .# Set a cookie.
1b50: 23 0a 70 72 6f 63 20 77 61 70 70 2d 73 65 74 2d  #.proc wapp-set-
1b60: 63 6f 6f 6b 69 65 20 7b 6e 61 6d 65 20 76 61 6c  cookie {name val
1b70: 75 65 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 77  ue} {.  global w
1b80: 61 70 70 0a 20 20 64 69 63 74 20 6c 61 70 70 65  app.  dict lappe
1b90: 6e 64 20 77 61 70 70 20 2e 6e 65 77 2d 63 6f 6f  nd wapp .new-coo
1ba0: 6b 69 65 73 20 24 6e 61 6d 65 20 24 76 61 6c 75  kies $name $valu
1bb0: 65 0a 7d 0a 0a 23 20 55 6e 73 65 74 20 61 20 63  e.}..# Unset a c
1bc0: 6f 6f 6b 69 65 0a 23 0a 70 72 6f 63 20 77 61 70  ookie.#.proc wap
1bd0: 70 2d 63 6c 65 61 72 2d 63 6f 6f 6b 69 65 20 7b  p-clear-cookie {
1be0: 6e 61 6d 65 7d 20 7b 0a 20 20 77 61 70 70 2d 73  name} {.  wapp-s
1bf0: 65 74 2d 63 6f 6f 6b 69 65 20 24 6e 61 6d 65 20  et-cookie $name 
1c00: 7b 7d 0a 7d 0a 0a 23 20 41 64 64 20 65 78 74 72  {}.}..# Add extr
1c10: 61 20 65 6e 74 72 69 65 73 20 74 6f 20 74 68 65  a entries to the
1c20: 20 72 65 70 6c 79 20 68 65 61 64 65 72 0a 23 0a   reply header.#.
1c30: 70 72 6f 63 20 77 61 70 70 2d 72 65 70 6c 79 2d  proc wapp-reply-
1c40: 65 78 74 72 61 20 7b 6e 61 6d 65 20 76 61 6c 75  extra {name valu
1c50: 65 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 77 61  e} {.  global wa
1c60: 70 70 0a 20 20 64 69 63 74 20 6c 61 70 70 65 6e  pp.  dict lappen
1c70: 64 20 77 61 70 70 20 2e 72 65 70 6c 79 2d 65 78  d wapp .reply-ex
1c80: 74 72 61 20 24 6e 61 6d 65 20 24 76 61 6c 75 65  tra $name $value
1c90: 0a 7d 0a 0a 23 20 53 70 65 63 69 66 69 65 73 20  .}..# Specifies 
1ca0: 68 6f 77 20 74 68 65 20 77 65 62 2d 70 61 67 65  how the web-page
1cb0: 20 75 6e 64 65 72 20 63 6f 6e 73 74 72 75 63 74   under construct
1cc0: 69 6f 6e 20 73 68 6f 75 6c 64 20 62 65 20 63 61  ion should be ca
1cd0: 63 68 65 64 2e 0a 23 20 54 68 65 20 61 72 67 75  ched..# The argu
1ce0: 6d 65 6e 74 20 73 68 6f 75 6c 64 20 62 65 20 6f  ment should be o
1cf0: 6e 65 20 6f 66 3a 0a 23 0a 23 20 20 20 20 6e 6f  ne of:.#.#    no
1d00: 2d 63 61 63 68 65 0a 23 20 20 20 20 6d 61 78 2d  -cache.#    max-
1d10: 61 67 65 3d 4e 20 20 20 20 20 20 20 20 20 20 20  age=N           
1d20: 20 20 28 66 6f 72 20 73 6f 6d 65 20 69 6e 74 65    (for some inte
1d30: 67 65 72 20 6e 75 6d 62 65 72 20 6f 66 20 73 65  ger number of se
1d40: 63 6f 6e 64 73 2c 20 4e 29 0a 23 20 20 20 20 70  conds, N).#    p
1d50: 72 69 76 61 74 65 2c 6d 61 78 2d 61 67 65 3d 4e  rivate,max-age=N
1d60: 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d 63 61 63  .#.proc wapp-cac
1d70: 68 65 2d 63 6f 6e 74 72 6f 6c 20 7b 78 7d 20 7b  he-control {x} {
1d80: 0a 20 20 77 61 70 70 2d 72 65 70 6c 79 2d 65 78  .  wapp-reply-ex
1d90: 74 72 61 20 43 61 63 68 65 2d 43 6f 6e 74 72 6f  tra Cache-Contro
1da0: 6c 20 24 78 0a 7d 0a 0a 23 20 52 65 64 69 72 65  l $x.}..# Redire
1db0: 63 74 20 74 6f 20 61 20 64 69 66 66 65 72 65 6e  ct to a differen
1dc0: 74 20 77 65 62 20 70 61 67 65 0a 23 0a 70 72 6f  t web page.#.pro
1dd0: 63 20 77 61 70 70 2d 72 65 64 69 72 65 63 74 20  c wapp-redirect 
1de0: 7b 75 72 69 7d 20 7b 0a 20 20 77 61 70 70 2d 72  {uri} {.  wapp-r
1df0: 65 70 6c 79 2d 63 6f 64 65 20 7b 33 30 37 20 52  eply-code {307 R
1e00: 65 64 69 72 65 63 74 7d 0a 20 20 77 61 70 70 2d  edirect}.  wapp-
1e10: 72 65 70 6c 79 2d 65 78 74 72 61 20 4c 6f 63 61  reply-extra Loca
1e20: 74 69 6f 6e 20 24 75 72 69 0a 7d 0a 0a 23 20 52  tion $uri.}..# R
1e30: 65 74 75 72 6e 20 74 68 65 20 76 61 6c 75 65 20  eturn the value 
1e40: 6f 66 20 61 20 77 61 70 70 20 70 61 72 61 6d 65  of a wapp parame
1e50: 74 65 72 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d  ter.#.proc wapp-
1e60: 70 61 72 61 6d 20 7b 6e 61 6d 65 20 7b 64 66 6c  param {name {dfl
1e70: 74 20 7b 7d 7d 7d 20 7b 0a 20 20 67 6c 6f 62 61  t {}}} {.  globa
1e80: 6c 20 77 61 70 70 0a 20 20 69 66 20 7b 21 5b 64  l wapp.  if {![d
1e90: 69 63 74 20 65 78 69 73 74 73 20 24 77 61 70 70  ict exists $wapp
1ea0: 20 24 6e 61 6d 65 5d 7d 20 7b 72 65 74 75 72 6e   $name]} {return
1eb0: 20 24 64 66 6c 74 7d 0a 20 20 72 65 74 75 72 6e   $dflt}.  return
1ec0: 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70 70   [dict get $wapp
1ed0: 20 24 6e 61 6d 65 5d 0a 7d 0a 0a 23 20 52 65 74   $name].}..# Ret
1ee0: 75 72 6e 20 74 72 75 65 20 69 66 20 61 20 61 6e  urn true if a an
1ef0: 64 20 6f 6e 6c 79 20 69 66 20 74 68 65 20 77 61  d only if the wa
1f00: 70 70 20 70 61 72 61 6d 65 74 65 72 20 24 6e 61  pp parameter $na
1f10: 6d 65 20 65 78 69 73 74 73 0a 23 0a 70 72 6f 63  me exists.#.proc
1f20: 20 77 61 70 70 2d 70 61 72 61 6d 2d 65 78 69 73   wapp-param-exis
1f30: 74 73 20 7b 6e 61 6d 65 7d 20 7b 0a 20 20 67 6c  ts {name} {.  gl
1f40: 6f 62 61 6c 20 77 61 70 70 0a 20 20 72 65 74 75  obal wapp.  retu
1f50: 72 6e 20 5b 64 69 63 74 20 65 78 69 73 74 73 20  rn [dict exists 
1f60: 24 77 61 70 70 20 24 6e 61 6d 65 5d 0a 7d 0a 0a  $wapp $name].}..
1f70: 23 20 53 65 74 20 74 68 65 20 76 61 6c 75 65 20  # Set the value 
1f80: 6f 66 20 61 20 77 61 70 70 20 70 61 72 61 6d 65  of a wapp parame
1f90: 74 65 72 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d  ter.#.proc wapp-
1fa0: 73 65 74 2d 70 61 72 61 6d 20 7b 6e 61 6d 65 20  set-param {name 
1fb0: 76 61 6c 75 65 7d 20 7b 0a 20 20 67 6c 6f 62 61  value} {.  globa
1fc0: 6c 20 77 61 70 70 0a 20 20 64 69 63 74 20 73 65  l wapp.  dict se
1fd0: 74 20 77 61 70 70 20 24 6e 61 6d 65 20 24 76 61  t wapp $name $va
1fe0: 6c 75 65 0a 7d 0a 0a 23 20 52 65 74 75 72 6e 20  lue.}..# Return 
1ff0: 61 6c 6c 20 70 61 72 61 6d 65 74 65 72 20 6e 61  all parameter na
2000: 6d 65 73 20 74 68 61 74 20 6d 61 74 63 68 20 74  mes that match t
2010: 68 65 20 47 4c 4f 42 20 70 61 74 74 65 72 6e 2c  he GLOB pattern,
2020: 20 6f 72 20 61 6c 6c 0a 23 20 6e 61 6d 65 73 20   or all.# names 
2030: 69 66 20 74 68 65 20 47 4c 4f 42 20 70 61 74 74  if the GLOB patt
2040: 65 72 6e 20 69 73 20 6f 6d 69 74 74 65 64 2e 0a  ern is omitted..
2050: 23 0a 70 72 6f 63 20 77 61 70 70 2d 70 61 72 61  #.proc wapp-para
2060: 6d 2d 6c 69 73 74 20 7b 7b 67 6c 6f 62 20 7b 2a  m-list {{glob {*
2070: 7d 7d 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 77  }}} {.  global w
2080: 61 70 70 0a 20 20 72 65 74 75 72 6e 20 5b 64 69  app.  return [di
2090: 63 74 20 6b 65 79 73 20 24 77 61 70 70 20 24 67  ct keys $wapp $g
20a0: 6c 6f 62 5d 0a 7d 0a 0a 23 20 42 79 20 64 65 66  lob].}..# By def
20b0: 61 75 6c 74 2c 20 57 61 70 70 20 64 6f 65 73 20  ault, Wapp does 
20c0: 6e 6f 74 20 64 65 63 6f 64 65 20 71 75 65 72 79  not decode query
20d0: 20 70 61 72 61 6d 65 74 65 72 73 20 61 6e 64 20   parameters and 
20e0: 50 4f 53 54 20 70 61 72 61 6d 65 74 65 72 73 0a  POST parameters.
20f0: 23 20 66 6f 72 20 63 72 6f 73 73 2d 6f 72 69 67  # for cross-orig
2100: 69 6e 20 72 65 71 75 65 73 74 73 2e 20 20 54 68  in requests.  Th
2110: 69 73 20 69 73 20 61 20 73 65 63 75 72 69 74 79  is is a security
2120: 20 72 65 73 74 72 69 63 74 69 6f 6e 2c 20 64 65   restriction, de
2130: 73 69 67 6e 65 64 20 74 6f 0a 23 20 68 65 6c 70  signed to.# help
2140: 20 70 72 65 76 65 6e 74 20 63 72 6f 73 73 2d 73   prevent cross-s
2150: 69 74 65 20 72 65 71 75 65 73 74 20 66 6f 72 67  ite request forg
2160: 65 72 79 20 28 43 53 52 46 29 20 61 74 74 61 63  ery (CSRF) attac
2170: 6b 73 2e 0a 23 0a 23 20 41 73 20 61 20 63 6f 6e  ks..#.# As a con
2180: 73 65 71 75 65 6e 63 65 20 6f 66 20 74 68 69 73  sequence of this
2190: 20 72 65 73 74 72 69 63 74 69 6f 6e 2c 20 55 52   restriction, UR
21a0: 4c 73 20 66 6f 72 20 73 69 74 65 73 20 67 65 6e  Ls for sites gen
21b0: 65 72 61 74 65 64 20 62 79 20 57 61 70 70 0a 23  erated by Wapp.#
21c0: 20 74 68 61 74 20 63 6f 6e 74 61 69 6e 20 71 75   that contain qu
21d0: 65 72 79 20 70 61 72 61 6d 65 74 65 72 73 20 77  ery parameters w
21e0: 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 61 73 20  ill not work as 
21f0: 55 52 4c 73 20 66 6f 75 6e 64 20 69 6e 20 6f 74  URLs found in ot
2200: 68 65 72 0a 23 20 77 65 62 73 69 74 65 73 2e 20  her.# websites. 
2210: 20 59 6f 75 20 63 61 6e 6e 6f 74 20 63 72 65 61   You cannot crea
2220: 74 65 20 61 20 6c 69 6e 6b 20 66 72 6f 6d 20 61  te a link from a
2230: 20 73 65 63 6f 6e 64 20 77 65 62 73 69 74 65 20   second website 
2240: 69 6e 74 6f 20 61 20 57 61 70 70 0a 23 20 77 65  into a Wapp.# we
2250: 62 73 69 74 65 20 69 66 20 74 68 65 20 6c 69 6e  bsite if the lin
2260: 6b 20 63 6f 6e 74 61 69 6e 73 20 71 75 65 72 79  k contains query
2270: 20 70 6c 61 6e 6e 65 72 2c 20 62 79 20 64 65 66   planner, by def
2280: 61 75 6c 74 2e 0a 23 0a 23 20 4f 66 20 63 6f 75  ault..#.# Of cou
2290: 72 73 65 2c 20 69 74 20 69 73 20 73 6f 6d 65 74  rse, it is somet
22a0: 69 6d 65 73 20 64 65 73 69 72 61 62 6c 65 20 74  imes desirable t
22b0: 6f 20 61 6c 6c 6f 77 20 71 75 65 72 79 20 70 61  o allow query pa
22c0: 72 61 6d 65 74 65 72 73 20 6f 6e 20 65 78 74 65  rameters on exte
22d0: 72 6e 61 6c 0a 23 20 6c 69 6e 6b 73 2e 20 20 46  rnal.# links.  F
22e0: 6f 72 20 55 52 4c 73 20 66 6f 72 20 77 68 69 63  or URLs for whic
22f0: 68 20 74 68 69 73 20 69 73 20 73 61 66 65 2c 20  h this is safe, 
2300: 74 68 65 20 61 70 70 6c 69 63 61 74 69 6f 6e 20  the application 
2310: 73 68 6f 75 6c 64 20 69 6e 76 6f 6b 65 0a 23 20  should invoke.# 
2320: 77 61 70 70 2d 61 6c 6c 6f 77 2d 78 6f 72 69 67  wapp-allow-xorig
2330: 69 6e 2d 70 61 72 61 6d 73 2e 20 20 54 68 69 73  in-params.  This
2340: 20 70 72 6f 63 65 64 75 72 65 20 74 65 6c 6c 73   procedure tells
2350: 20 57 61 70 70 20 74 68 61 74 20 69 74 20 69 73   Wapp that it is
2360: 20 73 61 66 65 20 74 6f 0a 23 20 67 6f 20 61 68   safe to.# go ah
2370: 65 61 64 20 61 6e 64 20 64 65 63 6f 64 65 20 74  ead and decode t
2380: 68 65 20 71 75 65 72 79 20 70 61 72 61 6d 65 74  he query paramet
2390: 65 72 73 20 65 76 65 6e 20 66 6f 72 20 63 72 6f  ers even for cro
23a0: 73 73 2d 73 69 74 65 20 72 65 71 75 65 73 74 73  ss-site requests
23b0: 2e 0a 23 0a 23 20 49 6e 20 6f 74 68 65 72 20 77  ..#.# In other w
23c0: 6f 72 64 73 2c 20 66 6f 72 20 57 61 70 70 20 73  ords, for Wapp s
23d0: 65 63 75 72 69 74 79 20 69 73 20 74 68 65 20 64  ecurity is the d
23e0: 65 66 61 75 6c 74 20 73 65 74 74 69 6e 67 2e 20  efault setting. 
23f0: 20 49 6e 64 69 76 69 64 75 61 6c 20 70 61 67 65   Individual page
2400: 73 0a 23 20 6e 65 65 64 20 74 6f 20 61 63 74 69  s.# need to acti
2410: 76 65 6c 79 20 64 69 73 61 62 6c 65 20 74 68 65  vely disable the
2420: 20 63 72 6f 73 73 2d 73 69 74 65 20 72 65 71 75   cross-site requ
2430: 65 73 74 20 73 65 63 75 72 69 74 79 20 69 66 20  est security if 
2440: 74 68 6f 73 65 20 70 61 67 65 73 0a 23 20 61 72  those pages.# ar
2450: 65 20 73 61 66 65 20 66 6f 72 20 63 72 6f 73 73  e safe for cross
2460: 2d 73 69 74 65 20 61 63 63 65 73 73 2e 0a 23 0a  -site access..#.
2470: 70 72 6f 63 20 77 61 70 70 2d 61 6c 6c 6f 77 2d  proc wapp-allow-
2480: 78 6f 72 69 67 69 6e 2d 70 61 72 61 6d 73 20 7b  xorigin-params {
2490: 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 77 61 70  } {.  global wap
24a0: 70 0a 20 20 69 66 20 7b 21 5b 64 69 63 74 20 65  p.  if {![dict e
24b0: 78 69 73 74 73 20 24 77 61 70 70 20 2e 71 70 5d  xists $wapp .qp]
24c0: 20 26 26 20 21 5b 64 69 63 74 20 67 65 74 20 24   && ![dict get $
24d0: 77 61 70 70 20 53 41 4d 45 5f 4f 52 49 47 49 4e  wapp SAME_ORIGIN
24e0: 5d 7d 20 7b 0a 20 20 20 20 77 61 70 70 49 6e 74  ]} {.    wappInt
24f0: 2d 64 65 63 6f 64 65 2d 71 75 65 72 79 2d 70 61  -decode-query-pa
2500: 72 61 6d 73 0a 20 20 7d 0a 7d 0a 0a 23 20 53 65  rams.  }.}..# Se
2510: 74 20 74 68 65 20 63 6f 6e 74 65 6e 74 2d 73 65  t the content-se
2520: 63 75 72 69 74 79 2d 70 6f 6c 69 63 79 2e 0a 23  curity-policy..#
2530: 0a 23 20 54 68 65 20 64 65 66 61 75 6c 74 20 63  .# The default c
2540: 6f 6e 74 65 6e 74 2d 73 65 63 75 72 69 74 79 2d  ontent-security-
2550: 70 6f 6c 69 63 79 20 69 73 20 76 65 72 79 20 73  policy is very s
2560: 74 72 69 63 74 3a 20 20 22 64 65 66 61 75 6c 74  trict:  "default
2570: 2d 73 72 63 20 27 73 65 6c 66 27 22 0a 23 20 54  -src 'self'".# T
2580: 68 65 20 64 65 66 61 75 6c 74 20 70 6f 6c 69 63  he default polic
2590: 79 20 70 72 6f 68 69 62 69 74 73 20 74 68 65 20  y prohibits the 
25a0: 75 73 65 20 6f 66 20 69 6e 2d 6c 69 6e 65 20 6a  use of in-line j
25b0: 61 76 61 73 63 72 69 70 74 20 6f 72 20 43 53 53  avascript or CSS
25c0: 2e 0a 23 0a 23 20 50 72 6f 76 69 64 65 20 61 6e  ..#.# Provide an
25d0: 20 61 6c 74 65 72 6e 61 74 69 76 65 20 43 53 50   alternative CSP
25e0: 20 61 73 20 74 68 65 20 61 72 67 75 6d 65 6e 74   as the argument
25f0: 2e 20 20 4f 72 20 75 73 65 20 22 6f 66 66 22 20  .  Or use "off" 
2600: 74 6f 20 64 69 73 61 62 6c 65 0a 23 20 74 68 65  to disable.# the
2610: 20 43 53 50 20 63 6f 6d 70 6c 65 74 65 6c 79 2e   CSP completely.
2620: 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d 63 6f 6e  .#.proc wapp-con
2630: 74 65 6e 74 2d 73 65 63 75 72 69 74 79 2d 70 6f  tent-security-po
2640: 6c 69 63 79 20 7b 76 61 6c 7d 20 7b 0a 20 20 67  licy {val} {.  g
2650: 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 69 66 20  lobal wapp.  if 
2660: 7b 24 76 61 6c 3d 3d 22 6f 66 66 22 7d 20 7b 0a  {$val=="off"} {.
2670: 20 20 20 20 64 69 63 74 20 75 6e 73 65 74 20 77      dict unset w
2680: 61 70 70 20 2e 63 73 70 0a 20 20 7d 20 65 6c 73  app .csp.  } els
2690: 65 20 7b 0a 20 20 20 20 64 69 63 74 20 73 65 74  e {.    dict set
26a0: 20 77 61 70 70 20 2e 63 73 70 20 24 76 61 6c 0a   wapp .csp $val.
26b0: 20 20 7d 0a 7d 0a 0a 23 20 45 78 61 6d 69 6e 65    }.}..# Examine
26c0: 20 74 68 65 20 62 6f 64 79 73 20 6f 66 20 61 6c   the bodys of al
26d0: 6c 20 70 72 6f 63 65 64 75 72 65 73 20 69 6e 20  l procedures in 
26e0: 74 68 69 73 20 70 72 6f 67 72 61 6d 20 6c 6f 6f  this program loo
26f0: 6b 69 6e 67 20 66 6f 72 0a 23 20 75 6e 73 61 66  king for.# unsaf
2700: 65 20 63 61 6c 6c 73 20 74 6f 20 76 61 72 69 6f  e calls to vario
2710: 75 73 20 57 61 70 70 20 69 6e 74 65 72 66 61 63  us Wapp interfac
2720: 65 73 2e 20 20 52 65 74 75 72 6e 20 61 20 74 65  es.  Return a te
2730: 78 74 20 73 74 72 69 6e 67 0a 23 20 63 6f 6e 74  xt string.# cont
2740: 61 69 6e 69 6e 67 20 77 61 72 6e 69 6e 67 73 2e  aining warnings.
2750: 20 52 65 74 75 72 6e 20 61 6e 20 65 6d 70 74 79   Return an empty
2760: 20 73 74 72 69 6e 67 20 69 66 20 61 6c 6c 20 69   string if all i
2770: 73 20 6f 6b 2e 0a 23 0a 23 20 54 68 69 73 20 72  s ok..#.# This r
2780: 6f 75 74 69 6e 65 20 69 73 20 61 64 76 69 73 6f  outine is adviso
2790: 72 79 20 6f 6e 6c 79 2e 20 20 49 74 20 6d 69 73  ry only.  It mis
27a0: 73 65 73 20 73 6f 6d 65 20 63 6f 6e 73 74 72 75  ses some constru
27b0: 63 74 73 20 74 68 61 74 20 61 72 65 0a 23 20 64  cts that are.# d
27c0: 61 6e 67 65 72 6f 75 73 20 61 6e 64 20 66 6c 61  angerous and fla
27d0: 67 73 20 6f 74 68 65 72 73 20 74 68 61 74 20 61  gs others that a
27e0: 72 65 20 73 61 66 65 2e 0a 23 0a 70 72 6f 63 20  re safe..#.proc 
27f0: 77 61 70 70 2d 73 61 66 65 74 79 2d 63 68 65 63  wapp-safety-chec
2800: 6b 20 7b 7d 20 7b 0a 20 20 73 65 74 20 72 65 73  k {} {.  set res
2810: 20 7b 7d 0a 20 20 66 6f 72 65 61 63 68 20 70 20   {}.  foreach p 
2820: 5b 69 6e 66 6f 20 70 72 6f 63 73 5d 20 7b 0a 20  [info procs] {. 
2830: 20 20 20 73 65 74 20 6c 6e 20 30 0a 20 20 20 20     set ln 0.    
2840: 66 6f 72 65 61 63 68 20 78 20 5b 73 70 6c 69 74  foreach x [split
2850: 20 5b 69 6e 66 6f 20 62 6f 64 79 20 24 70 5d 20   [info body $p] 
2860: 5c 6e 5d 20 7b 0a 20 20 20 20 20 20 69 6e 63 72  \n] {.      incr
2870: 20 6c 6e 0a 20 20 20 20 20 20 69 66 20 7b 5b 72   ln.      if {[r
2880: 65 67 65 78 70 20 7b 5e 5b 20 5c 74 5d 2a 77 61  egexp {^[ \t]*wa
2890: 70 70 5b 20 5c 74 5d 2b 28 5b 5e 5c 6e 5d 2b 29  pp[ \t]+([^\n]+)
28a0: 7d 20 24 78 20 61 6c 6c 20 74 61 69 6c 5d 0a 20  } $x all tail]. 
28b0: 20 20 20 20 20 20 26 26 20 5b 73 74 72 69 6e 67        && [string
28c0: 20 69 6e 64 65 78 20 24 74 61 69 6c 20 30 5d 21   index $tail 0]!
28d0: 3d 22 5c 31 37 33 22 0a 20 20 20 20 20 20 20 26  ="\173".       &
28e0: 26 20 5b 72 65 67 65 78 70 20 7b 5b 5b 24 5d 7d  & [regexp {[[$]}
28f0: 20 24 74 61 69 6c 5d 0a 20 20 20 20 20 20 7d 20   $tail].      } 
2900: 7b 0a 20 20 20 20 20 20 20 20 61 70 70 65 6e 64  {.        append
2910: 20 72 65 73 20 22 24 70 3a 24 6c 6e 3a 20 75 6e   res "$p:$ln: un
2920: 73 61 66 65 20 5c 22 77 61 70 70 5c 22 20 63 61  safe \"wapp\" ca
2930: 6c 6c 3a 20 5c 22 5b 73 74 72 69 6e 67 20 74 72  ll: \"[string tr
2940: 69 6d 20 24 78 5d 5c 22 5c 6e 22 0a 20 20 20 20  im $x]\"\n".    
2950: 20 20 7d 0a 20 20 20 20 20 20 69 66 20 7b 5b 72    }.      if {[r
2960: 65 67 65 78 70 20 7b 5e 5b 20 5c 74 5d 2a 77 61  egexp {^[ \t]*wa
2970: 70 70 2d 28 73 75 62 73 74 7c 74 72 69 6d 29 5b  pp-(subst|trim)[
2980: 20 5c 74 5d 2b 5b 5e 5c 31 37 33 5d 7d 20 24 78   \t]+[^\173]} $x
2990: 20 61 6c 6c 20 63 78 5d 7d 20 7b 0a 20 20 20 20   all cx]} {.    
29a0: 20 20 20 20 61 70 70 65 6e 64 20 72 65 73 20 22      append res "
29b0: 24 70 3a 24 6c 6e 3a 20 75 6e 73 61 66 65 20 5c  $p:$ln: unsafe \
29c0: 22 77 61 70 70 2d 24 63 78 5c 22 20 63 61 6c 6c  "wapp-$cx\" call
29d0: 3a 20 5c 22 5b 73 74 72 69 6e 67 20 74 72 69 6d  : \"[string trim
29e0: 20 24 78 5d 5c 22 5c 6e 22 0a 20 20 20 20 20 20   $x]\"\n".      
29f0: 7d 0a 20 20 20 20 7d 0a 20 20 7d 0a 20 20 72 65  }.    }.  }.  re
2a00: 74 75 72 6e 20 24 72 65 73 0a 7d 0a 0a 23 20 52  turn $res.}..# R
2a10: 65 74 75 72 6e 20 61 20 73 74 72 69 6e 67 20 74  eturn a string t
2a20: 68 61 74 20 64 65 73 63 72 69 70 74 73 20 74 68  hat descripts th
2a30: 65 20 63 75 72 72 65 6e 74 20 65 6e 76 69 72 6f  e current enviro
2a40: 6e 6d 65 6e 74 2e 20 20 41 70 70 6c 69 63 61 74  nment.  Applicat
2a50: 69 6f 6e 73 0a 23 20 6d 69 67 68 74 20 66 69 6e  ions.# might fin
2a60: 64 20 74 68 69 73 20 75 73 65 66 75 6c 20 66 6f  d this useful fo
2a70: 72 20 64 65 62 75 67 67 69 6e 67 2e 0a 23 0a 70  r debugging..#.p
2a80: 72 6f 63 20 77 61 70 70 2d 64 65 62 75 67 2d 65  roc wapp-debug-e
2a90: 6e 76 20 7b 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c  nv {} {.  global
2aa0: 20 77 61 70 70 0a 20 20 73 65 74 20 6f 75 74 20   wapp.  set out 
2ab0: 7b 7d 0a 20 20 66 6f 72 65 61 63 68 20 76 61 72  {}.  foreach var
2ac0: 20 5b 6c 73 6f 72 74 20 5b 64 69 63 74 20 6b 65   [lsort [dict ke
2ad0: 79 73 20 24 77 61 70 70 5d 5d 20 7b 0a 20 20 20  ys $wapp]] {.   
2ae0: 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 69 6e 64   if {[string ind
2af0: 65 78 20 24 76 61 72 20 30 5d 3d 3d 22 2e 22 7d  ex $var 0]=="."}
2b00: 20 63 6f 6e 74 69 6e 75 65 0a 20 20 20 20 61 70   continue.    ap
2b10: 70 65 6e 64 20 6f 75 74 20 22 24 76 61 72 20 3d  pend out "$var =
2b20: 20 5b 6c 69 73 74 20 5b 64 69 63 74 20 67 65 74   [list [dict get
2b30: 20 24 77 61 70 70 20 24 76 61 72 5d 5d 5c 6e 22   $wapp $var]]\n"
2b40: 0a 20 20 7d 0a 20 20 61 70 70 65 6e 64 20 6f 75  .  }.  append ou
2b50: 74 20 22 5c 5b 70 77 64 5c 5d 20 3d 20 5b 6c 69  t "\[pwd\] = [li
2b60: 73 74 20 5b 70 77 64 5d 5d 5c 6e 22 0a 20 20 72  st [pwd]]\n".  r
2b70: 65 74 75 72 6e 20 24 6f 75 74 0a 7d 0a 0a 23 20  eturn $out.}..# 
2b80: 54 72 61 63 69 6e 67 20 66 75 6e 63 74 69 6f 6e  Tracing function
2b90: 20 66 6f 72 20 65 61 63 68 20 48 54 54 50 20 72   for each HTTP r
2ba0: 65 71 75 65 73 74 2e 20 20 54 68 69 73 20 69 73  equest.  This is
2bb0: 20 6f 76 65 72 72 69 64 64 65 6e 20 62 79 20 77   overridden by w
2bc0: 61 70 70 2d 73 74 61 72 74 0a 23 20 69 66 20 74  app-start.# if t
2bd0: 72 61 63 69 6e 67 20 69 73 20 65 6e 61 62 6c 65  racing is enable
2be0: 64 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70 49 6e  d..#.proc wappIn
2bf0: 74 2d 74 72 61 63 65 20 7b 7d 20 7b 7d 0a 0a 23  t-trace {} {}..#
2c00: 20 53 74 61 72 74 20 75 70 20 61 20 6c 69 73 74   Start up a list
2c10: 65 6e 69 6e 67 20 73 6f 63 6b 65 74 2e 20 20 41  ening socket.  A
2c20: 72 72 61 6e 67 65 20 74 6f 20 69 6e 76 6f 6b 65  rrange to invoke
2c30: 20 77 61 70 70 49 6e 74 2d 6e 65 77 2d 63 6f 6e   wappInt-new-con
2c40: 6e 65 63 74 69 6f 6e 0a 23 20 66 6f 72 20 65 61  nection.# for ea
2c50: 63 68 20 69 6e 62 6f 75 6e 64 20 48 54 54 50 20  ch inbound HTTP 
2c60: 63 6f 6e 6e 65 63 74 69 6f 6e 2e 0a 23 0a 23 20  connection..#.# 
2c70: 20 20 20 70 6f 72 74 20 20 20 20 20 20 20 20 20     port         
2c80: 20 20 20 4c 69 73 74 65 6e 20 6f 6e 20 74 68 69     Listen on thi
2c90: 73 20 54 43 50 20 70 6f 72 74 2e 20 20 30 20 6d  s TCP port.  0 m
2ca0: 65 61 6e 73 20 74 6f 20 73 65 6c 65 63 74 20 61  eans to select a
2cb0: 20 70 6f 72 74 0a 23 20 20 20 20 20 20 20 20 20   port.#         
2cc0: 20 20 20 20 20 20 20 20 20 20 20 74 68 61 74 20             that 
2cd0: 69 73 20 6e 6f 74 20 63 75 72 72 65 6e 74 6c 79  is not currently
2ce0: 20 69 6e 20 75 73 65 0a 23 0a 23 20 20 20 20 77   in use.#.#    w
2cf0: 61 70 70 6d 6f 64 65 20 20 20 20 20 20 20 20 4f  appmode        O
2d00: 6e 65 20 6f 66 20 22 73 63 67 69 22 2c 20 22 72  ne of "scgi", "r
2d10: 65 6d 6f 74 65 2d 73 63 67 69 22 2c 20 22 73 65  emote-scgi", "se
2d20: 72 76 65 72 22 2c 20 6f 72 20 22 6c 6f 63 61 6c  rver", or "local
2d30: 22 2e 0a 23 0a 23 20 20 20 20 66 72 6f 6d 69 70  "..#.#    fromip
2d40: 20 20 20 20 20 20 20 20 20 20 49 66 20 6e 6f 74            If not
2d50: 20 7b 7d 2c 20 74 68 65 6e 20 72 65 6a 65 63 74   {}, then reject
2d60: 20 61 6c 6c 20 72 65 71 75 65 73 74 73 20 66 72   all requests fr
2d70: 6f 6d 20 49 50 20 61 64 64 72 65 73 73 65 73 0a  om IP addresses.
2d80: 23 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  #               
2d90: 20 20 20 20 20 6f 74 68 65 72 20 74 68 61 6e 20       other than 
2da0: 24 66 72 6f 6d 69 70 0a 23 0a 70 72 6f 63 20 77  $fromip.#.proc w
2db0: 61 70 70 49 6e 74 2d 73 74 61 72 74 2d 6c 69 73  appInt-start-lis
2dc0: 74 65 6e 65 72 20 7b 70 6f 72 74 20 77 61 70 70  tener {port wapp
2dd0: 6d 6f 64 65 20 66 72 6f 6d 69 70 7d 20 7b 0a 20  mode fromip} {. 
2de0: 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74   if {[string mat
2df0: 63 68 20 2a 73 63 67 69 20 24 77 61 70 70 6d 6f  ch *scgi $wappmo
2e00: 64 65 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 74  de]} {.    set t
2e10: 79 70 65 20 53 43 47 49 0a 20 20 20 20 73 65 74  ype SCGI.    set
2e20: 20 73 65 72 76 65 72 20 5b 6c 69 73 74 20 77 61   server [list wa
2e30: 70 70 49 6e 74 2d 6e 65 77 2d 63 6f 6e 6e 65 63  ppInt-new-connec
2e40: 74 69 6f 6e 20 5c 0a 20 20 20 20 20 20 20 20 20  tion \.         
2e50: 20 20 20 20 20 20 20 77 61 70 70 49 6e 74 2d 73         wappInt-s
2e60: 63 67 69 2d 72 65 61 64 61 62 6c 65 20 24 77 61  cgi-readable $wa
2e70: 70 70 6d 6f 64 65 20 24 66 72 6f 6d 69 70 5d 0a  ppmode $fromip].
2e80: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73    } else {.    s
2e90: 65 74 20 74 79 70 65 20 48 54 54 50 0a 20 20 20  et type HTTP.   
2ea0: 20 73 65 74 20 73 65 72 76 65 72 20 5b 6c 69 73   set server [lis
2eb0: 74 20 77 61 70 70 49 6e 74 2d 6e 65 77 2d 63 6f  t wappInt-new-co
2ec0: 6e 6e 65 63 74 69 6f 6e 20 5c 0a 20 20 20 20 20  nnection \.     
2ed0: 20 20 20 20 20 20 20 20 20 20 20 77 61 70 70 49             wappI
2ee0: 6e 74 2d 68 74 74 70 2d 72 65 61 64 61 62 6c 65  nt-http-readable
2ef0: 20 24 77 61 70 70 6d 6f 64 65 20 24 66 72 6f 6d   $wappmode $from
2f00: 69 70 5d 0a 20 20 7d 0a 20 20 69 66 20 7b 24 77  ip].  }.  if {$w
2f10: 61 70 70 6d 6f 64 65 3d 3d 22 6c 6f 63 61 6c 22  appmode=="local"
2f20: 20 7c 7c 20 24 77 61 70 70 6d 6f 64 65 3d 3d 22   || $wappmode=="
2f30: 73 63 67 69 22 7d 20 7b 0a 20 20 20 20 73 65 74  scgi"} {.    set
2f40: 20 78 20 5b 73 6f 63 6b 65 74 20 2d 73 65 72 76   x [socket -serv
2f50: 65 72 20 24 73 65 72 76 65 72 20 2d 6d 79 61 64  er $server -myad
2f60: 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 24 70 6f  dr 127.0.0.1 $po
2f70: 72 74 5d 0a 20 20 7d 20 65 6c 73 65 20 7b 0a 20  rt].  } else {. 
2f80: 20 20 20 73 65 74 20 78 20 5b 73 6f 63 6b 65 74     set x [socket
2f90: 20 2d 73 65 72 76 65 72 20 24 73 65 72 76 65 72   -server $server
2fa0: 20 24 70 6f 72 74 5d 0a 20 20 7d 0a 20 20 73 65   $port].  }.  se
2fb0: 74 20 63 6f 6e 69 6e 66 6f 20 5b 63 68 61 6e 20  t coninfo [chan 
2fc0: 63 6f 6e 66 69 67 75 72 65 20 24 78 20 2d 73 6f  configure $x -so
2fd0: 63 6b 6e 61 6d 65 5d 0a 20 20 73 65 74 20 70 6f  ckname].  set po
2fe0: 72 74 20 5b 6c 69 6e 64 65 78 20 24 63 6f 6e 69  rt [lindex $coni
2ff0: 6e 66 6f 20 32 5d 0a 20 20 69 66 20 7b 24 77 61  nfo 2].  if {$wa
3000: 70 70 6d 6f 64 65 3d 3d 22 6c 6f 63 61 6c 22 7d  ppmode=="local"}
3010: 20 7b 0a 20 20 20 20 77 61 70 70 49 6e 74 2d 73   {.    wappInt-s
3020: 74 61 72 74 2d 62 72 6f 77 73 65 72 20 68 74 74  tart-browser htt
3030: 70 3a 2f 2f 31 32 37 2e 30 2e 30 2e 31 3a 24 70  p://127.0.0.1:$p
3040: 6f 72 74 2f 0a 20 20 7d 20 65 6c 73 65 69 66 20  ort/.  } elseif 
3050: 7b 24 66 72 6f 6d 69 70 21 3d 22 22 7d 20 7b 0a  {$fromip!=""} {.
3060: 20 20 20 20 70 75 74 73 20 22 4c 69 73 74 65 6e      puts "Listen
3070: 69 6e 67 20 66 6f 72 20 24 74 79 70 65 20 72 65  ing for $type re
3080: 71 75 65 73 74 73 20 6f 6e 20 54 43 50 20 70 6f  quests on TCP po
3090: 72 74 20 24 70 6f 72 74 20 66 72 6f 6d 20 49 50  rt $port from IP
30a0: 20 24 66 72 6f 6d 69 70 22 0a 20 20 7d 20 65 6c   $fromip".  } el
30b0: 73 65 20 7b 0a 20 20 20 20 70 75 74 73 20 22 4c  se {.    puts "L
30c0: 69 73 74 65 6e 69 6e 67 20 66 6f 72 20 24 74 79  istening for $ty
30d0: 70 65 20 72 65 71 75 65 73 74 73 20 6f 6e 20 54  pe requests on T
30e0: 43 50 20 70 6f 72 74 20 24 70 6f 72 74 22 0a 20  CP port $port". 
30f0: 20 7d 0a 7d 0a 0a 23 20 53 74 61 72 74 20 61 20   }.}..# Start a 
3100: 77 65 62 2d 62 72 6f 77 73 65 72 20 61 6e 64 20  web-browser and 
3110: 70 6f 69 6e 74 20 69 74 20 61 74 20 24 55 52 4c  point it at $URL
3120: 0a 23 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d  .#.proc wappInt-
3130: 73 74 61 72 74 2d 62 72 6f 77 73 65 72 20 7b 75  start-browser {u
3140: 72 6c 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 74  rl} {.  global t
3150: 63 6c 5f 70 6c 61 74 66 6f 72 6d 0a 20 20 69 66  cl_platform.  if
3160: 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28   {$tcl_platform(
3170: 70 6c 61 74 66 6f 72 6d 29 3d 3d 22 77 69 6e 64  platform)=="wind
3180: 6f 77 73 22 7d 20 7b 0a 20 20 20 20 65 78 65 63  ows"} {.    exec
3190: 20 63 6d 64 20 2f 63 20 73 74 61 72 74 20 24 75   cmd /c start $u
31a0: 72 6c 20 26 0a 20 20 7d 20 65 6c 73 65 69 66 20  rl &.  } elseif 
31b0: 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 6f  {$tcl_platform(o
31c0: 73 29 3d 3d 22 44 61 72 77 69 6e 22 7d 20 7b 0a  s)=="Darwin"} {.
31d0: 20 20 20 20 65 78 65 63 20 6f 70 65 6e 20 24 75      exec open $u
31e0: 72 6c 20 26 0a 20 20 7d 20 65 6c 73 65 69 66 20  rl &.  } elseif 
31f0: 7b 5b 63 61 74 63 68 20 7b 65 78 65 63 20 78 64  {[catch {exec xd
3200: 67 2d 6f 70 65 6e 20 24 75 72 6c 7d 5d 7d 20 7b  g-open $url}]} {
3210: 0a 20 20 20 20 65 78 65 63 20 66 69 72 65 66 6f  .    exec firefo
3220: 78 20 24 75 72 6c 20 26 0a 20 20 7d 0a 7d 0a 0a  x $url &.  }.}..
3230: 23 20 54 68 69 73 20 72 6f 75 74 69 6e 65 20 69  # This routine i
3240: 73 20 61 20 22 73 6f 63 6b 65 74 20 2d 73 65 72  s a "socket -ser
3250: 76 65 72 22 20 63 61 6c 6c 62 61 63 6b 2e 20 20  ver" callback.  
3260: 54 68 65 20 24 63 68 61 6e 2c 20 24 69 70 2c 20  The $chan, $ip, 
3270: 61 6e 64 20 24 70 6f 72 74 0a 23 20 61 72 67 75  and $port.# argu
3280: 6d 65 6e 74 73 20 61 72 65 20 61 64 64 65 64 20  ments are added 
3290: 62 79 20 74 68 65 20 73 6f 63 6b 65 74 20 63 6f  by the socket co
32a0: 6d 6d 61 6e 64 2e 0a 23 0a 23 20 41 72 72 61 6e  mmand..#.# Arran
32b0: 67 65 20 74 6f 20 69 6e 76 6f 6b 65 20 24 63 61  ge to invoke $ca
32c0: 6c 6c 62 61 63 6b 20 77 68 65 6e 20 63 6f 6e 74  llback when cont
32d0: 65 6e 74 20 69 73 20 61 76 61 69 6c 61 62 6c 65  ent is available
32e0: 20 6f 6e 20 74 68 65 20 6e 65 77 20 73 6f 63 6b   on the new sock
32f0: 65 74 2e 0a 23 20 54 68 65 20 24 63 61 6c 6c 62  et..# The $callb
3300: 61 63 6b 20 77 69 6c 6c 20 70 72 6f 63 65 73 73  ack will process
3310: 20 69 6e 62 6f 75 6e 64 20 48 54 54 50 20 6f 72   inbound HTTP or
3320: 20 53 43 47 49 20 63 6f 6e 74 65 6e 74 2e 20 20   SCGI content.  
3330: 52 65 6a 65 63 74 20 74 68 65 0a 23 20 72 65 71  Reject the.# req
3340: 75 65 73 74 20 69 66 20 24 66 72 6f 6d 69 70 20  uest if $fromip 
3350: 69 73 20 6e 6f 74 20 61 6e 20 65 6d 70 74 79 20  is not an empty 
3360: 73 74 72 69 6e 67 20 61 6e 64 20 64 6f 65 73 20  string and does 
3370: 6e 6f 74 20 6d 61 74 63 68 20 24 69 70 2e 0a 23  not match $ip..#
3380: 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 6e 65  .proc wappInt-ne
3390: 77 2d 63 6f 6e 6e 65 63 74 69 6f 6e 20 7b 63 61  w-connection {ca
33a0: 6c 6c 62 61 63 6b 20 77 61 70 70 6d 6f 64 65 20  llback wappmode 
33b0: 66 72 6f 6d 69 70 20 63 68 61 6e 20 69 70 20 70  fromip chan ip p
33c0: 6f 72 74 7d 20 7b 0a 20 20 75 70 76 61 72 20 23  ort} {.  upvar #
33d0: 30 20 77 61 70 70 49 6e 74 2d 24 63 68 61 6e 20  0 wappInt-$chan 
33e0: 57 0a 20 20 69 66 20 7b 24 66 72 6f 6d 69 70 21  W.  if {$fromip!
33f0: 3d 22 22 20 26 26 20 21 5b 73 74 72 69 6e 67 20  ="" && ![string 
3400: 6d 61 74 63 68 20 24 66 72 6f 6d 69 70 20 24 69  match $fromip $i
3410: 70 5d 7d 20 7b 0a 20 20 20 20 63 6c 6f 73 65 20  p]} {.    close 
3420: 24 63 68 61 6e 0a 20 20 20 20 72 65 74 75 72 6e  $chan.    return
3430: 0a 20 20 7d 0a 20 20 73 65 74 20 57 20 5b 64 69  .  }.  set W [di
3440: 63 74 20 63 72 65 61 74 65 20 52 45 4d 4f 54 45  ct create REMOTE
3450: 5f 41 44 44 52 20 24 69 70 20 52 45 4d 4f 54 45  _ADDR $ip REMOTE
3460: 5f 50 4f 52 54 20 24 70 6f 72 74 20 57 41 50 50  _PORT $port WAPP
3470: 5f 4d 4f 44 45 20 24 77 61 70 70 6d 6f 64 65 20  _MODE $wappmode 
3480: 5c 0a 20 20 20 20 20 20 20 20 20 2e 68 65 61 64  \.         .head
3490: 65 72 20 7b 7d 5d 0a 20 20 66 63 6f 6e 66 69 67  er {}].  fconfig
34a0: 75 72 65 20 24 63 68 61 6e 20 2d 62 6c 6f 63 6b  ure $chan -block
34b0: 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69  ing 0 -translati
34c0: 6f 6e 20 62 69 6e 61 72 79 0a 20 20 66 69 6c 65  on binary.  file
34d0: 65 76 65 6e 74 20 24 63 68 61 6e 20 72 65 61 64  event $chan read
34e0: 61 62 6c 65 20 5b 6c 69 73 74 20 24 63 61 6c 6c  able [list $call
34f0: 62 61 63 6b 20 24 63 68 61 6e 5d 0a 7d 0a 0a 23  back $chan].}..#
3500: 20 43 6c 6f 73 65 20 61 6e 20 69 6e 70 75 74 20   Close an input 
3510: 63 68 61 6e 6e 65 6c 0a 23 0a 70 72 6f 63 20 77  channel.#.proc w
3520: 61 70 70 49 6e 74 2d 63 6c 6f 73 65 2d 63 68 61  appInt-close-cha
3530: 6e 6e 65 6c 20 7b 63 68 61 6e 7d 20 7b 0a 20 20  nnel {chan} {.  
3540: 69 66 20 7b 24 63 68 61 6e 3d 3d 22 73 74 64 6f  if {$chan=="stdo
3550: 75 74 22 7d 20 7b 0a 20 20 20 20 23 20 54 68 69  ut"} {.    # Thi
3560: 73 20 68 61 70 70 65 6e 73 20 61 66 74 65 72 20  s happens after 
3570: 63 6f 6d 70 6c 65 74 69 6e 67 20 61 20 43 47 49  completing a CGI
3580: 20 72 65 71 75 65 73 74 0a 20 20 20 20 65 78 69   request.    exi
3590: 74 20 30 0a 20 20 7d 20 65 6c 73 65 20 7b 0a 20  t 0.  } else {. 
35a0: 20 20 20 75 6e 73 65 74 20 3a 3a 77 61 70 70 49     unset ::wappI
35b0: 6e 74 2d 24 63 68 61 6e 0a 20 20 20 20 63 6c 6f  nt-$chan.    clo
35c0: 73 65 20 24 63 68 61 6e 0a 20 20 7d 0a 7d 0a 0a  se $chan.  }.}..
35d0: 23 20 50 72 6f 63 65 73 73 20 6e 65 77 20 74 65  # Process new te
35e0: 78 74 20 72 65 63 65 69 76 65 64 20 6f 6e 20 61  xt received on a
35f0: 6e 20 69 6e 62 6f 75 6e 64 20 48 54 54 50 20 72  n inbound HTTP r
3600: 65 71 75 65 73 74 0a 23 0a 70 72 6f 63 20 77 61  equest.#.proc wa
3610: 70 70 49 6e 74 2d 68 74 74 70 2d 72 65 61 64 61  ppInt-http-reada
3620: 62 6c 65 20 7b 63 68 61 6e 7d 20 7b 0a 20 20 69  ble {chan} {.  i
3630: 66 20 7b 5b 63 61 74 63 68 20 5b 6c 69 73 74 20  f {[catch [list 
3640: 77 61 70 70 49 6e 74 2d 68 74 74 70 2d 72 65 61  wappInt-http-rea
3650: 64 61 62 6c 65 2d 75 6e 73 61 66 65 20 24 63 68  dable-unsafe $ch
3660: 61 6e 5d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20  an] msg]} {.    
3670: 70 75 74 73 20 73 74 64 65 72 72 20 22 24 6d 73  puts stderr "$ms
3680: 67 5c 6e 24 3a 3a 65 72 72 6f 72 49 6e 66 6f 22  g\n$::errorInfo"
3690: 0a 20 20 20 20 77 61 70 70 49 6e 74 2d 63 6c 6f  .    wappInt-clo
36a0: 73 65 2d 63 68 61 6e 6e 65 6c 20 24 63 68 61 6e  se-channel $chan
36b0: 0a 20 20 7d 0a 7d 0a 70 72 6f 63 20 77 61 70 70  .  }.}.proc wapp
36c0: 49 6e 74 2d 68 74 74 70 2d 72 65 61 64 61 62 6c  Int-http-readabl
36d0: 65 2d 75 6e 73 61 66 65 20 7b 63 68 61 6e 7d 20  e-unsafe {chan} 
36e0: 7b 0a 20 20 75 70 76 61 72 20 23 30 20 77 61 70  {.  upvar #0 wap
36f0: 70 49 6e 74 2d 24 63 68 61 6e 20 57 20 77 61 70  pInt-$chan W wap
3700: 70 20 77 61 70 70 0a 20 20 69 66 20 7b 21 5b 64  p wapp.  if {![d
3710: 69 63 74 20 65 78 69 73 74 73 20 24 57 20 2e 74  ict exists $W .t
3720: 6f 72 65 61 64 5d 7d 20 7b 0a 20 20 20 20 23 20  oread]} {.    # 
3730: 49 66 20 74 68 65 20 2e 74 6f 72 65 61 64 20 6b  If the .toread k
3740: 65 79 20 69 73 20 6e 6f 74 20 73 65 74 2c 20 74  ey is not set, t
3750: 68 61 74 20 6d 65 61 6e 73 20 77 65 20 61 72 65  hat means we are
3760: 20 73 74 69 6c 6c 20 72 65 61 64 69 6e 67 0a 20   still reading. 
3770: 20 20 20 23 20 74 68 65 20 68 65 61 64 65 72 0a     # the header.
3780: 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 73 74      set line [st
3790: 72 69 6e 67 20 74 72 69 6d 72 69 67 68 74 20 5b  ring trimright [
37a0: 67 65 74 73 20 24 63 68 61 6e 5d 5d 0a 20 20 20  gets $chan]].   
37b0: 20 73 65 74 20 6e 20 5b 73 74 72 69 6e 67 20 6c   set n [string l
37c0: 65 6e 67 74 68 20 24 6c 69 6e 65 5d 0a 20 20 20  ength $line].   
37d0: 20 69 66 20 7b 24 6e 3e 30 7d 20 7b 0a 20 20 20   if {$n>0} {.   
37e0: 20 20 20 69 66 20 7b 5b 64 69 63 74 20 67 65 74     if {[dict get
37f0: 20 24 57 20 2e 68 65 61 64 65 72 5d 3d 3d 22 22   $W .header]==""
3800: 20 7c 7c 20 5b 72 65 67 65 78 70 20 7b 5e 5c 73   || [regexp {^\s
3810: 2b 7d 20 24 6c 69 6e 65 5d 7d 20 7b 0a 20 20 20  +} $line]} {.   
3820: 20 20 20 20 20 64 69 63 74 20 61 70 70 65 6e 64       dict append
3830: 20 57 20 2e 68 65 61 64 65 72 20 24 6c 69 6e 65   W .header $line
3840: 0a 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a  .      } else {.
3850: 20 20 20 20 20 20 20 20 64 69 63 74 20 61 70 70          dict app
3860: 65 6e 64 20 57 20 2e 68 65 61 64 65 72 20 5c 6e  end W .header \n
3870: 24 6c 69 6e 65 0a 20 20 20 20 20 20 7d 0a 20 20  $line.      }.  
3880: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20      if {[string 
3890: 6c 65 6e 67 74 68 20 5b 64 69 63 74 20 67 65 74  length [dict get
38a0: 20 24 57 20 2e 68 65 61 64 65 72 5d 5d 3e 31 30   $W .header]]>10
38b0: 30 30 30 30 7d 20 7b 0a 20 20 20 20 20 20 20 20  0000} {.        
38c0: 65 72 72 6f 72 20 22 48 54 54 50 20 72 65 71 75  error "HTTP requ
38d0: 65 73 74 20 68 65 61 64 65 72 20 74 6f 6f 20 62  est header too b
38e0: 69 67 20 2d 20 70 6f 73 73 69 62 6c 65 20 44 4f  ig - possible DO
38f0: 53 20 61 74 74 61 63 6b 22 0a 20 20 20 20 20 20  S attack".      
3900: 7d 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b  }.    } elseif {
3910: 24 6e 3d 3d 30 7d 20 7b 0a 20 20 20 20 20 20 23  $n==0} {.      #
3920: 20 57 65 20 68 61 76 65 20 72 65 61 63 68 65 64   We have reached
3930: 20 74 68 65 20 62 6c 61 6e 6b 20 6c 69 6e 65 20   the blank line 
3940: 74 68 61 74 20 74 65 72 6d 69 6e 61 74 65 73 20  that terminates 
3950: 74 68 65 20 68 65 61 64 65 72 2e 0a 20 20 20 20  the header..    
3960: 20 20 67 6c 6f 62 61 6c 20 61 72 67 76 30 0a 20    global argv0. 
3970: 20 20 20 20 20 73 65 74 20 61 30 20 5b 66 69 6c       set a0 [fil
3980: 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 24 61 72 67  e normalize $arg
3990: 76 30 5d 0a 20 20 20 20 20 20 64 69 63 74 20 73  v0].      dict s
39a0: 65 74 20 57 20 53 43 52 49 50 54 5f 46 49 4c 45  et W SCRIPT_FILE
39b0: 4e 41 4d 45 20 24 61 30 0a 20 20 20 20 20 20 64  NAME $a0.      d
39c0: 69 63 74 20 73 65 74 20 57 20 44 4f 43 55 4d 45  ict set W DOCUME
39d0: 4e 54 5f 52 4f 4f 54 20 5b 66 69 6c 65 20 64 69  NT_ROOT [file di
39e0: 72 20 24 61 30 5d 0a 20 20 20 20 20 20 69 66 20  r $a0].      if 
39f0: 7b 5b 77 61 70 70 49 6e 74 2d 70 61 72 73 65 2d  {[wappInt-parse-
3a00: 68 65 61 64 65 72 20 24 63 68 61 6e 5d 7d 20 7b  header $chan]} {
3a10: 0a 20 20 20 20 20 20 20 20 63 61 74 63 68 20 7b  .        catch {
3a20: 63 6c 6f 73 65 20 24 63 68 61 6e 7d 0a 20 20 20  close $chan}.   
3a30: 20 20 20 20 20 72 65 74 75 72 6e 0a 20 20 20 20       return.    
3a40: 20 20 7d 0a 20 20 20 20 20 20 73 65 74 20 6c 65    }.      set le
3a50: 6e 20 30 0a 20 20 20 20 20 20 69 66 20 7b 5b 64  n 0.      if {[d
3a60: 69 63 74 20 65 78 69 73 74 73 20 24 57 20 43 4f  ict exists $W CO
3a70: 4e 54 45 4e 54 5f 4c 45 4e 47 54 48 5d 7d 20 7b  NTENT_LENGTH]} {
3a80: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 65 6e  .        set len
3a90: 20 5b 64 69 63 74 20 67 65 74 20 24 57 20 43 4f   [dict get $W CO
3aa0: 4e 54 45 4e 54 5f 4c 45 4e 47 54 48 5d 0a 20 20  NTENT_LENGTH].  
3ab0: 20 20 20 20 7d 0a 20 20 20 20 20 20 69 66 20 7b      }.      if {
3ac0: 24 6c 65 6e 3e 30 7d 20 7b 0a 20 20 20 20 20 20  $len>0} {.      
3ad0: 20 20 23 20 53 74 69 6c 6c 20 6e 65 65 64 20 74    # Still need t
3ae0: 6f 20 72 65 61 64 20 74 68 65 20 71 75 65 72 79  o read the query
3af0: 20 63 6f 6e 74 65 6e 74 0a 20 20 20 20 20 20 20   content.       
3b00: 20 64 69 63 74 20 73 65 74 20 57 20 2e 74 6f 72   dict set W .tor
3b10: 65 61 64 20 24 6c 65 6e 0a 20 20 20 20 20 20 7d  ead $len.      }
3b20: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20   else {.        
3b30: 23 20 54 68 65 72 65 20 69 73 20 6e 6f 20 71 75  # There is no qu
3b40: 65 72 79 20 63 6f 6e 74 65 6e 74 2c 20 73 6f 20  ery content, so 
3b50: 68 61 6e 64 6c 65 20 74 68 65 20 72 65 71 75 65  handle the reque
3b60: 73 74 20 69 6d 6d 65 64 69 61 74 65 6c 79 0a 20  st immediately. 
3b70: 20 20 20 20 20 20 20 73 65 74 20 77 61 70 70 20         set wapp 
3b80: 24 57 0a 20 20 20 20 20 20 20 20 77 61 70 70 49  $W.        wappI
3b90: 6e 74 2d 68 61 6e 64 6c 65 2d 72 65 71 75 65 73  nt-handle-reques
3ba0: 74 20 24 63 68 61 6e 20 30 0a 20 20 20 20 20 20  t $chan 0.      
3bb0: 7d 0a 20 20 20 20 7d 0a 20 20 7d 20 65 6c 73 65  }.    }.  } else
3bc0: 20 7b 0a 20 20 20 20 23 20 49 66 20 2e 74 6f 72   {.    # If .tor
3bd0: 65 61 64 20 69 73 20 73 65 74 2c 20 74 68 61 74  ead is set, that
3be0: 20 6d 65 61 6e 73 20 77 65 20 61 72 65 20 72 65   means we are re
3bf0: 61 64 69 6e 67 20 74 68 65 20 71 75 65 72 79 20  ading the query 
3c00: 63 6f 6e 74 65 6e 74 2e 0a 20 20 20 20 23 20 43  content..    # C
3c10: 6f 6e 74 69 6e 75 65 20 72 65 61 64 69 6e 67 20  ontinue reading 
3c20: 75 6e 74 69 6c 20 2e 74 6f 72 65 61 64 20 72 65  until .toread re
3c30: 61 63 68 65 73 20 7a 65 72 6f 2e 0a 20 20 20 20  aches zero..    
3c40: 73 65 74 20 67 6f 74 20 5b 72 65 61 64 20 24 63  set got [read $c
3c50: 68 61 6e 20 5b 64 69 63 74 20 67 65 74 20 24 57  han [dict get $W
3c60: 20 2e 74 6f 72 65 61 64 5d 5d 0a 20 20 20 20 64   .toread]].    d
3c70: 69 63 74 20 61 70 70 65 6e 64 20 57 20 43 4f 4e  ict append W CON
3c80: 54 45 4e 54 20 24 67 6f 74 0a 20 20 20 20 64 69  TENT $got.    di
3c90: 63 74 20 73 65 74 20 57 20 2e 74 6f 72 65 61 64  ct set W .toread
3ca0: 20 5b 65 78 70 72 20 7b 5b 64 69 63 74 20 67 65   [expr {[dict ge
3cb0: 74 20 24 57 20 2e 74 6f 72 65 61 64 5d 2d 5b 73  t $W .toread]-[s
3cc0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 67 6f  tring length $go
3cd0: 74 5d 7d 5d 0a 20 20 20 20 69 66 20 7b 5b 64 69  t]}].    if {[di
3ce0: 63 74 20 67 65 74 20 24 57 20 2e 74 6f 72 65 61  ct get $W .torea
3cf0: 64 5d 3c 3d 30 7d 20 7b 0a 20 20 20 20 20 20 23  d]<=0} {.      #
3d00: 20 48 61 6e 64 6c 65 20 74 68 65 20 72 65 71 75   Handle the requ
3d10: 65 73 74 20 61 73 20 73 6f 6f 6e 20 61 73 20 61  est as soon as a
3d20: 6c 6c 20 74 68 65 20 71 75 65 72 79 20 63 6f 6e  ll the query con
3d30: 74 65 6e 74 20 69 73 20 72 65 63 65 69 76 65 64  tent is received
3d40: 0a 20 20 20 20 20 20 73 65 74 20 77 61 70 70 20  .      set wapp 
3d50: 24 57 0a 20 20 20 20 20 20 77 61 70 70 49 6e 74  $W.      wappInt
3d60: 2d 68 61 6e 64 6c 65 2d 72 65 71 75 65 73 74 20  -handle-request 
3d70: 24 63 68 61 6e 20 30 0a 20 20 20 20 7d 0a 20 20  $chan 0.    }.  
3d80: 7d 0a 7d 0a 0a 23 20 44 65 63 6f 64 65 20 74 68  }.}..# Decode th
3d90: 65 20 48 54 54 50 20 72 65 71 75 65 73 74 20 68  e HTTP request h
3da0: 65 61 64 65 72 2e 0a 23 0a 23 20 54 68 69 73 20  eader..#.# This 
3db0: 72 6f 75 74 69 6e 65 20 69 73 20 61 6c 77 61 79  routine is alway
3dc0: 73 20 72 75 6e 6e 69 6e 67 20 69 6e 73 69 64 65  s running inside
3dd0: 20 6f 66 20 61 20 5b 63 61 74 63 68 5d 2c 20 73   of a [catch], s
3de0: 6f 20 69 66 0a 23 20 61 6e 79 20 70 72 6f 62 6c  o if.# any probl
3df0: 65 6d 73 20 61 72 69 73 65 2c 20 73 69 6d 70 6c  ems arise, simpl
3e00: 79 20 72 61 69 73 65 20 61 6e 20 65 72 72 6f 72  y raise an error
3e10: 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70 49 6e 74  ..#.proc wappInt
3e20: 2d 70 61 72 73 65 2d 68 65 61 64 65 72 20 7b 63  -parse-header {c
3e30: 68 61 6e 7d 20 7b 0a 20 20 75 70 76 61 72 20 23  han} {.  upvar #
3e40: 30 20 77 61 70 70 49 6e 74 2d 24 63 68 61 6e 20  0 wappInt-$chan 
3e50: 57 0a 20 20 73 65 74 20 68 64 72 20 5b 73 70 6c  W.  set hdr [spl
3e60: 69 74 20 5b 64 69 63 74 20 67 65 74 20 24 57 20  it [dict get $W 
3e70: 2e 68 65 61 64 65 72 5d 20 5c 6e 5d 0a 20 20 69  .header] \n].  i
3e80: 66 20 7b 24 68 64 72 3d 3d 22 22 7d 20 7b 72 65  f {$hdr==""} {re
3e90: 74 75 72 6e 20 31 7d 0a 20 20 73 65 74 20 72 65  turn 1}.  set re
3ea0: 71 20 5b 6c 69 6e 64 65 78 20 24 68 64 72 20 30  q [lindex $hdr 0
3eb0: 5d 0a 20 20 64 69 63 74 20 73 65 74 20 57 20 52  ].  dict set W R
3ec0: 45 51 55 45 53 54 5f 4d 45 54 48 4f 44 20 5b 73  EQUEST_METHOD [s
3ed0: 65 74 20 6d 65 74 68 6f 64 20 5b 6c 69 6e 64 65  et method [linde
3ee0: 78 20 24 72 65 71 20 30 5d 5d 0a 20 20 69 66 20  x $req 0]].  if 
3ef0: 7b 5b 6c 73 65 61 72 63 68 20 7b 47 45 54 20 48  {[lsearch {GET H
3f00: 45 41 44 20 50 4f 53 54 7d 20 24 6d 65 74 68 6f  EAD POST} $metho
3f10: 64 5d 3c 30 7d 20 7b 0a 20 20 20 20 65 72 72 6f  d]<0} {.    erro
3f20: 72 20 22 75 6e 73 75 70 70 6f 72 74 65 64 20 72  r "unsupported r
3f30: 65 71 75 65 73 74 20 6d 65 74 68 6f 64 3a 20 5c  equest method: \
3f40: 22 5b 64 69 63 74 20 67 65 74 20 24 57 20 52 45  "[dict get $W RE
3f50: 51 55 45 53 54 5f 4d 45 54 48 4f 44 5d 5c 22 22  QUEST_METHOD]\""
3f60: 0a 20 20 7d 0a 20 20 73 65 74 20 75 72 69 20 5b  .  }.  set uri [
3f70: 6c 69 6e 64 65 78 20 24 72 65 71 20 31 5d 0a 20  lindex $req 1]. 
3f80: 20 73 65 74 20 73 70 6c 69 74 5f 75 72 69 20 5b   set split_uri [
3f90: 73 70 6c 69 74 20 24 75 72 69 20 3f 5d 0a 20 20  split $uri ?].  
3fa0: 73 65 74 20 75 72 69 30 20 5b 6c 69 6e 64 65 78  set uri0 [lindex
3fb0: 20 24 73 70 6c 69 74 5f 75 72 69 20 30 5d 0a 20   $split_uri 0]. 
3fc0: 20 69 66 20 7b 21 5b 72 65 67 65 78 70 20 7b 5e   if {![regexp {^
3fd0: 2f 5b 2d 2e 61 2d 7a 30 2d 39 5f 2f 5d 2a 24 7d  /[-.a-z0-9_/]*$}
3fe0: 20 24 75 72 69 30 5d 7d 20 7b 0a 20 20 20 20 65   $uri0]} {.    e
3ff0: 72 72 6f 72 20 22 69 6e 76 61 6c 69 64 20 72 65  rror "invalid re
4000: 71 75 65 73 74 20 75 72 69 3a 20 5c 22 24 75 72  quest uri: \"$ur
4010: 69 30 5c 22 22 0a 20 20 7d 0a 20 20 64 69 63 74  i0\"".  }.  dict
4020: 20 73 65 74 20 57 20 52 45 51 55 45 53 54 5f 55   set W REQUEST_U
4030: 52 49 20 24 75 72 69 30 0a 20 20 64 69 63 74 20  RI $uri0.  dict 
4040: 73 65 74 20 57 20 50 41 54 48 5f 49 4e 46 4f 20  set W PATH_INFO 
4050: 24 75 72 69 30 0a 20 20 73 65 74 20 75 72 69 31  $uri0.  set uri1
4060: 20 5b 6c 69 6e 64 65 78 20 24 73 70 6c 69 74 5f   [lindex $split_
4070: 75 72 69 20 31 5d 0a 20 20 64 69 63 74 20 73 65  uri 1].  dict se
4080: 74 20 57 20 51 55 45 52 59 5f 53 54 52 49 4e 47  t W QUERY_STRING
4090: 20 24 75 72 69 31 0a 20 20 73 65 74 20 6e 20 5b   $uri1.  set n [
40a0: 6c 6c 65 6e 67 74 68 20 24 68 64 72 5d 0a 20 20  llength $hdr].  
40b0: 66 6f 72 20 7b 73 65 74 20 69 20 31 7d 20 7b 24  for {set i 1} {$
40c0: 69 3c 24 6e 7d 20 7b 69 6e 63 72 20 69 7d 20 7b  i<$n} {incr i} {
40d0: 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 6e 64  .    set x [lind
40e0: 65 78 20 24 68 64 72 20 24 69 5d 0a 20 20 20 20  ex $hdr $i].    
40f0: 69 66 20 7b 21 5b 72 65 67 65 78 70 20 7b 5e 28  if {![regexp {^(
4100: 2e 2b 29 3a 20 2b 28 2e 2a 29 24 7d 20 24 78 20  .+): +(.*)$} $x 
4110: 61 6c 6c 20 6e 61 6d 65 20 76 61 6c 75 65 5d 7d  all name value]}
4120: 20 7b 0a 20 20 20 20 20 20 65 72 72 6f 72 20 22   {.      error "
4130: 69 6e 76 61 6c 69 64 20 68 65 61 64 65 72 20 6c  invalid header l
4140: 69 6e 65 3a 20 5c 22 24 78 5c 22 22 0a 20 20 20  ine: \"$x\"".   
4150: 20 7d 0a 20 20 20 20 73 65 74 20 6e 61 6d 65 20   }.    set name 
4160: 5b 73 74 72 69 6e 67 20 74 6f 75 70 70 65 72 20  [string toupper 
4170: 24 6e 61 6d 65 5d 0a 20 20 20 20 73 77 69 74 63  $name].    switc
4180: 68 20 2d 2d 20 24 6e 61 6d 65 20 7b 0a 20 20 20  h -- $name {.   
4190: 20 20 20 52 45 46 45 52 45 52 20 7b 73 65 74 20     REFERER {set 
41a0: 6e 61 6d 65 20 48 54 54 50 5f 52 45 46 45 52 45  name HTTP_REFERE
41b0: 52 7d 0a 20 20 20 20 20 20 55 53 45 52 2d 41 47  R}.      USER-AG
41c0: 45 4e 54 20 7b 73 65 74 20 6e 61 6d 65 20 48 54  ENT {set name HT
41d0: 54 50 5f 55 53 45 52 5f 41 47 45 4e 54 7d 0a 20  TP_USER_AGENT}. 
41e0: 20 20 20 20 20 43 4f 4e 54 45 4e 54 2d 4c 45 4e       CONTENT-LEN
41f0: 47 54 48 20 7b 73 65 74 20 6e 61 6d 65 20 43 4f  GTH {set name CO
4200: 4e 54 45 4e 54 5f 4c 45 4e 47 54 48 7d 0a 20 20  NTENT_LENGTH}.  
4210: 20 20 20 20 43 4f 4e 54 45 4e 54 2d 54 59 50 45      CONTENT-TYPE
4220: 20 7b 73 65 74 20 6e 61 6d 65 20 43 4f 4e 54 45   {set name CONTE
4230: 4e 54 5f 54 59 50 45 7d 0a 20 20 20 20 20 20 48  NT_TYPE}.      H
4240: 4f 53 54 20 7b 73 65 74 20 6e 61 6d 65 20 48 54  OST {set name HT
4250: 54 50 5f 48 4f 53 54 7d 0a 20 20 20 20 20 20 43  TP_HOST}.      C
4260: 4f 4f 4b 49 45 20 7b 73 65 74 20 6e 61 6d 65 20  OOKIE {set name 
4270: 48 54 54 50 5f 43 4f 4f 4b 49 45 7d 0a 20 20 20  HTTP_COOKIE}.   
4280: 20 20 20 41 43 43 45 50 54 2d 45 4e 43 4f 44 49     ACCEPT-ENCODI
4290: 4e 47 20 7b 73 65 74 20 6e 61 6d 65 20 48 54 54  NG {set name HTT
42a0: 50 5f 41 43 43 45 50 54 5f 45 4e 43 4f 44 49 4e  P_ACCEPT_ENCODIN
42b0: 47 7d 0a 20 20 20 20 20 20 64 65 66 61 75 6c 74  G}.      default
42c0: 20 7b 73 65 74 20 6e 61 6d 65 20 2e 68 64 72 3a   {set name .hdr:
42d0: 24 6e 61 6d 65 7d 0a 20 20 20 20 7d 0a 20 20 20  $name}.    }.   
42e0: 20 64 69 63 74 20 73 65 74 20 57 20 24 6e 61 6d   dict set W $nam
42f0: 65 20 24 76 61 6c 75 65 0a 20 20 7d 0a 20 20 72  e $value.  }.  r
4300: 65 74 75 72 6e 20 30 0a 7d 0a 0a 23 20 44 65 63  eturn 0.}..# Dec
4310: 6f 64 65 20 74 68 65 20 51 55 45 52 59 5f 53 54  ode the QUERY_ST
4320: 52 49 4e 47 20 70 61 72 61 6d 65 74 65 72 73 20  RING parameters 
4330: 66 72 6f 6d 20 61 20 47 45 54 20 72 65 71 75 65  from a GET reque
4340: 73 74 20 6f 72 20 74 68 65 0a 23 20 61 70 70 6c  st or the.# appl
4350: 69 63 61 74 69 6f 6e 2f 78 2d 77 77 77 2d 66 6f  ication/x-www-fo
4360: 72 6d 2d 75 72 6c 65 6e 63 6f 64 65 64 20 43 4f  rm-urlencoded CO
4370: 4e 54 45 4e 54 20 66 72 6f 6d 20 61 20 50 4f 53  NTENT from a POS
4380: 54 20 72 65 71 75 65 73 74 2e 0a 23 0a 23 20 54  T request..#.# T
4390: 68 69 73 20 72 6f 75 74 69 6e 65 20 73 65 74 73  his routine sets
43a0: 20 74 68 65 20 22 2e 71 70 22 20 65 6c 65 6d 65   the ".qp" eleme
43b0: 6e 74 20 6f 66 20 74 68 65 20 3a 3a 77 61 70 70  nt of the ::wapp
43c0: 20 64 69 63 74 20 61 73 20 61 20 73 69 67 6e 61   dict as a signa
43d0: 6c 0a 23 20 74 68 61 74 20 71 75 65 72 79 20 70  l.# that query p
43e0: 61 72 61 6d 65 74 65 72 73 20 68 61 76 65 20 61  arameters have a
43f0: 6c 72 65 61 64 79 20 62 65 65 6e 20 64 65 63 6f  lready been deco
4400: 64 65 64 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70  ded..#.proc wapp
4410: 49 6e 74 2d 64 65 63 6f 64 65 2d 71 75 65 72 79  Int-decode-query
4420: 2d 70 61 72 61 6d 73 20 7b 7d 20 7b 0a 20 20 67  -params {} {.  g
4430: 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 64 69 63  lobal wapp.  dic
4440: 74 20 73 65 74 20 77 61 70 70 20 2e 71 70 20 31  t set wapp .qp 1
4450: 0a 20 20 69 66 20 7b 5b 64 69 63 74 20 65 78 69  .  if {[dict exi
4460: 73 74 73 20 24 77 61 70 70 20 51 55 45 52 59 5f  sts $wapp QUERY_
4470: 53 54 52 49 4e 47 5d 7d 20 7b 0a 20 20 20 20 66  STRING]} {.    f
4480: 6f 72 65 61 63 68 20 71 74 65 72 6d 20 5b 73 70  oreach qterm [sp
4490: 6c 69 74 20 5b 64 69 63 74 20 67 65 74 20 24 77  lit [dict get $w
44a0: 61 70 70 20 51 55 45 52 59 5f 53 54 52 49 4e 47  app QUERY_STRING
44b0: 5d 20 26 5d 20 7b 0a 20 20 20 20 20 20 73 65 74  ] &] {.      set
44c0: 20 71 73 70 6c 69 74 20 5b 73 70 6c 69 74 20 24   qsplit [split $
44d0: 71 74 65 72 6d 20 3d 5d 0a 20 20 20 20 20 20 73  qterm =].      s
44e0: 65 74 20 6e 6d 20 5b 6c 69 6e 64 65 78 20 24 71  et nm [lindex $q
44f0: 73 70 6c 69 74 20 30 5d 0a 20 20 20 20 20 20 69  split 0].      i
4500: 66 20 7b 5b 72 65 67 65 78 70 20 7b 5e 5b 61 2d  f {[regexp {^[a-
4510: 7a 5d 5b 61 2d 7a 30 2d 39 5d 2a 24 7d 20 24 6e  z][a-z0-9]*$} $n
4520: 6d 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 64 69  m]} {.        di
4530: 63 74 20 73 65 74 20 77 61 70 70 20 24 6e 6d 20  ct set wapp $nm 
4540: 5b 77 61 70 70 49 6e 74 2d 64 65 63 6f 64 65 2d  [wappInt-decode-
4550: 75 72 6c 20 5b 6c 69 6e 64 65 78 20 24 71 73 70  url [lindex $qsp
4560: 6c 69 74 20 31 5d 5d 0a 20 20 20 20 20 20 7d 0a  lit 1]].      }.
4570: 20 20 20 20 7d 0a 20 20 7d 0a 20 20 69 66 20 7b      }.  }.  if {
4580: 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 77 61  [dict exists $wa
4590: 70 70 20 43 4f 4e 54 45 4e 54 5f 54 59 50 45 5d  pp CONTENT_TYPE]
45a0: 20 26 26 20 5b 64 69 63 74 20 65 78 69 73 74 73   && [dict exists
45b0: 20 24 77 61 70 70 20 43 4f 4e 54 45 4e 54 5d 7d   $wapp CONTENT]}
45c0: 20 7b 0a 20 20 20 20 73 65 74 20 63 74 79 70 65   {.    set ctype
45d0: 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70 70   [dict get $wapp
45e0: 20 43 4f 4e 54 45 4e 54 5f 54 59 50 45 5d 0a 20   CONTENT_TYPE]. 
45f0: 20 20 20 69 66 20 7b 24 63 74 79 70 65 3d 3d 22     if {$ctype=="
4600: 61 70 70 6c 69 63 61 74 69 6f 6e 2f 78 2d 77 77  application/x-ww
4610: 77 2d 66 6f 72 6d 2d 75 72 6c 65 6e 63 6f 64 65  w-form-urlencode
4620: 64 22 7d 20 7b 0a 20 20 20 20 20 20 66 6f 72 65  d"} {.      fore
4630: 61 63 68 20 71 74 65 72 6d 20 5b 73 70 6c 69 74  ach qterm [split
4640: 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 20 5b 64   [string trim [d
4650: 69 63 74 20 67 65 74 20 24 77 61 70 70 20 43 4f  ict get $wapp CO
4660: 4e 54 45 4e 54 5d 5d 20 26 5d 20 7b 0a 20 20 20  NTENT]] &] {.   
4670: 20 20 20 20 20 73 65 74 20 71 73 70 6c 69 74 20       set qsplit 
4680: 5b 73 70 6c 69 74 20 24 71 74 65 72 6d 20 3d 5d  [split $qterm =]
4690: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6e 6d 20  .        set nm 
46a0: 5b 6c 69 6e 64 65 78 20 24 71 73 70 6c 69 74 20  [lindex $qsplit 
46b0: 30 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b  0].        if {[
46c0: 72 65 67 65 78 70 20 7b 5e 5b 61 2d 7a 5d 5b 2d  regexp {^[a-z][-
46d0: 61 2d 7a 30 2d 39 5f 5d 2a 24 7d 20 24 6e 6d 5d  a-z0-9_]*$} $nm]
46e0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 64 69  } {.          di
46f0: 63 74 20 73 65 74 20 77 61 70 70 20 24 6e 6d 20  ct set wapp $nm 
4700: 5b 77 61 70 70 49 6e 74 2d 64 65 63 6f 64 65 2d  [wappInt-decode-
4710: 75 72 6c 20 5b 6c 69 6e 64 65 78 20 24 71 73 70  url [lindex $qsp
4720: 6c 69 74 20 31 5d 5d 0a 20 20 20 20 20 20 20 20  lit 1]].        
4730: 7d 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 20  }.      }.    } 
4740: 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20  elseif {[string 
4750: 6d 61 74 63 68 20 6d 75 6c 74 69 70 61 72 74 2f  match multipart/
4760: 66 6f 72 6d 2d 64 61 74 61 2a 20 24 63 74 79 70  form-data* $ctyp
4770: 65 5d 7d 20 7b 0a 20 20 20 20 20 20 72 65 67 65  e]} {.      rege
4780: 78 70 20 7b 5e 28 2e 2a 3f 29 5c 72 5c 6e 28 2e  xp {^(.*?)\r\n(.
4790: 2a 29 24 7d 20 5b 64 69 63 74 20 67 65 74 20 24  *)$} [dict get $
47a0: 77 61 70 70 20 43 4f 4e 54 45 4e 54 5d 20 61 6c  wapp CONTENT] al
47b0: 6c 20 64 69 76 69 64 65 72 20 62 6f 64 79 0a 20  l divider body. 
47c0: 20 20 20 20 20 73 65 74 20 6e 64 69 76 20 5b 73       set ndiv [s
47d0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 69  tring length $di
47e0: 76 69 64 65 72 5d 0a 20 20 20 20 20 20 77 68 69  vider].      whi
47f0: 6c 65 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67  le {[string leng
4800: 74 68 20 24 62 6f 64 79 5d 7d 20 7b 0a 20 20 20  th $body]} {.   
4810: 20 20 20 20 20 73 65 74 20 69 64 78 20 5b 73 74       set idx [st
4820: 72 69 6e 67 20 66 69 72 73 74 20 24 64 69 76 69  ring first $divi
4830: 64 65 72 20 24 62 6f 64 79 5d 0a 20 20 20 20 20  der $body].     
4840: 20 20 20 73 65 74 20 75 6e 69 74 20 5b 73 74 72     set unit [str
4850: 69 6e 67 20 72 61 6e 67 65 20 24 62 6f 64 79 20  ing range $body 
4860: 30 20 5b 65 78 70 72 20 7b 24 69 64 78 2d 33 7d  0 [expr {$idx-3}
4870: 5d 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 62  ]].        set b
4880: 6f 64 79 20 5b 73 74 72 69 6e 67 20 72 61 6e 67  ody [string rang
4890: 65 20 24 62 6f 64 79 20 5b 65 78 70 72 20 7b 24  e $body [expr {$
48a0: 69 64 78 2b 24 6e 64 69 76 2b 32 7d 5d 20 65 6e  idx+$ndiv+2}] en
48b0: 64 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b  d].        if {[
48c0: 72 65 67 65 78 70 20 7b 5e 43 6f 6e 74 65 6e 74  regexp {^Content
48d0: 2d 44 69 73 70 6f 73 69 74 69 6f 6e 3a 20 66 6f  -Disposition: fo
48e0: 72 6d 2d 64 61 74 61 3b 20 28 2e 2a 3f 29 5c 72  rm-data; (.*?)\r
48f0: 5c 6e 5c 72 5c 6e 28 2e 2a 29 24 7d 20 5c 0a 20  \n\r\n(.*)$} \. 
4900: 20 20 20 20 20 20 20 20 20 20 20 20 24 75 6e 69              $uni
4910: 74 20 75 6e 69 74 20 68 64 72 20 63 6f 6e 74 65  t unit hdr conte
4920: 6e 74 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20  nt]} {.         
4930: 20 69 66 20 7b 5b 72 65 67 65 78 70 20 7b 6e 61   if {[regexp {na
4940: 6d 65 3d 22 28 2e 2a 29 22 3b 20 66 69 6c 65 6e  me="(.*)"; filen
4950: 61 6d 65 3d 22 28 2e 2a 29 22 5c 72 5c 6e 43 6f  ame="(.*)"\r\nCo
4960: 6e 74 65 6e 74 2d 54 79 70 65 3a 20 28 2e 2a 3f  ntent-Type: (.*?
4970: 29 24 7d 5c 0a 20 20 20 20 20 20 20 20 20 20 20  )$}\.           
4980: 20 20 20 20 20 24 68 64 72 20 68 72 20 6e 61 6d       $hdr hr nam
4990: 65 20 66 69 6c 65 6e 61 6d 65 20 6d 69 6d 65 74  e filename mimet
49a0: 79 70 65 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20  ype]} {.        
49b0: 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61 70      dict set wap
49c0: 70 20 24 6e 61 6d 65 2e 66 69 6c 65 6e 61 6d 65  p $name.filename
49d0: 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20   \.             
49e0: 20 5b 73 74 72 69 6e 67 20 6d 61 70 20 5b 6c 69   [string map [li
49f0: 73 74 20 5c 5c 5c 22 20 5c 22 20 5c 5c 5c 5c 20  st \\\" \" \\\\ 
4a00: 5c 5c 5d 20 24 66 69 6c 65 6e 61 6d 65 5d 0a 20  \\] $filename]. 
4a10: 20 20 20 20 20 20 20 20 20 20 20 64 69 63 74 20             dict 
4a20: 73 65 74 20 77 61 70 70 20 24 6e 61 6d 65 2e 6d  set wapp $name.m
4a30: 69 6d 65 74 79 70 65 20 24 6d 69 6d 65 74 79 70  imetype $mimetyp
4a40: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 64 69  e.            di
4a50: 63 74 20 73 65 74 20 77 61 70 70 20 24 6e 61 6d  ct set wapp $nam
4a60: 65 2e 63 6f 6e 74 65 6e 74 20 24 63 6f 6e 74 65  e.content $conte
4a70: 6e 74 0a 20 20 20 20 20 20 20 20 20 20 7d 20 65  nt.          } e
4a80: 6c 73 65 69 66 20 7b 5b 72 65 67 65 78 70 20 7b  lseif {[regexp {
4a90: 6e 61 6d 65 3d 22 28 2e 2a 29 22 7d 20 24 68 64  name="(.*)"} $hd
4aa0: 72 20 68 72 20 6e 61 6d 65 5d 7d 20 7b 0a 20 20  r hr name]} {.  
4ab0: 20 20 20 20 20 20 20 20 20 20 64 69 63 74 20 73            dict s
4ac0: 65 74 20 77 61 70 70 20 24 6e 61 6d 65 20 24 63  et wapp $name $c
4ad0: 6f 6e 74 65 6e 74 0a 20 20 20 20 20 20 20 20 20  ontent.         
4ae0: 20 7d 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20   }.        }.   
4af0: 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d 0a 7d     }.    }.  }.}
4b00: 0a 0a 23 20 49 6e 76 6f 6b 65 20 61 70 70 6c 69  ..# Invoke appli
4b10: 63 61 74 69 6f 6e 2d 73 75 70 70 6c 69 65 64 20  cation-supplied 
4b20: 6d 65 74 68 6f 64 73 20 74 6f 20 67 65 6e 65 72  methods to gener
4b30: 61 74 65 20 61 20 72 65 70 6c 79 20 74 6f 0a 23  ate a reply to.#
4b40: 20 61 20 73 69 6e 67 6c 65 20 48 54 54 50 20 72   a single HTTP r
4b50: 65 71 75 65 73 74 2e 0a 23 0a 23 20 54 68 69 73  equest..#.# This
4b60: 20 72 6f 75 74 69 6e 65 20 61 6c 77 61 79 73 20   routine always 
4b70: 72 75 6e 73 20 77 69 74 68 69 6e 20 5b 63 61 74  runs within [cat
4b80: 63 68 5d 2c 20 73 6f 20 68 61 6e 64 6c 65 20 65  ch], so handle e
4b90: 78 63 65 70 74 69 6f 6e 73 20 62 79 0a 23 20 69  xceptions by.# i
4ba0: 6e 76 6f 6b 69 6e 67 20 5b 65 72 72 6f 72 5d 2e  nvoking [error].
4bb0: 0a 23 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d  .#.proc wappInt-
4bc0: 68 61 6e 64 6c 65 2d 72 65 71 75 65 73 74 20 7b  handle-request {
4bd0: 63 68 61 6e 20 75 73 65 43 67 69 7d 20 7b 0a 20  chan useCgi} {. 
4be0: 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 64   global wapp.  d
4bf0: 69 63 74 20 73 65 74 20 77 61 70 70 20 2e 72 65  ict set wapp .re
4c00: 70 6c 79 20 7b 7d 0a 20 20 64 69 63 74 20 73 65  ply {}.  dict se
4c10: 74 20 77 61 70 70 20 2e 6d 69 6d 65 74 79 70 65  t wapp .mimetype
4c20: 20 7b 74 65 78 74 2f 68 74 6d 6c 3b 20 63 68 61   {text/html; cha
4c30: 72 73 65 74 3d 75 74 66 2d 38 7d 0a 20 20 64 69  rset=utf-8}.  di
4c40: 63 74 20 73 65 74 20 77 61 70 70 20 2e 72 65 70  ct set wapp .rep
4c50: 6c 79 2d 63 6f 64 65 20 7b 32 30 30 20 4f 6b 7d  ly-code {200 Ok}
4c60: 0a 20 20 64 69 63 74 20 73 65 74 20 77 61 70 70  .  dict set wapp
4c70: 20 2e 63 73 70 20 7b 64 65 66 61 75 6c 74 2d 73   .csp {default-s
4c80: 72 63 20 27 73 65 6c 66 27 7d 0a 0a 20 20 23 20  rc 'self'}..  # 
4c90: 53 65 74 20 75 70 20 61 64 64 69 74 69 6f 6e 61  Set up additiona
4ca0: 6c 20 43 47 49 20 65 6e 76 69 72 6f 6e 6d 65 6e  l CGI environmen
4cb0: 74 20 76 61 6c 75 65 73 0a 20 20 23 0a 20 20 69  t values.  #.  i
4cc0: 66 20 7b 21 5b 64 69 63 74 20 65 78 69 73 74 73  f {![dict exists
4cd0: 20 24 77 61 70 70 20 48 54 54 50 5f 48 4f 53 54   $wapp HTTP_HOST
4ce0: 5d 7d 20 7b 0a 20 20 20 20 64 69 63 74 20 73 65  ]} {.    dict se
4cf0: 74 20 77 61 70 70 20 42 41 53 45 5f 55 52 4c 20  t wapp BASE_URL 
4d00: 7b 7d 0a 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b  {}.  } elseif {[
4d10: 64 69 63 74 20 65 78 69 73 74 73 20 24 77 61 70  dict exists $wap
4d20: 70 20 48 54 54 50 53 5d 7d 20 7b 0a 20 20 20 20  p HTTPS]} {.    
4d30: 64 69 63 74 20 73 65 74 20 77 61 70 70 20 42 41  dict set wapp BA
4d40: 53 45 5f 55 52 4c 20 68 74 74 70 73 3a 2f 2f 5b  SE_URL https://[
4d50: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 48  dict get $wapp H
4d60: 54 54 50 5f 48 4f 53 54 5d 0a 20 20 7d 20 65 6c  TTP_HOST].  } el
4d70: 73 65 20 7b 0a 20 20 20 20 64 69 63 74 20 73 65  se {.    dict se
4d80: 74 20 77 61 70 70 20 42 41 53 45 5f 55 52 4c 20  t wapp BASE_URL 
4d90: 68 74 74 70 3a 2f 2f 5b 64 69 63 74 20 67 65 74  http://[dict get
4da0: 20 24 77 61 70 70 20 48 54 54 50 5f 48 4f 53 54   $wapp HTTP_HOST
4db0: 5d 0a 20 20 7d 0a 20 20 69 66 20 7b 21 5b 64 69  ].  }.  if {![di
4dc0: 63 74 20 65 78 69 73 74 73 20 24 77 61 70 70 20  ct exists $wapp 
4dd0: 52 45 51 55 45 53 54 5f 55 52 49 5d 7d 20 7b 0a  REQUEST_URI]} {.
4de0: 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61 70      dict set wap
4df0: 70 20 52 45 51 55 45 53 54 5f 55 52 49 20 2f 0a  p REQUEST_URI /.
4e00: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 72 65 67    } elseif {[reg
4e10: 73 75 62 20 7b 5c 3f 2e 2a 7d 20 5b 64 69 63 74  sub {\?.*} [dict
4e20: 20 67 65 74 20 24 77 61 70 70 20 52 45 51 55 45   get $wapp REQUE
4e30: 53 54 5f 55 52 49 5d 20 7b 7d 20 6e 65 77 52 5d  ST_URI] {} newR]
4e40: 7d 20 7b 0a 20 20 20 20 23 20 53 6f 6d 65 20 73  } {.    # Some s
4e50: 65 72 76 65 72 73 20 28 65 78 3a 20 6e 67 69 6e  ervers (ex: ngin
4e60: 78 29 20 61 70 70 65 6e 64 20 74 68 65 20 71 75  x) append the qu
4e70: 65 72 79 20 70 61 72 61 6d 65 74 65 72 73 20 74  ery parameters t
4e80: 6f 20 52 45 51 55 45 53 54 5f 55 52 49 2e 0a 20  o REQUEST_URI.. 
4e90: 20 20 20 23 20 54 68 65 73 65 20 6e 65 65 64 20     # These need 
4ea0: 74 6f 20 62 65 20 73 74 72 69 70 70 65 64 20 6f  to be stripped o
4eb0: 66 66 0a 20 20 20 20 64 69 63 74 20 73 65 74 20  ff.    dict set 
4ec0: 77 61 70 70 20 52 45 51 55 45 53 54 5f 55 52 49  wapp REQUEST_URI
4ed0: 20 24 6e 65 77 52 0a 20 20 7d 0a 20 20 69 66 20   $newR.  }.  if 
4ee0: 7b 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 77  {[dict exists $w
4ef0: 61 70 70 20 53 43 52 49 50 54 5f 4e 41 4d 45 5d  app SCRIPT_NAME]
4f00: 7d 20 7b 0a 20 20 20 20 64 69 63 74 20 61 70 70  } {.    dict app
4f10: 65 6e 64 20 77 61 70 70 20 42 41 53 45 5f 55 52  end wapp BASE_UR
4f20: 4c 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70  L [dict get $wap
4f30: 70 20 53 43 52 49 50 54 5f 4e 41 4d 45 5d 0a 20  p SCRIPT_NAME]. 
4f40: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 64 69   } else {.    di
4f50: 63 74 20 73 65 74 20 77 61 70 70 20 53 43 52 49  ct set wapp SCRI
4f60: 50 54 5f 4e 41 4d 45 20 7b 7d 0a 20 20 7d 0a 20  PT_NAME {}.  }. 
4f70: 20 69 66 20 7b 21 5b 64 69 63 74 20 65 78 69 73   if {![dict exis
4f80: 74 73 20 24 77 61 70 70 20 50 41 54 48 5f 49 4e  ts $wapp PATH_IN
4f90: 46 4f 5d 7d 20 7b 0a 20 20 20 20 23 20 49 66 20  FO]} {.    # If 
4fa0: 50 41 54 48 5f 49 4e 46 4f 20 69 73 20 6d 69 73  PATH_INFO is mis
4fb0: 73 69 6e 67 20 28 65 78 3a 20 6e 67 69 6e 78 29  sing (ex: nginx)
4fc0: 20 74 68 65 6e 20 63 6f 6e 73 74 72 75 63 74 20   then construct 
4fd0: 69 74 0a 20 20 20 20 73 65 74 20 55 52 49 20 5b  it.    set URI [
4fe0: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 52  dict get $wapp R
4ff0: 45 51 55 45 53 54 5f 55 52 49 5d 0a 20 20 20 20  EQUEST_URI].    
5000: 73 65 74 20 73 6b 69 70 20 5b 73 74 72 69 6e 67  set skip [string
5010: 20 6c 65 6e 67 74 68 20 5b 64 69 63 74 20 67 65   length [dict ge
5020: 74 20 24 77 61 70 70 20 53 43 52 49 50 54 5f 4e  t $wapp SCRIPT_N
5030: 41 4d 45 5d 5d 0a 20 20 20 20 64 69 63 74 20 73  AME]].    dict s
5040: 65 74 20 77 61 70 70 20 50 41 54 48 5f 49 4e 46  et wapp PATH_INF
5050: 4f 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20  O [string range 
5060: 24 55 52 49 20 24 73 6b 69 70 20 65 6e 64 5d 0a  $URI $skip end].
5070: 20 20 7d 0a 20 20 69 66 20 7b 5b 72 65 67 65 78    }.  if {[regex
5080: 70 20 7b 5e 2f 28 5b 5e 2f 5d 2b 29 28 2e 2a 29  p {^/([^/]+)(.*)
5090: 24 7d 20 5b 64 69 63 74 20 67 65 74 20 24 77 61  $} [dict get $wa
50a0: 70 70 20 50 41 54 48 5f 49 4e 46 4f 5d 20 61 6c  pp PATH_INFO] al
50b0: 6c 20 68 65 61 64 20 74 61 69 6c 5d 7d 20 7b 0a  l head tail]} {.
50c0: 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61 70      dict set wap
50d0: 70 20 50 41 54 48 5f 48 45 41 44 20 24 68 65 61  p PATH_HEAD $hea
50e0: 64 0a 20 20 20 20 64 69 63 74 20 73 65 74 20 77  d.    dict set w
50f0: 61 70 70 20 50 41 54 48 5f 54 41 49 4c 20 5b 73  app PATH_TAIL [s
5100: 74 72 69 6e 67 20 74 72 69 6d 6c 65 66 74 20 24  tring trimleft $
5110: 74 61 69 6c 20 2f 5d 0a 20 20 7d 20 65 6c 73 65  tail /].  } else
5120: 20 7b 0a 20 20 20 20 64 69 63 74 20 73 65 74 20   {.    dict set 
5130: 77 61 70 70 20 50 41 54 48 5f 49 4e 46 4f 20 7b  wapp PATH_INFO {
5140: 7d 0a 20 20 20 20 64 69 63 74 20 73 65 74 20 77  }.    dict set w
5150: 61 70 70 20 50 41 54 48 5f 48 45 41 44 20 7b 7d  app PATH_HEAD {}
5160: 0a 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61  .    dict set wa
5170: 70 70 20 50 41 54 48 5f 54 41 49 4c 20 7b 7d 0a  pp PATH_TAIL {}.
5180: 20 20 7d 0a 20 20 64 69 63 74 20 73 65 74 20 77    }.  dict set w
5190: 61 70 70 20 53 45 4c 46 5f 55 52 4c 20 5b 64 69  app SELF_URL [di
51a0: 63 74 20 67 65 74 20 24 77 61 70 70 20 42 41 53  ct get $wapp BAS
51b0: 45 5f 55 52 4c 5d 2f 5b 64 69 63 74 20 67 65 74  E_URL]/[dict get
51c0: 20 24 77 61 70 70 20 50 41 54 48 5f 48 45 41 44   $wapp PATH_HEAD
51d0: 5d 0a 0a 20 20 23 20 50 61 72 73 65 20 71 75 65  ]..  # Parse que
51e0: 72 79 20 70 61 72 61 6d 65 74 65 72 73 20 66 72  ry parameters fr
51f0: 6f 6d 20 74 68 65 20 71 75 65 72 79 20 73 74 72  om the query str
5200: 69 6e 67 2c 20 74 68 65 20 63 6f 6f 6b 69 65 73  ing, the cookies
5210: 2c 20 61 6e 64 0a 20 20 23 20 50 4f 53 54 20 64  , and.  # POST d
5220: 61 74 61 0a 20 20 23 0a 20 20 69 66 20 7b 5b 64  ata.  #.  if {[d
5230: 69 63 74 20 65 78 69 73 74 73 20 24 77 61 70 70  ict exists $wapp
5240: 20 48 54 54 50 5f 43 4f 4f 4b 49 45 5d 7d 20 7b   HTTP_COOKIE]} {
5250: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 71 74 65  .    foreach qte
5260: 72 6d 20 5b 73 70 6c 69 74 20 5b 64 69 63 74 20  rm [split [dict 
5270: 67 65 74 20 24 77 61 70 70 20 48 54 54 50 5f 43  get $wapp HTTP_C
5280: 4f 4f 4b 49 45 5d 20 7b 3b 7d 5d 20 7b 0a 20 20  OOKIE] {;}] {.  
5290: 20 20 20 20 73 65 74 20 71 73 70 6c 69 74 20 5b      set qsplit [
52a0: 73 70 6c 69 74 20 5b 73 74 72 69 6e 67 20 74 72  split [string tr
52b0: 69 6d 20 24 71 74 65 72 6d 5d 20 3d 5d 0a 20 20  im $qterm] =].  
52c0: 20 20 20 20 73 65 74 20 6e 6d 20 5b 6c 69 6e 64      set nm [lind
52d0: 65 78 20 24 71 73 70 6c 69 74 20 30 5d 0a 20 20  ex $qsplit 0].  
52e0: 20 20 20 20 69 66 20 7b 5b 72 65 67 65 78 70 20      if {[regexp 
52f0: 7b 5e 5b 61 2d 7a 5d 5b 2d 61 2d 7a 30 2d 39 5f  {^[a-z][-a-z0-9_
5300: 5d 2a 24 7d 20 24 6e 6d 5d 7d 20 7b 0a 20 20 20  ]*$} $nm]} {.   
5310: 20 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61       dict set wa
5320: 70 70 20 24 6e 6d 20 5b 77 61 70 70 49 6e 74 2d  pp $nm [wappInt-
5330: 64 65 63 6f 64 65 2d 75 72 6c 20 5b 6c 69 6e 64  decode-url [lind
5340: 65 78 20 24 71 73 70 6c 69 74 20 31 5d 5d 0a 20  ex $qsplit 1]]. 
5350: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d       }.    }.  }
5360: 0a 20 20 73 65 74 20 73 61 6d 65 5f 6f 72 69 67  .  set same_orig
5370: 69 6e 20 30 0a 20 20 69 66 20 7b 5b 64 69 63 74  in 0.  if {[dict
5380: 20 65 78 69 73 74 73 20 24 77 61 70 70 20 48 54   exists $wapp HT
5390: 54 50 5f 52 45 46 45 52 45 52 5d 7d 20 7b 0a 20  TP_REFERER]} {. 
53a0: 20 20 20 73 65 74 20 72 65 66 65 72 65 72 20 5b     set referer [
53b0: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 48  dict get $wapp H
53c0: 54 54 50 5f 52 45 46 45 52 45 52 5d 0a 20 20 20  TTP_REFERER].   
53d0: 20 73 65 74 20 62 61 73 65 20 5b 64 69 63 74 20   set base [dict 
53e0: 67 65 74 20 24 77 61 70 70 20 42 41 53 45 5f 55  get $wapp BASE_U
53f0: 52 4c 5d 0a 20 20 20 20 69 66 20 7b 24 72 65 66  RL].    if {$ref
5400: 65 72 65 72 3d 3d 24 62 61 73 65 20 7c 7c 20 5b  erer==$base || [
5410: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 62 61  string match $ba
5420: 73 65 2f 2a 20 24 72 65 66 65 72 65 72 5d 7d 20  se/* $referer]} 
5430: 7b 0a 20 20 20 20 20 20 73 65 74 20 73 61 6d 65  {.      set same
5440: 5f 6f 72 69 67 69 6e 20 31 0a 20 20 20 20 7d 0a  _origin 1.    }.
5450: 20 20 7d 0a 20 20 64 69 63 74 20 73 65 74 20 77    }.  dict set w
5460: 61 70 70 20 53 41 4d 45 5f 4f 52 49 47 49 4e 20  app SAME_ORIGIN 
5470: 24 73 61 6d 65 5f 6f 72 69 67 69 6e 0a 20 20 69  $same_origin.  i
5480: 66 20 7b 24 73 61 6d 65 5f 6f 72 69 67 69 6e 7d  f {$same_origin}
5490: 20 7b 0a 20 20 20 20 77 61 70 70 49 6e 74 2d 64   {.    wappInt-d
54a0: 65 63 6f 64 65 2d 71 75 65 72 79 2d 70 61 72 61  ecode-query-para
54b0: 6d 73 0a 20 20 7d 0a 0a 20 20 23 20 49 6e 76 6f  ms.  }..  # Invo
54c0: 6b 65 20 74 68 65 20 61 70 70 6c 69 63 61 74 69  ke the applicati
54d0: 6f 6e 2d 64 65 66 69 6e 65 64 20 68 61 6e 64 6c  on-defined handl
54e0: 65 72 20 70 72 6f 63 65 64 75 72 65 20 66 6f 72  er procedure for
54f0: 20 74 68 69 73 20 70 61 67 65 0a 20 20 23 20 72   this page.  # r
5500: 65 71 75 65 73 74 2e 20 20 49 66 20 61 6e 20 65  equest.  If an e
5510: 72 72 6f 72 20 6f 63 63 75 72 73 20 77 68 69 6c  rror occurs whil
5520: 65 20 72 75 6e 6e 69 6e 67 20 74 68 61 74 20 70  e running that p
5530: 72 6f 63 65 64 75 72 65 2c 20 67 65 6e 65 72 61  rocedure, genera
5540: 74 65 0a 20 20 23 20 61 6e 20 48 54 54 50 20 72  te.  # an HTTP r
5550: 65 70 6c 79 20 74 68 61 74 20 63 6f 6e 74 61 69  eply that contai
5560: 6e 73 20 74 68 65 20 65 72 72 6f 72 20 6d 65 73  ns the error mes
5570: 73 61 67 65 2e 0a 20 20 23 0a 20 20 77 61 70 70  sage..  #.  wapp
5580: 2d 62 65 66 6f 72 65 2d 64 69 73 70 61 74 63 68  -before-dispatch
5590: 2d 68 6f 6f 6b 0a 20 20 77 61 70 70 49 6e 74 2d  -hook.  wappInt-
55a0: 74 72 61 63 65 0a 20 20 73 65 74 20 6d 6e 61 6d  trace.  set mnam
55b0: 65 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70  e [dict get $wap
55c0: 70 20 50 41 54 48 5f 48 45 41 44 5d 0a 20 20 69  p PATH_HEAD].  i
55d0: 66 20 7b 5b 63 61 74 63 68 20 7b 0a 20 20 20 20  f {[catch {.    
55e0: 69 66 20 7b 24 6d 6e 61 6d 65 21 3d 22 22 20 26  if {$mname!="" &
55f0: 26 20 5b 6c 6c 65 6e 67 74 68 20 5b 69 6e 66 6f  & [llength [info
5600: 20 70 72 6f 63 20 77 61 70 70 2d 70 61 67 65 2d   proc wapp-page-
5610: 24 6d 6e 61 6d 65 5d 5d 3e 30 7d 20 7b 0a 20 20  $mname]]>0} {.  
5620: 20 20 20 20 77 61 70 70 2d 70 61 67 65 2d 24 6d      wapp-page-$m
5630: 6e 61 6d 65 0a 20 20 20 20 7d 20 65 6c 73 65 20  name.    } else 
5640: 7b 0a 20 20 20 20 20 20 77 61 70 70 2d 64 65 66  {.      wapp-def
5650: 61 75 6c 74 0a 20 20 20 20 7d 0a 20 20 7d 20 6d  ault.    }.  } m
5660: 73 67 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b  sg]} {.    if {[
5670: 77 61 70 70 2d 70 61 72 61 6d 20 57 41 50 50 5f  wapp-param WAPP_
5680: 4d 4f 44 45 5d 3d 3d 22 6c 6f 63 61 6c 22 20 7c  MODE]=="local" |
5690: 7c 20 5b 77 61 70 70 2d 70 61 72 61 6d 20 57 41  | [wapp-param WA
56a0: 50 50 5f 4d 4f 44 45 5d 3d 3d 22 73 65 72 76 65  PP_MODE]=="serve
56b0: 72 22 7d 20 7b 0a 20 20 20 20 20 20 70 75 74 73  r"} {.      puts
56c0: 20 22 45 52 52 4f 52 3a 20 24 3a 3a 65 72 72 6f   "ERROR: $::erro
56d0: 72 49 6e 66 6f 22 0a 20 20 20 20 7d 0a 20 20 20  rInfo".    }.   
56e0: 20 77 61 70 70 2d 72 65 73 65 74 0a 20 20 20 20   wapp-reset.    
56f0: 77 61 70 70 2d 72 65 70 6c 79 2d 63 6f 64 65 20  wapp-reply-code 
5700: 22 35 30 30 20 49 6e 74 65 72 6e 61 6c 20 53 65  "500 Internal Se
5710: 72 76 65 72 20 45 72 72 6f 72 22 0a 20 20 20 20  rver Error".    
5720: 77 61 70 70 2d 6d 69 6d 65 74 79 70 65 20 74 65  wapp-mimetype te
5730: 78 74 2f 68 74 6d 6c 0a 20 20 20 20 77 61 70 70  xt/html.    wapp
5740: 2d 74 72 69 6d 20 7b 0a 20 20 20 20 20 20 3c 68  -trim {.      <h
5750: 31 3e 57 61 70 70 20 41 70 70 6c 69 63 61 74 69  1>Wapp Applicati
5760: 6f 6e 20 45 72 72 6f 72 3c 2f 68 31 3e 0a 20 20  on Error</h1>.  
5770: 20 20 20 20 3c 70 72 65 3e 25 68 74 6d 6c 28 24      <pre>%html($
5780: 3a 3a 65 72 72 6f 72 49 6e 66 6f 29 3c 2f 70 72  ::errorInfo)</pr
5790: 65 3e 0a 20 20 20 20 7d 0a 20 20 20 20 64 69 63  e>.    }.    dic
57a0: 74 20 75 6e 73 65 74 20 77 61 70 70 20 2e 6e 65  t unset wapp .ne
57b0: 77 2d 63 6f 6f 6b 69 65 73 0a 20 20 7d 0a 0a 20  w-cookies.  }.. 
57c0: 20 23 20 54 72 61 6e 73 6d 69 74 20 74 68 65 20   # Transmit the 
57d0: 48 54 54 50 20 72 65 70 6c 79 0a 20 20 23 0a 20  HTTP reply.  #. 
57e0: 20 69 66 20 7b 24 63 68 61 6e 3d 3d 22 73 74 64   if {$chan=="std
57f0: 6f 75 74 22 7d 20 7b 0a 20 20 20 20 70 75 74 73  out"} {.    puts
5800: 20 24 63 68 61 6e 20 22 53 74 61 74 75 73 3a 20   $chan "Status: 
5810: 5b 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20  [dict get $wapp 
5820: 2e 72 65 70 6c 79 2d 63 6f 64 65 5d 5c 72 22 0a  .reply-code]\r".
5830: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 70    } else {.    p
5840: 75 74 73 20 24 63 68 61 6e 20 22 48 54 54 50 2f  uts $chan "HTTP/
5850: 31 2e 31 20 5b 64 69 63 74 20 67 65 74 20 24 77  1.1 [dict get $w
5860: 61 70 70 20 2e 72 65 70 6c 79 2d 63 6f 64 65 5d  app .reply-code]
5870: 5c 72 22 0a 20 20 20 20 70 75 74 73 20 24 63 68  \r".    puts $ch
5880: 61 6e 20 22 53 65 72 76 65 72 3a 20 77 61 70 70  an "Server: wapp
5890: 5c 72 22 0a 20 20 20 20 70 75 74 73 20 24 63 68  \r".    puts $ch
58a0: 61 6e 20 22 43 6f 6e 6e 65 63 74 69 6f 6e 3a 20  an "Connection: 
58b0: 63 6c 6f 73 65 5c 72 22 0a 20 20 7d 0a 20 20 69  close\r".  }.  i
58c0: 66 20 7b 5b 64 69 63 74 20 65 78 69 73 74 73 20  f {[dict exists 
58d0: 24 77 61 70 70 20 2e 72 65 70 6c 79 2d 65 78 74  $wapp .reply-ext
58e0: 72 61 5d 7d 20 7b 0a 20 20 20 20 66 6f 72 65 61  ra]} {.    forea
58f0: 63 68 20 7b 6e 61 6d 65 20 76 61 6c 75 65 7d 20  ch {name value} 
5900: 5b 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20  [dict get $wapp 
5910: 2e 72 65 70 6c 79 2d 65 78 74 72 61 5d 20 7b 0a  .reply-extra] {.
5920: 20 20 20 20 20 20 70 75 74 73 20 24 63 68 61 6e        puts $chan
5930: 20 22 24 6e 61 6d 65 3a 20 24 76 61 6c 75 65 5c   "$name: $value\
5940: 72 22 0a 20 20 20 20 7d 0a 20 20 7d 0a 20 20 69  r".    }.  }.  i
5950: 66 20 7b 5b 64 69 63 74 20 65 78 69 73 74 73 20  f {[dict exists 
5960: 24 77 61 70 70 20 2e 63 73 70 5d 7d 20 7b 0a 20  $wapp .csp]} {. 
5970: 20 20 20 70 75 74 73 20 24 63 68 61 6e 20 22 43     puts $chan "C
5980: 6f 6e 74 65 6e 74 2d 53 65 63 75 72 69 74 79 2d  ontent-Security-
5990: 50 6f 6c 69 63 79 3a 20 5b 64 69 63 74 20 67 65  Policy: [dict ge
59a0: 74 20 24 77 61 70 70 20 2e 63 73 70 5d 5c 72 22  t $wapp .csp]\r"
59b0: 0a 20 20 7d 0a 20 20 73 65 74 20 6d 69 6d 65 74  .  }.  set mimet
59c0: 79 70 65 20 5b 64 69 63 74 20 67 65 74 20 24 77  ype [dict get $w
59d0: 61 70 70 20 2e 6d 69 6d 65 74 79 70 65 5d 0a 20  app .mimetype]. 
59e0: 20 70 75 74 73 20 24 63 68 61 6e 20 22 43 6f 6e   puts $chan "Con
59f0: 74 65 6e 74 2d 54 79 70 65 3a 20 24 6d 69 6d 65  tent-Type: $mime
5a00: 74 79 70 65 5c 72 22 0a 20 20 69 66 20 7b 5b 64  type\r".  if {[d
5a10: 69 63 74 20 65 78 69 73 74 73 20 24 77 61 70 70  ict exists $wapp
5a20: 20 2e 6e 65 77 2d 63 6f 6f 6b 69 65 73 5d 7d 20   .new-cookies]} 
5a30: 7b 0a 20 20 20 20 66 6f 72 65 61 63 68 20 7b 6e  {.    foreach {n
5a40: 6d 20 76 61 6c 7d 20 5b 64 69 63 74 20 67 65 74  m val} [dict get
5a50: 20 24 77 61 70 70 20 2e 6e 65 77 2d 63 6f 6f 6b   $wapp .new-cook
5a60: 69 65 73 5d 20 7b 0a 20 20 20 20 20 20 69 66 20  ies] {.      if 
5a70: 7b 5b 72 65 67 65 78 70 20 7b 5e 5b 61 2d 7a 5d  {[regexp {^[a-z]
5a80: 5b 2d 61 2d 7a 30 2d 39 5f 5d 2a 24 7d 20 24 6e  [-a-z0-9_]*$} $n
5a90: 6d 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 69 66  m]} {.        if
5aa0: 20 7b 24 76 61 6c 3d 3d 22 22 7d 20 7b 0a 20 20   {$val==""} {.  
5ab0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 63 68          puts $ch
5ac0: 61 6e 20 22 53 65 74 2d 43 6f 6f 6b 69 65 3a 20  an "Set-Cookie: 
5ad0: 24 6e 6d 3d 3b 20 48 74 74 70 4f 6e 6c 79 3b 20  $nm=; HttpOnly; 
5ae0: 50 61 74 68 3d 2f 3b 20 4d 61 78 2d 41 67 65 3d  Path=/; Max-Age=
5af0: 31 5c 72 22 0a 20 20 20 20 20 20 20 20 7d 20 65  1\r".        } e
5b00: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20  lse {.          
5b10: 73 65 74 20 76 61 6c 20 5b 77 61 70 70 49 6e 74  set val [wappInt
5b20: 2d 65 6e 63 2d 75 72 6c 20 24 76 61 6c 5d 0a 20  -enc-url $val]. 
5b30: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 63           puts $c
5b40: 68 61 6e 20 22 53 65 74 2d 43 6f 6f 6b 69 65 3a  han "Set-Cookie:
5b50: 20 24 6e 6d 3d 24 76 61 6c 3b 20 48 74 74 70 4f   $nm=$val; HttpO
5b60: 6e 6c 79 3b 20 50 61 74 68 3d 2f 5c 72 22 0a 20  nly; Path=/\r". 
5b70: 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 7d         }.      }
5b80: 0a 20 20 20 20 7d 0a 20 20 7d 0a 20 20 69 66 20  .    }.  }.  if 
5b90: 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 74  {[string match t
5ba0: 65 78 74 2f 2a 20 24 6d 69 6d 65 74 79 70 65 5d  ext/* $mimetype]
5bb0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 70 6c  } {.    set repl
5bc0: 79 20 5b 65 6e 63 6f 64 69 6e 67 20 63 6f 6e 76  y [encoding conv
5bd0: 65 72 74 74 6f 20 75 74 66 2d 38 20 5b 64 69 63  ertto utf-8 [dic
5be0: 74 20 67 65 74 20 24 77 61 70 70 20 2e 72 65 70  t get $wapp .rep
5bf0: 6c 79 5d 5d 0a 20 20 20 20 69 66 20 7b 5b 72 65  ly]].    if {[re
5c00: 67 65 78 70 20 7b 5c 79 67 7a 69 70 5c 79 7d 20  gexp {\ygzip\y} 
5c10: 5b 77 61 70 70 2d 70 61 72 61 6d 20 48 54 54 50  [wapp-param HTTP
5c20: 5f 41 43 43 45 50 54 5f 45 4e 43 4f 44 49 4e 47  _ACCEPT_ENCODING
5c30: 5d 5d 7d 20 7b 0a 20 20 20 20 20 20 63 61 74 63  ]]} {.      catc
5c40: 68 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20  h {.        set 
5c50: 78 20 5b 7a 6c 69 62 20 67 7a 69 70 20 24 72 65  x [zlib gzip $re
5c60: 70 6c 79 5d 0a 20 20 20 20 20 20 20 20 73 65 74  ply].        set
5c70: 20 72 65 70 6c 79 20 24 78 0a 20 20 20 20 20 20   reply $x.      
5c80: 20 20 70 75 74 73 20 24 63 68 61 6e 20 22 43 6f    puts $chan "Co
5c90: 6e 74 65 6e 74 2d 45 6e 63 6f 64 69 6e 67 3a 20  ntent-Encoding: 
5ca0: 67 7a 69 70 5c 72 22 0a 20 20 20 20 20 20 7d 0a  gzip\r".      }.
5cb0: 20 20 20 20 7d 0a 20 20 7d 20 65 6c 73 65 20 7b      }.  } else {
5cc0: 0a 20 20 20 20 73 65 74 20 72 65 70 6c 79 20 5b  .    set reply [
5cd0: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 2e  dict get $wapp .
5ce0: 72 65 70 6c 79 5d 0a 20 20 7d 0a 20 20 70 75 74  reply].  }.  put
5cf0: 73 20 24 63 68 61 6e 20 22 43 6f 6e 74 65 6e 74  s $chan "Content
5d00: 2d 4c 65 6e 67 74 68 3a 20 5b 73 74 72 69 6e 67  -Length: [string
5d10: 20 6c 65 6e 67 74 68 20 24 72 65 70 6c 79 5d 5c   length $reply]\
5d20: 72 22 0a 20 20 70 75 74 73 20 24 63 68 61 6e 20  r".  puts $chan 
5d30: 5c 72 0a 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77  \r.  puts -nonew
5d40: 6c 69 6e 65 20 24 63 68 61 6e 20 24 72 65 70 6c  line $chan $repl
5d50: 79 0a 20 20 66 6c 75 73 68 20 24 63 68 61 6e 0a  y.  flush $chan.
5d60: 20 20 77 61 70 70 49 6e 74 2d 63 6c 6f 73 65 2d    wappInt-close-
5d70: 63 68 61 6e 6e 65 6c 20 24 63 68 61 6e 0a 7d 0a  channel $chan.}.
5d80: 0a 23 20 54 68 69 73 20 72 6f 75 74 69 6e 65 20  .# This routine 
5d90: 72 75 6e 73 20 6a 75 73 74 20 70 72 69 6f 72 20  runs just prior 
5da0: 74 6f 20 72 65 71 75 65 73 74 2d 68 61 6e 64 6c  to request-handl
5db0: 65 72 20 64 69 73 70 61 74 63 68 2e 20 20 54 68  er dispatch.  Th
5dc0: 65 0a 23 20 64 65 66 61 75 6c 74 20 69 6d 70 6c  e.# default impl
5dd0: 65 6d 65 6e 74 61 74 69 6f 6e 20 69 73 20 61 20  ementation is a 
5de0: 6e 6f 2d 6f 70 2c 20 62 75 74 20 61 70 70 6c 69  no-op, but appli
5df0: 63 61 74 69 6f 6e 73 20 63 61 6e 20 6f 76 65 72  cations can over
5e00: 72 69 64 65 0a 23 20 74 6f 20 64 6f 20 61 64 64  ride.# to do add
5e10: 69 74 69 6f 6e 61 6c 20 74 72 61 6e 73 66 6f 72  itional transfor
5e20: 6d 61 74 69 6f 6e 73 20 6f 72 20 63 68 65 63 6b  mations or check
5e30: 73 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d 62  s..#.proc wapp-b
5e40: 65 66 6f 72 65 2d 64 69 73 70 61 74 63 68 2d 68  efore-dispatch-h
5e50: 6f 6f 6b 20 7b 7d 20 7b 72 65 74 75 72 6e 7d 0a  ook {} {return}.
5e60: 0a 23 20 50 72 6f 63 65 73 73 20 61 20 73 69 6e  .# Process a sin
5e70: 67 6c 65 20 43 47 49 20 72 65 71 75 65 73 74 0a  gle CGI request.
5e80: 23 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 68  #.proc wappInt-h
5e90: 61 6e 64 6c 65 2d 63 67 69 2d 72 65 71 75 65 73  andle-cgi-reques
5ea0: 74 20 7b 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20  t {} {.  global 
5eb0: 77 61 70 70 20 65 6e 76 0a 20 20 66 6f 72 65 61  wapp env.  forea
5ec0: 63 68 20 6b 65 79 20 7b 0a 20 20 20 20 43 4f 4e  ch key {.    CON
5ed0: 54 45 4e 54 5f 4c 45 4e 47 54 48 0a 20 20 20 20  TENT_LENGTH.    
5ee0: 43 4f 4e 54 45 4e 54 5f 54 59 50 45 0a 20 20 20  CONTENT_TYPE.   
5ef0: 20 44 4f 43 55 4d 45 4e 54 5f 52 4f 4f 54 0a 20   DOCUMENT_ROOT. 
5f00: 20 20 20 48 54 54 50 5f 41 43 43 45 50 54 5f 45     HTTP_ACCEPT_E
5f10: 4e 43 4f 44 49 4e 47 0a 20 20 20 20 48 54 54 50  NCODING.    HTTP
5f20: 5f 43 4f 4f 4b 49 45 0a 20 20 20 20 48 54 54 50  _COOKIE.    HTTP
5f30: 5f 48 4f 53 54 0a 20 20 20 20 48 54 54 50 5f 52  _HOST.    HTTP_R
5f40: 45 46 45 52 45 52 0a 20 20 20 20 48 54 54 50 5f  EFERER.    HTTP_
5f50: 55 53 45 52 5f 41 47 45 4e 54 0a 20 20 20 20 48  USER_AGENT.    H
5f60: 54 54 50 53 0a 20 20 20 20 50 41 54 48 5f 49 4e  TTPS.    PATH_IN
5f70: 46 4f 0a 20 20 20 20 51 55 45 52 59 5f 53 54 52  FO.    QUERY_STR
5f80: 49 4e 47 0a 20 20 20 20 52 45 4d 4f 54 45 5f 41  ING.    REMOTE_A
5f90: 44 44 52 0a 20 20 20 20 52 45 51 55 45 53 54 5f  DDR.    REQUEST_
5fa0: 4d 45 54 48 4f 44 0a 20 20 20 20 52 45 51 55 45  METHOD.    REQUE
5fb0: 53 54 5f 55 52 49 0a 20 20 20 20 52 45 4d 4f 54  ST_URI.    REMOT
5fc0: 45 5f 55 53 45 52 0a 20 20 20 20 53 43 52 49 50  E_USER.    SCRIP
5fd0: 54 5f 46 49 4c 45 4e 41 4d 45 0a 20 20 20 20 53  T_FILENAME.    S
5fe0: 43 52 49 50 54 5f 4e 41 4d 45 0a 20 20 20 20 53  CRIPT_NAME.    S
5ff0: 45 52 56 45 52 5f 4e 41 4d 45 0a 20 20 20 20 53  ERVER_NAME.    S
6000: 45 52 56 45 52 5f 50 4f 52 54 0a 20 20 20 20 53  ERVER_PORT.    S
6010: 45 52 56 45 52 5f 50 52 4f 54 4f 43 4f 4c 0a 20  ERVER_PROTOCOL. 
6020: 20 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e   } {.    if {[in
6030: 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 24 6b  fo exists env($k
6040: 65 79 29 5d 7d 20 7b 0a 20 20 20 20 20 20 64 69  ey)]} {.      di
6050: 63 74 20 73 65 74 20 77 61 70 70 20 24 6b 65 79  ct set wapp $key
6060: 20 24 65 6e 76 28 24 6b 65 79 29 0a 20 20 20 20   $env($key).    
6070: 7d 0a 20 20 7d 0a 20 20 73 65 74 20 6c 65 6e 20  }.  }.  set len 
6080: 30 0a 20 20 69 66 20 7b 5b 64 69 63 74 20 65 78  0.  if {[dict ex
6090: 69 73 74 73 20 24 77 61 70 70 20 43 4f 4e 54 45  ists $wapp CONTE
60a0: 4e 54 5f 4c 45 4e 47 54 48 5d 7d 20 7b 0a 20 20  NT_LENGTH]} {.  
60b0: 20 20 73 65 74 20 6c 65 6e 20 5b 64 69 63 74 20    set len [dict 
60c0: 67 65 74 20 24 77 61 70 70 20 43 4f 4e 54 45 4e  get $wapp CONTEN
60d0: 54 5f 4c 45 4e 47 54 48 5d 0a 20 20 7d 0a 20 20  T_LENGTH].  }.  
60e0: 69 66 20 7b 24 6c 65 6e 3e 30 7d 20 7b 0a 20 20  if {$len>0} {.  
60f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 73 74 64    fconfigure std
6100: 69 6e 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20  in -translation 
6110: 62 69 6e 61 72 79 0a 20 20 20 20 64 69 63 74 20  binary.    dict 
6120: 73 65 74 20 77 61 70 70 20 43 4f 4e 54 45 4e 54  set wapp CONTENT
6130: 20 5b 72 65 61 64 20 73 74 64 69 6e 20 24 6c 65   [read stdin $le
6140: 6e 5d 0a 20 20 7d 0a 20 20 64 69 63 74 20 73 65  n].  }.  dict se
6150: 74 20 77 61 70 70 20 57 41 50 50 5f 4d 4f 44 45  t wapp WAPP_MODE
6160: 20 63 67 69 0a 20 20 66 63 6f 6e 66 69 67 75 72   cgi.  fconfigur
6170: 65 20 73 74 64 6f 75 74 20 2d 74 72 61 6e 73 6c  e stdout -transl
6180: 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 20 20 77  ation binary.  w
6190: 61 70 70 49 6e 74 2d 68 61 6e 64 6c 65 2d 72 65  appInt-handle-re
61a0: 71 75 65 73 74 20 73 74 64 6f 75 74 20 31 0a 7d  quest stdout 1.}
61b0: 0a 0a 23 20 50 72 6f 63 65 73 73 20 6e 65 77 20  ..# Process new 
61c0: 74 65 78 74 20 72 65 63 65 69 76 65 64 20 6f 6e  text received on
61d0: 20 61 6e 20 69 6e 62 6f 75 6e 64 20 53 43 47 49   an inbound SCGI
61e0: 20 72 65 71 75 65 73 74 0a 23 0a 70 72 6f 63 20   request.#.proc 
61f0: 77 61 70 70 49 6e 74 2d 73 63 67 69 2d 72 65 61  wappInt-scgi-rea
6200: 64 61 62 6c 65 20 7b 63 68 61 6e 7d 20 7b 0a 20  dable {chan} {. 
6210: 20 69 66 20 7b 5b 63 61 74 63 68 20 5b 6c 69 73   if {[catch [lis
6220: 74 20 77 61 70 70 49 6e 74 2d 73 63 67 69 2d 72  t wappInt-scgi-r
6230: 65 61 64 61 62 6c 65 2d 75 6e 73 61 66 65 20 24  eadable-unsafe $
6240: 63 68 61 6e 5d 20 6d 73 67 5d 7d 20 7b 0a 20 20  chan] msg]} {.  
6250: 20 20 70 75 74 73 20 73 74 64 65 72 72 20 22 24    puts stderr "$
6260: 6d 73 67 5c 6e 24 3a 3a 65 72 72 6f 72 49 6e 66  msg\n$::errorInf
6270: 6f 22 0a 20 20 20 20 77 61 70 70 49 6e 74 2d 63  o".    wappInt-c
6280: 6c 6f 73 65 2d 63 68 61 6e 6e 65 6c 20 24 63 68  lose-channel $ch
6290: 61 6e 0a 20 20 7d 0a 7d 0a 70 72 6f 63 20 77 61  an.  }.}.proc wa
62a0: 70 70 49 6e 74 2d 73 63 67 69 2d 72 65 61 64 61  ppInt-scgi-reada
62b0: 62 6c 65 2d 75 6e 73 61 66 65 20 7b 63 68 61 6e  ble-unsafe {chan
62c0: 7d 20 7b 0a 20 20 75 70 76 61 72 20 23 30 20 77  } {.  upvar #0 w
62d0: 61 70 70 49 6e 74 2d 24 63 68 61 6e 20 57 20 77  appInt-$chan W w
62e0: 61 70 70 20 77 61 70 70 0a 20 20 69 66 20 7b 21  app wapp.  if {!
62f0: 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 57 20  [dict exists $W 
6300: 2e 74 6f 72 65 61 64 5d 7d 20 7b 0a 20 20 20 20  .toread]} {.    
6310: 23 20 49 66 20 74 68 65 20 2e 74 6f 72 65 61 64  # If the .toread
6320: 20 6b 65 79 20 69 73 20 6e 6f 74 20 73 65 74 2c   key is not set,
6330: 20 74 68 61 74 20 6d 65 61 6e 73 20 77 65 20 61   that means we a
6340: 72 65 20 73 74 69 6c 6c 20 72 65 61 64 69 6e 67  re still reading
6350: 0a 20 20 20 20 23 20 74 68 65 20 68 65 61 64 65  .    # the heade
6360: 72 2e 0a 20 20 20 20 23 0a 20 20 20 20 23 20 41  r..    #.    # A
6370: 6e 20 53 47 49 20 68 65 61 64 65 72 20 69 73 20  n SGI header is 
6380: 73 68 6f 72 74 2e 20 20 54 68 69 73 20 69 6d 70  short.  This imp
6390: 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 61 73 73 75  lementation assu
63a0: 6d 65 73 20 74 68 65 20 65 6e 74 69 72 65 0a 20  mes the entire. 
63b0: 20 20 20 23 20 68 65 61 64 65 72 20 69 73 20 61     # header is a
63c0: 76 61 69 6c 61 62 6c 65 20 61 6c 6c 20 61 74 20  vailable all at 
63d0: 6f 6e 63 65 2e 0a 20 20 20 20 23 0a 20 20 20 20  once..    #.    
63e0: 64 69 63 74 20 73 65 74 20 57 20 2e 72 65 6d 6f  dict set W .remo
63f0: 76 65 5f 61 64 64 72 20 5b 64 69 63 74 20 67 65  ve_addr [dict ge
6400: 74 20 24 57 20 52 45 4d 4f 54 45 5f 41 44 44 52  t $W REMOTE_ADDR
6410: 5d 0a 20 20 20 20 73 65 74 20 72 65 71 20 5b 72  ].    set req [r
6420: 65 61 64 20 24 63 68 61 6e 20 31 35 5d 0a 20 20  ead $chan 15].  
6430: 20 20 73 65 74 20 6e 20 5b 73 74 72 69 6e 67 20    set n [string 
6440: 6c 65 6e 67 74 68 20 24 72 65 71 5d 0a 20 20 20  length $req].   
6450: 20 73 63 61 6e 20 24 72 65 71 20 25 64 3a 25 73   scan $req %d:%s
6460: 20 6c 65 6e 20 68 64 72 0a 20 20 20 20 69 6e 63   len hdr.    inc
6470: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65  r len [string le
6480: 6e 67 74 68 20 22 24 6c 65 6e 3a 2c 22 5d 0a 20  ngth "$len:,"]. 
6490: 20 20 20 61 70 70 65 6e 64 20 68 64 72 20 5b 72     append hdr [r
64a0: 65 61 64 20 24 63 68 61 6e 20 5b 65 78 70 72 20  ead $chan [expr 
64b0: 7b 24 6c 65 6e 2d 31 35 7d 5d 5d 0a 20 20 20 20  {$len-15}]].    
64c0: 66 6f 72 65 61 63 68 20 7b 6e 6d 20 76 61 6c 7d  foreach {nm val}
64d0: 20 5b 73 70 6c 69 74 20 24 68 64 72 20 5c 30 30   [split $hdr \00
64e0: 30 5d 20 7b 0a 20 20 20 20 20 20 69 66 20 7b 24  0] {.      if {$
64f0: 6e 6d 3d 3d 22 2c 22 7d 20 62 72 65 61 6b 0a 20  nm==","} break. 
6500: 20 20 20 20 20 64 69 63 74 20 73 65 74 20 57 20       dict set W 
6510: 24 6e 6d 20 24 76 61 6c 0a 20 20 20 20 7d 0a 20  $nm $val.    }. 
6520: 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20     set len 0.   
6530: 20 69 66 20 7b 5b 64 69 63 74 20 65 78 69 73 74   if {[dict exist
6540: 73 20 24 57 20 43 4f 4e 54 45 4e 54 5f 4c 45 4e  s $W CONTENT_LEN
6550: 47 54 48 5d 7d 20 7b 0a 20 20 20 20 20 20 73 65  GTH]} {.      se
6560: 74 20 6c 65 6e 20 5b 64 69 63 74 20 67 65 74 20  t len [dict get 
6570: 24 57 20 43 4f 4e 54 45 4e 54 5f 4c 45 4e 47 54  $W CONTENT_LENGT
6580: 48 5d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20  H].    }.    if 
6590: 7b 24 6c 65 6e 3e 30 7d 20 7b 0a 20 20 20 20 20  {$len>0} {.     
65a0: 20 23 20 53 74 69 6c 6c 20 6e 65 65 64 20 74 6f   # Still need to
65b0: 20 72 65 61 64 20 74 68 65 20 71 75 65 72 79 20   read the query 
65c0: 63 6f 6e 74 65 6e 74 0a 20 20 20 20 20 20 64 69  content.      di
65d0: 63 74 20 73 65 74 20 57 20 2e 74 6f 72 65 61 64  ct set W .toread
65e0: 20 24 6c 65 6e 0a 20 20 20 20 7d 20 65 6c 73 65   $len.    } else
65f0: 20 7b 0a 20 20 20 20 20 20 23 20 54 68 65 72 65   {.      # There
6600: 20 69 73 20 6e 6f 20 71 75 65 72 79 20 63 6f 6e   is no query con
6610: 74 65 6e 74 2c 20 73 6f 20 68 61 6e 64 6c 65 20  tent, so handle 
6620: 74 68 65 20 72 65 71 75 65 73 74 20 69 6d 6d 65  the request imme
6630: 64 69 61 74 65 6c 79 0a 20 20 20 20 20 20 64 69  diately.      di
6640: 63 74 20 73 65 74 20 57 20 53 45 52 56 45 52 5f  ct set W SERVER_
6650: 41 44 44 52 20 5b 64 69 63 74 20 67 65 74 20 24  ADDR [dict get $
6660: 57 20 2e 72 65 6d 6f 76 65 5f 61 64 64 72 5d 0a  W .remove_addr].
6670: 20 20 20 20 20 20 73 65 74 20 77 61 70 70 20 24        set wapp $
6680: 57 0a 20 20 20 20 20 20 77 61 70 70 49 6e 74 2d  W.      wappInt-
6690: 68 61 6e 64 6c 65 2d 72 65 71 75 65 73 74 20 24  handle-request $
66a0: 63 68 61 6e 20 30 0a 20 20 20 20 7d 0a 20 20 7d  chan 0.    }.  }
66b0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 23 20 49 66   else {.    # If
66c0: 20 2e 74 6f 72 65 61 64 20 69 73 20 73 65 74 2c   .toread is set,
66d0: 20 74 68 61 74 20 6d 65 61 6e 73 20 77 65 20 61   that means we a
66e0: 72 65 20 72 65 61 64 69 6e 67 20 74 68 65 20 71  re reading the q
66f0: 75 65 72 79 20 63 6f 6e 74 65 6e 74 2e 0a 20 20  uery content..  
6700: 20 20 23 20 43 6f 6e 74 69 6e 75 65 20 72 65 61    # Continue rea
6710: 64 69 6e 67 20 75 6e 74 69 6c 20 2e 74 6f 72 65  ding until .tore
6720: 61 64 20 72 65 61 63 68 65 73 20 7a 65 72 6f 2e  ad reaches zero.
6730: 0a 20 20 20 20 73 65 74 20 67 6f 74 20 5b 72 65  .    set got [re
6740: 61 64 20 24 63 68 61 6e 20 5b 64 69 63 74 20 67  ad $chan [dict g
6750: 65 74 20 24 57 20 2e 74 6f 72 65 61 64 5d 5d 0a  et $W .toread]].
6760: 20 20 20 20 64 69 63 74 20 61 70 70 65 6e 64 20      dict append 
6770: 57 20 43 4f 4e 54 45 4e 54 20 24 67 6f 74 0a 20  W CONTENT $got. 
6780: 20 20 20 64 69 63 74 20 73 65 74 20 57 20 2e 74     dict set W .t
6790: 6f 72 65 61 64 20 5b 65 78 70 72 20 7b 5b 64 69  oread [expr {[di
67a0: 63 74 20 67 65 74 20 24 57 20 2e 74 6f 72 65 61  ct get $W .torea
67b0: 64 5d 2d 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74  d]-[string lengt
67c0: 68 20 24 67 6f 74 5d 7d 5d 0a 20 20 20 20 69 66  h $got]}].    if
67d0: 20 7b 5b 64 69 63 74 20 67 65 74 20 24 57 20 2e   {[dict get $W .
67e0: 74 6f 72 65 61 64 5d 3c 3d 30 7d 20 7b 0a 20 20  toread]<=0} {.  
67f0: 20 20 20 20 23 20 48 61 6e 64 6c 65 20 74 68 65      # Handle the
6800: 20 72 65 71 75 65 73 74 20 61 73 20 73 6f 6f 6e   request as soon
6810: 20 61 73 20 61 6c 6c 20 74 68 65 20 71 75 65 72   as all the quer
6820: 79 20 63 6f 6e 74 65 6e 74 20 69 73 20 72 65 63  y content is rec
6830: 65 69 76 65 64 0a 20 20 20 20 20 20 64 69 63 74  eived.      dict
6840: 20 73 65 74 20 57 20 53 45 52 56 45 52 5f 41 44   set W SERVER_AD
6850: 44 52 20 5b 64 69 63 74 20 67 65 74 20 24 57 20  DR [dict get $W 
6860: 2e 72 65 6d 6f 76 65 5f 61 64 64 72 5d 0a 20 20  .remove_addr].  
6870: 20 20 20 20 73 65 74 20 77 61 70 70 20 24 57 0a      set wapp $W.
6880: 20 20 20 20 20 20 77 61 70 70 49 6e 74 2d 68 61        wappInt-ha
6890: 6e 64 6c 65 2d 72 65 71 75 65 73 74 20 24 63 68  ndle-request $ch
68a0: 61 6e 20 30 0a 20 20 20 20 7d 0a 20 20 7d 0a 7d  an 0.    }.  }.}
68b0: 0a 0a 23 20 53 74 61 72 74 20 75 70 20 74 68 65  ..# Start up the
68c0: 20 77 61 70 70 20 66 72 61 6d 65 77 6f 72 6b 2e   wapp framework.
68d0: 20 20 50 61 72 61 6d 65 74 65 72 73 20 61 72 65    Parameters are
68e0: 20 61 20 6c 69 73 74 20 70 61 73 73 65 64 20 61   a list passed a
68f0: 73 20 74 68 65 0a 23 20 73 69 6e 67 6c 65 20 61  s the.# single a
6900: 72 67 75 6d 65 6e 74 2e 0a 23 0a 23 20 20 20 20  rgument..#.#    
6910: 2d 73 65 72 76 65 72 20 24 50 4f 52 54 20 20 20  -server $PORT   
6920: 20 20 20 20 20 20 4c 69 73 74 65 6e 20 66 6f 72        Listen for
6930: 20 48 54 54 50 20 72 65 71 75 65 73 74 73 20 6f   HTTP requests o
6940: 6e 20 74 68 69 73 20 54 43 50 20 70 6f 72 74 20  n this TCP port 
6950: 24 50 4f 52 54 0a 23 0a 23 20 20 20 20 2d 6c 6f  $PORT.#.#    -lo
6960: 63 61 6c 20 24 50 4f 52 54 20 20 20 20 20 20 20  cal $PORT       
6970: 20 20 20 4c 69 73 74 65 6e 20 66 6f 72 20 48 54     Listen for HT
6980: 54 50 20 72 65 71 75 65 73 74 73 20 6f 6e 20 31  TP requests on 1
6990: 32 37 2e 30 2e 30 2e 31 3a 24 50 4f 52 54 0a 23  27.0.0.1:$PORT.#
69a0: 0a 23 20 20 20 20 2d 73 63 67 69 20 24 50 4f 52  .#    -scgi $POR
69b0: 54 20 20 20 20 20 20 20 20 20 20 20 4c 69 73 74  T           List
69c0: 65 6e 20 66 6f 72 20 53 43 47 49 20 72 65 71 75  en for SCGI requ
69d0: 65 73 74 73 20 6f 6e 20 31 32 37 2e 30 2e 30 2e  ests on 127.0.0.
69e0: 31 3a 24 50 4f 52 54 0a 23 0a 23 20 20 20 20 2d  1:$PORT.#.#    -
69f0: 72 65 6d 6f 74 65 2d 73 63 67 69 20 24 50 4f 52  remote-scgi $POR
6a00: 54 20 20 20 20 4c 69 73 74 65 6e 20 66 6f 72 20  T    Listen for 
6a10: 53 43 47 49 20 72 65 71 75 65 73 74 73 20 6f 6e  SCGI requests on
6a20: 20 54 43 50 20 70 6f 72 74 20 24 50 4f 52 54 0a   TCP port $PORT.
6a30: 23 0a 23 20 20 20 20 2d 63 67 69 20 20 20 20 20  #.#    -cgi     
6a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 48 61 6e               Han
6a50: 64 6c 65 20 61 20 73 69 6e 67 6c 65 20 43 47 49  dle a single CGI
6a60: 20 72 65 71 75 65 73 74 0a 23 0a 23 20 57 69 74   request.#.# Wit
6a70: 68 20 6e 6f 20 61 72 67 75 6d 65 6e 74 73 2c 20  h no arguments, 
6a80: 74 68 65 20 62 65 68 61 76 69 6f 72 20 69 73 20  the behavior is 
6a90: 63 61 6c 6c 65 64 20 22 61 75 74 6f 22 2e 20 20  called "auto".  
6aa0: 49 6e 20 22 61 75 74 6f 22 20 6d 6f 64 65 2c 0a  In "auto" mode,.
6ab0: 23 20 69 66 20 74 68 65 20 47 41 54 45 57 41 59  # if the GATEWAY
6ac0: 5f 49 4e 54 45 52 46 41 43 45 20 65 6e 76 69 72  _INTERFACE envir
6ad0: 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 20  onment variable 
6ae0: 69 6e 64 69 63 61 74 65 73 20 43 47 49 2c 20 74  indicates CGI, t
6af0: 68 65 6e 20 72 75 6e 0a 23 20 61 73 20 43 47 49  hen run.# as CGI
6b00: 2e 20 20 4f 74 68 65 72 77 69 73 65 2c 20 73 74  .  Otherwise, st
6b10: 61 72 74 20 61 6e 20 48 54 54 50 20 73 65 72 76  art an HTTP serv
6b20: 65 72 20 62 6f 75 6e 64 20 74 6f 20 74 68 65 20  er bound to the 
6b30: 6c 6f 6f 70 62 61 63 6b 20 61 64 64 72 65 73 73  loopback address
6b40: 0a 23 20 6f 6e 6c 79 2c 20 6f 6e 20 61 6e 20 61  .# only, on an a
6b50: 72 62 69 74 72 61 72 79 20 54 43 50 20 70 6f 72  rbitrary TCP por
6b60: 74 2c 20 61 6e 64 20 61 75 74 6f 6d 61 74 69 63  t, and automatic
6b70: 61 6c 6c 79 20 6c 61 75 6e 63 68 20 61 20 77 65  ally launch a we
6b80: 62 20 62 72 6f 77 73 65 72 0a 23 20 6f 6e 20 74  b browser.# on t
6b90: 68 61 74 20 54 43 50 20 70 6f 72 74 2e 0a 23 0a  hat TCP port..#.
6ba0: 23 20 41 64 64 69 74 69 6f 6e 61 6c 20 6f 70 74  # Additional opt
6bb0: 69 6f 6e 73 3a 0a 23 0a 23 20 20 20 20 2d 66 72  ions:.#.#    -fr
6bc0: 6f 6d 69 70 20 47 4c 4f 42 20 20 20 20 20 20 20  omip GLOB       
6bd0: 20 20 52 65 6a 65 63 74 20 61 6e 79 20 69 6e 63    Reject any inc
6be0: 6f 6d 69 6e 67 20 72 65 71 75 65 73 74 20 77 68  oming request wh
6bf0: 65 72 65 20 74 68 65 20 72 65 6d 6f 74 65 0a 23  ere the remote.#
6c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6c10: 20 20 20 20 20 20 20 20 20 49 50 20 61 64 64 72           IP addr
6c20: 65 73 73 20 64 6f 65 73 20 6e 6f 74 20 6d 61 74  ess does not mat
6c30: 63 68 20 74 68 65 20 47 4c 4f 42 20 70 61 74 74  ch the GLOB patt
6c40: 65 72 6e 2e 20 20 54 68 69 73 0a 23 20 20 20 20  ern.  This.#    
6c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6c60: 20 20 20 20 20 76 61 6c 75 65 20 64 65 66 61 75       value defau
6c70: 6c 74 73 20 74 6f 20 27 31 32 37 2e 30 2e 30 2e  lts to '127.0.0.
6c80: 31 27 20 66 6f 72 20 2d 6c 6f 63 61 6c 20 61 6e  1' for -local an
6c90: 64 20 2d 73 63 67 69 2e 0a 23 0a 23 20 20 20 20  d -scgi..#.#    
6ca0: 2d 6e 6f 77 61 69 74 20 20 20 20 20 20 20 20 20  -nowait         
6cb0: 20 20 20 20 20 44 6f 20 6e 6f 74 20 77 61 69 74       Do not wait
6cc0: 20 69 6e 20 74 68 65 20 65 76 65 6e 74 20 6c 6f   in the event lo
6cd0: 6f 70 2e 20 20 52 65 74 75 72 6e 20 69 6d 6d 65  op.  Return imme
6ce0: 64 69 61 74 65 6c 79 0a 23 20 20 20 20 20 20 20  diately.#       
6cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6d00: 20 20 61 66 74 65 72 20 61 6c 6c 20 65 76 65 6e    after all even
6d10: 74 20 68 61 6e 64 6c 65 72 73 20 61 72 65 20 65  t handlers are e
6d20: 73 74 61 62 6c 69 73 68 65 64 2e 0a 23 0a 23 20  stablished..#.# 
6d30: 20 20 20 2d 74 72 61 63 65 20 20 20 20 20 20 20     -trace       
6d40: 20 20 20 20 20 20 20 20 22 70 75 74 73 22 20 65          "puts" e
6d50: 61 63 68 20 72 65 71 75 65 73 74 20 55 52 4c 20  ach request URL 
6d60: 61 73 20 69 74 20 69 73 20 68 61 6e 64 6c 65 64  as it is handled
6d70: 2c 20 66 6f 72 0a 23 20 20 20 20 20 20 20 20 20  , for.#         
6d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6d90: 64 65 62 75 67 67 69 6e 67 0a 23 0a 23 20 20 20  debugging.#.#   
6da0: 20 2d 6c 69 6e 74 20 20 20 20 20 20 20 20 20 20   -lint          
6db0: 20 20 20 20 20 20 52 75 6e 20 77 61 70 70 2d 73        Run wapp-s
6dc0: 61 66 65 74 79 2d 63 68 65 63 6b 20 6f 6e 20 74  afety-check on t
6dd0: 68 65 20 61 70 70 6c 69 63 61 74 69 6f 6e 20 69  he application i
6de0: 6e 73 74 65 61 64 0a 23 20 20 20 20 20 20 20 20  nstead.#        
6df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6e00: 20 6f 66 20 72 75 6e 6e 69 6e 67 20 74 68 65 20   of running the 
6e10: 61 70 70 6c 69 63 61 74 69 6f 6e 20 69 74 73 65  application itse
6e20: 6c 66 0a 23 0a 23 20 20 20 20 2d 44 76 61 72 3d  lf.#.#    -Dvar=
6e30: 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 20 53  value          S
6e40: 65 74 20 54 43 4c 20 67 6c 6f 62 61 6c 20 76 61  et TCL global va
6e50: 72 69 61 62 6c 65 20 22 76 61 72 22 20 74 6f 20  riable "var" to 
6e60: 22 76 61 6c 75 65 22 0a 23 0a 23 0a 70 72 6f 63  "value".#.#.proc
6e70: 20 77 61 70 70 2d 73 74 61 72 74 20 7b 61 72 67   wapp-start {arg
6e80: 6c 69 73 74 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c  list} {.  global
6e90: 20 65 6e 76 0a 20 20 73 65 74 20 6d 6f 64 65 20   env.  set mode 
6ea0: 61 75 74 6f 0a 20 20 73 65 74 20 70 6f 72 74 20  auto.  set port 
6eb0: 30 0a 20 20 73 65 74 20 6e 6f 77 61 69 74 20 30  0.  set nowait 0
6ec0: 0a 20 20 73 65 74 20 66 72 6f 6d 69 70 20 7b 7d  .  set fromip {}
6ed0: 0a 20 20 73 65 74 20 6e 20 5b 6c 6c 65 6e 67 74  .  set n [llengt
6ee0: 68 20 24 61 72 67 6c 69 73 74 5d 0a 20 20 66 6f  h $arglist].  fo
6ef0: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 3c  r {set i 0} {$i<
6f00: 24 6e 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 20  $n} {incr i} {. 
6f10: 20 20 20 73 65 74 20 74 65 72 6d 20 5b 6c 69 6e     set term [lin
6f20: 64 65 78 20 24 61 72 67 6c 69 73 74 20 24 69 5d  dex $arglist $i]
6f30: 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67  .    if {[string
6f40: 20 6d 61 74 63 68 20 2d 2d 2a 20 24 74 65 72 6d   match --* $term
6f50: 5d 7d 20 7b 73 65 74 20 74 65 72 6d 20 5b 73 74  ]} {set term [st
6f60: 72 69 6e 67 20 72 61 6e 67 65 20 24 74 65 72 6d  ring range $term
6f70: 20 31 20 65 6e 64 5d 7d 0a 20 20 20 20 73 77 69   1 end]}.    swi
6f80: 74 63 68 20 2d 67 6c 6f 62 20 2d 2d 20 24 74 65  tch -glob -- $te
6f90: 72 6d 20 7b 0a 20 20 20 20 20 20 2d 73 65 72 76  rm {.      -serv
6fa0: 65 72 20 7b 0a 20 20 20 20 20 20 20 20 69 6e 63  er {.        inc
6fb0: 72 20 69 3b 0a 20 20 20 20 20 20 20 20 73 65 74  r i;.        set
6fc0: 20 6d 6f 64 65 20 22 73 65 72 76 65 72 22 0a 20   mode "server". 
6fd0: 20 20 20 20 20 20 20 73 65 74 20 70 6f 72 74 20         set port 
6fe0: 5b 6c 69 6e 64 65 78 20 24 61 72 67 6c 69 73 74  [lindex $arglist
6ff0: 20 24 69 5d 0a 20 20 20 20 20 20 7d 0a 20 20 20   $i].      }.   
7000: 20 20 20 2d 6c 6f 63 61 6c 20 7b 0a 20 20 20 20     -local {.    
7010: 20 20 20 20 69 6e 63 72 20 69 3b 0a 20 20 20 20      incr i;.    
7020: 20 20 20 20 73 65 74 20 6d 6f 64 65 20 22 6c 6f      set mode "lo
7030: 63 61 6c 22 0a 20 20 20 20 20 20 20 20 73 65 74  cal".        set
7040: 20 66 72 6f 6d 69 70 20 31 32 37 2e 30 2e 30 2e   fromip 127.0.0.
7050: 31 0a 20 20 20 20 20 20 20 20 73 65 74 20 70 6f  1.        set po
7060: 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 6c  rt [lindex $argl
7070: 69 73 74 20 24 69 5d 0a 20 20 20 20 20 20 7d 0a  ist $i].      }.
7080: 20 20 20 20 20 20 2d 73 63 67 69 20 7b 0a 20 20        -scgi {.  
7090: 20 20 20 20 20 20 69 6e 63 72 20 69 3b 0a 20 20        incr i;.  
70a0: 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65 20 22        set mode "
70b0: 73 63 67 69 22 0a 20 20 20 20 20 20 20 20 73 65  scgi".        se
70c0: 74 20 66 72 6f 6d 69 70 20 31 32 37 2e 30 2e 30  t fromip 127.0.0
70d0: 2e 31 0a 20 20 20 20 20 20 20 20 73 65 74 20 70  .1.        set p
70e0: 6f 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67  ort [lindex $arg
70f0: 6c 69 73 74 20 24 69 5d 0a 20 20 20 20 20 20 7d  list $i].      }
7100: 0a 20 20 20 20 20 20 2d 72 65 6d 6f 74 65 2d 73  .      -remote-s
7110: 63 67 69 20 7b 0a 20 20 20 20 20 20 20 20 69 6e  cgi {.        in
7120: 63 72 20 69 3b 0a 20 20 20 20 20 20 20 20 73 65  cr i;.        se
7130: 74 20 6d 6f 64 65 20 22 72 65 6d 6f 74 65 2d 73  t mode "remote-s
7140: 63 67 69 22 0a 20 20 20 20 20 20 20 20 73 65 74  cgi".        set
7150: 20 70 6f 72 74 20 5b 6c 69 6e 64 65 78 20 24 61   port [lindex $a
7160: 72 67 6c 69 73 74 20 24 69 5d 0a 20 20 20 20 20  rglist $i].     
7170: 20 7d 0a 20 20 20 20 20 20 2d 63 67 69 20 7b 0a   }.      -cgi {.
7180: 20 20 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65          set mode
7190: 20 22 63 67 69 22 0a 20 20 20 20 20 20 7d 0a 20   "cgi".      }. 
71a0: 20 20 20 20 20 2d 66 72 6f 6d 69 70 20 7b 0a 20       -fromip {. 
71b0: 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20         incr i.  
71c0: 20 20 20 20 20 20 73 65 74 20 66 72 6f 6d 69 70        set fromip
71d0: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 6c 69 73   [lindex $arglis
71e0: 74 20 24 69 5d 0a 20 20 20 20 20 20 7d 0a 20 20  t $i].      }.  
71f0: 20 20 20 20 2d 6e 6f 77 61 69 74 20 7b 0a 20 20      -nowait {.  
7200: 20 20 20 20 20 20 73 65 74 20 6e 6f 77 61 69 74        set nowait
7210: 20 31 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 20   1.      }.     
7220: 20 2d 74 72 61 63 65 20 7b 0a 20 20 20 20 20 20   -trace {.      
7230: 20 20 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 74    proc wappInt-t
7240: 72 61 63 65 20 7b 7d 20 7b 0a 20 20 20 20 20 20  race {} {.      
7250: 20 20 20 20 73 65 74 20 71 20 5b 77 61 70 70 2d      set q [wapp-
7260: 70 61 72 61 6d 20 51 55 45 52 59 5f 53 54 52 49  param QUERY_STRI
7270: 4e 47 5d 0a 20 20 20 20 20 20 20 20 20 20 73 65  NG].          se
7280: 74 20 75 72 69 20 5b 77 61 70 70 2d 70 61 72 61  t uri [wapp-para
7290: 6d 20 42 41 53 45 5f 55 52 4c 5d 5b 77 61 70 70  m BASE_URL][wapp
72a0: 2d 70 61 72 61 6d 20 50 41 54 48 5f 49 4e 46 4f  -param PATH_INFO
72b0: 5d 0a 20 20 20 20 20 20 20 20 20 20 69 66 20 7b  ].          if {
72c0: 24 71 21 3d 22 22 7d 20 7b 61 70 70 65 6e 64 20  $q!=""} {append 
72d0: 75 72 69 20 3f 24 71 7d 0a 20 20 20 20 20 20 20  uri ?$q}.       
72e0: 20 20 20 70 75 74 73 20 24 75 72 69 0a 20 20 20     puts $uri.   
72f0: 20 20 20 20 20 7d 0a 20 20 20 20 20 20 7d 0a 20       }.      }. 
7300: 20 20 20 20 20 2d 6c 69 6e 74 20 7b 0a 20 20 20       -lint {.   
7310: 20 20 20 20 20 73 65 74 20 72 65 73 20 5b 77 61       set res [wa
7320: 70 70 2d 73 61 66 65 74 79 2d 63 68 65 63 6b 5d  pp-safety-check]
7330: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 24 72 65  .        if {$re
7340: 73 21 3d 22 22 7d 20 7b 0a 20 20 20 20 20 20 20  s!=""} {.       
7350: 20 20 20 70 75 74 73 20 22 50 6f 74 65 6e 74 69     puts "Potenti
7360: 61 6c 20 70 72 6f 62 6c 65 6d 73 20 69 6e 20 74  al problems in t
7370: 68 69 73 20 63 6f 64 65 3a 22 0a 20 20 20 20 20  his code:".     
7380: 20 20 20 20 20 70 75 74 73 20 24 72 65 73 0a 20       puts $res. 
7390: 20 20 20 20 20 20 20 20 20 65 78 69 74 20 31 0a           exit 1.
73a0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b          } else {
73b0: 0a 20 20 20 20 20 20 20 20 20 20 65 78 69 74 0a  .          exit.
73c0: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20          }.      
73d0: 7d 0a 20 20 20 20 20 20 2d 44 2a 3d 2a 20 7b 0a  }.      -D*=* {.
73e0: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 72 65 67          if {[reg
73f0: 65 78 70 20 7b 5e 2e 44 28 5b 5e 3d 5d 2b 29 3d  exp {^.D([^=]+)=
7400: 28 2e 2a 29 24 7d 20 24 74 65 72 6d 20 61 6c 6c  (.*)$} $term all
7410: 20 76 61 72 20 76 61 6c 5d 7d 20 7b 0a 20 20 20   var val]} {.   
7420: 20 20 20 20 20 20 20 73 65 74 20 3a 3a 24 76 61         set ::$va
7430: 72 20 24 76 61 6c 0a 20 20 20 20 20 20 20 20 7d  r $val.        }
7440: 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 64  .      }.      d
7450: 65 66 61 75 6c 74 20 7b 0a 20 20 20 20 20 20 20  efault {.       
7460: 20 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20   error "unknown 
7470: 6f 70 74 69 6f 6e 3a 20 24 74 65 72 6d 22 0a 20  option: $term". 
7480: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d       }.    }.  }
7490: 0a 20 20 69 66 20 7b 24 6d 6f 64 65 3d 3d 22 61  .  if {$mode=="a
74a0: 75 74 6f 22 7d 20 7b 0a 20 20 20 20 69 66 20 7b  uto"} {.    if {
74b0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76  [info exists env
74c0: 28 47 41 54 45 57 41 59 5f 49 4e 54 45 52 46 41  (GATEWAY_INTERFA
74d0: 43 45 29 5d 0a 20 20 20 20 20 20 20 20 26 26 20  CE)].        && 
74e0: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 43 47  [string match CG
74f0: 49 2f 31 2e 2a 20 24 65 6e 76 28 47 41 54 45 57  I/1.* $env(GATEW
7500: 41 59 5f 49 4e 54 45 52 46 41 43 45 29 5d 7d 20  AY_INTERFACE)]} 
7510: 7b 0a 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65  {.      set mode
7520: 20 63 67 69 0a 20 20 20 20 7d 20 65 6c 73 65 20   cgi.    } else 
7530: 7b 0a 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65  {.      set mode
7540: 20 6c 6f 63 61 6c 0a 20 20 20 20 7d 0a 20 20 7d   local.    }.  }
7550: 0a 20 20 69 66 20 7b 24 6d 6f 64 65 3d 3d 22 63  .  if {$mode=="c
7560: 67 69 22 7d 20 7b 0a 20 20 20 20 77 61 70 70 49  gi"} {.    wappI
7570: 6e 74 2d 68 61 6e 64 6c 65 2d 63 67 69 2d 72 65  nt-handle-cgi-re
7580: 71 75 65 73 74 0a 20 20 7d 20 65 6c 73 65 20 7b  quest.  } else {
7590: 0a 20 20 20 20 77 61 70 70 49 6e 74 2d 73 74 61  .    wappInt-sta
75a0: 72 74 2d 6c 69 73 74 65 6e 65 72 20 24 70 6f 72  rt-listener $por
75b0: 74 20 24 6d 6f 64 65 20 24 66 72 6f 6d 69 70 0a  t $mode $fromip.
75c0: 20 20 20 20 69 66 20 7b 21 24 6e 6f 77 61 69 74      if {!$nowait
75d0: 7d 20 7b 0a 20 20 20 20 20 20 76 77 61 69 74 20  } {.      vwait 
75e0: 3a 3a 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a  ::forever.    }.
75f0: 20 20 7d 0a 7d 0a 0a 23 20 43 61 6c 6c 20 74 68    }.}..# Call th
7600: 69 73 20 76 65 72 73 69 6f 6e 20 31 2e 30 0a 70  is version 1.0.p
7610: 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 77  ackage provide w
7620: 61 70 70 20 31 2e 30 0a                          app 1.0.