(module awful (;; Parameters awful-apps debug-file debug-db-query? debug-db-query-prefix db-credentials ajax-library enable-ajax ajax-namespace enable-session page-access-control page-access-denied-message page-doctype page-css page-charset login-page-path main-page-path app-root-path valid-password? page-template ajax-invalid-session-message web-repl-access-control web-repl-access-denied-message session-inspector-access-control session-inspector-access-denied-message page-exception-message http-request-variables db-connection page-javascript sid enable-javascript-compression javascript-compressor debug-resources enable-session-cookie session-cookie-name awful-response-headers development-mode? enable-web-repl-fancy-editor web-repl-fancy-editor-base-uri ;; Procedures ++ concat include-javascript add-javascript debug debug-pp $session $session-set! $ $db $db-row-obj sql-quote define-page undefine-page define-session-page ajax ajax-link periodical-ajax login-form define-login-trampoline enable-web-repl enable-session-inspector awful-version load-apps link form redirect-to ;; Required by the awful server add-resource! register-dispatcher register-root-dir-handler awful-start ;; Required by db-support eggs db-enabled? db-inquirer db-connect db-disconnect sql-quoter db-make-row-obj ) ; end export list (import scheme chicken data-structures utils extras ports srfi-69 files srfi-1) ;; Units (use posix srfi-13 regex) ;; Eggs (use intarweb spiffy spiffy-request-vars html-tags html-utils uri-common http-session json spiffy-cookies) ;;; Version (define (awful-version) "0.27") ;;; Parameters ;; User-configurable parameters (define awful-apps (make-parameter '())) (define debug-file (make-parameter #f)) (define debug-db-query? (make-parameter #t)) (define debug-db-query-prefix (make-parameter "")) (define db-credentials (make-parameter #f)) (define ajax-library (make-parameter "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js")) (define enable-ajax (make-parameter #f)) (define ajax-namespace (make-parameter "ajax")) (define enable-session (make-parameter #f)) (define page-access-control (make-parameter (lambda (path) #t))) (define page-access-denied-message (make-parameter (lambda (path) (
"The following awful apps have been reloaded on "
(seconds->string (current-seconds)))
(itemize (map "[" ( href: (or (%web-repl-path) "/web-repl") "Web REPL") "]"
(if (enable-session)
(++ " [" ( href: (or (%session-inspector-path) "/session-inspector")
"Session inspector") "]")
"")))))
;; If web-repl has not been activated, activate it allowing access
;; to the localhost at least (`web-repl-access-control' can be
;; used to provide more permissive control)
(unless (%web-repl-path)
(let ((old-access-control (web-repl-access-control)))
(web-repl-access-control
(lambda ()
(or (old-access-control)
(equal? (remote-address) "127.0.0.1")))))
(enable-web-repl "/web-repl"))
;; If session-inspector has not been activated, and if
;; `enable-session' is #t, activate it allowing access to the
;; localhost at least (`session-inspector-access-control' can be
;; used to provide more permissive control)
(when (and (enable-session) (not (%session-inspector-path)))
(let ((old-access-control (session-inspector-access-control)))
(session-inspector-access-control
(lambda ()
(or (old-access-control)
(equal? (remote-address) "127.0.0.1"))))
(enable-session-inspector "/session-inspector")))
;; The reload page
(define-reload-page))
(define (awful-start #!key dev-mode? port ip-address use-fancy-web-repl?)
(enable-web-repl-fancy-editor use-fancy-web-repl?)
(when dev-mode? (development-mode-actions))
;; Start Spiffy
(start-server port: (or port (server-port))
bind-address: (or ip-address (server-bind-address))))
(define (get-sid)
(if (enable-session-cookie)
(or (read-cookie (session-cookie-name)) ($ 'sid))
($ 'sid)))
(define (redirect-to new-uri)
;; Just set the `%redirect' internal parameter, so `run-resource' is
;; able to know where to redirect.
(%redirect new-uri))
;;; Javascript
(define (include-javascript . files)
(string-intersperse
(map (lambda (file)
( (awful-apps)))))
no-ajax: #t
title: "Awful reloaded applications"))
(define (development-mode-actions)
(development-mode? #t)
(print "Awful is running in development mode.")
(debug-log (current-error-port))
;; Print the call chain, the error message and links to the
;; web-repl and session-inspector (if enabled)
(page-exception-message
(lambda (exn)
(++ (
convert-to-entities?: #t
(with-output-to-string
(lambda ()
(print-call-chain)
(print-error-message exn))))
(