(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