(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
;; Procedures
++ concat include-javascript add-javascript debug debug-pp $session
$session-set! $ $db $db-row-obj sql-quote define-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 regex ports srfi-69 files srfi-1)
;; Units
(use posix srfi-13)
;; Eggs
(use intarweb spiffy spiffy-request-vars html-tags html-utils uri-common
http-session json spiffy-cookies)
;;; Version
(define (awful-version) "0.24")
;;; 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) (
"Access denied."))))
(define page-doctype (make-parameter ""))
(define page-css (make-parameter #f))
(define page-charset (make-parameter #f))
(define login-page-path (make-parameter "/login")) ;; don't forget no-session: #t for this page
(define main-page-path (make-parameter "/"))
(define app-root-path (make-parameter "/"))
(define valid-password? (make-parameter (lambda (user password) #f)))
(define page-template (make-parameter html-page))
(define ajax-invalid-session-message (make-parameter "Invalid session."))
(define web-repl-access-control (make-parameter (lambda () #f)))
(define web-repl-access-denied-message (make-parameter ( "Access denied.")))
(define session-inspector-access-control (make-parameter (lambda () #f)))
(define session-inspector-access-denied-message (make-parameter ( "Access denied.")))
(define enable-javascript-compression (make-parameter #f))
(define javascript-compressor (make-parameter identity))
(define page-exception-message
(make-parameter
(lambda (exn)
( "An error has accurred while processing your request."))))
(define debug-resources (make-parameter #f)) ;; usually useful for awful development debugging
(define enable-session-cookie (make-parameter #t))
(define session-cookie-name (make-parameter "awful-cookie"))
;; Parameters for internal use (but exported, since they are internally used by other eggs)
(define http-request-variables (make-parameter #f))
(define db-connection (make-parameter #f))
(define page-javascript (make-parameter ""))
(define sid (make-parameter #f))
(define db-enabled? (make-parameter #f))
;; Parameters for internal use and not exported
(define %redirect (make-parameter #f))
;; db-support parameters (set by awful- eggs)
(define missing-db-msg "Database access is not enabled (see `enable-db').")
(define db-inquirer (make-parameter (lambda (query) (error '$db missing-db-msg))))
(define db-connect (make-parameter (lambda (credentials) (error 'db-connect missing-db-msg))))
(define db-disconnect (make-parameter (lambda (connection) (error 'db-disconnect missing-db-msg))))
(define sql-quoter (make-parameter (lambda args (error 'sql-quote missing-db-msg))))
(define db-make-row-obj (make-parameter (lambda (q) (error '$db-row-obj missing-db-msg))))
;;; Misc
(define ++ string-append)
(define (concat args #!optional (sep ""))
(string-intersperse (map ->string args) sep))
(define (string->symbol* str)
(if (string? str)
(string->symbol str)
str))
(define (load-apps apps)
(set! *resources* (make-hash-table equal?))
(for-each load apps))
(define awful-start start-server)
(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 file)
(