diff --git a/scheme/lib/nettime.scm b/scheme/lib/nettime.scm index 92c619f..aa2228f 100644 --- a/scheme/lib/nettime.scm +++ b/scheme/lib/nettime.scm @@ -46,10 +46,18 @@ (car (host-info:addresses hst-info)) (service-info:port srvc-info))) (send-message socket "") - (select-ports timeout (socket:inport socket)) - (let ((result (read-integer (socket:inport socket)))) - (close-socket socket) - (- result 2208988800)))) + (if (null? (select-ports timeout (socket:inport socket))) + (begin + (close-socket socket) + #f) + (with-fatal-error-handler* + (lambda (result punt) + ;; we may see a "connection refused" error here + #f) + (lambda () + (let ((result (read-integer (socket:inport socket)))) + (close-socket socket) + (- result 2208988800))))))) (define (rfc867-daytime/tcp host) (let* ((hst-info (host-info host)) @@ -74,10 +82,20 @@ (car (host-info:addresses hst-info)) (service-info:port srvc-info))) (send-message socket "") - (select-ports timeout (socket:inport socket)) - (let ((result (read-string 20 (socket:inport socket)))) - (close-socket socket) - result))) + (if (null? (select-ports timeout (socket:inport socket))) + (begin + (close-socket socket) + #f) + (with-fatal-error-handler* + (lambda (result punt) + ;; we may see a "connection refused" error here + #f) + (lambda () + (call-with-values + (lambda () (receive-message socket 20)) + (lambda (result socket-address) + (close-socket socket) + result))))))) ;; read 4 bytes from fd and build an integer from them (define (read-integer fd) diff --git a/scheme/packages.scm b/scheme/packages.scm index a80a127..6a7afd0 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -453,7 +453,8 @@ (define-structures ((rfc867 rfc867-interface) (rfc868 rfc868-interface)) - (open scheme-with-scsh) + (open scheme-with-scsh + handle-fatal-error) (files (lib nettime))) (define-structure dns dns-interface