From 020d3d3ede6f62a699892989a869832864f1e8a6 Mon Sep 17 00:00:00 2001 From: Thomas Hintz Date: Sat, 1 Aug 2015 11:11:16 -0700 Subject: [PATCH] Maybe fixing session issues. --- simple.scm | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/simple.scm b/simple.scm index 8a48377..17ff6e5 100644 --- a/simple.scm +++ b/simple.scm @@ -187,23 +187,36 @@ (define (define-page path contents #!key css title doctype headers charset (method 'GET) use-session) ;; for define-session-page - (##sys#check-closure contents 'define-page) + (unless (procedure? contents) (error "contents must be a procedure")) (add-resource! path ;; args is path + any procedure match args (lambda args - (sid (get-sid use-session)) - (server-refresh-session!) + ;; (sid (get-sid use-session)) + ;; (server-refresh-session!) (if (use-session? use-session) (if ((page-access-control) (car args)) (begin ;; TODO is this a duplicate of the above? - (maybe-create/refresh-session! use-session) - (send-response - body: - (with-output-to-string - (lambda () - (apply contents (cdr args)))))) + ;; (maybe-create/refresh-session! use-session) + (handle-exceptions + exn + (if ((condition-predicate 'redirect) exn) + (let ((new-uri ((condition-property-accessor 'redirect 'uri) exn))) + (send-response + body: + (string-append + "