Wapp

Check-in [e6c6f398a0]
Login

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

Overview
Comment:Add the wapp-redirect command.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: e6c6f398a0707953173697aac0e88de9dfe1b894727e2fb4b492403ae0200b5d
User & Date: drh 2018-01-28 17:32:05.545
Context
2018-01-28
17:45
When the value of a cookie is an empty string, set its max age to 1 second so that it will be cleared from the browser. (check-in: b76fa41ae9 user: drh tags: trunk)
17:32
Add the wapp-redirect command. (check-in: e6c6f398a0 user: drh tags: trunk)
2018-01-27
22:17
Enable JSON1 in wapptclsh (check-in: a763b12070 user: drh tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Changes to test01.tcl.
︙︙
12
13
14
15
16
17
18

19
20
21
22



23
24
25
26
27
28
29

  wapp-subst {<li><p><a href='%html($B)/fullenv'>Full Environment</a>\n}
  set crazy [lsort [dict keys $wapp]]
  wapp-subst {<li><p><a href='%html($B)/env?keys=%url($crazy)'>}
  wapp "Environment with crazy URL\n"
  wapp-subst {<li><p><a href='%html($B)/lint'>Lint</a>\n}
  wapp-subst {<li><p><a href='%html($B)/errorout'>Deliberate error</a>\n}
  wapp-subst {<li><p><a href='%html($B)/encodings'>Encoding checks</a>\n}

  wapp "</ol>"
  if {[dict exists $wapp showenv]} {
    wapp-page-env
  }



}
proc wapp-page-env {} {
  global wapp
  wapp-set-cookie env-cookie simple
  wapp "<h1>Wapp Environment</h1>\n"
  wapp-unsafe "<form method='GET' action='[dict get $wapp SELF_URL]'>\n"
  wapp "<input type='checkbox' name='showhdr'"








>




>
>
>








12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

  wapp-subst {<li><p><a href='%html($B)/fullenv'>Full Environment</a>\n}
  set crazy [lsort [dict keys $wapp]]
  wapp-subst {<li><p><a href='%html($B)/env?keys=%url($crazy)'>}
  wapp "Environment with crazy URL\n"
  wapp-subst {<li><p><a href='%html($B)/lint'>Lint</a>\n}
  wapp-subst {<li><p><a href='%html($B)/errorout'>Deliberate error</a>\n}
  wapp-subst {<li><p><a href='%html($B)/encodings'>Encoding checks</a>\n}
  wapp-subst {<li><p><a href='%html($B)/redirect'>Redirect to env</a>\n}
  wapp "</ol>"
  if {[dict exists $wapp showenv]} {
    wapp-page-env
  }
}
proc wapp-page-redirect {} {
  wapp-redirect env
}
proc wapp-page-env {} {
  global wapp
  wapp-set-cookie env-cookie simple
  wapp "<h1>Wapp Environment</h1>\n"
  wapp-unsafe "<form method='GET' action='[dict get $wapp SELF_URL]'>\n"
  wapp "<input type='checkbox' name='showhdr'"
︙︙
Changes to wapp.tcl.
︙︙
158
159
160
161
162
163
164




















165
166
167
168
169
170
171


# Set a cookie
#
proc wapp-set-cookie {name value} {
  global wapp
  dict lappend wapp .new-cookies $name $value
}





















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








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








158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191


# Set a cookie
#
proc wapp-set-cookie {name value} {
  global wapp
  dict lappend wapp .new-cookies $name $value
}

# Unset a cookie
#
proc wapp-clear-cookie {name} {
  wapp-set-cookie $name {}
}

# Add extra entries to the reply header
#
proc wapp-reply-extra {name value} {
  global wapp
  dict lappend wapp .reply-extra $name $value
}

# Redirect to a different web page
#
proc wapp-redirect {uri} {
  wapp-reply-code {302 found}
  wapp-reply-extra Location $uri
}

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





542
543
544
545
546
547
548

  if {$chan=="stdout"} {
    puts $chan "Status: [dict get $wapp .reply-code]\r"
  } else {
    puts $chan "HTTP/1.0 [dict get $wapp .reply-code]\r"
    puts $chan "Server: wapp\r"
    puts $chan "Content-Length: [string length [dict get $wapp .reply]]\r"
    puts $chan "Connection: Closed\r"





  }
  set mimetype [dict get $wapp .mimetype]
  puts $chan "Content-Type: $mimetype\r"
  if {[dict exists $wapp .new-cookies]} {
    foreach {nm val} [dict get $wapp .new-cookies] {
      if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
        set val [wappInt-enc-url $val]








>
>
>
>
>








555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

  if {$chan=="stdout"} {
    puts $chan "Status: [dict get $wapp .reply-code]\r"
  } else {
    puts $chan "HTTP/1.0 [dict get $wapp .reply-code]\r"
    puts $chan "Server: wapp\r"
    puts $chan "Content-Length: [string length [dict get $wapp .reply]]\r"
    puts $chan "Connection: Closed\r"
  }
  if {[dict exists $wapp .reply-extra]} {
    foreach {name value} [dict get $wapp .reply-extra] {
      puts $chan "$name: $value\r"
    }
  }
  set mimetype [dict get $wapp .mimetype]
  puts $chan "Content-Type: $mimetype\r"
  if {[dict exists $wapp .new-cookies]} {
    foreach {nm val} [dict get $wapp .new-cookies] {
      if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
        set val [wappInt-enc-url $val]
︙︙