︙ | | |
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
-
+
-
-
+
+
|
;;
(defstruct sdat
;; database
(dbtype 'pg)
(dbinit #f)
(conn #f)
;; page info
(page "home")
(page "index")
(page-type 'html)
(toppage "home")
(curr-page "home")
(toppage "index")
(curr-page "index")
(content-type "Content-type: text/html; charset=iso-8859-1\n\n")
;; forms and variables
(formdat #f)
(params '())
(path-params '())
(session-key #f)
(pagedat '())
|
︙ | | |
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
|
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
|
-
+
-
+
|
;; Usage: (s:get-err s:big)
(define (s:get-err wrapperfunc)
(let ((errmsg (sdat-curr-err s:session)))
(if errmsg ((if wrapperfunc
wrapperfunc
s:strong) errmsg) '())))
(define (stml:cgi-session session)
(define (stml:cgi-session session #!optional (configf #f))
;; (session:initialize session)
(session:setup session)
(session:setup session configf)
(session:get-vars session)
(sdat-log-port-set! session ;; (current-error-port))
(open-output-file (sdat-logfile session) #:append))
(s:validate-inputs)
(change-directory (sdat-sroot session))
(session:run-actions session)
|
︙ | | |
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
|
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
|
-
+
|
(s:html (s:head
(s:title err)
(s:body
(s:h1 "ERROR")
(s:p err)))))))
(define (stml:main proc)
(define (stml:main proc #!optional (configf #f))
(handle-exceptions
exn
(if (sdat-debug-mode s:session)
(begin
(print "Content-type: text/html")
(print "")
(print "<html> <head> <title>EXCEPTION</title> </head> <body>")
|
︙ | | |
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
|
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
|
-
+
|
;; (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>")))
(if proc (proc s:session) (stml:cgi-session s:session))
(if proc (proc s:session) (stml:cgi-session s:session configf))
;; (raise-error)
;; (exit)
))
;; find out if we are in debugmode
(define (s:debug-mode?)
(sdat-debug-mode s:session))
|
︙ | | |