scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

In RFC867/RFC868: work correctly if the remote server isn't there.

This commit is contained in:
sperber 2003-01-21 12:02:51 +00:00
parent 3c73d6a37f
commit e5d3139845
2 changed files with 28 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
scheme/lib/nettime.scm
View File

@ -46,10 +46,18 @@
(car (host-info:addresses hst-info)) (car (host-info:addresses hst-info))
(service-info:port srvc-info))) (service-info:port srvc-info)))
(send-message socket "") (send-message socket "")
(select-ports timeout (socket:inport socket)) (if (null? (select-ports timeout (socket:inport socket)))
(let ((result (read-integer (socket:inport socket)))) (begin
(close-socket socket) (close-socket socket)
(- result 2208988800)))) #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) (define (rfc867-daytime/tcp host)
(let* ((hst-info (host-info host)) (let* ((hst-info (host-info host))
@ -74,10 +82,20 @@
(car (host-info:addresses hst-info)) (car (host-info:addresses hst-info))
(service-info:port srvc-info))) (service-info:port srvc-info)))
(send-message socket "") (send-message socket "")
(select-ports timeout (socket:inport socket)) (if (null? (select-ports timeout (socket:inport socket)))
(let ((result (read-string 20 (socket:inport socket)))) (begin
(close-socket socket) (close-socket socket)
result))) #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 ;; read 4 bytes from fd and build an integer from them
(define (read-integer fd) (define (read-integer fd)

3
scheme/packages.scm
View File

@ -453,7 +453,8 @@
(define-structures ((rfc867 rfc867-interface) (define-structures ((rfc867 rfc867-interface)
(rfc868 rfc868-interface)) (rfc868 rfc868-interface))
(open scheme-with-scsh) (open scheme-with-scsh
handle-fatal-error)
(files (lib nettime))) (files (lib nettime)))
(define-structure dns dns-interface (define-structure dns dns-interface