Wapp

Check-in [a3a740ad51]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Allow "%html%(...)%" as an alternative to "%html(...)" for use in cases where the "..." contains one or more ")" characters.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:a3a740ad5141addfdf00461faf79cc14ec970bbb9ef28c8645f07c5fc91977a7
User & Date: drh 2018-02-18 23:45:22
Context
2018-02-27
04:05
Fix typos in the security.md document. check-in: 3d9bec254b user: drh tags: trunk
2018-02-19
12:32
Attempt to reimplement wapp-subst and wapp-trim using the -command option to regsub. This prevents bracket-command evaluatation in unsubstituted script, but it does not handle backslash escapes quite right. Closed-Leaf check-in: 9352328572 user: drh tags: regsub-command
2018-02-18
23:45
Allow "%html%(...)%" as an alternative to "%html(...)" for use in cases where the "..." contains one or more ")" characters. check-in: a3a740ad51 user: drh tags: trunk
2018-02-16
19:24
In "local" and "server" modes, if a TCL error occurs in the page processing routine, write that error onto standard output in addition to sending it back as the reply to request. check-in: 99b13e374c user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/test01.tcl.

5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#
if {[catch {package require wapp}]} {
  source [file dir [file dir [info script]]]/wapp.tcl
}
proc wapp-default {} {
  global wapp
  set B [wapp-param BASE_URL]

  set R [wapp-param SCRIPT_NAME]
  wapp-cache-control max-age=15
  wapp "<h1>Hello, World!</h1>\n"
  wapp "<ol>"
  wapp-unsafe "<li><p><a href='$R/env'>Wapp Environment</a></p>\n"
  wapp-subst {<li><p><a href='env2'>Environment using wapp-debug-env</a>\n}
   wapp-subst {<li><p><a href='%url($B)/fullenv'>Full Environment</a>\n}
  set crazy [lsort [wapp-param-list]]
  wapp-subst {<li><p><a href='%url($B)/env?keys=%url($crazy)'>}
  wapp "Environment with crazy URL</a>\n"
  wapp-trim {
    <li><p><a href='%url($B)/lint'>Lint</a>
    <li><p><a href='%url($B)/errorout'>Deliberate error</a>
    <li><p><a href='%url($B)/encodings'>Encoding checks</a>
    <li><p><a href='%url($B)/redirect'>Redirect to env</a>
    <li><p><a href='%url($B)/globals'>TCL global variables</a>
    <li><p><a href='%url($B)/csptest'>Content Security Policy</a>
    <li><p><a href='%url($B)/fileupload'>File Upload
    Using multipart/form-data</a>
    <li><p><a href='%url($B)/self'>The source code to this script</a>
  }
  set x "%string(...)"
  set v abc'def\"ghi\\jkl
  wapp-subst {<li>%html($x) substitution test: "%string($v)"\n}
  wapp "</ol>"
  if {[wapp-param-exists showenv]} {
    wapp-page-env
  }
  wapp-trim {
    <p>The creator of Wapp:<br>
    <img src="%url($R/drh.jpg)">







>






|









|






|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#
if {[catch {package require wapp}]} {
  source [file dir [file dir [info script]]]/wapp.tcl
}
proc wapp-default {} {
  global wapp
  set B [wapp-param BASE_URL]
  set BX(y) $B
  set R [wapp-param SCRIPT_NAME]
  wapp-cache-control max-age=15
  wapp "<h1>Hello, World!</h1>\n"
  wapp "<ol>"
  wapp-unsafe "<li><p><a href='$R/env'>Wapp Environment</a></p>\n"
  wapp-subst {<li><p><a href='env2'>Environment using wapp-debug-env</a>\n}
  wapp-subst {<li><p><a href='%url%($B)%/fullenv'>Full Environment</a>\n}
  set crazy [lsort [wapp-param-list]]
  wapp-subst {<li><p><a href='%url($B)/env?keys=%url($crazy)'>}
  wapp "Environment with crazy URL</a>\n"
  wapp-trim {
    <li><p><a href='%url($B)/lint'>Lint</a>
    <li><p><a href='%url($B)/errorout'>Deliberate error</a>
    <li><p><a href='%url($B)/encodings'>Encoding checks</a>
    <li><p><a href='%url($B)/redirect'>Redirect to env</a>
    <li><p><a href='%url($B)/globals'>TCL global variables</a>
    <li><p><a href='%url%($BX(y))%/csptest'>Content Security Policy</a>
    <li><p><a href='%url($B)/fileupload'>File Upload
    Using multipart/form-data</a>
    <li><p><a href='%url($B)/self'>The source code to this script</a>
  }
  set x "%string(...)"
  set v abc'def\"ghi\\jkl
  wapp-subst {<li>%html($x) substitution test: "%string%($v)%"\n}
  wapp "</ol>"
  if {[wapp-param-exists showenv]} {
    wapp-page-env
  }
  wapp-trim {
    <p>The creator of Wapp:<br>
    <img src="%url($R/drh.jpg)">

Changes to wapp.tcl.

51
52
53
54
55
56
57












58
59
60
61
62
63
64
65
66











67
68
69
70
71
72
73
...
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
# substitutions are made:
#
#     %html(...)          Escape text for inclusion in HTML
#     %url(...)           Escape text for use as a URL
#     %qp(...)            Escape text for use as a URI query parameter
#     %string(...)        Escape text for use within a JSON string
#     %unsafe(...)        No transformations of the text












#
# The %unsafe substitution should be avoided whenever possible, obviously.
# In addition to the substitutions above, the text also does backslash
# escapes.
#
proc wapp-subst {txt} {
  global wapp
  regsub -all {%(html|url|qp|string|unsafe)\(([^)]+)\)} $txt \
         {[wappInt-enc-\1 "\2"]} txt











  dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}

# There must be a wappInt-enc-NAME routine for each possible substitution
# in wapp-subst.  Thus there are routines for "html", "url", "qp", and "unsafe".
#
#    wappInt-enc-html           Escape text so that it is safe to use in the
................................................................................
  }
  return $s
}
proc wappInt-enc-string {s} {
  return [string map {\\ \\\\ \" \\\" ' \\'} $s]
}

# Works like wapp-subst, but also removes whitespace from the beginning
# of lines.
#
proc wapp-trim {txt} {
  global wapp
  regsub -all {\n\s+} [string trim $txt] \n txt
  regsub -all {%(html|url|qp|string|unsafe)\(([^)]+)\)} $txt \
         {[wappInt-enc-\1 "\2"]} txt
  dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}

# This is a helper routine for wappInt-enc-url and wappInt-enc-qp.  It returns
# an appropriate %HH encoding for the single character c.  If c is a unicode
# character, then this routine might return multiple bytes:  %HH%HH%HH
#
proc wappInt-%HHchar {c} {
  if {$c==" "} {return +}
  return [regsub -all .. [binary encode hex [encoding convertto utf-8 $c]] {%&}]







>
>
>
>
>
>
>
>
>
>
>
>







|
|
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
132
133
134
135
136
137
138











139
140
141
142
143
144
145
# substitutions are made:
#
#     %html(...)          Escape text for inclusion in HTML
#     %url(...)           Escape text for use as a URL
#     %qp(...)            Escape text for use as a URI query parameter
#     %string(...)        Escape text for use within a JSON string
#     %unsafe(...)        No transformations of the text
#
# The substitutions above terminate at the first ")" character.  If the
# text of the TCL string in ... contains ")" characters itself, use instead:
#
#     %html%(...)%
#     %url%(...)%
#     %qp%(...)%
#     %string%(...)%
#     %unsafe%(...)%
#
# In other words, use "%(...)%" instead of "(...)" to include the TCL string
# to substitute.
#
# The %unsafe substitution should be avoided whenever possible, obviously.
# In addition to the substitutions above, the text also does backslash
# escapes.
#
proc wapp-subst {txt} {
  global wapp
  regsub -all {%(html|url|qp|string|unsafe){1,1}?(|%)\((.+)\)\2} $txt \
         {[wappInt-enc-\1 "\3"]} txt
  dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}

# Works like wapp-subst, but also removes whitespace from the beginning
# of lines.
#
proc wapp-trim {txt} {
  global wapp
  regsub -all {\n\s+} [string trim $txt] \n txt
  regsub -all {%(html|url|qp|string|unsafe){1,1}?(|%)\((.+)\)\2} $txt \
         {[wappInt-enc-\1 "\3"]} txt
  dict append wapp .reply [uplevel 1 [list subst -novariables $txt]]
}

# There must be a wappInt-enc-NAME routine for each possible substitution
# in wapp-subst.  Thus there are routines for "html", "url", "qp", and "unsafe".
#
#    wappInt-enc-html           Escape text so that it is safe to use in the
................................................................................
  }
  return $s
}
proc wappInt-enc-string {s} {
  return [string map {\\ \\\\ \" \\\" ' \\'} $s]
}












# This is a helper routine for wappInt-enc-url and wappInt-enc-qp.  It returns
# an appropriate %HH encoding for the single character c.  If c is a unicode
# character, then this routine might return multiple bytes:  %HH%HH%HH
#
proc wappInt-%HHchar {c} {
  if {$c==" "} {return +}
  return [regsub -all .. [binary encode hex [encoding convertto utf-8 $c]] {%&}]