diff --git a/predicates.rkt b/predicates.rkt index e9d101c..d06cb5a 100644 --- a/predicates.rkt +++ b/predicates.rkt @@ -219,6 +219,8 @@ (check-true (pmap-key? #f)) (check-true (pmap-key? "foo-bar")) (check-true (pmap-key? 'foo-bar)) + ; todo: should this fail? + (check-false (pmap-key? "foobar.p")) (check-false (pmap-key? "")) (check-false (pmap-key? " "))) diff --git a/server-routes.rkt b/server-routes.rkt index dfa3d74..aeabdb3 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -1,8 +1,8 @@ #lang racket/base (require racket/list racket/contract racket/rerequire racket/file racket/format xml) -(require (only-in net/url url-query url->path)) -(require (only-in web-server/http/request-structs request-uri)) -(require "world.rkt" "regenerate.rkt" "readability.rkt" "predicates.rkt") +(require (only-in net/url url-query url->path url->string)) +(require (only-in web-server/http/request-structs request-uri request-client-ip)) +(require "world.rkt" "regenerate.rkt" "readability.rkt" "predicates.rkt" "debug.rkt") (module+ test (require rackunit)) @@ -72,8 +72,8 @@ -(define/contract (route-index pollen-file-root) - (complete-path? . -> . xexpr?) +(define/contract (route-index) + (-> xexpr?) ;; This function generates the Pollen dashboard. ;; First, generate some lists of files. @@ -147,5 +147,9 @@ ; default route -(define (route-default path #:force force-value) - (regenerate path #:force force-value)) \ No newline at end of file +(define (route-default req) + (define request-url (request-uri req)) + (define path (reroot-path (url->path request-url) pollen-file-root)) + (define force (equal? (get-query-value request-url 'force) "true")) + (with-handlers ([exn:fail? (λ(e) (message "Default route ignoring" (url->string request-url)))]) + (regenerate path #:force force))) \ No newline at end of file diff --git a/server.rkt b/server.rkt index fca1b29..15c3e76 100755 --- a/server.rkt +++ b/server.rkt @@ -1,42 +1,41 @@ -#! /Applications/Racket/bin/racket #lang web-server (require web-server/servlet-env) (require web-server/dispatch web-server/dispatchers/dispatch) (require xml) -(require "server-routes.rkt" "predicates.rkt") +(require "server-routes.rkt" "predicates.rkt" "debug.rkt") -(displayln "Pollen server starting..." (current-error-port)) +(message "Pollen server starting...") +(message "Racket version" (version)) + +(define (logger req) + (message (url->string (request-uri req)) "from" (request-client-ip req))) (define/contract (route-wrapper route-proc) - ;; todo: make better contract for return value (procedure? . -> . procedure?) (λ(req string-arg) - (define filename string-arg) + (logger req) + (define filename string-arg) (response/xexpr (route-proc (build-path pollen-file-root filename))))) (define-values (start url) (dispatch-rules - [("start") (λ(req) (response/xexpr (route-index pollen-file-root)))] + [("start") (λ(req) + (logger req) + (response/xexpr (route-index)))] [("source" (string-arg)) (route-wrapper route-source)] [("xexpr" (string-arg)) (route-wrapper route-xexpr)] [("raw" (string-arg)) (route-wrapper route-raw-html)] [("html" (string-arg)) (route-wrapper route-html)] [else (λ(req) ;; because it's the "else" route, can't use string-arg matcher - (define request-url (request-uri req)) - ;; /inform is a magic request that must be allowed to pass through - (if (not (equal? (url->string request-url) "/shit")) - (let ([path (reroot-path (url->path request-url) pollen-file-root)] - [force (equal? (get-query-value request-url 'force) "true")]) - (route-default path #:force force)) - (map (λ(x) (displayln x (current-error-port))) - (list (request-uri req) (request-host-ip req) (request-host-port req) (request-client-ip req)))) + (logger req) + (route-default req) (next-dispatcher))])) -(displayln "Ready to rock" (current-error-port)) +(message "Ready to rock") (serve/servlet start - #:port 8080 + #:port 8088 #:listen-ip #f #:servlet-regexp #rx"" ; respond to top level #:command-line? #t