(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 session-cookie-setter awful-response-headers development-mode? enable-web-repl-fancy-editor web-repl-fancy-editor-base-uri awful-listen awful-accept awful-backlog awful-listener javascript-position awful-resources-table sxml->html enable-sxml ;; 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 reload-apps link form redirect-to add-request-handler-hook! remove-request-handler-hook! set-page-title! ;; spiffy-request-vars wrapper with-request-variables true-boolean-values as-boolean as-list as-number as-alist as-vector as-hash-table as-string as-symbol nonempty ;; 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 tcp) ;; Eggs (use intarweb spiffy spiffy-request-vars html-tags html-utils uri-common http-session json spiffy-cookies regex sxml-transforms) ;;; Version (define (awful-version) "0.38.1") ;;; 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 "//ajax.googleapis.com/ajax/libs/jquery/1.8.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) (
convert-to-entities?: #t (with-output-to-string (lambda () (print-call-chain) (print-error-message exn)))) ("[" ( 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 thunk #!key dev-mode? port ip-address use-fancy-web-repl? privileged-code) (enable-web-repl-fancy-editor use-fancy-web-repl?) (when dev-mode? (development-mode? #t)) (when port (server-port port)) (when ip-address (server-bind-address ip-address)) ;; if privileged-code is provided, it is loaded before switching ;; user/group (when privileged-code (privileged-code)) (let ((listener ((awful-listener)))) (switch-user/group (spiffy-user) (spiffy-group)) (when (and (not (eq? (software-type) 'windows)) (zero? (current-effective-user-id))) (print "WARNING: awful is running with administrator privileges (not recommended)")) ;; load apps (thunk) ;; Check for invalid javascript positioning (unless (memq (javascript-position) '(top bottom)) (error 'awful-start "Invalid value for `javascript-position'. Valid ones are: `top' and `bottom'.")) (register-root-dir-handler) (register-dispatcher) (accept-loop listener (awful-accept)))) (define (get-sid #!optional force-read-sid) (and (or (enable-session) force-read-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) (let ((js (parameterize ((generate-sxml? (enable-sxml))) (map (lambda (file) (