X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scratchy.git;a=blobdiff_plain;f=scratchy.scm;h=bdbdee4386ab00bb77dd73462a682bd569d2263c;hp=df538b43a04cc8297389f2b2c78826ac56db6fa8;hb=99049adeaed71d9b6a2c53a79104acbbdc946db9;hpb=6ee5bee184695648170e6255ceea7c76cc31c581 diff --git a/scratchy.scm b/scratchy.scm index df538b4..bdbdee4 100644 --- a/scratchy.scm +++ b/scratchy.scm @@ -20,7 +20,7 @@ ;;; Global constants -(define scratchy-version "1.0.0") +(define scratchy-version "1.0.1") (define scratchy-footer (conc "\n" @@ -58,24 +58,27 @@ (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)) @@ -314,12 +317,12 @@ 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) - (let* ((progname (car (argv))) + (let* ((progname (pathname-file (car (argv)))) (config (make-config '() '() 70 #t '() '()))) (if (null? (cdr (argv))) (print-usage progname)