better logging & error handling in server

pull/9/head
Matthew Butterick 11 years ago
parent 4764068d98
commit 12aa680383

@ -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? " ")))

@ -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))
(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)))

@ -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

Loading…
Cancel
Save