;;; Global constants
-(define scratchy-version "1.0.0")
+(define scratchy-version "1.0.1")
(define scratchy-footer
(conc "\n"
(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))
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)