-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathTCPTIME
243 lines (197 loc) · 10.8 KB
/
TCPTIME
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
(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