Improved connection error handling.

[scratchy.git] / scratchy.scm

diff --git a/scratchy.scm b/scratchy.scm
index df538b4..bdbdee4 100644 (file)
--- a/scratchy.scm
+++ b/scratchy.scm
@@ -20,7 +20,7 @@
 
 ;;; Global constants
 
 
 ;;; Global constants
 

-(define scratchy-version "1.0.0")
+(define scratchy-version "1.0.1")

 
 (define scratchy-footer
   (conc "\n"
 
 (define scratchy-footer
   (conc "\n"


@@ -58,24 +58,27 @@
 
 (define (server-loop listener config)
   (let-values (((in-port out-port) (tcp-accept listener)))
 
 (define (server-loop listener config)
   (let-values (((in-port out-port) (tcp-accept listener)))

-    (let* ((line (read-line in-port))
-           (selector (string-trim-both line)))
-      (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
-        (print "Accepted connection from " remote-ip
-               " on " (seconds->string))
-        (condition-case
-            (begin
-              (with-output-to-port out-port
-                (lambda ()
-                  (serve-selector (if (= (string-length selector) 0)
-                                      "/"
-                                      selector)
-                                  config)))
-              (print "... served selector '" selector "'. Closing connection."))
-          (o (exn)
-             (print-error-message o out-port)
-             (print-error-message o)
-             (print "Error while attempting to serve selector " selector ".")))))
+    (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
+      (print "Accepted connection from " remote-ip
+             " on " (seconds->string)))
+    (condition-case
+        (let* ((line (read-line in-port))
+               (selector (string-trim-both line)))
+          (condition-case
+              (begin
+                (with-output-to-port out-port
+                  (lambda ()
+                    (serve-selector (if (= (string-length selector) 0)
+                                        "/"
+                                        selector)
+                                    config)))
+                (print "... served selector '" selector "'. Closing connection."))
+            (o (exn)
+               (print-error-message o out-port)
+               (print-error-message o)
+               (print "Error while attempting to serve selector " selector "."))))
+      (o (exn)
+         (print-error-message o)))

     (close-input-port in-port)
     (close-output-port out-port))
   (server-loop listener config))
     (close-input-port in-port)
     (close-output-port out-port))
   (server-loop listener config))


@@ -314,12 +317,12 @@
          progname " -h/--help\n"
          progname " [-n/--no-footer] [-u/--user UID] [-g/--group GID] root-dir hostname [port]\n"
          "\n"
          progname " -h/--help\n"
          progname " [-n/--no-footer] [-u/--user UID] [-g/--group GID] root-dir hostname [port]\n"
          "\n"

-         "The -n option tells the server to not display a directory footer."
-         "The -u and -g can be used to set the UID and GID of the process following"
+         "The -n option tells the server to not display a directory footer.\n"
+         "The -u and -g can be used to set the UID and GID of the process following\n"

          "the creation of the TCP port listener (which often requires root)."))
 
 (define (main)
          "the creation of the TCP port listener (which often requires root)."))
 
 (define (main)

-  (let* ((progname (car (argv)))
+  (let* ((progname (pathname-file (car (argv))))

          (config (make-config '() '() 70 #t '() '())))
     (if (null? (cdr (argv)))
         (print-usage progname)
          (config (make-config '() '() 70 #t '() '())))
     (if (null? (cdr (argv)))
         (print-usage progname)