diff --git a/runserver.ss b/runserver.ss index 7b54339..57c7b1c 100644 --- a/runserver.ss +++ b/runserver.ss @@ -21,8 +21,7 @@ (display "#lang scheme\n(require \"config-example.ss\")\n(provide (all-defined-out) (all-from-out \"config-example.ss\"))" config-file-out) (close-output-port config-file-out)) (require "server.ss") (require "utilities.ss") -(ignoring-errors - '(let loop () - (server) - (display "tell clients to reregister, the server made a boo-boo") - (loop))) +(let loop () + (server) + (display "tell clients to reregister, the server made a boo-boo") + (loop)) diff --git a/server.ss b/server.ss index ba9ebad..2bcc985 100644 --- a/server.ss +++ b/server.ss @@ -41,8 +41,9 @@ ;Dispatching text (the function that actually does it) (define (dispatch name type message) (for ([port (get-output-port-list)]) - (write `(,name ,type ,message) port) - (flush-output port))) + (with-handlers (((lambda (exn) #t) (lambda (exn) (close-output-port port) #t))) + (write `(,name ,type ,message) port) + (flush-output port)))) ;The server! This could possibly be better-named. Anyway, configurable port -- ;for now assuming that we want it to just listen on every address. Right now, ;only sending of source really works. diff --git a/utilities.ss b/utilities.ss index 1c20894..161e171 100644 --- a/utilities.ss +++ b/utilities.ss @@ -85,25 +85,28 @@ "COPYING:\n\n" (string-from-text-file copying)))) ;server/daemon macro! (define-macro (define-listener-and-verifier port close? body) - `(let ([listener (tcp-listen ,port)]) - ;So it keeps going, and going, and going... - (let loop () - (let-values ([(client->me me->client) - (tcp-accept listener)]) - ;Reading the s-expression that should have been sent by a client, - ;verifying it, then processing it based on the type - (let ([data (read client->me)]) - (if (verify-data data) - (let ([name (car data)] - [type (cadr data)] - [message (caddr data)]) - ;Check what exactly they want with a cond over (eq? type ...) - (cond - ,@body)) - (begin - (write '("server" "text" "Malformed data was ignored.") me->client) - (close-output-port me->client)))) - ;Whoops, we don't want this closed sometimes! - ,(when close? '(close-output-port me->client)) - (close-input-port client->me)) - (loop)))) + `(let ([listener (tcp-listen ,port)]) + ;So it keeps going, and going, and going... + (with-handlers (((lambda (exn) #t) (lambda (exn) + (tcp-close listener)))) + (let loop () + (let-values ([(client->me me->client) + (tcp-accept listener)]) + (with-handlers (((lambda (exn) #t) (lambda (exn) (close-input-port client->me) (close-output-port me->client) #t))) + ;Reading the s-expression that should have been sent by a client, + ;verifying it, then processing it based on the type + (let ([data (read client->me)]) + (if (verify-data data) + (let ([name (car data)] + [type (cadr data)] + [message (caddr data)]) + ;Check what exactly they want with a cond over (eq? type ...) + (cond + ,@body)) + (begin + (write '("server" "text" "Malformed data was ignored.") me->client) + (close-output-port me->client)))) + ;Whoops, we don't want this closed sometimes! + ,(when close? '(close-output-port me->client)) + (close-input-port client->me)) + (loop))))))