From 12aa6803832f80ba0f8c7252f5ae85780e396c60 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 11 Oct 2013 18:41:45 -0700
Subject: [PATCH] better logging & error handling in server

---
 predicates.rkt    |  2 ++
 server-routes.rkt | 18 +++++++++++-------
 server.rkt        | 31 +++++++++++++++----------------
 3 files changed, 28 insertions(+), 23 deletions(-)

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