(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "15-Sep-87 11:28:32" |{MCS:MCS:STANFORD}TCPTIME.;22| 10709 changes to%: (VARS TCPTIMECOMS) previous date%: "14-Sep-87 08:59:11" |{MCS:MCS:STANFORD}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