(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-Sep-87 11:28:32" |{MCS:MCS:STANFORD}<LANE>TCPTIME.;22| 10709
changes to%: (VARS TCPTIMECOMS)
previous date%: "14-Sep-87 08:59:11" |{MCS:MCS:STANFORD}<LANE>TCPTIME.;21|)
(* "
Copyright (c) 1986, 1987 by Stanford University. All rights reserved.
")
(PRETTYCOMPRINT TCPTIMECOMS)
(RPAQQ TCPTIMECOMS ((* * Common TCP and UDP Time Client and Server Functions)
(FNS RFC868.SETTIME RFC868.START.SERVER RFC868.STOP.SERVER)
(INITVARS (RFC868.TIME.PORT 37)
(RFC868.DEFAULT.PROTOCOL 'TCP))
(ADDVARS (RFC868.ASCII.OSTYPES VMS))
(* Constant adjusts Jan 1, 1901 by one year (in seconds)
since lisp will not accept Jan 1, 1900)
[DECLARE%: DONTCOPY (CONSTANTS (RFC868.START.OF.TIME (DIFFERENCE (TIMES 365 24 60
60)
(IDATE
" 1-Jan-01 00:00:00 GMT"
]
(GLOBALVARS RFC868.TIME.PORT RFC868.DEFAULT.PROTOCOL RFC868.ASCII.OSTYPES
RFC868.PROTOCOLS)
(FNS RFC868.IDATE RFC868.SETNEWTIME)
(* * TCP Time Client and Server)
(FNS TCP.SETTIME TCP.TIMESERVER)
(ADDVARS (RFC868.PROTOCOLS (TCP TCP.SETTIME TCP.TIMESERVER)))
(INITVARS TCP.TIME.HOSTS (TCP.TIME.PORT RFC868.TIME.PORT)
(TCP.SETTIME.TIMEOUT 10000))
(GLOBALVARS TCP.TIME.HOSTS TCP.TIME.PORT TCP.SETTIME.TIMEOUT)
(DECLARE%: DONTCOPY (MACROS READTIME WRITETIME))
(FILES TCP)
(* * UDP Time Client and Server)
(FNS UDP.SETTIME UDP.TIMESERVER)
(ADDVARS (RFC868.PROTOCOLS (UDP UDP.SETTIME UDP.TIMESERVER)))
(INITVARS UDP.TIME.HOSTS (UDP.TIME.PORT RFC868.TIME.PORT)
(UDP.SETTIME.TIMEOUT 10000))
(GLOBALVARS UDP.TIME.HOSTS UDP.TIME.PORT UDP.SETTIME.TIMEOUT)
(DECLARE%: DONTCOPY (MACROS UDP.APPEND.TIME GETBASETIME))
(FILES TCPUDP)))
(* * Common TCP and UDP Time Client and Server Functions)
(DEFINEQ
(RFC868.SETTIME
[LAMBDA (RETFLG PROTOCOL) (* ; "Edited 10-Sep-87 11:03 by cdl")
(* DECLARATIONS%: (RECORD SERVICE
(PROTOCOL CLIENT SERVER)))
(LET (SERVICE)
(if (SETQ SERVICE (ASSOC (OR PROTOCOL RFC868.DEFAULT.PROTOCOL)
RFC868.PROTOCOLS))
then (with SERVICE SERVICE (APPLY* CLIENT RETFLG])
(RFC868.START.SERVER
[LAMBDA (PROTOCOL ASCIIFLG) (* ; "Edited 10-Sep-87 11:03 by cdl")
(* DECLARATIONS%: (RECORD SERVICE
(PROTOCOL CLIENT SERVER)))
(LET (SERVICE)
(if [AND (SETQ SERVICE (ASSOC (OR PROTOCOL RFC868.DEFAULT.PROTOCOL)
RFC868.PROTOCOLS))
(with SERVICE SERVICE (NOT (FIND.PROCESS SERVER]
then (with SERVICE SERVICE (ADD.PROCESS `(,SERVER ,ASCIIFLG) 'RESTARTABLE T])
(RFC868.STOP.SERVER
[LAMBDA (PROTOCOL) (* ; "Edited 10-Sep-87 11:03 by cdl")
(* DECLARATIONS%: (RECORD SERVICE
(PROTOCOL CLIENT SERVER)))
(LET (SERVICE PROCESS)
(if [AND (SETQ SERVICE (ASSOC (OR PROTOCOL RFC868.DEFAULT.PROTOCOL)
RFC868.PROTOCOLS))
(with SERVICE SERVICE (SETQ PROCESS (FIND.PROCESS SERVER]
then (DEL.PROCESS PROCESS])
)
(RPAQ? RFC868.TIME.PORT 37)
(RPAQ? RFC868.DEFAULT.PROTOCOL 'TCP)
(ADDTOVAR RFC868.ASCII.OSTYPES VMS)
(* Constant adjusts Jan 1, 1901 by one year (in seconds) since lisp will not accept Jan 1, 1900)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(RPAQ RFC868.START.OF.TIME (DIFFERENCE (TIMES 365 24 60 60)
(IDATE " 1-Jan-01 00:00:00 GMT")))
[CONSTANTS (RFC868.START.OF.TIME (DIFFERENCE (TIMES 365 24 60 60)
(IDATE " 1-Jan-01 00:00:00 GMT"]
)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS RFC868.TIME.PORT RFC868.DEFAULT.PROTOCOL RFC868.ASCII.OSTYPES RFC868.PROTOCOLS)
)
(DEFINEQ
(RFC868.IDATE
[LAMBDA NIL (* ; "Edited 10-Sep-87 13:38 by cdl")
(PLUS RFC868.START.OF.TIME (IDATE])
(RFC868.SETNEWTIME
[LAMBDA (TIME RETFLG) (* ; "Edited 10-Sep-87 13:37 by cdl")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(SETQ TIME (DIFFERENCE TIME RFC868.START.OF.TIME))
(if RETFLG
then TIME
else (PRINTOUT PROMPTWINDOW T "[Time reset to " [SETTIME (GDATE TIME '(DATEFORMAT TIME.ZONE]
"]")
T])
)
(* * TCP Time Client and Server)
(DEFINEQ
(TCP.SETTIME
[LAMBDA (RETFLG) (* ; "Edited 10-Sep-87 13:20 by cdl")
(bind STREAM TIME RESULT declare%: (SPECVARS STREAM HOST) for HOST in TCP.TIME.HOSTS
when (AND (SETQ STREAM (RESETVAR \TCP.DEFAULT.USER.TIMEOUT TCP.SETTIME.TIMEOUT
(TCP.OPEN HOST TCP.TIME.PORT NIL 'ACTIVE 'INPUT T)))
[SETQ TIME (RESETLST [RESETSAVE NIL `(CLOSEF? ,STREAM]
(if (AND RFC868.ASCII.OSTYPES (MEMB (GETOSTYPE HOST)
RFC868.ASCII.OSTYPES))
then (NLSETQ (READ STREAM))
else (NLSETQ (READTIME STREAM]
(SETQ RESULT (RFC868.SETNEWTIME (CAR TIME)
RETFLG))) do (RETURN RESULT])
(TCP.TIMESERVER
[LAMBDA (ASCIIFLG) (* ; "Edited 14-Sep-87 08:58 by cdl")
(DECLARE (SPECVARS ASCIIFLG))
(bind STREAM declare%: (SPECVARS STREAM) first
(* Allow TCP to clean up old connection if this is a RESTART)
(BLOCK) while T
when (SETQ STREAM (TCP.OPEN NIL NIL TCP.TIME.PORT 'PASSIVE 'OUTPUT T))
do (RESETLST [RESETSAVE NIL `(CLOSEF? ,STREAM]
(if ASCIIFLG
then (PRINTOUT STREAM (RFC868.IDATE))
else (WRITETIME STREAM (RFC868.IDATE])
)
(ADDTOVAR RFC868.PROTOCOLS (TCP TCP.SETTIME TCP.TIMESERVER))
(RPAQ? TCP.TIME.HOSTS NIL)
(RPAQ? TCP.TIME.PORT RFC868.TIME.PORT)
(RPAQ? TCP.SETTIME.TIMEOUT 10000)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TCP.TIME.HOSTS TCP.TIME.PORT TCP.SETTIME.TIMEOUT)
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
[PUTPROPS READTIME MACRO ((STREAM)
(PLUS (LSH (BIN16 STREAM)
16)
(BIN16 STREAM]
[PUTPROPS WRITETIME MACRO ((STREAM TIME)
(BOUT16 STREAM (RSH TIME 16))
(BOUT16 STREAM (LOGAND TIME (MASK.1'S 0 16]
)
)
(FILESLOAD TCP)
(* * UDP Time Client and Server)
(DEFINEQ
(UDP.SETTIME
[LAMBDA (RETFLG) (* ; "Edited 10-Sep-87 13:20 by cdl")
(DECLARE (SPECVARS RETFLG))
(LET (SOCKET)
(DECLARE (SPECVARS SOCKET))
(RESETLST [RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET]
(bind UDP ADDRESS RESULT for HOST in UDP.TIME.HOSTS
when (AND (SETQ ADDRESS (DODIP.HOSTP HOST))
(SETQ UDP (UDP.EXCHANGE SOCKET (UDP.SETUP (\ALLOCATE.ETHERPACKET)
ADDRESS UDP.TIME.PORT 0 SOCKET
'FREE)
UDP.SETTIME.TIMEOUT))
(SETQ RESULT (RFC868.SETNEWTIME (with UDP UDP (GETBASETIME UDPCONTENTS 0
))
RETFLG))) do (RETURN RESULT])
(UDP.TIMESERVER
[LAMBDA NIL (* ; "Edited 10-Sep-87 13:04 by cdl")
(LET (SOCKET)
(DECLARE (SPECVARS SOCKET))
(RESETLST [RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET UDP.TIME.PORT]
(bind UDP while (SETQ UDP (UDP.GET SOCKET T))
do (UDP.SETUP UDP (with IP UDP IPSOURCEADDRESS)
(with UDP UDP UDPSOURCEPORT)
0 SOCKET 'FREE)
(UDP.APPEND.TIME UDP (RFC868.IDATE))
(UDP.SEND SOCKET UDP])
)
(ADDTOVAR RFC868.PROTOCOLS (UDP UDP.SETTIME UDP.TIMESERVER))
(RPAQ? UDP.TIME.HOSTS NIL)
(RPAQ? UDP.TIME.PORT RFC868.TIME.PORT)
(RPAQ? UDP.SETTIME.TIMEOUT 10000)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS UDP.TIME.HOSTS UDP.TIME.PORT UDP.SETTIME.TIMEOUT)
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
[PUTPROPS UDP.APPEND.TIME MACRO (OPENLAMBDA (UDP TIME)
(UDP.APPEND.WORD UDP (RSH TIME 16))
(UDP.APPEND.WORD UDP (LOGAND TIME (MASK.1'S 0 16]
[PUTPROPS GETBASETIME MACRO ((OFFSET BASE)
(PLUS (LSH (\GETBASE OFFSET BASE)
16)
(\GETBASE OFFSET (ADD1 BASE]
)
)
(FILESLOAD TCPUDP)
(PUTPROPS TCPTIME COPYRIGHT ("Stanford University" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2617 4432 (RFC868.SETTIME 2627 . 3164) (RFC868.START.SERVER 3166 . 3816) (
RFC868.STOP.SERVER 3818 . 4430)) (5108 5698 (RFC868.IDATE 5118 . 5283) (RFC868.SETNEWTIME 5285 . 5696)
) (5738 7386 (TCP.SETTIME 5748 . 6687) (TCP.TIMESERVER 6689 . 7384)) (8117 9840 (UDP.SETTIME 8127 .
9191) (UDP.TIMESERVER 9193 . 9838)))))
STOP