Rework NETTIME:
- ditch NETTIME structure; create two structures RFC867 and RFC868 instead - make the UDP versions work - comment fixes - add copyright notice
This commit is contained in:
parent
7b82bb70e0
commit
94f127d3b1
|
@ -3,61 +3,81 @@
|
||||||
;;; This file is part of the Scheme Untergrund Networking package.
|
;;; This file is part of the Scheme Untergrund Networking package.
|
||||||
|
|
||||||
;;; Copyright (c) 1998 by Eric Marsden
|
;;; Copyright (c) 1998 by Eric Marsden
|
||||||
|
;;; Copyright (c) 2003 by Mike Sperber <sperber@informatik.uni-tuebingen.de>
|
||||||
;;; For copyright information, see the file COPYING which comes with
|
;;; For copyright information, see the file COPYING which comes with
|
||||||
;;; the distribution.
|
;;; the distribution.
|
||||||
|
|
||||||
;;; Overview ========================================================
|
|
||||||
;;
|
|
||||||
;; Most Unix hosts provide a Daytime service which sends the current
|
|
||||||
;; date and time as a human-readable character string. The daytime
|
|
||||||
;; service is typically served on port 13 as both TCP and UDP.
|
|
||||||
;;
|
|
||||||
;; The Time protocol provides a site-independent, machine readable
|
|
||||||
;; date and time. A "time" consists of the number of seconds since
|
|
||||||
;; midnight on 1st January 1900. The Time service is typically served
|
|
||||||
;; on port 37 as TCP and UDP. The idea is that you can confirm your
|
|
||||||
;; system's idea of the time by polling several independent sites on
|
|
||||||
;; the network.
|
|
||||||
|
|
||||||
|
|
||||||
;;; Related work ======================================================
|
;;; Related work ======================================================
|
||||||
;;
|
;;
|
||||||
;; * Time.pm is a Perl module by Graham Barr
|
;; * Time.pm is a Perl module by Graham Barr
|
||||||
;; * rfc868 describes the Time protocol
|
;; * rfc868 describes the Time protocol
|
||||||
|
;; http://www.ietf.org/rfc/rfc868.txt
|
||||||
;; * rfc867 describes the Daytime protocol in all its glory
|
;; * rfc867 describes the Daytime protocol in all its glory
|
||||||
|
;; http://www.ietf.org/rfc/rfc867.txt
|
||||||
;; * for a genuinely useful protocol look at the Network Time Protocol
|
;; * for a genuinely useful protocol look at the Network Time Protocol
|
||||||
;; defined in rfc1305, which allows for the synchronization of clocks
|
;; defined in rfc1305, which allows for the synchronization of clocks
|
||||||
;; on networked computers.
|
;; on networked computers.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; args host protocol, where host may be an IP number or a fqdn. we
|
;; args host protocol, where host may be an IP number or a fqdn. we
|
||||||
;; subtract 70 years' worth of seconds at the end, since the time
|
;; subtract 70 years' worth of seconds at the end, since the time
|
||||||
;; protocol returns the number of seconds since 1900, whereas Unix
|
;; protocol returns the number of seconds since 1900, whereas Unix
|
||||||
;; time is since 1970.
|
;; time is since 1970.
|
||||||
(define (net-time host tcp/udp)
|
|
||||||
|
(define (rfc868-time/tcp host)
|
||||||
(let* ((hst-info (host-info host))
|
(let* ((hst-info (host-info host))
|
||||||
(srvc-info (service-info "time" "tcp"))
|
(srvc-info (service-info "time" "tcp"))
|
||||||
(sock (socket-connect protocol-family/internet
|
(sock (socket-connect protocol-family/internet
|
||||||
tcp/udp
|
socket-type/stream
|
||||||
(host-info:name hst-info)
|
(host-info:name hst-info)
|
||||||
(service-info:port srvc-info)))
|
(service-info:port srvc-info)))
|
||||||
(result (read-integer (socket:inport sock))))
|
(result (read-integer (socket:inport sock))))
|
||||||
(close-socket sock)
|
(close-socket sock)
|
||||||
(- result 2208988800)))
|
(- result 2208988800)))
|
||||||
|
|
||||||
|
(define (rfc868-time/udp host . maybe-timeout)
|
||||||
|
(let* ((hst-info (host-info host))
|
||||||
|
(srvc-info (service-info "time" "udp"))
|
||||||
|
(timeout (if (pair? maybe-timeout)
|
||||||
|
(car maybe-timeout)
|
||||||
|
#f))
|
||||||
|
(socket (create-socket protocol-family/internet socket-type/datagram)))
|
||||||
|
(connect-socket socket
|
||||||
|
(internet-address->socket-address
|
||||||
|
(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))))
|
||||||
|
|
||||||
(define (net-daytime host tcp/udp)
|
(define (rfc867-daytime/tcp host)
|
||||||
(let* ((hst-info (host-info host))
|
(let* ((hst-info (host-info host))
|
||||||
(srvc-info (service-info "daytime" "tcp"))
|
(srvc-info (service-info "daytime" "tcp"))
|
||||||
(sock (socket-connect protocol-family/internet
|
(sock (socket-connect protocol-family/internet
|
||||||
tcp/udp
|
socket-type/stream
|
||||||
(host-info:name hst-info)
|
(host-info:name hst-info)
|
||||||
(service-info:port srvc-info)))
|
(service-info:port srvc-info)))
|
||||||
(result (read-string 20 (socket:inport sock))))
|
(result (read-string 20 (socket:inport sock))))
|
||||||
(close-socket sock)
|
(close-socket sock)
|
||||||
result))
|
result))
|
||||||
|
|
||||||
|
(define (rfc867-daytime/udp host . maybe-timeout)
|
||||||
|
(let* ((hst-info (host-info host))
|
||||||
|
(srvc-info (service-info "daytime" "udp"))
|
||||||
|
(timeout (if (pair? maybe-timeout)
|
||||||
|
(car maybe-timeout)
|
||||||
|
#f))
|
||||||
|
(socket (create-socket protocol-family/internet socket-type/datagram)))
|
||||||
|
(connect-socket socket
|
||||||
|
(internet-address->socket-address
|
||||||
|
(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)))
|
||||||
|
|
||||||
;; 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)
|
||||||
|
@ -71,6 +91,3 @@
|
||||||
;; what about EOF??
|
;; what about EOF??
|
||||||
(define (read-byte fd)
|
(define (read-byte fd)
|
||||||
(char->ascii (read-char fd)))
|
(char->ascii (read-char fd)))
|
||||||
|
|
||||||
|
|
||||||
;; EOF
|
|
||||||
|
|
|
@ -132,9 +132,11 @@
|
||||||
pop3-quit
|
pop3-quit
|
||||||
pop3-error?))
|
pop3-error?))
|
||||||
|
|
||||||
(define-interface nettime-interface
|
(define-interface rfc868-interface
|
||||||
(export net-time
|
(export rfc868-time/tcp rfc868-time/udp))
|
||||||
net-daytime))
|
|
||||||
|
(define-interface rfc867-interface
|
||||||
|
(export rfc867-daytime/tcp rfc867-daytime/udp))
|
||||||
|
|
||||||
(define-interface dns-interface
|
(define-interface dns-interface
|
||||||
(export dns-clear-cache! ; clears the cache
|
(export dns-clear-cache! ; clears the cache
|
||||||
|
@ -449,7 +451,8 @@
|
||||||
crlf-io)
|
crlf-io)
|
||||||
(files (lib pop3)))
|
(files (lib pop3)))
|
||||||
|
|
||||||
(define-structure nettime nettime-interface
|
(define-structures ((rfc867 rfc867-interface)
|
||||||
|
(rfc868 rfc868-interface))
|
||||||
(open scheme-with-scsh)
|
(open scheme-with-scsh)
|
||||||
(files (lib nettime)))
|
(files (lib nettime)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue