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
|
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (require-extension syntax-case)
;; (declare (run-time-macros))
(handle-exceptions
exn
(begin
(print "Content-type: text/html")
(print "")
(print "<html> <head> <title>EXCEPTION</title> </head> <body>")
(print " QUERY_STRING is: <b> " (get-environment-variable "QUERY_STRING") " </b> <br>")
(print "<pre>")
;; (print " EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
(print-error-message exn)
(print-call-chain)
(print "</pre>")
(print "<table>")
(for-each (lambda (var)
(print "<tr><td>" (car var) "</td><td>" (cdr var) "</td></tr>"))
(get-environment-variables))
(print "</table>")
(print "</body></html>"))
(include "requirements.scm")
(declare (uses cookie))
(declare (uses html-filter))
(declare (uses misc-stml))
(declare (uses formdat))
(declare (uses stml))
(declare (uses session))
(declare (uses setup)) ;; s:session gets created here
(declare (uses sqltbl))
(declare (uses keystore))
(sdat-set-log-port! s:session ;; (current-error-port))
(open-output-file (sdat-get-logfile s:session) #:append))
(s:validate-inputs)
(session:run-actions s:session)
(sdat-set-pagedat! s:session
(append (sdat-get-pagedat s:session)
(s:call (sdat-get-toppage s:session))))
(if (eq? (sdat-get-page-type s:session) 'html) ;; default is html.
(session:cgi-out s:session)
(session:alt-out s:session))
(session:save-vars s:session)
(session:close s:session)
;; (raise-error)
;; (exit)
)
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
|
8
9
10
11
12
13
14
15
16
17
|
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (require-extension syntax-case)
;; (declare (run-time-macros))
(include "stmlcommon.scm")
(stml:main #f)
|