Wapp

Check-in [f909925b48]
Login

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

Overview
Comment:Add the wapp-before-reply-hook proc.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: f909925b48e824ba51b65347cebf999eef020f4c97d71b7d53a9067ca9bca171
User & Date: drh 2020-10-08 13:02:32.073
Context
2020-12-12
15:34
Add "Download" instructions to the homepage. (check-in: f9f5703a2c user: drh tags: trunk)
2020-10-08
13:02
Add the wapp-before-reply-hook proc. (check-in: f909925b48 user: drh tags: trunk)
2020-10-07
18:24
Add the capture.tcl test script. (check-in: 00f66ee5c9 user: drh tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Added examples/beforereply.tcl. 














































































































































































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

1
2
3
4
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
44
45
46
47
48
49
50
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

#!/usr/bin/wapptclsh
#
# This script demonstrates the use of the wapp-before-reply-hook interface.
#
# The wapp-before-reply-hook is a TCL proc that runs just before the reply
# to an HTTP request is generated.  It has the opportunity to review the
# HTTP reply to ensure that no sensitive information is present in the
# reply, due to accidents or bugs in the code.  It can modify the reply
# or generate an error.
#
# Most applications omit the wapp-before-reply-hook in which case it is
# a no-op.
#
# This demo is the "self.tcl" demo, with a wapp-before-reply-hook added
# that changes all instances of the string "before-reply" into "XXXXXXXXXXXX".
#
package require wapp
proc wapp-before-reply-hook {} {
  global wapp
  dict set wapp .reply \
    [string map {before-reply XXXXXXXXXXXX} [dict get $wapp .reply]]
}
proc common-header {} {
  wapp-trim {
    <html>
    <head>
    <meta name="viewport" content="width=device-width, initial-scale=1.0">
    <meta http-equiv="content-type" content="text/html; charset=UTF-8">
    <link href="%url([wapp-param SCRIPT_NAME]/style.css)" rel="stylesheet">
    <title>Wapp Self-Display Demo</title>
    </head>
    <body>
  }
}
proc common-footer {} {
  wapp-trim {
    </body>
    </html>
  }
}
proc wapp-default {} {
  wapp-cache-control max-age=3600
  common-header
  wapp-trim {
    <h1>Wapp Self-Display Demo</h1>
    <p>(Strings "&#98;efore-reply" changed into "XXXXXXXXXXXX".)</p>
    <ul>
    <li> <a href='%url([wapp-param SCRIPT_NAME])/self'>Show the script
    that generates this page</a>
    <li> <a href='%url([wapp-param SCRIPT_NAME])/env'>Wapp Environment</a>
    </ul>
  }
  common-footer
}
proc wapp-page-env {} {
  wapp-allow-xorigin-params
  common-header
  wapp-trim {
    <h1>Wapp Environment</h1>
    <pre>%html([wapp-debug-env])</pre>
  }
  common-footer
}
proc wapp-page-self {} {
  wapp-cache-control max-age=3600
  common-header
  set fd [open [wapp-param SCRIPT_FILENAME] rb]
  set script [read $fd]
  close $fd
  wapp-trim {
    <h1>Wapp Script That Shows A Copy Of Itself</h1>
    <pre>%html($script)</pre>
  }
  common-footer
}
proc wapp-page-style.css {} {
  wapp-mimetype text/css
  wapp-cache-control max-age=3600
  wapp-trim {
    pre {
       border: 1px solid black;
       padding: 1ex;
    }
  }
}
wapp-start $argv
Changes to wapp.tcl.
︙︙
734
735
736
737
738
739
740

741
742
743
744
745
746
747

    wapp-mimetype text/html
    wapp-trim {
      <h1>Wapp Application Error</h1>
      <pre>%html($::errorInfo)</pre>
    }
    dict unset wapp .new-cookies
  }


  # Transmit the HTTP reply
  #
  if {$chan=="stdout"} {
    puts $chan "Status: [dict get $wapp .reply-code]\r"
  } else {
    puts $chan "HTTP/1.1 [dict get $wapp .reply-code]\r"








>








734
735
736
737
738
739
740
741
742
743
744
745
746
747
748

    wapp-mimetype text/html
    wapp-trim {
      <h1>Wapp Application Error</h1>
      <pre>%html($::errorInfo)</pre>
    }
    dict unset wapp .new-cookies
  }
  wapp-before-reply-hook

  # Transmit the HTTP reply
  #
  if {$chan=="stdout"} {
    puts $chan "Status: [dict get $wapp .reply-code]\r"
  } else {
    puts $chan "HTTP/1.1 [dict get $wapp .reply-code]\r"
︙︙
790
791
792
793
794
795
796









797
798
799
800
801
802
803

}

# This routine runs just prior to request-handler dispatch.  The
# default implementation is a no-op, but applications can override
# to do additional transformations or checks.
#
proc wapp-before-dispatch-hook {} {return}










# Process a single CGI request
#
proc wappInt-handle-cgi-request {} {
  global wapp env
  foreach key [array names env {[A-Z]*}] {dict set wapp $key $env($key)}
  set len 0








>
>
>
>
>
>
>
>
>








791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813

}

# This routine runs just prior to request-handler dispatch.  The
# default implementation is a no-op, but applications can override
# to do additional transformations or checks.
#
proc wapp-before-dispatch-hook {} {return}

# This routine runs after the request-handler dispatch and just
# before the reply is generated.  The default implementation is
# a no-op, but applications can override to do validation and security
# checks on the reply, such as verifying that no sensitive information
# such as an API key or password is accidentally included in the
# reply text.
#
proc wapp-before-reply-hook {} {return}

# Process a single CGI request
#
proc wappInt-handle-cgi-request {} {
  global wapp env
  foreach key [array names env {[A-Z]*}] {dict set wapp $key $env($key)}
  set len 0
︙︙