Wapp

Hex Artifact Content
Login

Artifact b17444183a1731337ebb616a9bc061340ae78b66f0577a7f1dedd47a905cbf35:


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 20 5c 6e 20 5c 5c 6e 20   \\u003c \n \\n 
1630: 5c 72 20 5c 5c 72 0a 20 20 09 20 20 20 20 20 5c  \r \\r.  .     \
1640: 66 20 5c 5c 66 20 5c 74 20 5c 5c 74 20 5c 78 30  f \\f \t \\t \x0
1650: 31 20 5c 5c 75 30 30 30 31 20 5c 78 30 32 20 5c  1 \\u0001 \x02 \
1660: 5c 75 30 30 30 32 20 5c 78 30 33 20 5c 5c 75 30  \u0002 \x03 \\u0
1670: 30 30 33 0a 20 20 09 20 20 20 20 20 5c 78 30 34  003.  .     \x04
1680: 20 5c 5c 75 30 30 30 34 20 5c 78 30 35 20 5c 5c   \\u0004 \x05 \\
1690: 75 30 30 30 35 20 5c 78 30 36 20 5c 5c 75 30 30  u0005 \x06 \\u00
16a0: 30 36 20 5c 78 30 37 20 5c 5c 75 30 30 30 37 0a  06 \x07 \\u0007.
16b0: 20 20 09 20 20 20 20 20 5c 78 30 62 20 5c 5c 75    .     \x0b \\u
16c0: 30 30 30 62 20 5c 78 30 65 20 5c 5c 75 30 30 30  000b \x0e \\u000
16d0: 65 20 5c 78 30 66 20 5c 5c 75 30 30 30 66 20 5c  e \x0f \\u000f \
16e0: 78 31 30 20 5c 5c 75 30 30 31 30 0a 20 20 09 20  x10 \\u0010.  . 
16f0: 20 20 20 20 5c 78 31 31 20 5c 5c 75 30 30 31 31      \x11 \\u0011
1700: 20 5c 78 31 32 20 5c 5c 75 30 30 31 32 20 5c 78   \x12 \\u0012 \x
1710: 31 33 20 5c 5c 75 30 30 31 33 20 5c 78 31 34 20  13 \\u0013 \x14 
1720: 5c 5c 75 30 30 31 34 0a 20 20 09 20 20 20 20 20  \\u0014.  .     
1730: 5c 78 31 35 20 5c 5c 75 30 30 31 35 20 5c 78 31  \x15 \\u0015 \x1
1740: 36 20 5c 5c 75 30 30 31 36 20 5c 78 31 37 20 5c  6 \\u0016 \x17 \
1750: 5c 75 30 30 31 37 20 5c 78 31 38 20 5c 5c 75 30  \u0017 \x18 \\u0
1760: 30 31 38 0a 20 20 09 20 20 20 20 20 5c 78 31 39  018.  .     \x19
1770: 20 5c 5c 75 30 30 31 39 20 5c 78 31 61 20 5c 5c   \\u0019 \x1a \\
1780: 75 30 30 31 61 20 5c 78 31 62 20 5c 5c 75 30 30  u001a \x1b \\u00
1790: 31 62 20 5c 78 31 63 20 5c 5c 75 30 30 31 63 0a  1b \x1c \\u001c.
17a0: 20 20 09 20 20 20 20 20 5c 78 31 64 20 5c 5c 75    .     \x1d \\u
17b0: 30 30 31 64 20 5c 78 31 65 20 5c 5c 75 30 30 31  001d \x1e \\u001
17c0: 65 20 5c 78 31 66 20 5c 5c 75 30 30 31 66 7d 20  e \x1f \\u001f} 
17d0: 24 73 5d 0a 7d 0a 0a 23 20 54 68 69 73 20 69 73  $s].}..# This is
17e0: 20 61 20 68 65 6c 70 65 72 20 72 6f 75 74 69 6e   a helper routin
17f0: 65 20 66 6f 72 20 77 61 70 70 49 6e 74 2d 65 6e  e for wappInt-en
1800: 63 2d 75 72 6c 20 61 6e 64 20 77 61 70 70 49 6e  c-url and wappIn
1810: 74 2d 65 6e 63 2d 71 70 2e 20 20 49 74 20 72 65  t-enc-qp.  It re
1820: 74 75 72 6e 73 0a 23 20 61 6e 20 61 70 70 72 6f  turns.# an appro
1830: 70 72 69 61 74 65 20 25 48 48 20 65 6e 63 6f 64  priate %HH encod
1840: 69 6e 67 20 66 6f 72 20 74 68 65 20 73 69 6e 67  ing for the sing
1850: 6c 65 20 63 68 61 72 61 63 74 65 72 20 63 2e 20  le character c. 
1860: 20 49 66 20 63 20 69 73 20 61 20 75 6e 69 63 6f   If c is a unico
1870: 64 65 0a 23 20 63 68 61 72 61 63 74 65 72 2c 20  de.# character, 
1880: 74 68 65 6e 20 74 68 69 73 20 72 6f 75 74 69 6e  then this routin
1890: 65 20 6d 69 67 68 74 20 72 65 74 75 72 6e 20 6d  e might return m
18a0: 75 6c 74 69 70 6c 65 20 62 79 74 65 73 3a 20 20  ultiple bytes:  
18b0: 25 48 48 25 48 48 25 48 48 0a 23 0a 70 72 6f 63  %HH%HH%HH.#.proc
18c0: 20 77 61 70 70 49 6e 74 2d 25 48 48 63 68 61 72   wappInt-%HHchar
18d0: 20 7b 63 7d 20 7b 0a 20 20 69 66 20 7b 24 63 3d   {c} {.  if {$c=
18e0: 3d 22 20 22 7d 20 7b 72 65 74 75 72 6e 20 2b 7d  =" "} {return +}
18f0: 0a 20 20 72 65 74 75 72 6e 20 5b 72 65 67 73 75  .  return [regsu
1900: 62 20 2d 61 6c 6c 20 2e 2e 20 5b 62 69 6e 61 72  b -all .. [binar
1910: 79 20 65 6e 63 6f 64 65 20 68 65 78 20 5b 65 6e  y encode hex [en
1920: 63 6f 64 69 6e 67 20 63 6f 6e 76 65 72 74 74 6f  coding convertto
1930: 20 75 74 66 2d 38 20 24 63 5d 5d 20 7b 25 26 7d   utf-8 $c]] {%&}
1940: 5d 0a 7d 0a 0a 0a 23 20 55 6e 64 6f 20 74 68 65  ].}...# Undo the
1950: 20 77 77 77 2d 75 72 6c 2d 65 6e 63 6f 64 65 64   www-url-encoded
1960: 20 66 6f 72 6d 61 74 2e 0a 23 0a 23 20 48 54 3a   format..#.# HT:
1970: 20 54 68 69 73 20 63 6f 64 65 20 73 74 6f 6c 65   This code stole
1980: 6e 20 66 72 6f 6d 20 6e 63 67 69 2e 74 63 6c 0a  n from ncgi.tcl.
1990: 23 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 64  #.proc wappInt-d
19a0: 65 63 6f 64 65 2d 75 72 6c 20 7b 73 74 72 7d 20  ecode-url {str} 
19b0: 7b 0a 20 20 73 65 74 20 73 74 72 20 5b 73 74 72  {.  set str [str
19c0: 69 6e 67 20 6d 61 70 20 5b 6c 69 73 74 20 2b 20  ing map [list + 
19d0: 7b 20 7d 20 22 5c 5c 22 20 22 5c 5c 5c 5c 22 20  { } "\\" "\\\\" 
19e0: 5c 5b 20 5c 5c 5c 5b 20 5c 5d 20 5c 5c 5c 5d 5d  \[ \\\[ \] \\\]]
19f0: 20 24 73 74 72 5d 0a 20 20 72 65 67 73 75 62 20   $str].  regsub 
1a00: 2d 61 6c 6c 20 2d 2d 20 5c 0a 20 20 20 20 20 20  -all -- \.      
1a10: 7b 25 28 5b 45 65 5d 5b 41 2d 46 61 2d 66 30 2d  {%([Ee][A-Fa-f0-
1a20: 39 5d 29 25 28 5b 38 39 41 42 61 62 5d 5b 41 2d  9])%([89ABab][A-
1a30: 46 61 2d 66 30 2d 39 5d 29 25 28 5b 38 39 41 42  Fa-f0-9])%([89AB
1a40: 61 62 5d 5b 41 2d 46 61 2d 66 30 2d 39 5d 29 7d  ab][A-Fa-f0-9])}
1a50: 20 5c 0a 20 20 20 20 20 20 24 73 74 72 20 7b 5b   \.      $str {[
1a60: 65 6e 63 6f 64 69 6e 67 20 63 6f 6e 76 65 72 74  encoding convert
1a70: 66 72 6f 6d 20 75 74 66 2d 38 20 5b 62 69 6e 61  from utf-8 [bina
1a80: 72 79 20 64 65 63 6f 64 65 20 68 65 78 20 5c 31  ry decode hex \1
1a90: 5c 32 5c 33 5d 5d 7d 20 73 74 72 0a 20 20 72 65  \2\3]]} str.  re
1aa0: 67 73 75 62 20 2d 61 6c 6c 20 2d 2d 20 5c 0a 20  gsub -all -- \. 
1ab0: 20 20 20 20 20 7b 25 28 5b 43 44 63 64 5d 5b 41       {%([CDcd][A
1ac0: 2d 46 61 2d 66 30 2d 39 5d 29 25 28 5b 38 39 41  -Fa-f0-9])%([89A
1ad0: 42 61 62 5d 5b 41 2d 46 61 2d 66 30 2d 39 5d 29  Bab][A-Fa-f0-9])
1ae0: 7d 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  }               
1af0: 20 20 20 20 20 20 5c 0a 20 20 20 20 20 20 24 73        \.      $s
1b00: 74 72 20 7b 5b 65 6e 63 6f 64 69 6e 67 20 63 6f  tr {[encoding co
1b10: 6e 76 65 72 74 66 72 6f 6d 20 75 74 66 2d 38 20  nvertfrom utf-8 
1b20: 5b 62 69 6e 61 72 79 20 64 65 63 6f 64 65 20 68  [binary decode h
1b30: 65 78 20 5c 31 5c 32 5d 5d 7d 20 73 74 72 0a 20  ex \1\2]]} str. 
1b40: 20 72 65 67 73 75 62 20 2d 61 6c 6c 20 2d 2d 20   regsub -all -- 
1b50: 7b 25 28 5b 30 2d 37 5d 5b 41 2d 46 61 2d 66 30  {%([0-7][A-Fa-f0
1b60: 2d 39 5d 29 7d 20 24 73 74 72 20 7b 5c 5c 75 30  -9])} $str {\\u0
1b70: 30 5c 31 7d 20 73 74 72 0a 20 20 72 65 74 75 72  0\1} str.  retur
1b80: 6e 20 5b 73 75 62 73 74 20 2d 6e 6f 76 61 72 20  n [subst -novar 
1b90: 24 73 74 72 5d 0a 7d 0a 0a 23 20 52 65 73 65 74  $str].}..# Reset
1ba0: 20 74 68 65 20 64 6f 63 75 6d 65 6e 74 20 62 61   the document ba
1bb0: 63 6b 20 74 6f 20 61 6e 20 65 6d 70 74 79 20 73  ck to an empty s
1bc0: 74 72 69 6e 67 2e 0a 23 0a 70 72 6f 63 20 77 61  tring..#.proc wa
1bd0: 70 70 2d 72 65 73 65 74 20 7b 7d 20 7b 0a 20 20  pp-reset {} {.  
1be0: 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 64 69  global wapp.  di
1bf0: 63 74 20 73 65 74 20 77 61 70 70 20 2e 72 65 70  ct set wapp .rep
1c00: 6c 79 20 7b 7d 0a 7d 0a 0a 23 20 43 68 61 6e 67  ly {}.}..# Chang
1c10: 65 20 74 68 65 20 6d 69 6d 65 2d 74 79 70 65 20  e the mime-type 
1c20: 6f 66 20 74 68 65 20 72 65 73 75 6c 74 20 64 6f  of the result do
1c30: 63 75 6d 65 6e 74 2e 0a 23 0a 70 72 6f 63 20 77  cument..#.proc w
1c40: 61 70 70 2d 6d 69 6d 65 74 79 70 65 20 7b 78 7d  app-mimetype {x}
1c50: 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 77 61 70 70   {.  global wapp
1c60: 0a 20 20 64 69 63 74 20 73 65 74 20 77 61 70 70  .  dict set wapp
1c70: 20 2e 6d 69 6d 65 74 79 70 65 20 24 78 0a 7d 0a   .mimetype $x.}.
1c80: 0a 23 20 43 68 61 6e 67 65 20 74 68 65 20 72 65  .# Change the re
1c90: 70 6c 79 20 63 6f 64 65 2e 0a 23 0a 70 72 6f 63  ply code..#.proc
1ca0: 20 77 61 70 70 2d 72 65 70 6c 79 2d 63 6f 64 65   wapp-reply-code
1cb0: 20 7b 78 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20   {x} {.  global 
1cc0: 77 61 70 70 0a 20 20 64 69 63 74 20 73 65 74 20  wapp.  dict set 
1cd0: 77 61 70 70 20 2e 72 65 70 6c 79 2d 63 6f 64 65  wapp .reply-code
1ce0: 20 24 78 0a 7d 0a 0a 23 20 53 65 74 20 61 20 63   $x.}..# Set a c
1cf0: 6f 6f 6b 69 65 0a 23 0a 70 72 6f 63 20 77 61 70  ookie.#.proc wap
1d00: 70 2d 73 65 74 2d 63 6f 6f 6b 69 65 20 7b 6e 61  p-set-cookie {na
1d10: 6d 65 20 76 61 6c 75 65 7d 20 7b 0a 20 20 67 6c  me value} {.  gl
1d20: 6f 62 61 6c 20 77 61 70 70 0a 20 20 64 69 63 74  obal wapp.  dict
1d30: 20 6c 61 70 70 65 6e 64 20 77 61 70 70 20 2e 6e   lappend wapp .n
1d40: 65 77 2d 63 6f 6f 6b 69 65 73 20 24 6e 61 6d 65  ew-cookies $name
1d50: 20 24 76 61 6c 75 65 0a 7d 0a 0a 23 20 55 6e 73   $value.}..# Uns
1d60: 65 74 20 61 20 63 6f 6f 6b 69 65 0a 23 0a 70 72  et a cookie.#.pr
1d70: 6f 63 20 77 61 70 70 2d 63 6c 65 61 72 2d 63 6f  oc wapp-clear-co
1d80: 6f 6b 69 65 20 7b 6e 61 6d 65 7d 20 7b 0a 20 20  okie {name} {.  
1d90: 77 61 70 70 2d 73 65 74 2d 63 6f 6f 6b 69 65 20  wapp-set-cookie 
1da0: 24 6e 61 6d 65 20 7b 7d 0a 7d 0a 0a 23 20 41 64  $name {}.}..# Ad
1db0: 64 20 65 78 74 72 61 20 65 6e 74 72 69 65 73 20  d extra entries 
1dc0: 74 6f 20 74 68 65 20 72 65 70 6c 79 20 68 65 61  to the reply hea
1dd0: 64 65 72 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d  der.#.proc wapp-
1de0: 72 65 70 6c 79 2d 65 78 74 72 61 20 7b 6e 61 6d  reply-extra {nam
1df0: 65 20 76 61 6c 75 65 7d 20 7b 0a 20 20 67 6c 6f  e value} {.  glo
1e00: 62 61 6c 20 77 61 70 70 0a 20 20 64 69 63 74 20  bal wapp.  dict 
1e10: 6c 61 70 70 65 6e 64 20 77 61 70 70 20 2e 72 65  lappend wapp .re
1e20: 70 6c 79 2d 65 78 74 72 61 20 24 6e 61 6d 65 20  ply-extra $name 
1e30: 24 76 61 6c 75 65 0a 7d 0a 0a 23 20 53 70 65 63  $value.}..# Spec
1e40: 69 66 69 65 73 20 68 6f 77 20 74 68 65 20 77 65  ifies how the we
1e50: 62 2d 70 61 67 65 20 75 6e 64 65 72 20 63 6f 6e  b-page under con
1e60: 73 74 72 75 63 74 69 6f 6e 20 73 68 6f 75 6c 64  struction should
1e70: 20 62 65 20 63 61 63 68 65 64 2e 0a 23 20 54 68   be cached..# Th
1e80: 65 20 61 72 67 75 6d 65 6e 74 20 73 68 6f 75 6c  e argument shoul
1e90: 64 20 62 65 20 6f 6e 65 20 6f 66 3a 0a 23 0a 23  d be one of:.#.#
1ea0: 20 20 20 20 6e 6f 2d 63 61 63 68 65 0a 23 20 20      no-cache.#  
1eb0: 20 20 6d 61 78 2d 61 67 65 3d 4e 20 20 20 20 20    max-age=N     
1ec0: 20 20 20 20 20 20 20 20 28 66 6f 72 20 73 6f 6d          (for som
1ed0: 65 20 69 6e 74 65 67 65 72 20 6e 75 6d 62 65 72  e integer number
1ee0: 20 6f 66 20 73 65 63 6f 6e 64 73 2c 20 4e 29 0a   of seconds, N).
1ef0: 23 20 20 20 20 70 72 69 76 61 74 65 2c 6d 61 78  #    private,max
1f00: 2d 61 67 65 3d 4e 0a 23 0a 70 72 6f 63 20 77 61  -age=N.#.proc wa
1f10: 70 70 2d 63 61 63 68 65 2d 63 6f 6e 74 72 6f 6c  pp-cache-control
1f20: 20 7b 78 7d 20 7b 0a 20 20 77 61 70 70 2d 72 65   {x} {.  wapp-re
1f30: 70 6c 79 2d 65 78 74 72 61 20 43 61 63 68 65 2d  ply-extra Cache-
1f40: 43 6f 6e 74 72 6f 6c 20 24 78 0a 7d 0a 0a 23 20  Control $x.}..# 
1f50: 52 65 64 69 72 65 63 74 20 74 6f 20 61 20 64 69  Redirect to a di
1f60: 66 66 65 72 65 6e 74 20 77 65 62 20 70 61 67 65  fferent web page
1f70: 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d 72 65 64  .#.proc wapp-red
1f80: 69 72 65 63 74 20 7b 75 72 69 7d 20 7b 0a 20 20  irect {uri} {.  
1f90: 77 61 70 70 2d 72 65 70 6c 79 2d 63 6f 64 65 20  wapp-reply-code 
1fa0: 7b 33 30 37 20 52 65 64 69 72 65 63 74 7d 0a 20  {307 Redirect}. 
1fb0: 20 77 61 70 70 2d 72 65 70 6c 79 2d 65 78 74 72   wapp-reply-extr
1fc0: 61 20 4c 6f 63 61 74 69 6f 6e 20 24 75 72 69 0a  a Location $uri.
1fd0: 7d 0a 0a 23 20 52 65 74 75 72 6e 20 74 68 65 20  }..# Return the 
1fe0: 76 61 6c 75 65 20 6f 66 20 61 20 77 61 70 70 20  value of a wapp 
1ff0: 70 61 72 61 6d 65 74 65 72 0a 23 0a 70 72 6f 63  parameter.#.proc
2000: 20 77 61 70 70 2d 70 61 72 61 6d 20 7b 6e 61 6d   wapp-param {nam
2010: 65 20 7b 64 66 6c 74 20 7b 7d 7d 7d 20 7b 0a 20  e {dflt {}}} {. 
2020: 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 69   global wapp.  i
2030: 66 20 7b 21 5b 64 69 63 74 20 65 78 69 73 74 73  f {![dict exists
2040: 20 24 77 61 70 70 20 24 6e 61 6d 65 5d 7d 20 7b   $wapp $name]} {
2050: 72 65 74 75 72 6e 20 24 64 66 6c 74 7d 0a 20 20  return $dflt}.  
2060: 72 65 74 75 72 6e 20 5b 64 69 63 74 20 67 65 74  return [dict get
2070: 20 24 77 61 70 70 20 24 6e 61 6d 65 5d 0a 7d 0a   $wapp $name].}.
2080: 0a 23 20 52 65 74 75 72 6e 20 74 72 75 65 20 69  .# Return true i
2090: 66 20 61 20 61 6e 64 20 6f 6e 6c 79 20 69 66 20  f a and only if 
20a0: 74 68 65 20 77 61 70 70 20 70 61 72 61 6d 65 74  the wapp paramet
20b0: 65 72 20 24 6e 61 6d 65 20 65 78 69 73 74 73 0a  er $name exists.
20c0: 23 0a 70 72 6f 63 20 77 61 70 70 2d 70 61 72 61  #.proc wapp-para
20d0: 6d 2d 65 78 69 73 74 73 20 7b 6e 61 6d 65 7d 20  m-exists {name} 
20e0: 7b 0a 20 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a  {.  global wapp.
20f0: 20 20 72 65 74 75 72 6e 20 5b 64 69 63 74 20 65    return [dict e
2100: 78 69 73 74 73 20 24 77 61 70 70 20 24 6e 61 6d  xists $wapp $nam
2110: 65 5d 0a 7d 0a 0a 23 20 53 65 74 20 74 68 65 20  e].}..# Set the 
2120: 76 61 6c 75 65 20 6f 66 20 61 20 77 61 70 70 20  value of a wapp 
2130: 70 61 72 61 6d 65 74 65 72 0a 23 0a 70 72 6f 63  parameter.#.proc
2140: 20 77 61 70 70 2d 73 65 74 2d 70 61 72 61 6d 20   wapp-set-param 
2150: 7b 6e 61 6d 65 20 76 61 6c 75 65 7d 20 7b 0a 20  {name value} {. 
2160: 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 64   global wapp.  d
2170: 69 63 74 20 73 65 74 20 77 61 70 70 20 24 6e 61  ict set wapp $na
2180: 6d 65 20 24 76 61 6c 75 65 0a 7d 0a 0a 23 20 52  me $value.}..# R
2190: 65 74 75 72 6e 20 61 6c 6c 20 70 61 72 61 6d 65  eturn all parame
21a0: 74 65 72 20 6e 61 6d 65 73 20 74 68 61 74 20 6d  ter names that m
21b0: 61 74 63 68 20 74 68 65 20 47 4c 4f 42 20 70 61  atch the GLOB pa
21c0: 74 74 65 72 6e 2c 20 6f 72 20 61 6c 6c 0a 23 20  ttern, or all.# 
21d0: 6e 61 6d 65 73 20 69 66 20 74 68 65 20 47 4c 4f  names if the GLO
21e0: 42 20 70 61 74 74 65 72 6e 20 69 73 20 6f 6d 69  B pattern is omi
21f0: 74 74 65 64 2e 0a 23 0a 70 72 6f 63 20 77 61 70  tted..#.proc wap
2200: 70 2d 70 61 72 61 6d 2d 6c 69 73 74 20 7b 7b 67  p-param-list {{g
2210: 6c 6f 62 20 7b 2a 7d 7d 7d 20 7b 0a 20 20 67 6c  lob {*}}} {.  gl
2220: 6f 62 61 6c 20 77 61 70 70 0a 20 20 72 65 74 75  obal wapp.  retu
2230: 72 6e 20 5b 64 69 63 74 20 6b 65 79 73 20 24 77  rn [dict keys $w
2240: 61 70 70 20 24 67 6c 6f 62 5d 0a 7d 0a 0a 23 20  app $glob].}..# 
2250: 42 79 20 64 65 66 61 75 6c 74 2c 20 57 61 70 70  By default, Wapp
2260: 20 64 6f 65 73 20 6e 6f 74 20 64 65 63 6f 64 65   does not decode
2270: 20 71 75 65 72 79 20 70 61 72 61 6d 65 74 65 72   query parameter
2280: 73 20 61 6e 64 20 50 4f 53 54 20 70 61 72 61 6d  s and POST param
2290: 65 74 65 72 73 0a 23 20 66 6f 72 20 63 72 6f 73  eters.# for cros
22a0: 73 2d 6f 72 69 67 69 6e 20 72 65 71 75 65 73 74  s-origin request
22b0: 73 2e 20 20 54 68 69 73 20 69 73 20 61 20 73 65  s.  This is a se
22c0: 63 75 72 69 74 79 20 72 65 73 74 72 69 63 74 69  curity restricti
22d0: 6f 6e 2c 20 64 65 73 69 67 6e 65 64 20 74 6f 0a  on, designed to.
22e0: 23 20 68 65 6c 70 20 70 72 65 76 65 6e 74 20 63  # help prevent c
22f0: 72 6f 73 73 2d 73 69 74 65 20 72 65 71 75 65 73  ross-site reques
2300: 74 20 66 6f 72 67 65 72 79 20 28 43 53 52 46 29  t forgery (CSRF)
2310: 20 61 74 74 61 63 6b 73 2e 0a 23 0a 23 20 41 73   attacks..#.# As
2320: 20 61 20 63 6f 6e 73 65 71 75 65 6e 63 65 20 6f   a consequence o
2330: 66 20 74 68 69 73 20 72 65 73 74 72 69 63 74 69  f this restricti
2340: 6f 6e 2c 20 55 52 4c 73 20 66 6f 72 20 73 69 74  on, URLs for sit
2350: 65 73 20 67 65 6e 65 72 61 74 65 64 20 62 79 20  es generated by 
2360: 57 61 70 70 0a 23 20 74 68 61 74 20 63 6f 6e 74  Wapp.# that cont
2370: 61 69 6e 20 71 75 65 72 79 20 70 61 72 61 6d 65  ain query parame
2380: 74 65 72 73 20 77 69 6c 6c 20 6e 6f 74 20 77 6f  ters will not wo
2390: 72 6b 20 61 73 20 55 52 4c 73 20 66 6f 75 6e 64  rk as URLs found
23a0: 20 69 6e 20 6f 74 68 65 72 0a 23 20 77 65 62 73   in other.# webs
23b0: 69 74 65 73 2e 20 20 59 6f 75 20 63 61 6e 6e 6f  ites.  You canno
23c0: 74 20 63 72 65 61 74 65 20 61 20 6c 69 6e 6b 20  t create a link 
23d0: 66 72 6f 6d 20 61 20 73 65 63 6f 6e 64 20 77 65  from a second we
23e0: 62 73 69 74 65 20 69 6e 74 6f 20 61 20 57 61 70  bsite into a Wap
23f0: 70 0a 23 20 77 65 62 73 69 74 65 20 69 66 20 74  p.# website if t
2400: 68 65 20 6c 69 6e 6b 20 63 6f 6e 74 61 69 6e 73  he link contains
2410: 20 71 75 65 72 79 20 70 6c 61 6e 6e 65 72 2c 20   query planner, 
2420: 62 79 20 64 65 66 61 75 6c 74 2e 0a 23 0a 23 20  by default..#.# 
2430: 4f 66 20 63 6f 75 72 73 65 2c 20 69 74 20 69 73  Of course, it is
2440: 20 73 6f 6d 65 74 69 6d 65 73 20 64 65 73 69 72   sometimes desir
2450: 61 62 6c 65 20 74 6f 20 61 6c 6c 6f 77 20 71 75  able to allow qu
2460: 65 72 79 20 70 61 72 61 6d 65 74 65 72 73 20 6f  ery parameters o
2470: 6e 20 65 78 74 65 72 6e 61 6c 0a 23 20 6c 69 6e  n external.# lin
2480: 6b 73 2e 20 20 46 6f 72 20 55 52 4c 73 20 66 6f  ks.  For URLs fo
2490: 72 20 77 68 69 63 68 20 74 68 69 73 20 69 73 20  r which this is 
24a0: 73 61 66 65 2c 20 74 68 65 20 61 70 70 6c 69 63  safe, the applic
24b0: 61 74 69 6f 6e 20 73 68 6f 75 6c 64 20 69 6e 76  ation should inv
24c0: 6f 6b 65 0a 23 20 77 61 70 70 2d 61 6c 6c 6f 77  oke.# wapp-allow
24d0: 2d 78 6f 72 69 67 69 6e 2d 70 61 72 61 6d 73 2e  -xorigin-params.
24e0: 20 20 54 68 69 73 20 70 72 6f 63 65 64 75 72 65    This procedure
24f0: 20 74 65 6c 6c 73 20 57 61 70 70 20 74 68 61 74   tells Wapp that
2500: 20 69 74 20 69 73 20 73 61 66 65 20 74 6f 0a 23   it is safe to.#
2510: 20 67 6f 20 61 68 65 61 64 20 61 6e 64 20 64 65   go ahead and de
2520: 63 6f 64 65 20 74 68 65 20 71 75 65 72 79 20 70  code the query p
2530: 61 72 61 6d 65 74 65 72 73 20 65 76 65 6e 20 66  arameters even f
2540: 6f 72 20 63 72 6f 73 73 2d 73 69 74 65 20 72 65  or cross-site re
2550: 71 75 65 73 74 73 2e 0a 23 0a 23 20 49 6e 20 6f  quests..#.# In o
2560: 74 68 65 72 20 77 6f 72 64 73 2c 20 66 6f 72 20  ther words, for 
2570: 57 61 70 70 20 73 65 63 75 72 69 74 79 20 69 73  Wapp security is
2580: 20 74 68 65 20 64 65 66 61 75 6c 74 20 73 65 74   the default set
2590: 74 69 6e 67 2e 20 20 49 6e 64 69 76 69 64 75 61  ting.  Individua
25a0: 6c 20 70 61 67 65 73 0a 23 20 6e 65 65 64 20 74  l pages.# need t
25b0: 6f 20 61 63 74 69 76 65 6c 79 20 64 69 73 61 62  o actively disab
25c0: 6c 65 20 74 68 65 20 63 72 6f 73 73 2d 73 69 74  le the cross-sit
25d0: 65 20 72 65 71 75 65 73 74 20 73 65 63 75 72 69  e request securi
25e0: 74 79 20 69 66 20 74 68 6f 73 65 20 70 61 67 65  ty if those page
25f0: 73 0a 23 20 61 72 65 20 73 61 66 65 20 66 6f 72  s.# are safe for
2600: 20 63 72 6f 73 73 2d 73 69 74 65 20 61 63 63 65   cross-site acce
2610: 73 73 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70 2d  ss..#.proc wapp-
2620: 61 6c 6c 6f 77 2d 78 6f 72 69 67 69 6e 2d 70 61  allow-xorigin-pa
2630: 72 61 6d 73 20 7b 7d 20 7b 0a 20 20 67 6c 6f 62  rams {} {.  glob
2640: 61 6c 20 77 61 70 70 0a 20 20 69 66 20 7b 21 5b  al wapp.  if {![
2650: 64 69 63 74 20 65 78 69 73 74 73 20 24 77 61 70  dict exists $wap
2660: 70 20 2e 71 70 5d 20 26 26 20 21 5b 64 69 63 74  p .qp] && ![dict
2670: 20 67 65 74 20 24 77 61 70 70 20 53 41 4d 45 5f   get $wapp SAME_
2680: 4f 52 49 47 49 4e 5d 7d 20 7b 0a 20 20 20 20 77  ORIGIN]} {.    w
2690: 61 70 70 49 6e 74 2d 64 65 63 6f 64 65 2d 71 75  appInt-decode-qu
26a0: 65 72 79 2d 70 61 72 61 6d 73 0a 20 20 7d 0a 7d  ery-params.  }.}
26b0: 0a 0a 23 20 53 65 74 20 74 68 65 20 63 6f 6e 74  ..# Set the cont
26c0: 65 6e 74 2d 73 65 63 75 72 69 74 79 2d 70 6f 6c  ent-security-pol
26d0: 69 63 79 2e 0a 23 0a 23 20 54 68 65 20 64 65 66  icy..#.# The def
26e0: 61 75 6c 74 20 63 6f 6e 74 65 6e 74 2d 73 65 63  ault content-sec
26f0: 75 72 69 74 79 2d 70 6f 6c 69 63 79 20 69 73 20  urity-policy is 
2700: 76 65 72 79 20 73 74 72 69 63 74 3a 20 20 22 64  very strict:  "d
2710: 65 66 61 75 6c 74 2d 73 72 63 20 27 73 65 6c 66  efault-src 'self
2720: 27 22 0a 23 20 54 68 65 20 64 65 66 61 75 6c 74  '".# The default
2730: 20 70 6f 6c 69 63 79 20 70 72 6f 68 69 62 69 74   policy prohibit
2740: 73 20 74 68 65 20 75 73 65 20 6f 66 20 69 6e 2d  s the use of in-
2750: 6c 69 6e 65 20 6a 61 76 61 73 63 72 69 70 74 20  line javascript 
2760: 6f 72 20 43 53 53 2e 0a 23 0a 23 20 50 72 6f 76  or CSS..#.# Prov
2770: 69 64 65 20 61 6e 20 61 6c 74 65 72 6e 61 74 69  ide an alternati
2780: 76 65 20 43 53 50 20 61 73 20 74 68 65 20 61 72  ve CSP as the ar
2790: 67 75 6d 65 6e 74 2e 20 20 4f 72 20 75 73 65 20  gument.  Or use 
27a0: 22 6f 66 66 22 20 74 6f 20 64 69 73 61 62 6c 65  "off" to disable
27b0: 0a 23 20 74 68 65 20 43 53 50 20 63 6f 6d 70 6c  .# the CSP compl
27c0: 65 74 65 6c 79 2e 0a 23 0a 70 72 6f 63 20 77 61  etely..#.proc wa
27d0: 70 70 2d 63 6f 6e 74 65 6e 74 2d 73 65 63 75 72  pp-content-secur
27e0: 69 74 79 2d 70 6f 6c 69 63 79 20 7b 76 61 6c 7d  ity-policy {val}
27f0: 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 77 61 70 70   {.  global wapp
2800: 0a 20 20 69 66 20 7b 24 76 61 6c 3d 3d 22 6f 66  .  if {$val=="of
2810: 66 22 7d 20 7b 0a 20 20 20 20 64 69 63 74 20 75  f"} {.    dict u
2820: 6e 73 65 74 20 77 61 70 70 20 2e 63 73 70 0a 20  nset wapp .csp. 
2830: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 64 69   } else {.    di
2840: 63 74 20 73 65 74 20 77 61 70 70 20 2e 63 73 70  ct set wapp .csp
2850: 20 24 76 61 6c 0a 20 20 7d 0a 7d 0a 0a 23 20 45   $val.  }.}..# E
2860: 78 61 6d 69 6e 65 20 74 68 65 20 62 6f 64 79 73  xamine the bodys
2870: 20 6f 66 20 61 6c 6c 20 70 72 6f 63 65 64 75 72   of all procedur
2880: 65 73 20 69 6e 20 74 68 69 73 20 70 72 6f 67 72  es in this progr
2890: 61 6d 20 6c 6f 6f 6b 69 6e 67 20 66 6f 72 0a 23  am looking for.#
28a0: 20 75 6e 73 61 66 65 20 63 61 6c 6c 73 20 74 6f   unsafe calls to
28b0: 20 76 61 72 69 6f 75 73 20 57 61 70 70 20 69 6e   various Wapp in
28c0: 74 65 72 66 61 63 65 73 2e 20 20 52 65 74 75 72  terfaces.  Retur
28d0: 6e 20 61 20 74 65 78 74 20 73 74 72 69 6e 67 0a  n a text string.
28e0: 23 20 63 6f 6e 74 61 69 6e 69 6e 67 20 77 61 72  # containing war
28f0: 6e 69 6e 67 73 2e 20 52 65 74 75 72 6e 20 61 6e  nings. Return an
2900: 20 65 6d 70 74 79 20 73 74 72 69 6e 67 20 69 66   empty string if
2910: 20 61 6c 6c 20 69 73 20 6f 6b 2e 0a 23 0a 23 20   all is ok..#.# 
2920: 54 68 69 73 20 72 6f 75 74 69 6e 65 20 69 73 20  This routine is 
2930: 61 64 76 69 73 6f 72 79 20 6f 6e 6c 79 2e 20 20  advisory only.  
2940: 49 74 20 6d 69 73 73 65 73 20 73 6f 6d 65 20 63  It misses some c
2950: 6f 6e 73 74 72 75 63 74 73 20 74 68 61 74 20 61  onstructs that a
2960: 72 65 0a 23 20 64 61 6e 67 65 72 6f 75 73 20 61  re.# dangerous a
2970: 6e 64 20 66 6c 61 67 73 20 6f 74 68 65 72 73 20  nd flags others 
2980: 74 68 61 74 20 61 72 65 20 73 61 66 65 2e 0a 23  that are safe..#
2990: 0a 70 72 6f 63 20 77 61 70 70 2d 73 61 66 65 74  .proc wapp-safet
29a0: 79 2d 63 68 65 63 6b 20 7b 7d 20 7b 0a 20 20 73  y-check {} {.  s
29b0: 65 74 20 72 65 73 20 7b 7d 0a 20 20 66 6f 72 65  et res {}.  fore
29c0: 61 63 68 20 70 20 5b 69 6e 66 6f 20 63 6f 6d 6d  ach p [info comm
29d0: 61 6e 64 5d 20 7b 0a 20 20 20 20 73 65 74 20 6c  and] {.    set l
29e0: 6e 20 30 0a 20 20 20 20 66 6f 72 65 61 63 68 20  n 0.    foreach 
29f0: 78 20 5b 73 70 6c 69 74 20 5b 69 6e 66 6f 20 62  x [split [info b
2a00: 6f 64 79 20 24 70 5d 20 5c 6e 5d 20 7b 0a 20 20  ody $p] \n] {.  
2a10: 20 20 20 20 69 6e 63 72 20 6c 6e 0a 20 20 20 20      incr ln.    
2a20: 20 20 69 66 20 7b 5b 72 65 67 65 78 70 20 7b 5e    if {[regexp {^
2a30: 5b 20 5c 74 5d 2a 77 61 70 70 5b 20 5c 74 5d 2b  [ \t]*wapp[ \t]+
2a40: 28 5b 5e 5c 6e 5d 2b 29 7d 20 24 78 20 61 6c 6c  ([^\n]+)} $x all
2a50: 20 74 61 69 6c 5d 0a 20 20 20 20 20 20 20 26 26   tail].       &&
2a60: 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24   [string index $
2a70: 74 61 69 6c 20 30 5d 21 3d 22 5c 31 37 33 22 0a  tail 0]!="\173".
2a80: 20 20 20 20 20 20 20 26 26 20 5b 72 65 67 65 78         && [regex
2a90: 70 20 7b 5b 5b 24 5d 7d 20 24 74 61 69 6c 5d 0a  p {[[$]} $tail].
2aa0: 20 20 20 20 20 20 7d 20 7b 0a 20 20 20 20 20 20        } {.      
2ab0: 20 20 61 70 70 65 6e 64 20 72 65 73 20 22 24 70    append res "$p
2ac0: 3a 24 6c 6e 3a 20 75 6e 73 61 66 65 20 5c 22 77  :$ln: unsafe \"w
2ad0: 61 70 70 5c 22 20 63 61 6c 6c 3a 20 5c 22 5b 73  app\" call: \"[s
2ae0: 74 72 69 6e 67 20 74 72 69 6d 20 24 78 5d 5c 22  tring trim $x]\"
2af0: 5c 6e 22 0a 20 20 20 20 20 20 7d 0a 20 20 20 20  \n".      }.    
2b00: 20 20 69 66 20 7b 5b 72 65 67 65 78 70 20 7b 5e    if {[regexp {^
2b10: 5b 20 5c 74 5d 2a 77 61 70 70 2d 28 73 75 62 73  [ \t]*wapp-(subs
2b20: 74 7c 74 72 69 6d 29 5b 20 5c 74 5d 2b 5b 5e 5c  t|trim)[ \t]+[^\
2b30: 31 37 33 5d 7d 20 24 78 20 61 6c 6c 20 63 78 5d  173]} $x all cx]
2b40: 7d 20 7b 0a 20 20 20 20 20 20 20 20 61 70 70 65  } {.        appe
2b50: 6e 64 20 72 65 73 20 22 24 70 3a 24 6c 6e 3a 20  nd res "$p:$ln: 
2b60: 75 6e 73 61 66 65 20 5c 22 77 61 70 70 2d 24 63  unsafe \"wapp-$c
2b70: 78 5c 22 20 63 61 6c 6c 3a 20 5c 22 5b 73 74 72  x\" call: \"[str
2b80: 69 6e 67 20 74 72 69 6d 20 24 78 5d 5c 22 5c 6e  ing trim $x]\"\n
2b90: 22 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a  ".      }.    }.
2ba0: 20 20 7d 0a 20 20 72 65 74 75 72 6e 20 24 72 65    }.  return $re
2bb0: 73 0a 7d 0a 0a 23 20 52 65 74 75 72 6e 20 61 20  s.}..# Return a 
2bc0: 73 74 72 69 6e 67 20 74 68 61 74 20 64 65 73 63  string that desc
2bd0: 72 69 70 74 73 20 74 68 65 20 63 75 72 72 65 6e  ripts the curren
2be0: 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 2e 20 20  t environment.  
2bf0: 41 70 70 6c 69 63 61 74 69 6f 6e 73 0a 23 20 6d  Applications.# m
2c00: 69 67 68 74 20 66 69 6e 64 20 74 68 69 73 20 75  ight find this u
2c10: 73 65 66 75 6c 20 66 6f 72 20 64 65 62 75 67 67  seful for debugg
2c20: 69 6e 67 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70  ing..#.proc wapp
2c30: 2d 64 65 62 75 67 2d 65 6e 76 20 7b 7d 20 7b 0a  -debug-env {} {.
2c40: 20 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20    global wapp.  
2c50: 73 65 74 20 6f 75 74 20 7b 7d 0a 20 20 66 6f 72  set out {}.  for
2c60: 65 61 63 68 20 76 61 72 20 5b 6c 73 6f 72 74 20  each var [lsort 
2c70: 5b 64 69 63 74 20 6b 65 79 73 20 24 77 61 70 70  [dict keys $wapp
2c80: 5d 5d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74  ]] {.    if {[st
2c90: 72 69 6e 67 20 69 6e 64 65 78 20 24 76 61 72 20  ring index $var 
2ca0: 30 5d 3d 3d 22 2e 22 7d 20 63 6f 6e 74 69 6e 75  0]=="."} continu
2cb0: 65 0a 20 20 20 20 61 70 70 65 6e 64 20 6f 75 74  e.    append out
2cc0: 20 22 24 76 61 72 20 3d 20 5b 6c 69 73 74 20 5b   "$var = [list [
2cd0: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 24  dict get $wapp $
2ce0: 76 61 72 5d 5d 5c 6e 22 0a 20 20 7d 0a 20 20 61  var]]\n".  }.  a
2cf0: 70 70 65 6e 64 20 6f 75 74 20 22 5c 5b 70 77 64  ppend out "\[pwd
2d00: 5c 5d 20 3d 20 5b 6c 69 73 74 20 5b 70 77 64 5d  \] = [list [pwd]
2d10: 5d 5c 6e 22 0a 20 20 72 65 74 75 72 6e 20 24 6f  ]\n".  return $o
2d20: 75 74 0a 7d 0a 0a 23 20 54 72 61 63 69 6e 67 20  ut.}..# Tracing 
2d30: 66 75 6e 63 74 69 6f 6e 20 66 6f 72 20 65 61 63  function for eac
2d40: 68 20 48 54 54 50 20 72 65 71 75 65 73 74 2e 20  h HTTP request. 
2d50: 20 54 68 69 73 20 69 73 20 6f 76 65 72 72 69 64   This is overrid
2d60: 64 65 6e 20 62 79 20 77 61 70 70 2d 73 74 61 72  den by wapp-star
2d70: 74 0a 23 20 69 66 20 74 72 61 63 69 6e 67 20 69  t.# if tracing i
2d80: 73 20 65 6e 61 62 6c 65 64 2e 0a 23 0a 70 72 6f  s enabled..#.pro
2d90: 63 20 77 61 70 70 49 6e 74 2d 74 72 61 63 65 20  c wappInt-trace 
2da0: 7b 7d 20 7b 7d 0a 0a 23 20 53 74 61 72 74 20 75  {} {}..# Start u
2db0: 70 20 61 20 6c 69 73 74 65 6e 69 6e 67 20 73 6f  p a listening so
2dc0: 63 6b 65 74 2e 20 20 41 72 72 61 6e 67 65 20 74  cket.  Arrange t
2dd0: 6f 20 69 6e 76 6f 6b 65 20 77 61 70 70 49 6e 74  o invoke wappInt
2de0: 2d 6e 65 77 2d 63 6f 6e 6e 65 63 74 69 6f 6e 0a  -new-connection.
2df0: 23 20 66 6f 72 20 65 61 63 68 20 69 6e 62 6f 75  # for each inbou
2e00: 6e 64 20 48 54 54 50 20 63 6f 6e 6e 65 63 74 69  nd HTTP connecti
2e10: 6f 6e 2e 0a 23 0a 23 20 20 20 20 70 6f 72 74 20  on..#.#    port 
2e20: 20 20 20 20 20 20 20 20 20 20 20 4c 69 73 74 65             Liste
2e30: 6e 20 6f 6e 20 74 68 69 73 20 54 43 50 20 70 6f  n on this TCP po
2e40: 72 74 2e 20 20 30 20 6d 65 61 6e 73 20 74 6f 20  rt.  0 means to 
2e50: 73 65 6c 65 63 74 20 61 20 70 6f 72 74 0a 23 20  select a port.# 
2e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e70: 20 20 20 74 68 61 74 20 69 73 20 6e 6f 74 20 63     that is not c
2e80: 75 72 72 65 6e 74 6c 79 20 69 6e 20 75 73 65 0a  urrently in use.
2e90: 23 0a 23 20 20 20 20 77 61 70 70 6d 6f 64 65 20  #.#    wappmode 
2ea0: 20 20 20 20 20 20 20 4f 6e 65 20 6f 66 20 22 73         One of "s
2eb0: 63 67 69 22 2c 20 22 72 65 6d 6f 74 65 2d 73 63  cgi", "remote-sc
2ec0: 67 69 22 2c 20 22 73 65 72 76 65 72 22 2c 20 6f  gi", "server", o
2ed0: 72 20 22 6c 6f 63 61 6c 22 2e 0a 23 0a 23 20 20  r "local"..#.#  
2ee0: 20 20 66 72 6f 6d 69 70 20 20 20 20 20 20 20 20    fromip        
2ef0: 20 20 49 66 20 6e 6f 74 20 7b 7d 2c 20 74 68 65    If not {}, the
2f00: 6e 20 72 65 6a 65 63 74 20 61 6c 6c 20 72 65 71  n reject all req
2f10: 75 65 73 74 73 20 66 72 6f 6d 20 49 50 20 61 64  uests from IP ad
2f20: 64 72 65 73 73 65 73 0a 23 20 20 20 20 20 20 20  dresses.#       
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 74 68               oth
2f40: 65 72 20 74 68 61 6e 20 24 66 72 6f 6d 69 70 0a  er than $fromip.
2f50: 23 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 73  #.proc wappInt-s
2f60: 74 61 72 74 2d 6c 69 73 74 65 6e 65 72 20 7b 70  tart-listener {p
2f70: 6f 72 74 20 77 61 70 70 6d 6f 64 65 20 66 72 6f  ort wappmode fro
2f80: 6d 69 70 7d 20 7b 0a 20 20 69 66 20 7b 5b 73 74  mip} {.  if {[st
2f90: 72 69 6e 67 20 6d 61 74 63 68 20 2a 73 63 67 69  ring match *scgi
2fa0: 20 24 77 61 70 70 6d 6f 64 65 5d 7d 20 7b 0a 20   $wappmode]} {. 
2fb0: 20 20 20 73 65 74 20 74 79 70 65 20 53 43 47 49     set type SCGI
2fc0: 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 20  .    set server 
2fd0: 5b 6c 69 73 74 20 77 61 70 70 49 6e 74 2d 6e 65  [list wappInt-ne
2fe0: 77 2d 63 6f 6e 6e 65 63 74 69 6f 6e 20 5c 0a 20  w-connection \. 
2ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 77                 w
3000: 61 70 70 49 6e 74 2d 73 63 67 69 2d 72 65 61 64  appInt-scgi-read
3010: 61 62 6c 65 20 24 77 61 70 70 6d 6f 64 65 20 24  able $wappmode $
3020: 66 72 6f 6d 69 70 5d 0a 20 20 7d 20 65 6c 73 65  fromip].  } else
3030: 20 7b 0a 20 20 20 20 73 65 74 20 74 79 70 65 20   {.    set type 
3040: 48 54 54 50 0a 20 20 20 20 73 65 74 20 73 65 72  HTTP.    set ser
3050: 76 65 72 20 5b 6c 69 73 74 20 77 61 70 70 49 6e  ver [list wappIn
3060: 74 2d 6e 65 77 2d 63 6f 6e 6e 65 63 74 69 6f 6e  t-new-connection
3070: 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20   \.             
3080: 20 20 20 77 61 70 70 49 6e 74 2d 68 74 74 70 2d     wappInt-http-
3090: 72 65 61 64 61 62 6c 65 20 24 77 61 70 70 6d 6f  readable $wappmo
30a0: 64 65 20 24 66 72 6f 6d 69 70 5d 0a 20 20 7d 0a  de $fromip].  }.
30b0: 20 20 69 66 20 7b 24 77 61 70 70 6d 6f 64 65 3d    if {$wappmode=
30c0: 3d 22 6c 6f 63 61 6c 22 20 7c 7c 20 24 77 61 70  ="local" || $wap
30d0: 70 6d 6f 64 65 3d 3d 22 73 63 67 69 22 7d 20 7b  pmode=="scgi"} {
30e0: 0a 20 20 20 20 73 65 74 20 78 20 5b 73 6f 63 6b  .    set x [sock
30f0: 65 74 20 2d 73 65 72 76 65 72 20 24 73 65 72 76  et -server $serv
3100: 65 72 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30  er -myaddr 127.0
3110: 2e 30 2e 31 20 24 70 6f 72 74 5d 0a 20 20 7d 20  .0.1 $port].  } 
3120: 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 20 78  else {.    set x
3130: 20 5b 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72   [socket -server
3140: 20 24 73 65 72 76 65 72 20 24 70 6f 72 74 5d 0a   $server $port].
3150: 20 20 7d 0a 20 20 73 65 74 20 63 6f 6e 69 6e 66    }.  set coninf
3160: 6f 20 5b 63 68 61 6e 20 63 6f 6e 66 69 67 75 72  o [chan configur
3170: 65 20 24 78 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a  e $x -sockname].
3180: 20 20 73 65 74 20 70 6f 72 74 20 5b 6c 69 6e 64    set port [lind
3190: 65 78 20 24 63 6f 6e 69 6e 66 6f 20 32 5d 0a 20  ex $coninfo 2]. 
31a0: 20 69 66 20 7b 24 77 61 70 70 6d 6f 64 65 3d 3d   if {$wappmode==
31b0: 22 6c 6f 63 61 6c 22 7d 20 7b 0a 20 20 20 20 77  "local"} {.    w
31c0: 61 70 70 49 6e 74 2d 73 74 61 72 74 2d 62 72 6f  appInt-start-bro
31d0: 77 73 65 72 20 68 74 74 70 3a 2f 2f 31 32 37 2e  wser http://127.
31e0: 30 2e 30 2e 31 3a 24 70 6f 72 74 2f 0a 20 20 7d  0.0.1:$port/.  }
31f0: 20 65 6c 73 65 69 66 20 7b 24 66 72 6f 6d 69 70   elseif {$fromip
3200: 21 3d 22 22 7d 20 7b 0a 20 20 20 20 70 75 74 73  !=""} {.    puts
3210: 20 22 4c 69 73 74 65 6e 69 6e 67 20 66 6f 72 20   "Listening for 
3220: 24 74 79 70 65 20 72 65 71 75 65 73 74 73 20 6f  $type requests o
3230: 6e 20 54 43 50 20 70 6f 72 74 20 24 70 6f 72 74  n TCP port $port
3240: 20 66 72 6f 6d 20 49 50 20 24 66 72 6f 6d 69 70   from IP $fromip
3250: 22 0a 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20  ".  } else {.   
3260: 20 70 75 74 73 20 22 4c 69 73 74 65 6e 69 6e 67   puts "Listening
3270: 20 66 6f 72 20 24 74 79 70 65 20 72 65 71 75 65   for $type reque
3280: 73 74 73 20 6f 6e 20 54 43 50 20 70 6f 72 74 20  sts on TCP port 
3290: 24 70 6f 72 74 22 0a 20 20 7d 0a 7d 0a 0a 23 20  $port".  }.}..# 
32a0: 53 74 61 72 74 20 61 20 77 65 62 2d 62 72 6f 77  Start a web-brow
32b0: 73 65 72 20 61 6e 64 20 70 6f 69 6e 74 20 69 74  ser and point it
32c0: 20 61 74 20 24 55 52 4c 0a 23 0a 70 72 6f 63 20   at $URL.#.proc 
32d0: 77 61 70 70 49 6e 74 2d 73 74 61 72 74 2d 62 72  wappInt-start-br
32e0: 6f 77 73 65 72 20 7b 75 72 6c 7d 20 7b 0a 20 20  owser {url} {.  
32f0: 67 6c 6f 62 61 6c 20 74 63 6c 5f 70 6c 61 74 66  global tcl_platf
3300: 6f 72 6d 0a 20 20 69 66 20 7b 24 74 63 6c 5f 70  orm.  if {$tcl_p
3310: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d  latform(platform
3320: 29 3d 3d 22 77 69 6e 64 6f 77 73 22 7d 20 7b 0a  )=="windows"} {.
3330: 20 20 20 20 65 78 65 63 20 63 6d 64 20 2f 63 20      exec cmd /c 
3340: 73 74 61 72 74 20 24 75 72 6c 20 26 0a 20 20 7d  start $url &.  }
3350: 20 65 6c 73 65 69 66 20 7b 24 74 63 6c 5f 70 6c   elseif {$tcl_pl
3360: 61 74 66 6f 72 6d 28 6f 73 29 3d 3d 22 44 61 72  atform(os)=="Dar
3370: 77 69 6e 22 7d 20 7b 0a 20 20 20 20 65 78 65 63  win"} {.    exec
3380: 20 6f 70 65 6e 20 24 75 72 6c 20 26 0a 20 20 7d   open $url &.  }
3390: 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20   elseif {[catch 
33a0: 7b 65 78 65 63 20 78 64 67 2d 6f 70 65 6e 20 24  {exec xdg-open $
33b0: 75 72 6c 7d 5d 7d 20 7b 0a 20 20 20 20 65 78 65  url}]} {.    exe
33c0: 63 20 66 69 72 65 66 6f 78 20 24 75 72 6c 20 26  c firefox $url &
33d0: 0a 20 20 7d 0a 7d 0a 0a 23 20 54 68 69 73 20 72  .  }.}..# This r
33e0: 6f 75 74 69 6e 65 20 69 73 20 61 20 22 73 6f 63  outine is a "soc
33f0: 6b 65 74 20 2d 73 65 72 76 65 72 22 20 63 61 6c  ket -server" cal
3400: 6c 62 61 63 6b 2e 20 20 54 68 65 20 24 63 68 61  lback.  The $cha
3410: 6e 2c 20 24 69 70 2c 20 61 6e 64 20 24 70 6f 72  n, $ip, and $por
3420: 74 0a 23 20 61 72 67 75 6d 65 6e 74 73 20 61 72  t.# arguments ar
3430: 65 20 61 64 64 65 64 20 62 79 20 74 68 65 20 73  e added by the s
3440: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 2e 0a 23  ocket command..#
3450: 0a 23 20 41 72 72 61 6e 67 65 20 74 6f 20 69 6e  .# Arrange to in
3460: 76 6f 6b 65 20 24 63 61 6c 6c 62 61 63 6b 20 77  voke $callback w
3470: 68 65 6e 20 63 6f 6e 74 65 6e 74 20 69 73 20 61  hen content is a
3480: 76 61 69 6c 61 62 6c 65 20 6f 6e 20 74 68 65 20  vailable on the 
3490: 6e 65 77 20 73 6f 63 6b 65 74 2e 0a 23 20 54 68  new socket..# Th
34a0: 65 20 24 63 61 6c 6c 62 61 63 6b 20 77 69 6c 6c  e $callback will
34b0: 20 70 72 6f 63 65 73 73 20 69 6e 62 6f 75 6e 64   process inbound
34c0: 20 48 54 54 50 20 6f 72 20 53 43 47 49 20 63 6f   HTTP or SCGI co
34d0: 6e 74 65 6e 74 2e 20 20 52 65 6a 65 63 74 20 74  ntent.  Reject t
34e0: 68 65 0a 23 20 72 65 71 75 65 73 74 20 69 66 20  he.# request if 
34f0: 24 66 72 6f 6d 69 70 20 69 73 20 6e 6f 74 20 61  $fromip is not a
3500: 6e 20 65 6d 70 74 79 20 73 74 72 69 6e 67 20 61  n empty string a
3510: 6e 64 20 64 6f 65 73 20 6e 6f 74 20 6d 61 74 63  nd does not matc
3520: 68 20 24 69 70 2e 0a 23 0a 70 72 6f 63 20 77 61  h $ip..#.proc wa
3530: 70 70 49 6e 74 2d 6e 65 77 2d 63 6f 6e 6e 65 63  ppInt-new-connec
3540: 74 69 6f 6e 20 7b 63 61 6c 6c 62 61 63 6b 20 77  tion {callback w
3550: 61 70 70 6d 6f 64 65 20 66 72 6f 6d 69 70 20 63  appmode fromip c
3560: 68 61 6e 20 69 70 20 70 6f 72 74 7d 20 7b 0a 20  han ip port} {. 
3570: 20 75 70 76 61 72 20 23 30 20 77 61 70 70 49 6e   upvar #0 wappIn
3580: 74 2d 24 63 68 61 6e 20 57 0a 20 20 69 66 20 7b  t-$chan W.  if {
3590: 24 66 72 6f 6d 69 70 21 3d 22 22 20 26 26 20 21  $fromip!="" && !
35a0: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 66  [string match $f
35b0: 72 6f 6d 69 70 20 24 69 70 5d 7d 20 7b 0a 20 20  romip $ip]} {.  
35c0: 20 20 63 6c 6f 73 65 20 24 63 68 61 6e 0a 20 20    close $chan.  
35d0: 20 20 72 65 74 75 72 6e 0a 20 20 7d 0a 20 20 73    return.  }.  s
35e0: 65 74 20 57 20 5b 64 69 63 74 20 63 72 65 61 74  et W [dict creat
35f0: 65 20 52 45 4d 4f 54 45 5f 41 44 44 52 20 24 69  e REMOTE_ADDR $i
3600: 70 20 52 45 4d 4f 54 45 5f 50 4f 52 54 20 24 70  p REMOTE_PORT $p
3610: 6f 72 74 20 57 41 50 50 5f 4d 4f 44 45 20 24 77  ort WAPP_MODE $w
3620: 61 70 70 6d 6f 64 65 20 5c 0a 20 20 20 20 20 20  appmode \.      
3630: 20 20 20 2e 68 65 61 64 65 72 20 7b 7d 5d 0a 20     .header {}]. 
3640: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 68 61   fconfigure $cha
3650: 6e 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74  n -blocking 0 -t
3660: 72 61 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72  ranslation binar
3670: 79 0a 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63  y.  fileevent $c
3680: 68 61 6e 20 72 65 61 64 61 62 6c 65 20 5b 6c 69  han readable [li
3690: 73 74 20 24 63 61 6c 6c 62 61 63 6b 20 24 63 68  st $callback $ch
36a0: 61 6e 5d 0a 7d 0a 0a 23 20 43 6c 6f 73 65 20 61  an].}..# Close a
36b0: 6e 20 69 6e 70 75 74 20 63 68 61 6e 6e 65 6c 0a  n input channel.
36c0: 23 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 63  #.proc wappInt-c
36d0: 6c 6f 73 65 2d 63 68 61 6e 6e 65 6c 20 7b 63 68  lose-channel {ch
36e0: 61 6e 7d 20 7b 0a 20 20 69 66 20 7b 24 63 68 61  an} {.  if {$cha
36f0: 6e 3d 3d 22 73 74 64 6f 75 74 22 7d 20 7b 0a 20  n=="stdout"} {. 
3700: 20 20 20 23 20 54 68 69 73 20 68 61 70 70 65 6e     # This happen
3710: 73 20 61 66 74 65 72 20 63 6f 6d 70 6c 65 74 69  s after completi
3720: 6e 67 20 61 20 43 47 49 20 72 65 71 75 65 73 74  ng a CGI request
3730: 0a 20 20 20 20 65 78 69 74 20 30 0a 20 20 7d 20  .    exit 0.  } 
3740: 65 6c 73 65 20 7b 0a 20 20 20 20 75 6e 73 65 74  else {.    unset
3750: 20 3a 3a 77 61 70 70 49 6e 74 2d 24 63 68 61 6e   ::wappInt-$chan
3760: 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 68 61 6e  .    close $chan
3770: 0a 20 20 7d 0a 7d 0a 0a 23 20 50 72 6f 63 65 73  .  }.}..# Proces
3780: 73 20 6e 65 77 20 74 65 78 74 20 72 65 63 65 69  s new text recei
3790: 76 65 64 20 6f 6e 20 61 6e 20 69 6e 62 6f 75 6e  ved on an inboun
37a0: 64 20 48 54 54 50 20 72 65 71 75 65 73 74 0a 23  d HTTP request.#
37b0: 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 68 74  .proc wappInt-ht
37c0: 74 70 2d 72 65 61 64 61 62 6c 65 20 7b 63 68 61  tp-readable {cha
37d0: 6e 7d 20 7b 0a 20 20 69 66 20 7b 5b 63 61 74 63  n} {.  if {[catc
37e0: 68 20 5b 6c 69 73 74 20 77 61 70 70 49 6e 74 2d  h [list wappInt-
37f0: 68 74 74 70 2d 72 65 61 64 61 62 6c 65 2d 75 6e  http-readable-un
3800: 73 61 66 65 20 24 63 68 61 6e 5d 20 6d 73 67 5d  safe $chan] msg]
3810: 7d 20 7b 0a 20 20 20 20 70 75 74 73 20 73 74 64  } {.    puts std
3820: 65 72 72 20 22 24 6d 73 67 5c 6e 24 3a 3a 65 72  err "$msg\n$::er
3830: 72 6f 72 49 6e 66 6f 22 0a 20 20 20 20 77 61 70  rorInfo".    wap
3840: 70 49 6e 74 2d 63 6c 6f 73 65 2d 63 68 61 6e 6e  pInt-close-chann
3850: 65 6c 20 24 63 68 61 6e 0a 20 20 7d 0a 7d 0a 70  el $chan.  }.}.p
3860: 72 6f 63 20 77 61 70 70 49 6e 74 2d 68 74 74 70  roc wappInt-http
3870: 2d 72 65 61 64 61 62 6c 65 2d 75 6e 73 61 66 65  -readable-unsafe
3880: 20 7b 63 68 61 6e 7d 20 7b 0a 20 20 75 70 76 61   {chan} {.  upva
3890: 72 20 23 30 20 77 61 70 70 49 6e 74 2d 24 63 68  r #0 wappInt-$ch
38a0: 61 6e 20 57 20 77 61 70 70 20 77 61 70 70 0a 20  an W wapp wapp. 
38b0: 20 69 66 20 7b 21 5b 64 69 63 74 20 65 78 69 73   if {![dict exis
38c0: 74 73 20 24 57 20 2e 74 6f 72 65 61 64 5d 7d 20  ts $W .toread]} 
38d0: 7b 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 2e  {.    # If the .
38e0: 74 6f 72 65 61 64 20 6b 65 79 20 69 73 20 6e 6f  toread key is no
38f0: 74 20 73 65 74 2c 20 74 68 61 74 20 6d 65 61 6e  t set, that mean
3900: 73 20 77 65 20 61 72 65 20 73 74 69 6c 6c 20 72  s we are still r
3910: 65 61 64 69 6e 67 0a 20 20 20 20 23 20 74 68 65  eading.    # the
3920: 20 68 65 61 64 65 72 0a 20 20 20 20 73 65 74 20   header.    set 
3930: 6c 69 6e 65 20 5b 73 74 72 69 6e 67 20 74 72 69  line [string tri
3940: 6d 72 69 67 68 74 20 5b 67 65 74 73 20 24 63 68  mright [gets $ch
3950: 61 6e 5d 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b  an]].    set n [
3960: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c  string length $l
3970: 69 6e 65 5d 0a 20 20 20 20 69 66 20 7b 24 6e 3e  ine].    if {$n>
3980: 30 7d 20 7b 0a 20 20 20 20 20 20 69 66 20 7b 5b  0} {.      if {[
3990: 64 69 63 74 20 67 65 74 20 24 57 20 2e 68 65 61  dict get $W .hea
39a0: 64 65 72 5d 3d 3d 22 22 20 7c 7c 20 5b 72 65 67  der]=="" || [reg
39b0: 65 78 70 20 7b 5e 5c 73 2b 7d 20 24 6c 69 6e 65  exp {^\s+} $line
39c0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 64 69 63  ]} {.        dic
39d0: 74 20 61 70 70 65 6e 64 20 57 20 2e 68 65 61 64  t append W .head
39e0: 65 72 20 24 6c 69 6e 65 0a 20 20 20 20 20 20 7d  er $line.      }
39f0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20   else {.        
3a00: 64 69 63 74 20 61 70 70 65 6e 64 20 57 20 2e 68  dict append W .h
3a10: 65 61 64 65 72 20 5c 6e 24 6c 69 6e 65 0a 20 20  eader \n$line.  
3a20: 20 20 20 20 7d 0a 20 20 20 20 20 20 69 66 20 7b      }.      if {
3a30: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 5b  [string length [
3a40: 64 69 63 74 20 67 65 74 20 24 57 20 2e 68 65 61  dict get $W .hea
3a50: 64 65 72 5d 5d 3e 31 30 30 30 30 30 7d 20 7b 0a  der]]>100000} {.
3a60: 20 20 20 20 20 20 20 20 65 72 72 6f 72 20 22 48          error "H
3a70: 54 54 50 20 72 65 71 75 65 73 74 20 68 65 61 64  TTP request head
3a80: 65 72 20 74 6f 6f 20 62 69 67 20 2d 20 70 6f 73  er too big - pos
3a90: 73 69 62 6c 65 20 44 4f 53 20 61 74 74 61 63 6b  sible DOS attack
3aa0: 22 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 20  ".      }.    } 
3ab0: 65 6c 73 65 69 66 20 7b 24 6e 3d 3d 30 7d 20 7b  elseif {$n==0} {
3ac0: 0a 20 20 20 20 20 20 23 20 57 65 20 68 61 76 65  .      # We have
3ad0: 20 72 65 61 63 68 65 64 20 74 68 65 20 62 6c 61   reached the bla
3ae0: 6e 6b 20 6c 69 6e 65 20 74 68 61 74 20 74 65 72  nk line that ter
3af0: 6d 69 6e 61 74 65 73 20 74 68 65 20 68 65 61 64  minates the head
3b00: 65 72 2e 0a 20 20 20 20 20 20 67 6c 6f 62 61 6c  er..      global
3b10: 20 61 72 67 76 30 0a 20 20 20 20 20 20 69 66 20   argv0.      if 
3b20: 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 3a 3a  {[info exists ::
3b30: 61 72 67 76 30 5d 7d 20 7b 0a 20 20 20 20 20 20  argv0]} {.      
3b40: 20 20 73 65 74 20 61 30 20 5b 66 69 6c 65 20 6e    set a0 [file n
3b50: 6f 72 6d 61 6c 69 7a 65 20 24 61 72 67 76 30 5d  ormalize $argv0]
3b60: 0a 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a  .      } else {.
3b70: 20 20 20 20 20 20 20 20 73 65 74 20 61 30 20 2f          set a0 /
3b80: 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 64  .      }.      d
3b90: 69 63 74 20 73 65 74 20 57 20 53 43 52 49 50 54  ict set W SCRIPT
3ba0: 5f 46 49 4c 45 4e 41 4d 45 20 24 61 30 0a 20 20  _FILENAME $a0.  
3bb0: 20 20 20 20 64 69 63 74 20 73 65 74 20 57 20 44      dict set W D
3bc0: 4f 43 55 4d 45 4e 54 5f 52 4f 4f 54 20 5b 66 69  OCUMENT_ROOT [fi
3bd0: 6c 65 20 64 69 72 20 24 61 30 5d 0a 20 20 20 20  le dir $a0].    
3be0: 20 20 69 66 20 7b 5b 77 61 70 70 49 6e 74 2d 70    if {[wappInt-p
3bf0: 61 72 73 65 2d 68 65 61 64 65 72 20 24 63 68 61  arse-header $cha
3c00: 6e 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 63 61  n]} {.        ca
3c10: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 68 61 6e  tch {close $chan
3c20: 7d 0a 20 20 20 20 20 20 20 20 72 65 74 75 72 6e  }.        return
3c30: 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 73  .      }.      s
3c40: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 20 20 69  et len 0.      i
3c50: 66 20 7b 5b 64 69 63 74 20 65 78 69 73 74 73 20  f {[dict exists 
3c60: 24 57 20 43 4f 4e 54 45 4e 54 5f 4c 45 4e 47 54  $W CONTENT_LENGT
3c70: 48 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65  H]} {.        se
3c80: 74 20 6c 65 6e 20 5b 64 69 63 74 20 67 65 74 20  t len [dict get 
3c90: 24 57 20 43 4f 4e 54 45 4e 54 5f 4c 45 4e 47 54  $W CONTENT_LENGT
3ca0: 48 5d 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 20  H].      }.     
3cb0: 20 69 66 20 7b 24 6c 65 6e 3e 30 7d 20 7b 0a 20   if {$len>0} {. 
3cc0: 20 20 20 20 20 20 20 23 20 53 74 69 6c 6c 20 6e         # Still n
3cd0: 65 65 64 20 74 6f 20 72 65 61 64 20 74 68 65 20  eed to read the 
3ce0: 71 75 65 72 79 20 63 6f 6e 74 65 6e 74 0a 20 20  query content.  
3cf0: 20 20 20 20 20 20 64 69 63 74 20 73 65 74 20 57        dict set W
3d00: 20 2e 74 6f 72 65 61 64 20 24 6c 65 6e 0a 20 20   .toread $len.  
3d10: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20      } else {.   
3d20: 20 20 20 20 20 23 20 54 68 65 72 65 20 69 73 20       # There is 
3d30: 6e 6f 20 71 75 65 72 79 20 63 6f 6e 74 65 6e 74  no query content
3d40: 2c 20 73 6f 20 68 61 6e 64 6c 65 20 74 68 65 20  , so handle the 
3d50: 72 65 71 75 65 73 74 20 69 6d 6d 65 64 69 61 74  request immediat
3d60: 65 6c 79 0a 20 20 20 20 20 20 20 20 73 65 74 20  ely.        set 
3d70: 77 61 70 70 20 24 57 0a 20 20 20 20 20 20 20 20  wapp $W.        
3d80: 77 61 70 70 49 6e 74 2d 68 61 6e 64 6c 65 2d 72  wappInt-handle-r
3d90: 65 71 75 65 73 74 20 24 63 68 61 6e 0a 20 20 20  equest $chan.   
3da0: 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d 20 65     }.    }.  } e
3db0: 6c 73 65 20 7b 0a 20 20 20 20 23 20 49 66 20 2e  lse {.    # If .
3dc0: 74 6f 72 65 61 64 20 69 73 20 73 65 74 2c 20 74  toread is set, t
3dd0: 68 61 74 20 6d 65 61 6e 73 20 77 65 20 61 72 65  hat means we are
3de0: 20 72 65 61 64 69 6e 67 20 74 68 65 20 71 75 65   reading the que
3df0: 72 79 20 63 6f 6e 74 65 6e 74 2e 0a 20 20 20 20  ry content..    
3e00: 23 20 43 6f 6e 74 69 6e 75 65 20 72 65 61 64 69  # Continue readi
3e10: 6e 67 20 75 6e 74 69 6c 20 2e 74 6f 72 65 61 64  ng until .toread
3e20: 20 72 65 61 63 68 65 73 20 7a 65 72 6f 2e 0a 20   reaches zero.. 
3e30: 20 20 20 73 65 74 20 67 6f 74 20 5b 72 65 61 64     set got [read
3e40: 20 24 63 68 61 6e 20 5b 64 69 63 74 20 67 65 74   $chan [dict get
3e50: 20 24 57 20 2e 74 6f 72 65 61 64 5d 5d 0a 20 20   $W .toread]].  
3e60: 20 20 64 69 63 74 20 61 70 70 65 6e 64 20 57 20    dict append W 
3e70: 43 4f 4e 54 45 4e 54 20 24 67 6f 74 0a 20 20 20  CONTENT $got.   
3e80: 20 64 69 63 74 20 73 65 74 20 57 20 2e 74 6f 72   dict set W .tor
3e90: 65 61 64 20 5b 65 78 70 72 20 7b 5b 64 69 63 74  ead [expr {[dict
3ea0: 20 67 65 74 20 24 57 20 2e 74 6f 72 65 61 64 5d   get $W .toread]
3eb0: 2d 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20  -[string length 
3ec0: 24 67 6f 74 5d 7d 5d 0a 20 20 20 20 69 66 20 7b  $got]}].    if {
3ed0: 5b 64 69 63 74 20 67 65 74 20 24 57 20 2e 74 6f  [dict get $W .to
3ee0: 72 65 61 64 5d 3c 3d 30 7d 20 7b 0a 20 20 20 20  read]<=0} {.    
3ef0: 20 20 23 20 48 61 6e 64 6c 65 20 74 68 65 20 72    # Handle the r
3f00: 65 71 75 65 73 74 20 61 73 20 73 6f 6f 6e 20 61  equest as soon a
3f10: 73 20 61 6c 6c 20 74 68 65 20 71 75 65 72 79 20  s all the query 
3f20: 63 6f 6e 74 65 6e 74 20 69 73 20 72 65 63 65 69  content is recei
3f30: 76 65 64 0a 20 20 20 20 20 20 73 65 74 20 77 61  ved.      set wa
3f40: 70 70 20 24 57 0a 20 20 20 20 20 20 77 61 70 70  pp $W.      wapp
3f50: 49 6e 74 2d 68 61 6e 64 6c 65 2d 72 65 71 75 65  Int-handle-reque
3f60: 73 74 20 24 63 68 61 6e 0a 20 20 20 20 7d 0a 20  st $chan.    }. 
3f70: 20 7d 0a 7d 0a 0a 23 20 44 65 63 6f 64 65 20 74   }.}..# Decode t
3f80: 68 65 20 48 54 54 50 20 72 65 71 75 65 73 74 20  he HTTP request 
3f90: 68 65 61 64 65 72 2e 0a 23 0a 23 20 54 68 69 73  header..#.# This
3fa0: 20 72 6f 75 74 69 6e 65 20 69 73 20 61 6c 77 61   routine is alwa
3fb0: 79 73 20 72 75 6e 6e 69 6e 67 20 69 6e 73 69 64  ys running insid
3fc0: 65 20 6f 66 20 61 20 5b 63 61 74 63 68 5d 2c 20  e of a [catch], 
3fd0: 73 6f 20 69 66 0a 23 20 61 6e 79 20 70 72 6f 62  so if.# any prob
3fe0: 6c 65 6d 73 20 61 72 69 73 65 2c 20 73 69 6d 70  lems arise, simp
3ff0: 6c 79 20 72 61 69 73 65 20 61 6e 20 65 72 72 6f  ly raise an erro
4000: 72 2e 0a 23 0a 70 72 6f 63 20 77 61 70 70 49 6e  r..#.proc wappIn
4010: 74 2d 70 61 72 73 65 2d 68 65 61 64 65 72 20 7b  t-parse-header {
4020: 63 68 61 6e 7d 20 7b 0a 20 20 75 70 76 61 72 20  chan} {.  upvar 
4030: 23 30 20 77 61 70 70 49 6e 74 2d 24 63 68 61 6e  #0 wappInt-$chan
4040: 20 57 0a 20 20 73 65 74 20 68 64 72 20 5b 73 70   W.  set hdr [sp
4050: 6c 69 74 20 5b 64 69 63 74 20 67 65 74 20 24 57  lit [dict get $W
4060: 20 2e 68 65 61 64 65 72 5d 20 5c 6e 5d 0a 20 20   .header] \n].  
4070: 69 66 20 7b 24 68 64 72 3d 3d 22 22 7d 20 7b 72  if {$hdr==""} {r
4080: 65 74 75 72 6e 20 31 7d 0a 20 20 73 65 74 20 72  eturn 1}.  set r
4090: 65 71 20 5b 6c 69 6e 64 65 78 20 24 68 64 72 20  eq [lindex $hdr 
40a0: 30 5d 0a 20 20 64 69 63 74 20 73 65 74 20 57 20  0].  dict set W 
40b0: 52 45 51 55 45 53 54 5f 4d 45 54 48 4f 44 20 5b  REQUEST_METHOD [
40c0: 73 65 74 20 6d 65 74 68 6f 64 20 5b 6c 69 6e 64  set method [lind
40d0: 65 78 20 24 72 65 71 20 30 5d 5d 0a 20 20 69 66  ex $req 0]].  if
40e0: 20 7b 5b 6c 73 65 61 72 63 68 20 7b 47 45 54 20   {[lsearch {GET 
40f0: 48 45 41 44 20 50 4f 53 54 7d 20 24 6d 65 74 68  HEAD POST} $meth
4100: 6f 64 5d 3c 30 7d 20 7b 0a 20 20 20 20 65 72 72  od]<0} {.    err
4110: 6f 72 20 22 75 6e 73 75 70 70 6f 72 74 65 64 20  or "unsupported 
4120: 72 65 71 75 65 73 74 20 6d 65 74 68 6f 64 3a 20  request method: 
4130: 5c 22 5b 64 69 63 74 20 67 65 74 20 24 57 20 52  \"[dict get $W R
4140: 45 51 55 45 53 54 5f 4d 45 54 48 4f 44 5d 5c 22  EQUEST_METHOD]\"
4150: 22 0a 20 20 7d 0a 20 20 73 65 74 20 75 72 69 20  ".  }.  set uri 
4160: 5b 6c 69 6e 64 65 78 20 24 72 65 71 20 31 5d 0a  [lindex $req 1].
4170: 20 20 73 65 74 20 73 70 6c 69 74 5f 75 72 69 20    set split_uri 
4180: 5b 73 70 6c 69 74 20 24 75 72 69 20 3f 5d 0a 20  [split $uri ?]. 
4190: 20 73 65 74 20 75 72 69 30 20 5b 6c 69 6e 64 65   set uri0 [linde
41a0: 78 20 24 73 70 6c 69 74 5f 75 72 69 20 30 5d 0a  x $split_uri 0].
41b0: 20 20 69 66 20 7b 21 5b 72 65 67 65 78 70 20 7b    if {![regexp {
41c0: 5e 2f 5b 2d 2e 61 2d 7a 30 2d 39 5f 2f 5d 2a 24  ^/[-.a-z0-9_/]*$
41d0: 7d 20 24 75 72 69 30 5d 7d 20 7b 0a 20 20 20 20  } $uri0]} {.    
41e0: 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 64 20 72  error "invalid r
41f0: 65 71 75 65 73 74 20 75 72 69 3a 20 5c 22 24 75  equest uri: \"$u
4200: 72 69 30 5c 22 22 0a 20 20 7d 0a 20 20 64 69 63  ri0\"".  }.  dic
4210: 74 20 73 65 74 20 57 20 52 45 51 55 45 53 54 5f  t set W REQUEST_
4220: 55 52 49 20 24 75 72 69 30 0a 20 20 64 69 63 74  URI $uri0.  dict
4230: 20 73 65 74 20 57 20 50 41 54 48 5f 49 4e 46 4f   set W PATH_INFO
4240: 20 24 75 72 69 30 0a 20 20 73 65 74 20 75 72 69   $uri0.  set uri
4250: 31 20 5b 6c 69 6e 64 65 78 20 24 73 70 6c 69 74  1 [lindex $split
4260: 5f 75 72 69 20 31 5d 0a 20 20 64 69 63 74 20 73  _uri 1].  dict s
4270: 65 74 20 57 20 51 55 45 52 59 5f 53 54 52 49 4e  et W QUERY_STRIN
4280: 47 20 24 75 72 69 31 0a 20 20 73 65 74 20 6e 20  G $uri1.  set n 
4290: 5b 6c 6c 65 6e 67 74 68 20 24 68 64 72 5d 0a 20  [llength $hdr]. 
42a0: 20 66 6f 72 20 7b 73 65 74 20 69 20 31 7d 20 7b   for {set i 1} {
42b0: 24 69 3c 24 6e 7d 20 7b 69 6e 63 72 20 69 7d 20  $i<$n} {incr i} 
42c0: 7b 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 6e  {.    set x [lin
42d0: 64 65 78 20 24 68 64 72 20 24 69 5d 0a 20 20 20  dex $hdr $i].   
42e0: 20 69 66 20 7b 21 5b 72 65 67 65 78 70 20 7b 5e   if {![regexp {^
42f0: 28 2e 2b 29 3a 20 2b 28 2e 2a 29 24 7d 20 24 78  (.+): +(.*)$} $x
4300: 20 61 6c 6c 20 6e 61 6d 65 20 76 61 6c 75 65 5d   all name value]
4310: 7d 20 7b 0a 20 20 20 20 20 20 65 72 72 6f 72 20  } {.      error 
4320: 22 69 6e 76 61 6c 69 64 20 68 65 61 64 65 72 20  "invalid header 
4330: 6c 69 6e 65 3a 20 5c 22 24 78 5c 22 22 0a 20 20  line: \"$x\"".  
4340: 20 20 7d 0a 20 20 20 20 73 65 74 20 6e 61 6d 65    }.    set name
4350: 20 5b 73 74 72 69 6e 67 20 74 6f 75 70 70 65 72   [string toupper
4360: 20 24 6e 61 6d 65 5d 0a 20 20 20 20 73 77 69 74   $name].    swit
4370: 63 68 20 2d 2d 20 24 6e 61 6d 65 20 7b 0a 20 20  ch -- $name {.  
4380: 20 20 20 20 52 45 46 45 52 45 52 20 7b 73 65 74      REFERER {set
4390: 20 6e 61 6d 65 20 48 54 54 50 5f 52 45 46 45 52   name HTTP_REFER
43a0: 45 52 7d 0a 20 20 20 20 20 20 55 53 45 52 2d 41  ER}.      USER-A
43b0: 47 45 4e 54 20 7b 73 65 74 20 6e 61 6d 65 20 48  GENT {set name H
43c0: 54 54 50 5f 55 53 45 52 5f 41 47 45 4e 54 7d 0a  TTP_USER_AGENT}.
43d0: 20 20 20 20 20 20 43 4f 4e 54 45 4e 54 2d 4c 45        CONTENT-LE
43e0: 4e 47 54 48 20 7b 73 65 74 20 6e 61 6d 65 20 43  NGTH {set name C
43f0: 4f 4e 54 45 4e 54 5f 4c 45 4e 47 54 48 7d 0a 20  ONTENT_LENGTH}. 
4400: 20 20 20 20 20 43 4f 4e 54 45 4e 54 2d 54 59 50       CONTENT-TYP
4410: 45 20 7b 73 65 74 20 6e 61 6d 65 20 43 4f 4e 54  E {set name CONT
4420: 45 4e 54 5f 54 59 50 45 7d 0a 20 20 20 20 20 20  ENT_TYPE}.      
4430: 48 4f 53 54 20 7b 73 65 74 20 6e 61 6d 65 20 48  HOST {set name H
4440: 54 54 50 5f 48 4f 53 54 7d 0a 20 20 20 20 20 20  TTP_HOST}.      
4450: 43 4f 4f 4b 49 45 20 7b 73 65 74 20 6e 61 6d 65  COOKIE {set name
4460: 20 48 54 54 50 5f 43 4f 4f 4b 49 45 7d 0a 20 20   HTTP_COOKIE}.  
4470: 20 20 20 20 41 43 43 45 50 54 2d 45 4e 43 4f 44      ACCEPT-ENCOD
4480: 49 4e 47 20 7b 73 65 74 20 6e 61 6d 65 20 48 54  ING {set name HT
4490: 54 50 5f 41 43 43 45 50 54 5f 45 4e 43 4f 44 49  TP_ACCEPT_ENCODI
44a0: 4e 47 7d 0a 20 20 20 20 20 20 64 65 66 61 75 6c  NG}.      defaul
44b0: 74 20 7b 73 65 74 20 6e 61 6d 65 20 2e 68 64 72  t {set name .hdr
44c0: 3a 24 6e 61 6d 65 7d 0a 20 20 20 20 7d 0a 20 20  :$name}.    }.  
44d0: 20 20 64 69 63 74 20 73 65 74 20 57 20 24 6e 61    dict set W $na
44e0: 6d 65 20 24 76 61 6c 75 65 0a 20 20 7d 0a 20 20  me $value.  }.  
44f0: 72 65 74 75 72 6e 20 30 0a 7d 0a 0a 23 20 44 65  return 0.}..# De
4500: 63 6f 64 65 20 74 68 65 20 51 55 45 52 59 5f 53  code the QUERY_S
4510: 54 52 49 4e 47 20 70 61 72 61 6d 65 74 65 72 73  TRING parameters
4520: 20 66 72 6f 6d 20 61 20 47 45 54 20 72 65 71 75   from a GET requ
4530: 65 73 74 20 6f 72 20 74 68 65 0a 23 20 61 70 70  est or the.# app
4540: 6c 69 63 61 74 69 6f 6e 2f 78 2d 77 77 77 2d 66  lication/x-www-f
4550: 6f 72 6d 2d 75 72 6c 65 6e 63 6f 64 65 64 20 43  orm-urlencoded C
4560: 4f 4e 54 45 4e 54 20 66 72 6f 6d 20 61 20 50 4f  ONTENT from a PO
4570: 53 54 20 72 65 71 75 65 73 74 2e 0a 23 0a 23 20  ST request..#.# 
4580: 54 68 69 73 20 72 6f 75 74 69 6e 65 20 73 65 74  This routine set
4590: 73 20 74 68 65 20 22 2e 71 70 22 20 65 6c 65 6d  s the ".qp" elem
45a0: 65 6e 74 20 6f 66 20 74 68 65 20 3a 3a 77 61 70  ent of the ::wap
45b0: 70 20 64 69 63 74 20 61 73 20 61 20 73 69 67 6e  p dict as a sign
45c0: 61 6c 0a 23 20 74 68 61 74 20 71 75 65 72 79 20  al.# that query 
45d0: 70 61 72 61 6d 65 74 65 72 73 20 68 61 76 65 20  parameters have 
45e0: 61 6c 72 65 61 64 79 20 62 65 65 6e 20 64 65 63  already been dec
45f0: 6f 64 65 64 2e 0a 23 0a 70 72 6f 63 20 77 61 70  oded..#.proc wap
4600: 70 49 6e 74 2d 64 65 63 6f 64 65 2d 71 75 65 72  pInt-decode-quer
4610: 79 2d 70 61 72 61 6d 73 20 7b 7d 20 7b 0a 20 20  y-params {} {.  
4620: 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 64 69  global wapp.  di
4630: 63 74 20 73 65 74 20 77 61 70 70 20 2e 71 70 20  ct set wapp .qp 
4640: 31 0a 20 20 69 66 20 7b 5b 64 69 63 74 20 65 78  1.  if {[dict ex
4650: 69 73 74 73 20 24 77 61 70 70 20 51 55 45 52 59  ists $wapp QUERY
4660: 5f 53 54 52 49 4e 47 5d 7d 20 7b 0a 20 20 20 20  _STRING]} {.    
4670: 66 6f 72 65 61 63 68 20 71 74 65 72 6d 20 5b 73  foreach qterm [s
4680: 70 6c 69 74 20 5b 64 69 63 74 20 67 65 74 20 24  plit [dict get $
4690: 77 61 70 70 20 51 55 45 52 59 5f 53 54 52 49 4e  wapp QUERY_STRIN
46a0: 47 5d 20 26 5d 20 7b 0a 20 20 20 20 20 20 73 65  G] &] {.      se
46b0: 74 20 71 73 70 6c 69 74 20 5b 73 70 6c 69 74 20  t qsplit [split 
46c0: 24 71 74 65 72 6d 20 3d 5d 0a 20 20 20 20 20 20  $qterm =].      
46d0: 73 65 74 20 6e 6d 20 5b 6c 69 6e 64 65 78 20 24  set nm [lindex $
46e0: 71 73 70 6c 69 74 20 30 5d 0a 20 20 20 20 20 20  qsplit 0].      
46f0: 69 66 20 7b 5b 72 65 67 65 78 70 20 7b 5e 5b 61  if {[regexp {^[a
4700: 2d 7a 5d 5b 61 2d 7a 30 2d 39 5d 2a 24 7d 20 24  -z][a-z0-9]*$} $
4710: 6e 6d 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 64  nm]} {.        d
4720: 69 63 74 20 73 65 74 20 77 61 70 70 20 24 6e 6d  ict set wapp $nm
4730: 20 5b 77 61 70 70 49 6e 74 2d 64 65 63 6f 64 65   [wappInt-decode
4740: 2d 75 72 6c 20 5b 6c 69 6e 64 65 78 20 24 71 73  -url [lindex $qs
4750: 70 6c 69 74 20 31 5d 5d 0a 20 20 20 20 20 20 7d  plit 1]].      }
4760: 0a 20 20 20 20 7d 0a 20 20 7d 0a 20 20 69 66 20  .    }.  }.  if 
4770: 7b 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 77  {[dict exists $w
4780: 61 70 70 20 43 4f 4e 54 45 4e 54 5f 54 59 50 45  app CONTENT_TYPE
4790: 5d 20 26 26 20 5b 64 69 63 74 20 65 78 69 73 74  ] && [dict exist
47a0: 73 20 24 77 61 70 70 20 43 4f 4e 54 45 4e 54 5d  s $wapp CONTENT]
47b0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 74 79 70  } {.    set ctyp
47c0: 65 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70  e [dict get $wap
47d0: 70 20 43 4f 4e 54 45 4e 54 5f 54 59 50 45 5d 0a  p CONTENT_TYPE].
47e0: 20 20 20 20 69 66 20 7b 24 63 74 79 70 65 3d 3d      if {$ctype==
47f0: 22 61 70 70 6c 69 63 61 74 69 6f 6e 2f 78 2d 77  "application/x-w
4800: 77 77 2d 66 6f 72 6d 2d 75 72 6c 65 6e 63 6f 64  ww-form-urlencod
4810: 65 64 22 7d 20 7b 0a 20 20 20 20 20 20 66 6f 72  ed"} {.      for
4820: 65 61 63 68 20 71 74 65 72 6d 20 5b 73 70 6c 69  each qterm [spli
4830: 74 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 20 5b  t [string trim [
4840: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 43  dict get $wapp C
4850: 4f 4e 54 45 4e 54 5d 5d 20 26 5d 20 7b 0a 20 20  ONTENT]] &] {.  
4860: 20 20 20 20 20 20 73 65 74 20 71 73 70 6c 69 74        set qsplit
4870: 20 5b 73 70 6c 69 74 20 24 71 74 65 72 6d 20 3d   [split $qterm =
4880: 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 6e 6d  ].        set nm
4890: 20 5b 6c 69 6e 64 65 78 20 24 71 73 70 6c 69 74   [lindex $qsplit
48a0: 20 30 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b   0].        if {
48b0: 5b 72 65 67 65 78 70 20 7b 5e 5b 61 2d 7a 5d 5b  [regexp {^[a-z][
48c0: 2d 61 2d 7a 30 2d 39 5f 5d 2a 24 7d 20 24 6e 6d  -a-z0-9_]*$} $nm
48d0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 64  ]} {.          d
48e0: 69 63 74 20 73 65 74 20 77 61 70 70 20 24 6e 6d  ict set wapp $nm
48f0: 20 5b 77 61 70 70 49 6e 74 2d 64 65 63 6f 64 65   [wappInt-decode
4900: 2d 75 72 6c 20 5b 6c 69 6e 64 65 78 20 24 71 73  -url [lindex $qs
4910: 70 6c 69 74 20 31 5d 5d 0a 20 20 20 20 20 20 20  plit 1]].       
4920: 20 7d 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 7d   }.      }.    }
4930: 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67   elseif {[string
4940: 20 6d 61 74 63 68 20 6d 75 6c 74 69 70 61 72 74   match multipart
4950: 2f 66 6f 72 6d 2d 64 61 74 61 2a 20 24 63 74 79  /form-data* $cty
4960: 70 65 5d 7d 20 7b 0a 20 20 20 20 20 20 72 65 67  pe]} {.      reg
4970: 65 78 70 20 7b 5e 28 2e 2a 3f 29 5c 72 5c 6e 28  exp {^(.*?)\r\n(
4980: 2e 2a 29 24 7d 20 5b 64 69 63 74 20 67 65 74 20  .*)$} [dict get 
4990: 24 77 61 70 70 20 43 4f 4e 54 45 4e 54 5d 20 61  $wapp CONTENT] a
49a0: 6c 6c 20 64 69 76 69 64 65 72 20 62 6f 64 79 0a  ll divider body.
49b0: 20 20 20 20 20 20 73 65 74 20 6e 64 69 76 20 5b        set ndiv [
49c0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 64  string length $d
49d0: 69 76 69 64 65 72 5d 0a 20 20 20 20 20 20 77 68  ivider].      wh
49e0: 69 6c 65 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e  ile {[string len
49f0: 67 74 68 20 24 62 6f 64 79 5d 7d 20 7b 0a 20 20  gth $body]} {.  
4a00: 20 20 20 20 20 20 73 65 74 20 69 64 78 20 5b 73        set idx [s
4a10: 74 72 69 6e 67 20 66 69 72 73 74 20 24 64 69 76  tring first $div
4a20: 69 64 65 72 20 24 62 6f 64 79 5d 0a 20 20 20 20  ider $body].    
4a30: 20 20 20 20 73 65 74 20 75 6e 69 74 20 5b 73 74      set unit [st
4a40: 72 69 6e 67 20 72 61 6e 67 65 20 24 62 6f 64 79  ring range $body
4a50: 20 30 20 5b 65 78 70 72 20 7b 24 69 64 78 2d 33   0 [expr {$idx-3
4a60: 7d 5d 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20  }]].        set 
4a70: 62 6f 64 79 20 5b 73 74 72 69 6e 67 20 72 61 6e  body [string ran
4a80: 67 65 20 24 62 6f 64 79 20 5b 65 78 70 72 20 7b  ge $body [expr {
4a90: 24 69 64 78 2b 24 6e 64 69 76 2b 32 7d 5d 20 65  $idx+$ndiv+2}] e
4aa0: 6e 64 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b  nd].        if {
4ab0: 5b 72 65 67 65 78 70 20 7b 5e 43 6f 6e 74 65 6e  [regexp {^Conten
4ac0: 74 2d 44 69 73 70 6f 73 69 74 69 6f 6e 3a 20 66  t-Disposition: f
4ad0: 6f 72 6d 2d 64 61 74 61 3b 20 28 2e 2a 3f 29 5c  orm-data; (.*?)\
4ae0: 72 5c 6e 5c 72 5c 6e 28 2e 2a 29 24 7d 20 5c 0a  r\n\r\n(.*)$} \.
4af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 24 75 6e               $un
4b00: 69 74 20 75 6e 69 74 20 68 64 72 20 63 6f 6e 74  it unit hdr cont
4b10: 65 6e 74 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20  ent]} {.        
4b20: 20 20 69 66 20 7b 5b 72 65 67 65 78 70 20 7b 6e    if {[regexp {n
4b30: 61 6d 65 3d 22 28 2e 2a 29 22 3b 20 66 69 6c 65  ame="(.*)"; file
4b40: 6e 61 6d 65 3d 22 28 2e 2a 29 22 5c 72 5c 6e 43  name="(.*)"\r\nC
4b50: 6f 6e 74 65 6e 74 2d 54 79 70 65 3a 20 28 2e 2a  ontent-Type: (.*
4b60: 3f 29 24 7d 5c 0a 20 20 20 20 20 20 20 20 20 20  ?)$}\.          
4b70: 20 20 20 20 20 20 24 68 64 72 20 68 72 20 6e 61        $hdr hr na
4b80: 6d 65 20 66 69 6c 65 6e 61 6d 65 20 6d 69 6d 65  me filename mime
4b90: 74 79 70 65 5d 7d 20 7b 0a 20 20 20 20 20 20 20  type]} {.       
4ba0: 20 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61       dict set wa
4bb0: 70 70 20 24 6e 61 6d 65 2e 66 69 6c 65 6e 61 6d  pp $name.filenam
4bc0: 65 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20  e \.            
4bd0: 20 20 5b 73 74 72 69 6e 67 20 6d 61 70 20 5b 6c    [string map [l
4be0: 69 73 74 20 5c 5c 5c 22 20 5c 22 20 5c 5c 5c 5c  ist \\\" \" \\\\
4bf0: 20 5c 5c 5d 20 24 66 69 6c 65 6e 61 6d 65 5d 0a   \\] $filename].
4c00: 20 20 20 20 20 20 20 20 20 20 20 20 64 69 63 74              dict
4c10: 20 73 65 74 20 77 61 70 70 20 24 6e 61 6d 65 2e   set wapp $name.
4c20: 6d 69 6d 65 74 79 70 65 20 24 6d 69 6d 65 74 79  mimetype $mimety
4c30: 70 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 64  pe.            d
4c40: 69 63 74 20 73 65 74 20 77 61 70 70 20 24 6e 61  ict set wapp $na
4c50: 6d 65 2e 63 6f 6e 74 65 6e 74 20 24 63 6f 6e 74  me.content $cont
4c60: 65 6e 74 0a 20 20 20 20 20 20 20 20 20 20 7d 20  ent.          } 
4c70: 65 6c 73 65 69 66 20 7b 5b 72 65 67 65 78 70 20  elseif {[regexp 
4c80: 7b 6e 61 6d 65 3d 22 28 2e 2a 29 22 7d 20 24 68  {name="(.*)"} $h
4c90: 64 72 20 68 72 20 6e 61 6d 65 5d 7d 20 7b 0a 20  dr hr name]} {. 
4ca0: 20 20 20 20 20 20 20 20 20 20 20 64 69 63 74 20             dict 
4cb0: 73 65 74 20 77 61 70 70 20 24 6e 61 6d 65 20 24  set wapp $name $
4cc0: 63 6f 6e 74 65 6e 74 0a 20 20 20 20 20 20 20 20  content.        
4cd0: 20 20 7d 0a 20 20 20 20 20 20 20 20 7d 0a 20 20    }.        }.  
4ce0: 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d 0a      }.    }.  }.
4cf0: 7d 0a 0a 23 20 49 6e 76 6f 6b 65 20 61 70 70 6c  }..# Invoke appl
4d00: 69 63 61 74 69 6f 6e 2d 73 75 70 70 6c 69 65 64  ication-supplied
4d10: 20 6d 65 74 68 6f 64 73 20 74 6f 20 67 65 6e 65   methods to gene
4d20: 72 61 74 65 20 61 20 72 65 70 6c 79 20 74 6f 0a  rate a reply to.
4d30: 23 20 61 20 73 69 6e 67 6c 65 20 48 54 54 50 20  # a single HTTP 
4d40: 72 65 71 75 65 73 74 2e 0a 23 0a 23 20 54 68 69  request..#.# Thi
4d50: 73 20 72 6f 75 74 69 6e 65 20 75 73 65 73 20 74  s routine uses t
4d60: 68 65 20 67 6c 6f 62 61 6c 20 76 61 72 69 61 62  he global variab
4d70: 6c 65 20 3a 3a 77 61 70 70 20 61 6e 64 20 73 6f  le ::wapp and so
4d80: 20 6d 75 73 74 20 6e 6f 74 20 62 65 20 6e 65 73   must not be nes
4d90: 74 65 64 2e 0a 23 20 49 74 20 6d 75 73 74 20 72  ted..# It must r
4da0: 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 69 6f 6e  un to completion
4db0: 20 62 65 66 6f 72 65 20 74 68 65 20 6e 65 78 74   before the next
4dc0: 20 69 6e 73 74 61 6e 63 65 20 72 75 6e 73 2e 20   instance runs. 
4dd0: 20 49 66 20 61 20 72 65 63 75 72 73 69 76 65 0a   If a recursive.
4de0: 23 20 69 6e 73 74 61 6e 63 65 73 20 6f 66 20 74  # instances of t
4df0: 68 69 73 20 72 6f 75 74 69 6e 65 20 73 74 61 72  his routine star
4e00: 74 73 20 77 68 69 6c 65 20 61 6e 6f 74 68 65 72  ts while another
4e10: 20 69 73 20 72 75 6e 6e 69 6e 67 2c 20 74 68 65   is running, the
4e20: 20 74 68 65 0a 23 20 72 65 63 75 72 73 69 76 65   the.# recursive
4e30: 20 69 6e 73 74 61 6e 63 65 20 69 73 20 61 64 64   instance is add
4e40: 65 64 20 74 6f 20 61 20 71 75 65 75 65 20 74 6f  ed to a queue to
4e50: 20 62 65 20 69 6e 76 6f 6b 65 64 20 61 66 74 65   be invoked afte
4e60: 72 20 74 68 65 20 63 75 72 72 65 6e 74 0a 23 20  r the current.# 
4e70: 69 6e 73 74 61 6e 63 65 20 66 69 6e 69 73 68 65  instance finishe
4e80: 73 2e 20 20 59 65 73 2c 20 74 68 69 73 20 6d 65  s.  Yes, this me
4e90: 61 6e 73 20 74 68 61 74 20 57 41 50 50 20 49 53  ans that WAPP IS
4ea0: 20 53 49 4e 47 4c 45 20 54 48 52 45 41 44 45 44   SINGLE THREADED
4eb0: 2e 20 20 4f 6e 6c 79 0a 23 20 61 20 73 69 6e 67  .  Only.# a sing
4ec0: 6c 65 20 70 61 67 65 20 72 65 6e 64 65 72 69 6e  le page renderin
4ed0: 67 20 69 6e 73 74 61 6e 63 65 20 6d 79 20 62 65  g instance my be
4ee0: 20 72 75 6e 6e 69 6e 67 20 61 74 20 61 20 74 69   running at a ti
4ef0: 6d 65 2e 20 20 54 68 65 72 65 20 63 61 6e 0a 23  me.  There can.#
4f00: 20 62 65 20 6d 75 6c 74 69 70 6c 65 20 48 54 54   be multiple HTT
4f10: 50 20 72 65 71 75 65 73 74 73 20 69 6e 62 6f 75  P requests inbou
4f20: 6e 64 20 61 74 20 6f 6e 63 65 2c 20 62 75 74 20  nd at once, but 
4f30: 6f 6e 6c 79 20 6f 6e 65 20 6d 79 20 62 65 20 70  only one my be p
4f40: 72 6f 63 65 73 73 65 64 0a 23 20 61 74 20 61 20  rocessed.# at a 
4f50: 74 69 6d 65 20 6f 6e 63 65 20 74 68 65 20 72 65  time once the re
4f60: 71 75 65 73 74 20 69 73 20 66 75 6c 6c 20 72 65  quest is full re
4f70: 61 64 20 61 6e 64 20 70 61 72 73 65 64 2e 0a 23  ad and parsed..#
4f80: 0a 73 65 74 20 77 61 70 70 49 6e 74 50 65 6e 64  .set wappIntPend
4f90: 69 6e 67 20 7b 7d 0a 73 65 74 20 77 61 70 70 49  ing {}.set wappI
4fa0: 6e 74 4c 6f 63 6b 20 30 0a 70 72 6f 63 20 77 61  ntLock 0.proc wa
4fb0: 70 70 49 6e 74 2d 68 61 6e 64 6c 65 2d 72 65 71  ppInt-handle-req
4fc0: 75 65 73 74 20 7b 63 68 61 6e 7d 20 7b 0a 20 20  uest {chan} {.  
4fd0: 67 6c 6f 62 61 6c 20 77 61 70 70 49 6e 74 50 65  global wappIntPe
4fe0: 6e 64 69 6e 67 20 77 61 70 70 49 6e 74 4c 6f 63  nding wappIntLoc
4ff0: 6b 0a 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63  k.  fileevent $c
5000: 68 61 6e 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a  han readable {}.
5010: 20 20 69 66 20 7b 24 77 61 70 70 49 6e 74 4c 6f    if {$wappIntLo
5020: 63 6b 7d 20 7b 0a 20 20 20 20 23 20 41 6e 6f 74  ck} {.    # Anot
5030: 68 65 72 20 69 6e 73 74 61 6e 63 65 20 6f 66 20  her instance of 
5040: 72 65 71 75 65 73 74 20 69 73 20 61 6c 72 65 61  request is alrea
5050: 64 79 20 72 75 6e 6e 69 6e 67 2c 20 73 6f 20 64  dy running, so d
5060: 65 66 65 72 20 74 68 69 73 20 6f 6e 65 0a 20 20  efer this one.  
5070: 20 20 6c 61 70 70 65 6e 64 20 77 61 70 70 49 6e    lappend wappIn
5080: 74 50 65 6e 64 69 6e 67 20 5b 6c 69 73 74 20 77  tPending [list w
5090: 61 70 70 49 6e 74 2d 68 61 6e 64 6c 65 2d 72 65  appInt-handle-re
50a0: 71 75 65 73 74 20 24 63 68 61 6e 5d 0a 20 20 20  quest $chan].   
50b0: 20 72 65 74 75 72 6e 0a 20 20 7d 0a 20 20 73 65   return.  }.  se
50c0: 74 20 77 61 70 70 49 6e 74 4c 6f 63 6b 20 31 0a  t wappIntLock 1.
50d0: 20 20 63 61 74 63 68 20 5b 6c 69 73 74 20 77 61    catch [list wa
50e0: 70 70 49 6e 74 2d 68 61 6e 64 6c 65 2d 72 65 71  ppInt-handle-req
50f0: 75 65 73 74 2d 75 6e 73 61 66 65 20 24 63 68 61  uest-unsafe $cha
5100: 6e 5d 0a 20 20 73 65 74 20 77 61 70 70 49 6e 74  n].  set wappInt
5110: 4c 6f 63 6b 20 30 0a 20 20 69 66 20 7b 5b 6c 6c  Lock 0.  if {[ll
5120: 65 6e 67 74 68 20 24 77 61 70 70 49 6e 74 50 65  ength $wappIntPe
5130: 6e 64 69 6e 67 5d 3e 30 7d 20 7b 0a 20 20 20 20  nding]>0} {.    
5140: 23 20 49 66 20 74 68 65 72 65 20 61 72 65 20 64  # If there are d
5150: 65 66 65 72 72 65 64 20 72 65 71 75 65 73 74 73  eferred requests
5160: 2c 20 74 68 65 6e 20 6c 61 75 6e 63 68 20 74 68  , then launch th
5170: 65 20 6f 6c 64 65 73 74 20 6f 6e 65 0a 20 20 20  e oldest one.   
5180: 20 61 66 74 65 72 20 69 64 6c 65 20 5b 6c 69 6e   after idle [lin
5190: 64 65 78 20 24 77 61 70 70 49 6e 74 50 65 6e 64  dex $wappIntPend
51a0: 69 6e 67 20 30 5d 0a 20 20 20 20 73 65 74 20 77  ing 0].    set w
51b0: 61 70 70 49 6e 74 50 65 6e 64 69 6e 67 20 5b 6c  appIntPending [l
51c0: 72 61 6e 67 65 20 24 77 61 70 70 49 6e 74 50 65  range $wappIntPe
51d0: 6e 64 69 6e 67 20 31 20 65 6e 64 5d 0a 20 20 7d  nding 1 end].  }
51e0: 0a 7d 0a 70 72 6f 63 20 77 61 70 70 49 6e 74 2d  .}.proc wappInt-
51f0: 68 61 6e 64 6c 65 2d 72 65 71 75 65 73 74 2d 75  handle-request-u
5200: 6e 73 61 66 65 20 7b 63 68 61 6e 7d 20 7b 0a 20  nsafe {chan} {. 
5210: 20 67 6c 6f 62 61 6c 20 77 61 70 70 0a 20 20 64   global wapp.  d
5220: 69 63 74 20 73 65 74 20 77 61 70 70 20 2e 72 65  ict set wapp .re
5230: 70 6c 79 20 7b 7d 0a 20 20 64 69 63 74 20 73 65  ply {}.  dict se
5240: 74 20 77 61 70 70 20 2e 6d 69 6d 65 74 79 70 65  t wapp .mimetype
5250: 20 7b 74 65 78 74 2f 68 74 6d 6c 3b 20 63 68 61   {text/html; cha
5260: 72 73 65 74 3d 75 74 66 2d 38 7d 0a 20 20 64 69  rset=utf-8}.  di
5270: 63 74 20 73 65 74 20 77 61 70 70 20 2e 72 65 70  ct set wapp .rep
5280: 6c 79 2d 63 6f 64 65 20 7b 32 30 30 20 4f 6b 7d  ly-code {200 Ok}
5290: 0a 20 20 64 69 63 74 20 73 65 74 20 77 61 70 70  .  dict set wapp
52a0: 20 2e 63 73 70 20 7b 64 65 66 61 75 6c 74 2d 73   .csp {default-s
52b0: 72 63 20 27 73 65 6c 66 27 7d 0a 0a 20 20 23 20  rc 'self'}..  # 
52c0: 53 65 74 20 75 70 20 61 64 64 69 74 69 6f 6e 61  Set up additiona
52d0: 6c 20 43 47 49 20 65 6e 76 69 72 6f 6e 6d 65 6e  l CGI environmen
52e0: 74 20 76 61 6c 75 65 73 0a 20 20 23 0a 20 20 69  t values.  #.  i
52f0: 66 20 7b 21 5b 64 69 63 74 20 65 78 69 73 74 73  f {![dict exists
5300: 20 24 77 61 70 70 20 48 54 54 50 5f 48 4f 53 54   $wapp HTTP_HOST
5310: 5d 7d 20 7b 0a 20 20 20 20 64 69 63 74 20 73 65  ]} {.    dict se
5320: 74 20 77 61 70 70 20 42 41 53 45 5f 55 52 4c 20  t wapp BASE_URL 
5330: 7b 7d 0a 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b  {}.  } elseif {[
5340: 64 69 63 74 20 65 78 69 73 74 73 20 24 77 61 70  dict exists $wap
5350: 70 20 48 54 54 50 53 5d 7d 20 7b 0a 20 20 20 20  p HTTPS]} {.    
5360: 64 69 63 74 20 73 65 74 20 77 61 70 70 20 42 41  dict set wapp BA
5370: 53 45 5f 55 52 4c 20 68 74 74 70 73 3a 2f 2f 5b  SE_URL https://[
5380: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 48  dict get $wapp H
5390: 54 54 50 5f 48 4f 53 54 5d 0a 20 20 7d 20 65 6c  TTP_HOST].  } el
53a0: 73 65 20 7b 0a 20 20 20 20 64 69 63 74 20 73 65  se {.    dict se
53b0: 74 20 77 61 70 70 20 42 41 53 45 5f 55 52 4c 20  t wapp BASE_URL 
53c0: 68 74 74 70 3a 2f 2f 5b 64 69 63 74 20 67 65 74  http://[dict get
53d0: 20 24 77 61 70 70 20 48 54 54 50 5f 48 4f 53 54   $wapp HTTP_HOST
53e0: 5d 0a 20 20 7d 0a 20 20 69 66 20 7b 21 5b 64 69  ].  }.  if {![di
53f0: 63 74 20 65 78 69 73 74 73 20 24 77 61 70 70 20  ct exists $wapp 
5400: 52 45 51 55 45 53 54 5f 55 52 49 5d 7d 20 7b 0a  REQUEST_URI]} {.
5410: 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61 70      dict set wap
5420: 70 20 52 45 51 55 45 53 54 5f 55 52 49 20 2f 0a  p REQUEST_URI /.
5430: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 72 65 67    } elseif {[reg
5440: 73 75 62 20 7b 5c 3f 2e 2a 7d 20 5b 64 69 63 74  sub {\?.*} [dict
5450: 20 67 65 74 20 24 77 61 70 70 20 52 45 51 55 45   get $wapp REQUE
5460: 53 54 5f 55 52 49 5d 20 7b 7d 20 6e 65 77 52 5d  ST_URI] {} newR]
5470: 7d 20 7b 0a 20 20 20 20 23 20 53 6f 6d 65 20 73  } {.    # Some s
5480: 65 72 76 65 72 73 20 28 65 78 3a 20 6e 67 69 6e  ervers (ex: ngin
5490: 78 29 20 61 70 70 65 6e 64 20 74 68 65 20 71 75  x) append the qu
54a0: 65 72 79 20 70 61 72 61 6d 65 74 65 72 73 20 74  ery parameters t
54b0: 6f 20 52 45 51 55 45 53 54 5f 55 52 49 2e 0a 20  o REQUEST_URI.. 
54c0: 20 20 20 23 20 54 68 65 73 65 20 6e 65 65 64 20     # These need 
54d0: 74 6f 20 62 65 20 73 74 72 69 70 70 65 64 20 6f  to be stripped o
54e0: 66 66 0a 20 20 20 20 64 69 63 74 20 73 65 74 20  ff.    dict set 
54f0: 77 61 70 70 20 52 45 51 55 45 53 54 5f 55 52 49  wapp REQUEST_URI
5500: 20 24 6e 65 77 52 0a 20 20 7d 0a 20 20 69 66 20   $newR.  }.  if 
5510: 7b 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 77  {[dict exists $w
5520: 61 70 70 20 53 43 52 49 50 54 5f 4e 41 4d 45 5d  app SCRIPT_NAME]
5530: 7d 20 7b 0a 20 20 20 20 64 69 63 74 20 61 70 70  } {.    dict app
5540: 65 6e 64 20 77 61 70 70 20 42 41 53 45 5f 55 52  end wapp BASE_UR
5550: 4c 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70  L [dict get $wap
5560: 70 20 53 43 52 49 50 54 5f 4e 41 4d 45 5d 0a 20  p SCRIPT_NAME]. 
5570: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 64 69   } else {.    di
5580: 63 74 20 73 65 74 20 77 61 70 70 20 53 43 52 49  ct set wapp SCRI
5590: 50 54 5f 4e 41 4d 45 20 7b 7d 0a 20 20 7d 0a 20  PT_NAME {}.  }. 
55a0: 20 69 66 20 7b 21 5b 64 69 63 74 20 65 78 69 73   if {![dict exis
55b0: 74 73 20 24 77 61 70 70 20 50 41 54 48 5f 49 4e  ts $wapp PATH_IN
55c0: 46 4f 5d 7d 20 7b 0a 20 20 20 20 23 20 49 66 20  FO]} {.    # If 
55d0: 50 41 54 48 5f 49 4e 46 4f 20 69 73 20 6d 69 73  PATH_INFO is mis
55e0: 73 69 6e 67 20 28 65 78 3a 20 6e 67 69 6e 78 29  sing (ex: nginx)
55f0: 20 74 68 65 6e 20 63 6f 6e 73 74 72 75 63 74 20   then construct 
5600: 69 74 0a 20 20 20 20 73 65 74 20 55 52 49 20 5b  it.    set URI [
5610: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 52  dict get $wapp R
5620: 45 51 55 45 53 54 5f 55 52 49 5d 0a 20 20 20 20  EQUEST_URI].    
5630: 73 65 74 20 73 6b 69 70 20 5b 73 74 72 69 6e 67  set skip [string
5640: 20 6c 65 6e 67 74 68 20 5b 64 69 63 74 20 67 65   length [dict ge
5650: 74 20 24 77 61 70 70 20 53 43 52 49 50 54 5f 4e  t $wapp SCRIPT_N
5660: 41 4d 45 5d 5d 0a 20 20 20 20 64 69 63 74 20 73  AME]].    dict s
5670: 65 74 20 77 61 70 70 20 50 41 54 48 5f 49 4e 46  et wapp PATH_INF
5680: 4f 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20  O [string range 
5690: 24 55 52 49 20 24 73 6b 69 70 20 65 6e 64 5d 0a  $URI $skip end].
56a0: 20 20 7d 0a 20 20 69 66 20 7b 5b 72 65 67 65 78    }.  if {[regex
56b0: 70 20 7b 5e 2f 28 5b 5e 2f 5d 2b 29 28 2e 2a 29  p {^/([^/]+)(.*)
56c0: 24 7d 20 5b 64 69 63 74 20 67 65 74 20 24 77 61  $} [dict get $wa
56d0: 70 70 20 50 41 54 48 5f 49 4e 46 4f 5d 20 61 6c  pp PATH_INFO] al
56e0: 6c 20 68 65 61 64 20 74 61 69 6c 5d 7d 20 7b 0a  l head tail]} {.
56f0: 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61 70      dict set wap
5700: 70 20 50 41 54 48 5f 48 45 41 44 20 24 68 65 61  p PATH_HEAD $hea
5710: 64 0a 20 20 20 20 64 69 63 74 20 73 65 74 20 77  d.    dict set w
5720: 61 70 70 20 50 41 54 48 5f 54 41 49 4c 20 5b 73  app PATH_TAIL [s
5730: 74 72 69 6e 67 20 74 72 69 6d 6c 65 66 74 20 24  tring trimleft $
5740: 74 61 69 6c 20 2f 5d 0a 20 20 7d 20 65 6c 73 65  tail /].  } else
5750: 20 7b 0a 20 20 20 20 64 69 63 74 20 73 65 74 20   {.    dict set 
5760: 77 61 70 70 20 50 41 54 48 5f 49 4e 46 4f 20 7b  wapp PATH_INFO {
5770: 7d 0a 20 20 20 20 64 69 63 74 20 73 65 74 20 77  }.    dict set w
5780: 61 70 70 20 50 41 54 48 5f 48 45 41 44 20 7b 7d  app PATH_HEAD {}
5790: 0a 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61  .    dict set wa
57a0: 70 70 20 50 41 54 48 5f 54 41 49 4c 20 7b 7d 0a  pp PATH_TAIL {}.
57b0: 20 20 7d 0a 20 20 64 69 63 74 20 73 65 74 20 77    }.  dict set w
57c0: 61 70 70 20 53 45 4c 46 5f 55 52 4c 20 5b 64 69  app SELF_URL [di
57d0: 63 74 20 67 65 74 20 24 77 61 70 70 20 42 41 53  ct get $wapp BAS
57e0: 45 5f 55 52 4c 5d 2f 5b 64 69 63 74 20 67 65 74  E_URL]/[dict get
57f0: 20 24 77 61 70 70 20 50 41 54 48 5f 48 45 41 44   $wapp PATH_HEAD
5800: 5d 0a 0a 20 20 23 20 50 61 72 73 65 20 71 75 65  ]..  # Parse que
5810: 72 79 20 70 61 72 61 6d 65 74 65 72 73 20 66 72  ry parameters fr
5820: 6f 6d 20 74 68 65 20 71 75 65 72 79 20 73 74 72  om the query str
5830: 69 6e 67 2c 20 74 68 65 20 63 6f 6f 6b 69 65 73  ing, the cookies
5840: 2c 20 61 6e 64 0a 20 20 23 20 50 4f 53 54 20 64  , and.  # POST d
5850: 61 74 61 0a 20 20 23 0a 20 20 69 66 20 7b 5b 64  ata.  #.  if {[d
5860: 69 63 74 20 65 78 69 73 74 73 20 24 77 61 70 70  ict exists $wapp
5870: 20 48 54 54 50 5f 43 4f 4f 4b 49 45 5d 7d 20 7b   HTTP_COOKIE]} {
5880: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 71 74 65  .    foreach qte
5890: 72 6d 20 5b 73 70 6c 69 74 20 5b 64 69 63 74 20  rm [split [dict 
58a0: 67 65 74 20 24 77 61 70 70 20 48 54 54 50 5f 43  get $wapp HTTP_C
58b0: 4f 4f 4b 49 45 5d 20 7b 3b 7d 5d 20 7b 0a 20 20  OOKIE] {;}] {.  
58c0: 20 20 20 20 73 65 74 20 71 73 70 6c 69 74 20 5b      set qsplit [
58d0: 73 70 6c 69 74 20 5b 73 74 72 69 6e 67 20 74 72  split [string tr
58e0: 69 6d 20 24 71 74 65 72 6d 5d 20 3d 5d 0a 20 20  im $qterm] =].  
58f0: 20 20 20 20 73 65 74 20 6e 6d 20 5b 6c 69 6e 64      set nm [lind
5900: 65 78 20 24 71 73 70 6c 69 74 20 30 5d 0a 20 20  ex $qsplit 0].  
5910: 20 20 20 20 69 66 20 7b 5b 72 65 67 65 78 70 20      if {[regexp 
5920: 7b 5e 5b 61 2d 7a 5d 5b 2d 61 2d 7a 30 2d 39 5f  {^[a-z][-a-z0-9_
5930: 5d 2a 24 7d 20 24 6e 6d 5d 7d 20 7b 0a 20 20 20  ]*$} $nm]} {.   
5940: 20 20 20 20 20 64 69 63 74 20 73 65 74 20 77 61       dict set wa
5950: 70 70 20 24 6e 6d 20 5b 77 61 70 70 49 6e 74 2d  pp $nm [wappInt-
5960: 64 65 63 6f 64 65 2d 75 72 6c 20 5b 6c 69 6e 64  decode-url [lind
5970: 65 78 20 24 71 73 70 6c 69 74 20 31 5d 5d 0a 20  ex $qsplit 1]]. 
5980: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d       }.    }.  }
5990: 0a 20 20 73 65 74 20 73 61 6d 65 5f 6f 72 69 67  .  set same_orig
59a0: 69 6e 20 30 0a 20 20 69 66 20 7b 5b 64 69 63 74  in 0.  if {[dict
59b0: 20 65 78 69 73 74 73 20 24 77 61 70 70 20 48 54   exists $wapp HT
59c0: 54 50 5f 52 45 46 45 52 45 52 5d 7d 20 7b 0a 20  TP_REFERER]} {. 
59d0: 20 20 20 73 65 74 20 72 65 66 65 72 65 72 20 5b     set referer [
59e0: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 48  dict get $wapp H
59f0: 54 54 50 5f 52 45 46 45 52 45 52 5d 0a 20 20 20  TTP_REFERER].   
5a00: 20 73 65 74 20 62 61 73 65 20 5b 64 69 63 74 20   set base [dict 
5a10: 67 65 74 20 24 77 61 70 70 20 42 41 53 45 5f 55  get $wapp BASE_U
5a20: 52 4c 5d 0a 20 20 20 20 69 66 20 7b 24 72 65 66  RL].    if {$ref
5a30: 65 72 65 72 3d 3d 24 62 61 73 65 20 7c 7c 20 5b  erer==$base || [
5a40: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 62 61  string match $ba
5a50: 73 65 2f 2a 20 24 72 65 66 65 72 65 72 5d 7d 20  se/* $referer]} 
5a60: 7b 0a 20 20 20 20 20 20 73 65 74 20 73 61 6d 65  {.      set same
5a70: 5f 6f 72 69 67 69 6e 20 31 0a 20 20 20 20 7d 0a  _origin 1.    }.
5a80: 20 20 7d 0a 20 20 64 69 63 74 20 73 65 74 20 77    }.  dict set w
5a90: 61 70 70 20 53 41 4d 45 5f 4f 52 49 47 49 4e 20  app SAME_ORIGIN 
5aa0: 24 73 61 6d 65 5f 6f 72 69 67 69 6e 0a 20 20 69  $same_origin.  i
5ab0: 66 20 7b 24 73 61 6d 65 5f 6f 72 69 67 69 6e 7d  f {$same_origin}
5ac0: 20 7b 0a 20 20 20 20 77 61 70 70 49 6e 74 2d 64   {.    wappInt-d
5ad0: 65 63 6f 64 65 2d 71 75 65 72 79 2d 70 61 72 61  ecode-query-para
5ae0: 6d 73 0a 20 20 7d 0a 0a 20 20 23 20 49 6e 76 6f  ms.  }..  # Invo
5af0: 6b 65 20 74 68 65 20 61 70 70 6c 69 63 61 74 69  ke the applicati
5b00: 6f 6e 2d 64 65 66 69 6e 65 64 20 68 61 6e 64 6c  on-defined handl
5b10: 65 72 20 70 72 6f 63 65 64 75 72 65 20 66 6f 72  er procedure for
5b20: 20 74 68 69 73 20 70 61 67 65 0a 20 20 23 20 72   this page.  # r
5b30: 65 71 75 65 73 74 2e 20 20 49 66 20 61 6e 20 65  equest.  If an e
5b40: 72 72 6f 72 20 6f 63 63 75 72 73 20 77 68 69 6c  rror occurs whil
5b50: 65 20 72 75 6e 6e 69 6e 67 20 74 68 61 74 20 70  e running that p
5b60: 72 6f 63 65 64 75 72 65 2c 20 67 65 6e 65 72 61  rocedure, genera
5b70: 74 65 0a 20 20 23 20 61 6e 20 48 54 54 50 20 72  te.  # an HTTP r
5b80: 65 70 6c 79 20 74 68 61 74 20 63 6f 6e 74 61 69  eply that contai
5b90: 6e 73 20 74 68 65 20 65 72 72 6f 72 20 6d 65 73  ns the error mes
5ba0: 73 61 67 65 2e 0a 20 20 23 0a 20 20 77 61 70 70  sage..  #.  wapp
5bb0: 2d 62 65 66 6f 72 65 2d 64 69 73 70 61 74 63 68  -before-dispatch
5bc0: 2d 68 6f 6f 6b 0a 20 20 77 61 70 70 49 6e 74 2d  -hook.  wappInt-
5bd0: 74 72 61 63 65 0a 20 20 73 65 74 20 6d 6e 61 6d  trace.  set mnam
5be0: 65 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70  e [dict get $wap
5bf0: 70 20 50 41 54 48 5f 48 45 41 44 5d 0a 20 20 69  p PATH_HEAD].  i
5c00: 66 20 7b 5b 63 61 74 63 68 20 7b 0a 20 20 20 20  f {[catch {.    
5c10: 69 66 20 7b 24 6d 6e 61 6d 65 21 3d 22 22 20 26  if {$mname!="" &
5c20: 26 20 5b 6c 6c 65 6e 67 74 68 20 5b 69 6e 66 6f  & [llength [info
5c30: 20 63 6f 6d 6d 61 6e 64 20 77 61 70 70 2d 70 61   command wapp-pa
5c40: 67 65 2d 24 6d 6e 61 6d 65 5d 5d 3e 30 7d 20 7b  ge-$mname]]>0} {
5c50: 0a 20 20 20 20 20 20 77 61 70 70 2d 70 61 67 65  .      wapp-page
5c60: 2d 24 6d 6e 61 6d 65 0a 20 20 20 20 7d 20 65 6c  -$mname.    } el
5c70: 73 65 20 7b 0a 20 20 20 20 20 20 77 61 70 70 2d  se {.      wapp-
5c80: 64 65 66 61 75 6c 74 0a 20 20 20 20 7d 0a 20 20  default.    }.  
5c90: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 69 66  } msg]} {.    if
5ca0: 20 7b 5b 77 61 70 70 2d 70 61 72 61 6d 20 57 41   {[wapp-param WA
5cb0: 50 50 5f 4d 4f 44 45 5d 3d 3d 22 6c 6f 63 61 6c  PP_MODE]=="local
5cc0: 22 20 7c 7c 20 5b 77 61 70 70 2d 70 61 72 61 6d  " || [wapp-param
5cd0: 20 57 41 50 50 5f 4d 4f 44 45 5d 3d 3d 22 73 65   WAPP_MODE]=="se
5ce0: 72 76 65 72 22 7d 20 7b 0a 20 20 20 20 20 20 70  rver"} {.      p
5cf0: 75 74 73 20 22 45 52 52 4f 52 3a 20 24 3a 3a 65  uts "ERROR: $::e
5d00: 72 72 6f 72 49 6e 66 6f 22 0a 20 20 20 20 7d 0a  rrorInfo".    }.
5d10: 20 20 20 20 77 61 70 70 2d 72 65 73 65 74 0a 20      wapp-reset. 
5d20: 20 20 20 77 61 70 70 2d 72 65 70 6c 79 2d 63 6f     wapp-reply-co
5d30: 64 65 20 22 35 30 30 20 49 6e 74 65 72 6e 61 6c  de "500 Internal
5d40: 20 53 65 72 76 65 72 20 45 72 72 6f 72 22 0a 20   Server Error". 
5d50: 20 20 20 77 61 70 70 2d 6d 69 6d 65 74 79 70 65     wapp-mimetype
5d60: 20 74 65 78 74 2f 68 74 6d 6c 0a 20 20 20 20 77   text/html.    w
5d70: 61 70 70 2d 74 72 69 6d 20 7b 0a 20 20 20 20 20  app-trim {.     
5d80: 20 3c 68 31 3e 57 61 70 70 20 41 70 70 6c 69 63   <h1>Wapp Applic
5d90: 61 74 69 6f 6e 20 45 72 72 6f 72 3c 2f 68 31 3e  ation Error</h1>
5da0: 0a 20 20 20 20 20 20 3c 70 72 65 3e 25 68 74 6d  .      <pre>%htm
5db0: 6c 28 24 3a 3a 65 72 72 6f 72 49 6e 66 6f 29 3c  l($::errorInfo)<
5dc0: 2f 70 72 65 3e 0a 20 20 20 20 7d 0a 20 20 20 20  /pre>.    }.    
5dd0: 64 69 63 74 20 75 6e 73 65 74 20 77 61 70 70 20  dict unset wapp 
5de0: 2e 6e 65 77 2d 63 6f 6f 6b 69 65 73 0a 20 20 7d  .new-cookies.  }
5df0: 0a 0a 20 20 23 20 54 72 61 6e 73 6d 69 74 20 74  ..  # Transmit t
5e00: 68 65 20 48 54 54 50 20 72 65 70 6c 79 0a 20 20  he HTTP reply.  
5e10: 23 0a 20 20 69 66 20 7b 24 63 68 61 6e 3d 3d 22  #.  if {$chan=="
5e20: 73 74 64 6f 75 74 22 7d 20 7b 0a 20 20 20 20 70  stdout"} {.    p
5e30: 75 74 73 20 24 63 68 61 6e 20 22 53 74 61 74 75  uts $chan "Statu
5e40: 73 3a 20 5b 64 69 63 74 20 67 65 74 20 24 77 61  s: [dict get $wa
5e50: 70 70 20 2e 72 65 70 6c 79 2d 63 6f 64 65 5d 5c  pp .reply-code]\
5e60: 72 22 0a 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20  r".  } else {.  
5e70: 20 20 70 75 74 73 20 24 63 68 61 6e 20 22 48 54    puts $chan "HT
5e80: 54 50 2f 31 2e 31 20 5b 64 69 63 74 20 67 65 74  TP/1.1 [dict get
5e90: 20 24 77 61 70 70 20 2e 72 65 70 6c 79 2d 63 6f   $wapp .reply-co
5ea0: 64 65 5d 5c 72 22 0a 20 20 20 20 70 75 74 73 20  de]\r".    puts 
5eb0: 24 63 68 61 6e 20 22 53 65 72 76 65 72 3a 20 77  $chan "Server: w
5ec0: 61 70 70 5c 72 22 0a 20 20 20 20 70 75 74 73 20  app\r".    puts 
5ed0: 24 63 68 61 6e 20 22 43 6f 6e 6e 65 63 74 69 6f  $chan "Connectio
5ee0: 6e 3a 20 63 6c 6f 73 65 5c 72 22 0a 20 20 7d 0a  n: close\r".  }.
5ef0: 20 20 69 66 20 7b 5b 64 69 63 74 20 65 78 69 73    if {[dict exis
5f00: 74 73 20 24 77 61 70 70 20 2e 72 65 70 6c 79 2d  ts $wapp .reply-
5f10: 65 78 74 72 61 5d 7d 20 7b 0a 20 20 20 20 66 6f  extra]} {.    fo
5f20: 72 65 61 63 68 20 7b 6e 61 6d 65 20 76 61 6c 75  reach {name valu
5f30: 65 7d 20 5b 64 69 63 74 20 67 65 74 20 24 77 61  e} [dict get $wa
5f40: 70 70 20 2e 72 65 70 6c 79 2d 65 78 74 72 61 5d  pp .reply-extra]
5f50: 20 7b 0a 20 20 20 20 20 20 70 75 74 73 20 24 63   {.      puts $c
5f60: 68 61 6e 20 22 24 6e 61 6d 65 3a 20 24 76 61 6c  han "$name: $val
5f70: 75 65 5c 72 22 0a 20 20 20 20 7d 0a 20 20 7d 0a  ue\r".    }.  }.
5f80: 20 20 69 66 20 7b 5b 64 69 63 74 20 65 78 69 73    if {[dict exis
5f90: 74 73 20 24 77 61 70 70 20 2e 63 73 70 5d 7d 20  ts $wapp .csp]} 
5fa0: 7b 0a 20 20 20 20 70 75 74 73 20 24 63 68 61 6e  {.    puts $chan
5fb0: 20 22 43 6f 6e 74 65 6e 74 2d 53 65 63 75 72 69   "Content-Securi
5fc0: 74 79 2d 50 6f 6c 69 63 79 3a 20 5b 64 69 63 74  ty-Policy: [dict
5fd0: 20 67 65 74 20 24 77 61 70 70 20 2e 63 73 70 5d   get $wapp .csp]
5fe0: 5c 72 22 0a 20 20 7d 0a 20 20 73 65 74 20 6d 69  \r".  }.  set mi
5ff0: 6d 65 74 79 70 65 20 5b 64 69 63 74 20 67 65 74  metype [dict get
6000: 20 24 77 61 70 70 20 2e 6d 69 6d 65 74 79 70 65   $wapp .mimetype
6010: 5d 0a 20 20 70 75 74 73 20 24 63 68 61 6e 20 22  ].  puts $chan "
6020: 43 6f 6e 74 65 6e 74 2d 54 79 70 65 3a 20 24 6d  Content-Type: $m
6030: 69 6d 65 74 79 70 65 5c 72 22 0a 20 20 69 66 20  imetype\r".  if 
6040: 7b 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 77  {[dict exists $w
6050: 61 70 70 20 2e 6e 65 77 2d 63 6f 6f 6b 69 65 73  app .new-cookies
6060: 5d 7d 20 7b 0a 20 20 20 20 66 6f 72 65 61 63 68  ]} {.    foreach
6070: 20 7b 6e 6d 20 76 61 6c 7d 20 5b 64 69 63 74 20   {nm val} [dict 
6080: 67 65 74 20 24 77 61 70 70 20 2e 6e 65 77 2d 63  get $wapp .new-c
6090: 6f 6f 6b 69 65 73 5d 20 7b 0a 20 20 20 20 20 20  ookies] {.      
60a0: 69 66 20 7b 5b 72 65 67 65 78 70 20 7b 5e 5b 61  if {[regexp {^[a
60b0: 2d 7a 5d 5b 2d 61 2d 7a 30 2d 39 5f 5d 2a 24 7d  -z][-a-z0-9_]*$}
60c0: 20 24 6e 6d 5d 7d 20 7b 0a 20 20 20 20 20 20 20   $nm]} {.       
60d0: 20 69 66 20 7b 24 76 61 6c 3d 3d 22 22 7d 20 7b   if {$val==""} {
60e0: 0a 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20  .          puts 
60f0: 24 63 68 61 6e 20 22 53 65 74 2d 43 6f 6f 6b 69  $chan "Set-Cooki
6100: 65 3a 20 24 6e 6d 3d 3b 20 48 74 74 70 4f 6e 6c  e: $nm=; HttpOnl
6110: 79 3b 20 50 61 74 68 3d 2f 3b 20 4d 61 78 2d 41  y; Path=/; Max-A
6120: 67 65 3d 31 5c 72 22 0a 20 20 20 20 20 20 20 20  ge=1\r".        
6130: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20  } else {.       
6140: 20 20 20 73 65 74 20 76 61 6c 20 5b 77 61 70 70     set val [wapp
6150: 49 6e 74 2d 65 6e 63 2d 75 72 6c 20 24 76 61 6c  Int-enc-url $val
6160: 5d 0a 20 20 20 20 20 20 20 20 20 20 70 75 74 73  ].          puts
6170: 20 24 63 68 61 6e 20 22 53 65 74 2d 43 6f 6f 6b   $chan "Set-Cook
6180: 69 65 3a 20 24 6e 6d 3d 24 76 61 6c 3b 20 48 74  ie: $nm=$val; Ht
6190: 74 70 4f 6e 6c 79 3b 20 50 61 74 68 3d 2f 5c 72  tpOnly; Path=/\r
61a0: 22 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20  ".        }.    
61b0: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d 0a 20 20    }.    }.  }.  
61c0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63  if {[string matc
61d0: 68 20 74 65 78 74 2f 2a 20 24 6d 69 6d 65 74 79  h text/* $mimety
61e0: 70 65 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 72  pe]} {.    set r
61f0: 65 70 6c 79 20 5b 65 6e 63 6f 64 69 6e 67 20 63  eply [encoding c
6200: 6f 6e 76 65 72 74 74 6f 20 75 74 66 2d 38 20 5b  onvertto utf-8 [
6210: 64 69 63 74 20 67 65 74 20 24 77 61 70 70 20 2e  dict get $wapp .
6220: 72 65 70 6c 79 5d 5d 0a 20 20 20 20 69 66 20 7b  reply]].    if {
6230: 5b 72 65 67 65 78 70 20 7b 5c 79 67 7a 69 70 5c  [regexp {\ygzip\
6240: 79 7d 20 5b 77 61 70 70 2d 70 61 72 61 6d 20 48  y} [wapp-param H
6250: 54 54 50 5f 41 43 43 45 50 54 5f 45 4e 43 4f 44  TTP_ACCEPT_ENCOD
6260: 49 4e 47 5d 5d 7d 20 7b 0a 20 20 20 20 20 20 63  ING]]} {.      c
6270: 61 74 63 68 20 7b 0a 20 20 20 20 20 20 20 20 73  atch {.        s
6280: 65 74 20 78 20 5b 7a 6c 69 62 20 67 7a 69 70 20  et x [zlib gzip 
6290: 24 72 65 70 6c 79 5d 0a 20 20 20 20 20 20 20 20  $reply].        
62a0: 73 65 74 20 72 65 70 6c 79 20 24 78 0a 20 20 20  set reply $x.   
62b0: 20 20 20 20 20 70 75 74 73 20 24 63 68 61 6e 20       puts $chan 
62c0: 22 43 6f 6e 74 65 6e 74 2d 45 6e 63 6f 64 69 6e  "Content-Encodin
62d0: 67 3a 20 67 7a 69 70 5c 72 22 0a 20 20 20 20 20  g: gzip\r".     
62e0: 20 7d 0a 20 20 20 20 7d 0a 20 20 7d 20 65 6c 73   }.    }.  } els
62f0: 65 20 7b 0a 20 20 20 20 73 65 74 20 72 65 70 6c  e {.    set repl
6300: 79 20 5b 64 69 63 74 20 67 65 74 20 24 77 61 70  y [dict get $wap
6310: 70 20 2e 72 65 70 6c 79 5d 0a 20 20 7d 0a 20 20  p .reply].  }.  
6320: 70 75 74 73 20 24 63 68 61 6e 20 22 43 6f 6e 74  puts $chan "Cont
6330: 65 6e 74 2d 4c 65 6e 67 74 68 3a 20 5b 73 74 72  ent-Length: [str
6340: 69 6e 67 20 6c 65 6e 67 74 68 20 24 72 65 70 6c  ing length $repl
6350: 79 5d 5c 72 22 0a 20 20 70 75 74 73 20 24 63 68  y]\r".  puts $ch
6360: 61 6e 20 5c 72 0a 20 20 70 75 74 73 20 2d 6e 6f  an \r.  puts -no
6370: 6e 65 77 6c 69 6e 65 20 24 63 68 61 6e 20 24 72  newline $chan $r
6380: 65 70 6c 79 0a 20 20 66 6c 75 73 68 20 24 63 68  eply.  flush $ch
6390: 61 6e 0a 20 20 77 61 70 70 49 6e 74 2d 63 6c 6f  an.  wappInt-clo
63a0: 73 65 2d 63 68 61 6e 6e 65 6c 20 24 63 68 61 6e  se-channel $chan
63b0: 0a 7d 0a 0a 23 20 54 68 69 73 20 72 6f 75 74 69  .}..# This routi
63c0: 6e 65 20 72 75 6e 73 20 6a 75 73 74 20 70 72 69  ne runs just pri
63d0: 6f 72 20 74 6f 20 72 65 71 75 65 73 74 2d 68 61  or to request-ha
63e0: 6e 64 6c 65 72 20 64 69 73 70 61 74 63 68 2e 20  ndler dispatch. 
63f0: 20 54 68 65 0a 23 20 64 65 66 61 75 6c 74 20 69   The.# default i
6400: 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 69 73  mplementation is
6410: 20 61 20 6e 6f 2d 6f 70 2c 20 62 75 74 20 61 70   a no-op, but ap
6420: 70 6c 69 63 61 74 69 6f 6e 73 20 63 61 6e 20 6f  plications can o
6430: 76 65 72 72 69 64 65 0a 23 20 74 6f 20 64 6f 20  verride.# to do 
6440: 61 64 64 69 74 69 6f 6e 61 6c 20 74 72 61 6e 73  additional trans
6450: 66 6f 72 6d 61 74 69 6f 6e 73 20 6f 72 20 63 68  formations or ch
6460: 65 63 6b 73 2e 0a 23 0a 70 72 6f 63 20 77 61 70  ecks..#.proc wap
6470: 70 2d 62 65 66 6f 72 65 2d 64 69 73 70 61 74 63  p-before-dispatc
6480: 68 2d 68 6f 6f 6b 20 7b 7d 20 7b 72 65 74 75 72  h-hook {} {retur
6490: 6e 7d 0a 0a 23 20 50 72 6f 63 65 73 73 20 61 20  n}..# Process a 
64a0: 73 69 6e 67 6c 65 20 43 47 49 20 72 65 71 75 65  single CGI reque
64b0: 73 74 0a 23 0a 70 72 6f 63 20 77 61 70 70 49 6e  st.#.proc wappIn
64c0: 74 2d 68 61 6e 64 6c 65 2d 63 67 69 2d 72 65 71  t-handle-cgi-req
64d0: 75 65 73 74 20 7b 7d 20 7b 0a 20 20 67 6c 6f 62  uest {} {.  glob
64e0: 61 6c 20 77 61 70 70 20 65 6e 76 0a 20 20 66 6f  al wapp env.  fo
64f0: 72 65 61 63 68 20 6b 65 79 20 5b 61 72 72 61 79  reach key [array
6500: 20 6e 61 6d 65 73 20 65 6e 76 20 7b 5b 41 2d 5a   names env {[A-Z
6510: 5d 2a 7d 5d 20 7b 64 69 63 74 20 73 65 74 20 77  ]*}] {dict set w
6520: 61 70 70 20 24 6b 65 79 20 24 65 6e 76 28 24 6b  app $key $env($k
6530: 65 79 29 7d 0a 20 20 73 65 74 20 6c 65 6e 20 30  ey)}.  set len 0
6540: 0a 20 20 69 66 20 7b 5b 64 69 63 74 20 65 78 69  .  if {[dict exi
6550: 73 74 73 20 24 77 61 70 70 20 43 4f 4e 54 45 4e  sts $wapp CONTEN
6560: 54 5f 4c 45 4e 47 54 48 5d 7d 20 7b 0a 20 20 20  T_LENGTH]} {.   
6570: 20 73 65 74 20 6c 65 6e 20 5b 64 69 63 74 20 67   set len [dict g
6580: 65 74 20 24 77 61 70 70 20 43 4f 4e 54 45 4e 54  et $wapp CONTENT
6590: 5f 4c 45 4e 47 54 48 5d 0a 20 20 7d 0a 20 20 69  _LENGTH].  }.  i
65a0: 66 20 7b 24 6c 65 6e 3e 30 7d 20 7b 0a 20 20 20  f {$len>0} {.   
65b0: 20 66 63 6f 6e 66 69 67 75 72 65 20 73 74 64 69   fconfigure stdi
65c0: 6e 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 62  n -translation b
65d0: 69 6e 61 72 79 0a 20 20 20 20 64 69 63 74 20 73  inary.    dict s
65e0: 65 74 20 77 61 70 70 20 43 4f 4e 54 45 4e 54 20  et wapp CONTENT 
65f0: 5b 72 65 61 64 20 73 74 64 69 6e 20 24 6c 65 6e  [read stdin $len
6600: 5d 0a 20 20 7d 0a 20 20 64 69 63 74 20 73 65 74  ].  }.  dict set
6610: 20 77 61 70 70 20 57 41 50 50 5f 4d 4f 44 45 20   wapp WAPP_MODE 
6620: 63 67 69 0a 20 20 66 63 6f 6e 66 69 67 75 72 65  cgi.  fconfigure
6630: 20 73 74 64 6f 75 74 20 2d 74 72 61 6e 73 6c 61   stdout -transla
6640: 74 69 6f 6e 20 62 69 6e 61 72 79 0a 20 20 77 61  tion binary.  wa
6650: 70 70 49 6e 74 2d 68 61 6e 64 6c 65 2d 72 65 71  ppInt-handle-req
6660: 75 65 73 74 2d 75 6e 73 61 66 65 20 73 74 64 6f  uest-unsafe stdo
6670: 75 74 0a 7d 0a 0a 23 20 50 72 6f 63 65 73 73 20  ut.}..# Process 
6680: 6e 65 77 20 74 65 78 74 20 72 65 63 65 69 76 65  new text receive
6690: 64 20 6f 6e 20 61 6e 20 69 6e 62 6f 75 6e 64 20  d on an inbound 
66a0: 53 43 47 49 20 72 65 71 75 65 73 74 0a 23 0a 70  SCGI request.#.p
66b0: 72 6f 63 20 77 61 70 70 49 6e 74 2d 73 63 67 69  roc wappInt-scgi
66c0: 2d 72 65 61 64 61 62 6c 65 20 7b 63 68 61 6e 7d  -readable {chan}
66d0: 20 7b 0a 20 20 69 66 20 7b 5b 63 61 74 63 68 20   {.  if {[catch 
66e0: 5b 6c 69 73 74 20 77 61 70 70 49 6e 74 2d 73 63  [list wappInt-sc
66f0: 67 69 2d 72 65 61 64 61 62 6c 65 2d 75 6e 73 61  gi-readable-unsa
6700: 66 65 20 24 63 68 61 6e 5d 20 6d 73 67 5d 7d 20  fe $chan] msg]} 
6710: 7b 0a 20 20 20 20 70 75 74 73 20 73 74 64 65 72  {.    puts stder
6720: 72 20 22 24 6d 73 67 5c 6e 24 3a 3a 65 72 72 6f  r "$msg\n$::erro
6730: 72 49 6e 66 6f 22 0a 20 20 20 20 77 61 70 70 49  rInfo".    wappI
6740: 6e 74 2d 63 6c 6f 73 65 2d 63 68 61 6e 6e 65 6c  nt-close-channel
6750: 20 24 63 68 61 6e 0a 20 20 7d 0a 7d 0a 70 72 6f   $chan.  }.}.pro
6760: 63 20 77 61 70 70 49 6e 74 2d 73 63 67 69 2d 72  c wappInt-scgi-r
6770: 65 61 64 61 62 6c 65 2d 75 6e 73 61 66 65 20 7b  eadable-unsafe {
6780: 63 68 61 6e 7d 20 7b 0a 20 20 75 70 76 61 72 20  chan} {.  upvar 
6790: 23 30 20 77 61 70 70 49 6e 74 2d 24 63 68 61 6e  #0 wappInt-$chan
67a0: 20 57 20 77 61 70 70 20 77 61 70 70 0a 20 20 69   W wapp wapp.  i
67b0: 66 20 7b 21 5b 64 69 63 74 20 65 78 69 73 74 73  f {![dict exists
67c0: 20 24 57 20 2e 74 6f 72 65 61 64 5d 7d 20 7b 0a   $W .toread]} {.
67d0: 20 20 20 20 23 20 49 66 20 74 68 65 20 2e 74 6f      # If the .to
67e0: 72 65 61 64 20 6b 65 79 20 69 73 20 6e 6f 74 20  read key is not 
67f0: 73 65 74 2c 20 74 68 61 74 20 6d 65 61 6e 73 20  set, that means 
6800: 77 65 20 61 72 65 20 73 74 69 6c 6c 20 72 65 61  we are still rea
6810: 64 69 6e 67 0a 20 20 20 20 23 20 74 68 65 20 68  ding.    # the h
6820: 65 61 64 65 72 2e 0a 20 20 20 20 23 0a 20 20 20  eader..    #.   
6830: 20 23 20 41 6e 20 53 47 49 20 68 65 61 64 65 72   # An SGI header
6840: 20 69 73 20 73 68 6f 72 74 2e 20 20 54 68 69 73   is short.  This
6850: 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20   implementation 
6860: 61 73 73 75 6d 65 73 20 74 68 65 20 65 6e 74 69  assumes the enti
6870: 72 65 0a 20 20 20 20 23 20 68 65 61 64 65 72 20  re.    # header 
6880: 69 73 20 61 76 61 69 6c 61 62 6c 65 20 61 6c 6c  is available all
6890: 20 61 74 20 6f 6e 63 65 2e 0a 20 20 20 20 23 0a   at once..    #.
68a0: 20 20 20 20 64 69 63 74 20 73 65 74 20 57 20 2e      dict set W .
68b0: 72 65 6d 6f 76 65 5f 61 64 64 72 20 5b 64 69 63  remove_addr [dic
68c0: 74 20 67 65 74 20 24 57 20 52 45 4d 4f 54 45 5f  t get $W REMOTE_
68d0: 41 44 44 52 5d 0a 20 20 20 20 73 65 74 20 72 65  ADDR].    set re
68e0: 71 20 5b 72 65 61 64 20 24 63 68 61 6e 20 31 35  q [read $chan 15
68f0: 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 73 74 72  ].    set n [str
6900: 69 6e 67 20 6c 65 6e 67 74 68 20 24 72 65 71 5d  ing length $req]
6910: 0a 20 20 20 20 73 63 61 6e 20 24 72 65 71 20 25  .    scan $req %
6920: 64 3a 25 73 20 6c 65 6e 20 68 64 72 0a 20 20 20  d:%s len hdr.   
6930: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e   incr len [strin
6940: 67 20 6c 65 6e 67 74 68 20 22 24 6c 65 6e 3a 2c  g length "$len:,
6950: 22 5d 0a 20 20 20 20 61 70 70 65 6e 64 20 68 64  "].    append hd
6960: 72 20 5b 72 65 61 64 20 24 63 68 61 6e 20 5b 65  r [read $chan [e
6970: 78 70 72 20 7b 24 6c 65 6e 2d 31 35 7d 5d 5d 0a  xpr {$len-15}]].
6980: 20 20 20 20 66 6f 72 65 61 63 68 20 7b 6e 6d 20      foreach {nm 
6990: 76 61 6c 7d 20 5b 73 70 6c 69 74 20 24 68 64 72  val} [split $hdr
69a0: 20 5c 30 30 30 5d 20 7b 0a 20 20 20 20 20 20 69   \000] {.      i
69b0: 66 20 7b 24 6e 6d 3d 3d 22 2c 22 7d 20 62 72 65  f {$nm==","} bre
69c0: 61 6b 0a 20 20 20 20 20 20 64 69 63 74 20 73 65  ak.      dict se
69d0: 74 20 57 20 24 6e 6d 20 24 76 61 6c 0a 20 20 20  t W $nm $val.   
69e0: 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30   }.    set len 0
69f0: 0a 20 20 20 20 69 66 20 7b 5b 64 69 63 74 20 65  .    if {[dict e
6a00: 78 69 73 74 73 20 24 57 20 43 4f 4e 54 45 4e 54  xists $W CONTENT
6a10: 5f 4c 45 4e 47 54 48 5d 7d 20 7b 0a 20 20 20 20  _LENGTH]} {.    
6a20: 20 20 73 65 74 20 6c 65 6e 20 5b 64 69 63 74 20    set len [dict 
6a30: 67 65 74 20 24 57 20 43 4f 4e 54 45 4e 54 5f 4c  get $W CONTENT_L
6a40: 45 4e 47 54 48 5d 0a 20 20 20 20 7d 0a 20 20 20  ENGTH].    }.   
6a50: 20 69 66 20 7b 24 6c 65 6e 3e 30 7d 20 7b 0a 20   if {$len>0} {. 
6a60: 20 20 20 20 20 23 20 53 74 69 6c 6c 20 6e 65 65       # Still nee
6a70: 64 20 74 6f 20 72 65 61 64 20 74 68 65 20 71 75  d to read the qu
6a80: 65 72 79 20 63 6f 6e 74 65 6e 74 0a 20 20 20 20  ery content.    
6a90: 20 20 64 69 63 74 20 73 65 74 20 57 20 2e 74 6f    dict set W .to
6aa0: 72 65 61 64 20 24 6c 65 6e 0a 20 20 20 20 7d 20  read $len.    } 
6ab0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 23 20 54  else {.      # T
6ac0: 68 65 72 65 20 69 73 20 6e 6f 20 71 75 65 72 79  here is no query
6ad0: 20 63 6f 6e 74 65 6e 74 2c 20 73 6f 20 68 61 6e   content, so han
6ae0: 64 6c 65 20 74 68 65 20 72 65 71 75 65 73 74 20  dle the request 
6af0: 69 6d 6d 65 64 69 61 74 65 6c 79 0a 20 20 20 20  immediately.    
6b00: 20 20 64 69 63 74 20 73 65 74 20 57 20 53 45 52    dict set W SER
6b10: 56 45 52 5f 41 44 44 52 20 5b 64 69 63 74 20 67  VER_ADDR [dict g
6b20: 65 74 20 24 57 20 2e 72 65 6d 6f 76 65 5f 61 64  et $W .remove_ad
6b30: 64 72 5d 0a 20 20 20 20 20 20 73 65 74 20 77 61  dr].      set wa
6b40: 70 70 20 24 57 0a 20 20 20 20 20 20 77 61 70 70  pp $W.      wapp
6b50: 49 6e 74 2d 68 61 6e 64 6c 65 2d 72 65 71 75 65  Int-handle-reque
6b60: 73 74 20 24 63 68 61 6e 0a 20 20 20 20 7d 0a 20  st $chan.    }. 
6b70: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 23 20   } else {.    # 
6b80: 49 66 20 2e 74 6f 72 65 61 64 20 69 73 20 73 65  If .toread is se
6b90: 74 2c 20 74 68 61 74 20 6d 65 61 6e 73 20 77 65  t, that means we
6ba0: 20 61 72 65 20 72 65 61 64 69 6e 67 20 74 68 65   are reading the
6bb0: 20 71 75 65 72 79 20 63 6f 6e 74 65 6e 74 2e 0a   query content..
6bc0: 20 20 20 20 23 20 43 6f 6e 74 69 6e 75 65 20 72      # Continue r
6bd0: 65 61 64 69 6e 67 20 75 6e 74 69 6c 20 2e 74 6f  eading until .to
6be0: 72 65 61 64 20 72 65 61 63 68 65 73 20 7a 65 72  read reaches zer
6bf0: 6f 2e 0a 20 20 20 20 73 65 74 20 67 6f 74 20 5b  o..    set got [
6c00: 72 65 61 64 20 24 63 68 61 6e 20 5b 64 69 63 74  read $chan [dict
6c10: 20 67 65 74 20 24 57 20 2e 74 6f 72 65 61 64 5d   get $W .toread]
6c20: 5d 0a 20 20 20 20 64 69 63 74 20 61 70 70 65 6e  ].    dict appen
6c30: 64 20 57 20 43 4f 4e 54 45 4e 54 20 24 67 6f 74  d W CONTENT $got
6c40: 0a 20 20 20 20 64 69 63 74 20 73 65 74 20 57 20  .    dict set W 
6c50: 2e 74 6f 72 65 61 64 20 5b 65 78 70 72 20 7b 5b  .toread [expr {[
6c60: 64 69 63 74 20 67 65 74 20 24 57 20 2e 74 6f 72  dict get $W .tor
6c70: 65 61 64 5d 2d 5b 73 74 72 69 6e 67 20 6c 65 6e  ead]-[string len
6c80: 67 74 68 20 24 67 6f 74 5d 7d 5d 0a 20 20 20 20  gth $got]}].    
6c90: 69 66 20 7b 5b 64 69 63 74 20 67 65 74 20 24 57  if {[dict get $W
6ca0: 20 2e 74 6f 72 65 61 64 5d 3c 3d 30 7d 20 7b 0a   .toread]<=0} {.
6cb0: 20 20 20 20 20 20 23 20 48 61 6e 64 6c 65 20 74        # Handle t
6cc0: 68 65 20 72 65 71 75 65 73 74 20 61 73 20 73 6f  he request as so
6cd0: 6f 6e 20 61 73 20 61 6c 6c 20 74 68 65 20 71 75  on as all the qu
6ce0: 65 72 79 20 63 6f 6e 74 65 6e 74 20 69 73 20 72  ery content is r
6cf0: 65 63 65 69 76 65 64 0a 20 20 20 20 20 20 64 69  eceived.      di
6d00: 63 74 20 73 65 74 20 57 20 53 45 52 56 45 52 5f  ct set W SERVER_
6d10: 41 44 44 52 20 5b 64 69 63 74 20 67 65 74 20 24  ADDR [dict get $
6d20: 57 20 2e 72 65 6d 6f 76 65 5f 61 64 64 72 5d 0a  W .remove_addr].
6d30: 20 20 20 20 20 20 73 65 74 20 77 61 70 70 20 24        set wapp $
6d40: 57 0a 20 20 20 20 20 20 77 61 70 70 49 6e 74 2d  W.      wappInt-
6d50: 68 61 6e 64 6c 65 2d 72 65 71 75 65 73 74 20 24  handle-request $
6d60: 63 68 61 6e 0a 20 20 20 20 7d 0a 20 20 7d 0a 7d  chan.    }.  }.}
6d70: 0a 0a 23 20 53 74 61 72 74 20 75 70 20 74 68 65  ..# Start up the
6d80: 20 77 61 70 70 20 66 72 61 6d 65 77 6f 72 6b 2e   wapp framework.
6d90: 20 20 50 61 72 61 6d 65 74 65 72 73 20 61 72 65    Parameters are
6da0: 20 61 20 6c 69 73 74 20 70 61 73 73 65 64 20 61   a list passed a
6db0: 73 20 74 68 65 0a 23 20 73 69 6e 67 6c 65 20 61  s the.# single a
6dc0: 72 67 75 6d 65 6e 74 2e 0a 23 0a 23 20 20 20 20  rgument..#.#    
6dd0: 2d 73 65 72 76 65 72 20 24 50 4f 52 54 20 20 20  -server $PORT   
6de0: 20 20 20 20 20 20 4c 69 73 74 65 6e 20 66 6f 72        Listen for
6df0: 20 48 54 54 50 20 72 65 71 75 65 73 74 73 20 6f   HTTP requests o
6e00: 6e 20 74 68 69 73 20 54 43 50 20 70 6f 72 74 20  n this TCP port 
6e10: 24 50 4f 52 54 0a 23 0a 23 20 20 20 20 2d 6c 6f  $PORT.#.#    -lo
6e20: 63 61 6c 20 24 50 4f 52 54 20 20 20 20 20 20 20  cal $PORT       
6e30: 20 20 20 4c 69 73 74 65 6e 20 66 6f 72 20 48 54     Listen for HT
6e40: 54 50 20 72 65 71 75 65 73 74 73 20 6f 6e 20 31  TP requests on 1
6e50: 32 37 2e 30 2e 30 2e 31 3a 24 50 4f 52 54 0a 23  27.0.0.1:$PORT.#
6e60: 0a 23 20 20 20 20 2d 73 63 67 69 20 24 50 4f 52  .#    -scgi $POR
6e70: 54 20 20 20 20 20 20 20 20 20 20 20 4c 69 73 74  T           List
6e80: 65 6e 20 66 6f 72 20 53 43 47 49 20 72 65 71 75  en for SCGI requ
6e90: 65 73 74 73 20 6f 6e 20 31 32 37 2e 30 2e 30 2e  ests on 127.0.0.
6ea0: 31 3a 24 50 4f 52 54 0a 23 0a 23 20 20 20 20 2d  1:$PORT.#.#    -
6eb0: 72 65 6d 6f 74 65 2d 73 63 67 69 20 24 50 4f 52  remote-scgi $POR
6ec0: 54 20 20 20 20 4c 69 73 74 65 6e 20 66 6f 72 20  T    Listen for 
6ed0: 53 43 47 49 20 72 65 71 75 65 73 74 73 20 6f 6e  SCGI requests on
6ee0: 20 54 43 50 20 70 6f 72 74 20 24 50 4f 52 54 0a   TCP port $PORT.
6ef0: 23 0a 23 20 20 20 20 2d 63 67 69 20 20 20 20 20  #.#    -cgi     
6f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 48 61 6e               Han
6f10: 64 6c 65 20 61 20 73 69 6e 67 6c 65 20 43 47 49  dle a single CGI
6f20: 20 72 65 71 75 65 73 74 0a 23 0a 23 20 57 69 74   request.#.# Wit
6f30: 68 20 6e 6f 20 61 72 67 75 6d 65 6e 74 73 2c 20  h no arguments, 
6f40: 74 68 65 20 62 65 68 61 76 69 6f 72 20 69 73 20  the behavior is 
6f50: 63 61 6c 6c 65 64 20 22 61 75 74 6f 22 2e 20 20  called "auto".  
6f60: 49 6e 20 22 61 75 74 6f 22 20 6d 6f 64 65 2c 0a  In "auto" mode,.
6f70: 23 20 69 66 20 74 68 65 20 47 41 54 45 57 41 59  # if the GATEWAY
6f80: 5f 49 4e 54 45 52 46 41 43 45 20 65 6e 76 69 72  _INTERFACE envir
6f90: 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 20  onment variable 
6fa0: 69 6e 64 69 63 61 74 65 73 20 43 47 49 2c 20 74  indicates CGI, t
6fb0: 68 65 6e 20 72 75 6e 0a 23 20 61 73 20 43 47 49  hen run.# as CGI
6fc0: 2e 20 20 4f 74 68 65 72 77 69 73 65 2c 20 73 74  .  Otherwise, st
6fd0: 61 72 74 20 61 6e 20 48 54 54 50 20 73 65 72 76  art an HTTP serv
6fe0: 65 72 20 62 6f 75 6e 64 20 74 6f 20 74 68 65 20  er bound to the 
6ff0: 6c 6f 6f 70 62 61 63 6b 20 61 64 64 72 65 73 73  loopback address
7000: 0a 23 20 6f 6e 6c 79 2c 20 6f 6e 20 61 6e 20 61  .# only, on an a
7010: 72 62 69 74 72 61 72 79 20 54 43 50 20 70 6f 72  rbitrary TCP por
7020: 74 2c 20 61 6e 64 20 61 75 74 6f 6d 61 74 69 63  t, and automatic
7030: 61 6c 6c 79 20 6c 61 75 6e 63 68 20 61 20 77 65  ally launch a we
7040: 62 20 62 72 6f 77 73 65 72 0a 23 20 6f 6e 20 74  b browser.# on t
7050: 68 61 74 20 54 43 50 20 70 6f 72 74 2e 0a 23 0a  hat TCP port..#.
7060: 23 20 41 64 64 69 74 69 6f 6e 61 6c 20 6f 70 74  # Additional opt
7070: 69 6f 6e 73 3a 0a 23 0a 23 20 20 20 20 2d 66 72  ions:.#.#    -fr
7080: 6f 6d 69 70 20 47 4c 4f 42 20 20 20 20 20 20 20  omip GLOB       
7090: 20 20 52 65 6a 65 63 74 20 61 6e 79 20 69 6e 63    Reject any inc
70a0: 6f 6d 69 6e 67 20 72 65 71 75 65 73 74 20 77 68  oming request wh
70b0: 65 72 65 20 74 68 65 20 72 65 6d 6f 74 65 0a 23  ere the remote.#
70c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
70d0: 20 20 20 20 20 20 20 20 20 49 50 20 61 64 64 72           IP addr
70e0: 65 73 73 20 64 6f 65 73 20 6e 6f 74 20 6d 61 74  ess does not mat
70f0: 63 68 20 74 68 65 20 47 4c 4f 42 20 70 61 74 74  ch the GLOB patt
7100: 65 72 6e 2e 20 20 54 68 69 73 0a 23 20 20 20 20  ern.  This.#    
7110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
7120: 20 20 20 20 20 76 61 6c 75 65 20 64 65 66 61 75       value defau
7130: 6c 74 73 20 74 6f 20 27 31 32 37 2e 30 2e 30 2e  lts to '127.0.0.
7140: 31 27 20 66 6f 72 20 2d 6c 6f 63 61 6c 20 61 6e  1' for -local an
7150: 64 20 2d 73 63 67 69 2e 0a 23 0a 23 20 20 20 20  d -scgi..#.#    
7160: 2d 6e 6f 77 61 69 74 20 20 20 20 20 20 20 20 20  -nowait         
7170: 20 20 20 20 20 44 6f 20 6e 6f 74 20 77 61 69 74       Do not wait
7180: 20 69 6e 20 74 68 65 20 65 76 65 6e 74 20 6c 6f   in the event lo
7190: 6f 70 2e 20 20 52 65 74 75 72 6e 20 69 6d 6d 65  op.  Return imme
71a0: 64 69 61 74 65 6c 79 0a 23 20 20 20 20 20 20 20  diately.#       
71b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
71c0: 20 20 61 66 74 65 72 20 61 6c 6c 20 65 76 65 6e    after all even
71d0: 74 20 68 61 6e 64 6c 65 72 73 20 61 72 65 20 65  t handlers are e
71e0: 73 74 61 62 6c 69 73 68 65 64 2e 0a 23 0a 23 20  stablished..#.# 
71f0: 20 20 20 2d 74 72 61 63 65 20 20 20 20 20 20 20     -trace       
7200: 20 20 20 20 20 20 20 20 22 70 75 74 73 22 20 65          "puts" e
7210: 61 63 68 20 72 65 71 75 65 73 74 20 55 52 4c 20  ach request URL 
7220: 61 73 20 69 74 20 69 73 20 68 61 6e 64 6c 65 64  as it is handled
7230: 2c 20 66 6f 72 0a 23 20 20 20 20 20 20 20 20 20  , for.#         
7240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
7250: 64 65 62 75 67 67 69 6e 67 0a 23 0a 23 20 20 20  debugging.#.#   
7260: 20 2d 6c 69 6e 74 20 20 20 20 20 20 20 20 20 20   -lint          
7270: 20 20 20 20 20 20 52 75 6e 20 77 61 70 70 2d 73        Run wapp-s
7280: 61 66 65 74 79 2d 63 68 65 63 6b 20 6f 6e 20 74  afety-check on t
7290: 68 65 20 61 70 70 6c 69 63 61 74 69 6f 6e 20 69  he application i
72a0: 6e 73 74 65 61 64 0a 23 20 20 20 20 20 20 20 20  nstead.#        
72b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
72c0: 20 6f 66 20 72 75 6e 6e 69 6e 67 20 74 68 65 20   of running the 
72d0: 61 70 70 6c 69 63 61 74 69 6f 6e 20 69 74 73 65  application itse
72e0: 6c 66 0a 23 0a 23 20 20 20 20 2d 44 76 61 72 3d  lf.#.#    -Dvar=
72f0: 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 20 53  value          S
7300: 65 74 20 54 43 4c 20 67 6c 6f 62 61 6c 20 76 61  et TCL global va
7310: 72 69 61 62 6c 65 20 22 76 61 72 22 20 74 6f 20  riable "var" to 
7320: 22 76 61 6c 75 65 22 0a 23 0a 23 0a 70 72 6f 63  "value".#.#.proc
7330: 20 77 61 70 70 2d 73 74 61 72 74 20 7b 61 72 67   wapp-start {arg
7340: 6c 69 73 74 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c  list} {.  global
7350: 20 65 6e 76 0a 20 20 73 65 74 20 6d 6f 64 65 20   env.  set mode 
7360: 61 75 74 6f 0a 20 20 73 65 74 20 70 6f 72 74 20  auto.  set port 
7370: 30 0a 20 20 73 65 74 20 6e 6f 77 61 69 74 20 30  0.  set nowait 0
7380: 0a 20 20 73 65 74 20 66 72 6f 6d 69 70 20 7b 7d  .  set fromip {}
7390: 0a 20 20 73 65 74 20 6e 20 5b 6c 6c 65 6e 67 74  .  set n [llengt
73a0: 68 20 24 61 72 67 6c 69 73 74 5d 0a 20 20 66 6f  h $arglist].  fo
73b0: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 3c  r {set i 0} {$i<
73c0: 24 6e 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 20  $n} {incr i} {. 
73d0: 20 20 20 73 65 74 20 74 65 72 6d 20 5b 6c 69 6e     set term [lin
73e0: 64 65 78 20 24 61 72 67 6c 69 73 74 20 24 69 5d  dex $arglist $i]
73f0: 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67  .    if {[string
7400: 20 6d 61 74 63 68 20 2d 2d 2a 20 24 74 65 72 6d   match --* $term
7410: 5d 7d 20 7b 73 65 74 20 74 65 72 6d 20 5b 73 74  ]} {set term [st
7420: 72 69 6e 67 20 72 61 6e 67 65 20 24 74 65 72 6d  ring range $term
7430: 20 31 20 65 6e 64 5d 7d 0a 20 20 20 20 73 77 69   1 end]}.    swi
7440: 74 63 68 20 2d 67 6c 6f 62 20 2d 2d 20 24 74 65  tch -glob -- $te
7450: 72 6d 20 7b 0a 20 20 20 20 20 20 2d 73 65 72 76  rm {.      -serv
7460: 65 72 20 7b 0a 20 20 20 20 20 20 20 20 69 6e 63  er {.        inc
7470: 72 20 69 3b 0a 20 20 20 20 20 20 20 20 73 65 74  r i;.        set
7480: 20 6d 6f 64 65 20 22 73 65 72 76 65 72 22 0a 20   mode "server". 
7490: 20 20 20 20 20 20 20 73 65 74 20 70 6f 72 74 20         set port 
74a0: 5b 6c 69 6e 64 65 78 20 24 61 72 67 6c 69 73 74  [lindex $arglist
74b0: 20 24 69 5d 0a 20 20 20 20 20 20 7d 0a 20 20 20   $i].      }.   
74c0: 20 20 20 2d 6c 6f 63 61 6c 20 7b 0a 20 20 20 20     -local {.    
74d0: 20 20 20 20 69 6e 63 72 20 69 3b 0a 20 20 20 20      incr i;.    
74e0: 20 20 20 20 73 65 74 20 6d 6f 64 65 20 22 6c 6f      set mode "lo
74f0: 63 61 6c 22 0a 20 20 20 20 20 20 20 20 73 65 74  cal".        set
7500: 20 66 72 6f 6d 69 70 20 31 32 37 2e 30 2e 30 2e   fromip 127.0.0.
7510: 31 0a 20 20 20 20 20 20 20 20 73 65 74 20 70 6f  1.        set po
7520: 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 6c  rt [lindex $argl
7530: 69 73 74 20 24 69 5d 0a 20 20 20 20 20 20 7d 0a  ist $i].      }.
7540: 20 20 20 20 20 20 2d 73 63 67 69 20 7b 0a 20 20        -scgi {.  
7550: 20 20 20 20 20 20 69 6e 63 72 20 69 3b 0a 20 20        incr i;.  
7560: 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65 20 22        set mode "
7570: 73 63 67 69 22 0a 20 20 20 20 20 20 20 20 73 65  scgi".        se
7580: 74 20 66 72 6f 6d 69 70 20 31 32 37 2e 30 2e 30  t fromip 127.0.0
7590: 2e 31 0a 20 20 20 20 20 20 20 20 73 65 74 20 70  .1.        set p
75a0: 6f 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67  ort [lindex $arg
75b0: 6c 69 73 74 20 24 69 5d 0a 20 20 20 20 20 20 7d  list $i].      }
75c0: 0a 20 20 20 20 20 20 2d 72 65 6d 6f 74 65 2d 73  .      -remote-s
75d0: 63 67 69 20 7b 0a 20 20 20 20 20 20 20 20 69 6e  cgi {.        in
75e0: 63 72 20 69 3b 0a 20 20 20 20 20 20 20 20 73 65  cr i;.        se
75f0: 74 20 6d 6f 64 65 20 22 72 65 6d 6f 74 65 2d 73  t mode "remote-s
7600: 63 67 69 22 0a 20 20 20 20 20 20 20 20 73 65 74  cgi".        set
7610: 20 70 6f 72 74 20 5b 6c 69 6e 64 65 78 20 24 61   port [lindex $a
7620: 72 67 6c 69 73 74 20 24 69 5d 0a 20 20 20 20 20  rglist $i].     
7630: 20 7d 0a 20 20 20 20 20 20 2d 63 67 69 20 7b 0a   }.      -cgi {.
7640: 20 20 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65          set mode
7650: 20 22 63 67 69 22 0a 20 20 20 20 20 20 7d 0a 20   "cgi".      }. 
7660: 20 20 20 20 20 2d 66 72 6f 6d 69 70 20 7b 0a 20       -fromip {. 
7670: 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20         incr i.  
7680: 20 20 20 20 20 20 73 65 74 20 66 72 6f 6d 69 70        set fromip
7690: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 6c 69 73   [lindex $arglis
76a0: 74 20 24 69 5d 0a 20 20 20 20 20 20 7d 0a 20 20  t $i].      }.  
76b0: 20 20 20 20 2d 6e 6f 77 61 69 74 20 7b 0a 20 20      -nowait {.  
76c0: 20 20 20 20 20 20 73 65 74 20 6e 6f 77 61 69 74        set nowait
76d0: 20 31 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 20   1.      }.     
76e0: 20 2d 74 72 61 63 65 20 7b 0a 20 20 20 20 20 20   -trace {.      
76f0: 20 20 70 72 6f 63 20 77 61 70 70 49 6e 74 2d 74    proc wappInt-t
7700: 72 61 63 65 20 7b 7d 20 7b 0a 20 20 20 20 20 20  race {} {.      
7710: 20 20 20 20 73 65 74 20 71 20 5b 77 61 70 70 2d      set q [wapp-
7720: 70 61 72 61 6d 20 51 55 45 52 59 5f 53 54 52 49  param QUERY_STRI
7730: 4e 47 5d 0a 20 20 20 20 20 20 20 20 20 20 73 65  NG].          se
7740: 74 20 75 72 69 20 5b 77 61 70 70 2d 70 61 72 61  t uri [wapp-para
7750: 6d 20 42 41 53 45 5f 55 52 4c 5d 5b 77 61 70 70  m BASE_URL][wapp
7760: 2d 70 61 72 61 6d 20 50 41 54 48 5f 49 4e 46 4f  -param PATH_INFO
7770: 5d 0a 20 20 20 20 20 20 20 20 20 20 69 66 20 7b  ].          if {
7780: 24 71 21 3d 22 22 7d 20 7b 61 70 70 65 6e 64 20  $q!=""} {append 
7790: 75 72 69 20 3f 24 71 7d 0a 20 20 20 20 20 20 20  uri ?$q}.       
77a0: 20 20 20 70 75 74 73 20 24 75 72 69 0a 20 20 20     puts $uri.   
77b0: 20 20 20 20 20 7d 0a 20 20 20 20 20 20 7d 0a 20       }.      }. 
77c0: 20 20 20 20 20 2d 6c 69 6e 74 20 7b 0a 20 20 20       -lint {.   
77d0: 20 20 20 20 20 73 65 74 20 72 65 73 20 5b 77 61       set res [wa
77e0: 70 70 2d 73 61 66 65 74 79 2d 63 68 65 63 6b 5d  pp-safety-check]
77f0: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 24 72 65  .        if {$re
7800: 73 21 3d 22 22 7d 20 7b 0a 20 20 20 20 20 20 20  s!=""} {.       
7810: 20 20 20 70 75 74 73 20 22 50 6f 74 65 6e 74 69     puts "Potenti
7820: 61 6c 20 70 72 6f 62 6c 65 6d 73 20 69 6e 20 74  al problems in t
7830: 68 69 73 20 63 6f 64 65 3a 22 0a 20 20 20 20 20  his code:".     
7840: 20 20 20 20 20 70 75 74 73 20 24 72 65 73 0a 20       puts $res. 
7850: 20 20 20 20 20 20 20 20 20 65 78 69 74 20 31 0a           exit 1.
7860: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b          } else {
7870: 0a 20 20 20 20 20 20 20 20 20 20 65 78 69 74 0a  .          exit.
7880: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20          }.      
7890: 7d 0a 20 20 20 20 20 20 2d 44 2a 3d 2a 20 7b 0a  }.      -D*=* {.
78a0: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 72 65 67          if {[reg
78b0: 65 78 70 20 7b 5e 2e 44 28 5b 5e 3d 5d 2b 29 3d  exp {^.D([^=]+)=
78c0: 28 2e 2a 29 24 7d 20 24 74 65 72 6d 20 61 6c 6c  (.*)$} $term all
78d0: 20 76 61 72 20 76 61 6c 5d 7d 20 7b 0a 20 20 20   var val]} {.   
78e0: 20 20 20 20 20 20 20 73 65 74 20 3a 3a 24 76 61         set ::$va
78f0: 72 20 24 76 61 6c 0a 20 20 20 20 20 20 20 20 7d  r $val.        }
7900: 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 64  .      }.      d
7910: 65 66 61 75 6c 74 20 7b 0a 20 20 20 20 20 20 20  efault {.       
7920: 20 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20   error "unknown 
7930: 6f 70 74 69 6f 6e 3a 20 24 74 65 72 6d 22 0a 20  option: $term". 
7940: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 7d       }.    }.  }
7950: 0a 20 20 69 66 20 7b 24 6d 6f 64 65 3d 3d 22 61  .  if {$mode=="a
7960: 75 74 6f 22 7d 20 7b 0a 20 20 20 20 69 66 20 7b  uto"} {.    if {
7970: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76  [info exists env
7980: 28 47 41 54 45 57 41 59 5f 49 4e 54 45 52 46 41  (GATEWAY_INTERFA
7990: 43 45 29 5d 0a 20 20 20 20 20 20 20 20 26 26 20  CE)].        && 
79a0: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 43 47  [string match CG
79b0: 49 2f 31 2e 2a 20 24 65 6e 76 28 47 41 54 45 57  I/1.* $env(GATEW
79c0: 41 59 5f 49 4e 54 45 52 46 41 43 45 29 5d 7d 20  AY_INTERFACE)]} 
79d0: 7b 0a 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65  {.      set mode
79e0: 20 63 67 69 0a 20 20 20 20 7d 20 65 6c 73 65 20   cgi.    } else 
79f0: 7b 0a 20 20 20 20 20 20 73 65 74 20 6d 6f 64 65  {.      set mode
7a00: 20 6c 6f 63 61 6c 0a 20 20 20 20 7d 0a 20 20 7d   local.    }.  }
7a10: 0a 20 20 69 66 20 7b 24 6d 6f 64 65 3d 3d 22 63  .  if {$mode=="c
7a20: 67 69 22 7d 20 7b 0a 20 20 20 20 77 61 70 70 49  gi"} {.    wappI
7a30: 6e 74 2d 68 61 6e 64 6c 65 2d 63 67 69 2d 72 65  nt-handle-cgi-re
7a40: 71 75 65 73 74 0a 20 20 7d 20 65 6c 73 65 20 7b  quest.  } else {
7a50: 0a 20 20 20 20 77 61 70 70 49 6e 74 2d 73 74 61  .    wappInt-sta
7a60: 72 74 2d 6c 69 73 74 65 6e 65 72 20 24 70 6f 72  rt-listener $por
7a70: 74 20 24 6d 6f 64 65 20 24 66 72 6f 6d 69 70 0a  t $mode $fromip.
7a80: 20 20 20 20 69 66 20 7b 21 24 6e 6f 77 61 69 74      if {!$nowait
7a90: 7d 20 7b 0a 20 20 20 20 20 20 76 77 61 69 74 20  } {.      vwait 
7aa0: 3a 3a 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a  ::forever.    }.
7ab0: 20 20 7d 0a 7d 0a 0a 23 20 43 61 6c 6c 20 74 68    }.}..# Call th
7ac0: 69 73 20 76 65 72 73 69 6f 6e 20 31 2e 30 0a 70  is version 1.0.p
7ad0: 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 77  ackage provide w
7ae0: 61 70 70 20 31 2e 30 0a                          app 1.0.