-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathDPUPFTPPATCH
128 lines (105 loc) · 5.62 KB
/
DPUPFTPPATCH
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
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 8-Sep-87 11:48:32" {DSK}<LISPFILES>MATT>DPUPFTPPATCH.;6 5640
changes to%: (FNS \FTP.NEGOTIATED.CONNECTION.SOCKET)
previous date%: "24-Jul-87 12:29:41" {DSK}<LISPFILES>MATT>DPUPFTPPATCH.;5)
(* "
Copyright (c) 1987 by Matt Heffron & XEROX Corporation. All rights reserved.
")
(PRETTYCOMPRINT DPUPFTPPATCHCOMS)
(RPAQQ DPUPFTPPATCHCOMS ((DECLARE%: DOCOPY FIRST (FILES DPUPFTP))
(FNS \FTP.NEGOTIATED.CONNECTION.SOCKET \FTP.OPEN.CONNECTION)
(INITVARS (*FTP.NEGOTIATED.CONNECTION.HOSTS* NIL))
(GLOBALVARS *FTP.NEGOTIATED.CONNECTION.HOSTS*)
(CONSTANTS (\PT.NEGOTIATED.CONNECTION 128)
(\PUPSOCKET.NEGOTIATED.CONNECTION 63))
(DECLARE%: DONTCOPY (FILES (LOADCOMP)
DPUPFTP))
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
DPUPFTPPATCH)))
(DECLARE%: DOCOPY FIRST
(FILESLOAD DPUPFTP)
)
(DEFINEQ
(\FTP.NEGOTIATED.CONNECTION.SOCKET
[LAMBDA (PORT)
(DECLARE (GLOBALVARS *FTP.NEGOTIATED.CONNECTION.HOSTS*))
(* ; "Edited 8-Sep-87 11:46 by Matt Heffron")
(if (ZEROP (CDR PORT))
then [CONS (CAR PORT)
(COND
((EQ (CDR PORT)
0)
\PUPSOCKET.FTP)
(T (CDR PORT]
(if (MEMB (CAR PORT)
*FTP.NEGOTIATED.CONNECTION.HOSTS*)
then (LET ((PUP (ALLOCATE.PUP))
RESULT.FTP.SOCKET NEGOTIATIONSOCKET)
(CLEARPUP PUP)
(SETQ NEGOTIATIONSOCKET (SETUPPUP PUP (CAR PORT)
\PUPSOCKET.NEGOTIATED.CONNECTION
\PT.NEGOTIATED.CONNECTION NIL NIL
'FREE))
(SENDPUP NEGOTIATIONSOCKET PUP)
(SETQ PUP (GETPUP NEGOTIATIONSOCKET 10000))
(if PUP
then (SETQ RESULT.FTP.SOCKET (fetch PUPSOURCESOCKET of PUP))
(RELEASE.PUP PUP)
else
(* ;; "Timed-out, just do it the old-fashoned way.")
(SETQ RESULT.FTP.SOCKET \PUPSOCKET.FTP))
(CONS (CAR PORT)
RESULT.FTP.SOCKET))
else
(* ;; "This is not talking to a known FTP negotiated connection host. So use the standard \PUPSOCKET.FTP.")
(CONS (CAR PORT)
\PUPSOCKET.FTP))
else
(* ;; "If they specified an explicit SOCKET in the PORT (i.e. in the HOST argument to \FTP.OPEN.CONNECTION), just return that PORT.")
PORT])
(\FTP.OPEN.CONNECTION
[LAMBDA (HOST ECHOSTREAM FAILURESTRING) (* ; "Edited 21-Jul-87 18:45 by Matt Heffron")
(LET ((PORT (BESTPUPADDRESS HOST PROMPTWINDOW))
INSTREAM)
(if [AND PORT (SETQ INSTREAM (OPENBSPSTREAM (\FTP.NEGOTIATED.CONNECTION.SOCKET PORT)
NIL
(FUNCTION \FTP.ERRORHANDLER)
NIL NIL (FUNCTION \FTP.WHENCLOSED)
(OR FAILURESTRING "Can't open FTP connection"]
then (if (TYPENAMEP INSTREAM 'STREAM)
then (SETQ INSTREAM (create FTPCONNECTION
FTPIN _ INSTREAM
FTPOUT _ (BSPOUTPUTSTREAM INSTREAM)
FTPHOST _ [\CANONICAL.HOSTNAME (COND
((LITATOM HOST)
HOST)
(T (ETHERHOSTNAME
PORT]
FTPBUSY _ T))
(if (\FTP.SENDVERSION INSTREAM ECHOSTREAM)
then (push \FTPCONNECTIONS INSTREAM)
INSTREAM
else (CLOSEBSPSTREAM (fetch FTPIN of INSTREAM)))
else INSTREAM])
)
(RPAQ? *FTP.NEGOTIATED.CONNECTION.HOSTS* NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *FTP.NEGOTIATED.CONNECTION.HOSTS*)
)
(DECLARE%: EVAL@COMPILE
(RPAQQ \PT.NEGOTIATED.CONNECTION 128)
(RPAQQ \PUPSOCKET.NEGOTIATED.CONNECTION 63)
(CONSTANTS (\PT.NEGOTIATED.CONNECTION 128)
(\PUPSOCKET.NEGOTIATED.CONNECTION 63))
)
(DECLARE%: DONTCOPY
(FILESLOAD (LOADCOMP)
DPUPFTP)
)
(PUTPROPS DPUPFTPPATCH FILETYPE :TCOMPL)
(PUTPROPS DPUPFTPPATCH MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS DPUPFTPPATCH COPYRIGHT ("Matt Heffron & XEROX Corporation" 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1140 4993 (\FTP.NEGOTIATED.CONNECTION.SOCKET 1150 . 3246) (\FTP.OPEN.CONNECTION 3248 .
4991)))))
STOP