Enabled IPv6 support.

[scratchy.git] / scratchy.scm

diff --git a/scratchy.scm b/scratchy.scm
index df538b4..6914fb6 100644 (file)
--- a/scratchy.scm
+++ b/scratchy.scm
@@ -5,7 +5,7 @@
 
 ;;; Imports
 
 
 ;;; Imports
 

-(import (chicken tcp)
+(import tcp6

         (chicken port)
         (chicken io)
         (chicken string)
         (chicken port)
         (chicken io)
         (chicken string)


@@ -20,7 +20,7 @@
 
 ;;; Global constants
 
 
 ;;; Global constants
 

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

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


@@ -42,7 +42,7 @@
 
 (define (run-server config)
   (set-buffering-mode! (current-output-port) #:line)
 
 (define (run-server config)
   (set-buffering-mode! (current-output-port) #:line)

-  (let ((listener (tcp-listen (config-port config))))
+  (let ((listener (tcp-listen (config-port config) 10 "::")))

     (print "Gopher server listening on port " (config-port config) " ...")
     (drop-privs config)
     (server-loop listener config))
     (print "Gopher server listening on port " (config-port config) " ...")
     (drop-privs config)
     (server-loop listener config))


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