(FILECREATED "10-NOV-83 21:37:26" {PHYLUM}<LISP>SOURCES>NETPATCHES.;1 13533
changes to: (VARS NETPATCHESCOMS)
(FNS \FTP.GENERATEFILES))
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT NETPATCHESCOMS)
(RPAQQ NETPATCHESCOMS ((FNS \LEAF.EVENTFN \REMOVEDEVICE \LEAF.DEVICEP VIDEORATE \STARTPUP \NSINIT
\FTP.GENERATEFILES)
(INITVARS (NONLEAFHOSTS))
(GLOBALVARS NONLEAFHOSTS)))
(DEFINEQ
(\LEAF.EVENTFN
[LAMBDA (FDEV FLG) (* bvm: "10-NOV-83 21:22")
(DECLARE (GLOBALVARS \OPENFILES)) (* Called before LOGOUT etc to clean up any leaf
connections we have open)
(PROG (CONNECTION)
(SELECTQ FLG
[BEFORELOGOUT (COND
((SETQ CONNECTION (fetch DEVICEINFO of FDEV))
(\CLOSELEAFCONNECTION CONNECTION FDEV]
[(AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
(COND
((SETQ CONNECTION (fetch DEVICEINFO of FDEV))
(\SEQUIN.FLUSH.CONNECTION CONNECTION \SS.ABORT)))
(COND
((for STREAM in \OPENFILES never (EQ (fetch DEVICE of STREAM)
FDEV))
(* Association between hostname and host goes away over logout, so flush it. If there is a file open on it,
however, assume it's okay)
(\REMOVEDEVICE FDEV)))
(while (LISTP \LOOKUPFILE.HOSTINFO) bind ENTRY
do (* Flush LookUpFile info)
(COND
((fetch LOOKUPSOCKET of (SETQ ENTRY (pop \LOOKUPFILE.HOSTINFO)))
(CLOSEPUPSOCKET (fetch LOOKUPSOCKET of ENTRY]
NIL])
(\REMOVEDEVICE
[LAMBDA (DEV) (* bvm: " 3-NOV-83 23:17")
(* Removes device DEV and also any association between
any of its name and DEV)
(DECLARE (GLOBALVARS \FILEDEVICES \FILEDEVICENAMES \DEVICENAMETODEVICE))
(PROG (TEMP)
(UNINTERRUPTABLY
(while (SETQ TEMP (find PAIR in \DEVICENAMETODEVICE suchthat (EQ (CDR PAIR)
DEV)))
do (SETQ \FILEDEVICENAMES (DREMOVE (CAR TEMP)
\FILEDEVICENAMES))
(SETQ \DEVICENAMETODEVICE (DREMOVE TEMP \DEVICENAMETODEVICE)))
(SETQ \FILEDEVICES (DREMOVE DEV \FILEDEVICES)))
(RETURN DEV])
(\LEAF.DEVICEP
[LAMBDA (HOST LEAFDEV) (* bvm: "10-NOV-83 21:25")
(* * Returns the device corresponding to this HOST, or NIL if it is an illegal leaf host)
(PROG ((NAME (\CANONICAL.HOSTNAME HOST))
DEVICE SEQUIN CONN)
(RETURN (COND
((NULL NAME)
NIL)
((NULL LEAFDEV) (* Called as predicate, don't try to open one)
NAME)
((AND (NEQ NAME HOST)
(SETQ DEVICE (\GETDEVICEFROMNAME NAME T T)))
DEVICE)
([AND (NOT (MEMB HOST NONLEAFHOSTS))
(NULL (SETQ SEQUIN (\OPENLEAFCONNECTION NAME]
NIL)
((type? SEQUIN SEQUIN)
(\DEFINEDEVICE NAME
(SETQ DEVICE
(create FDEV
DEVICENAME ← NAME
FDBINABLE ← T
FDBOUTABLE ← T
FDEXTENDABLE ← T
RESETABLE ← T
RANDOMACCESSP ← T
PAGEMAPPED ← T
CLOSEFILE ←(FUNCTION \LEAF.CLOSEFILE)
DELETEFILE ←(FUNCTION \LEAF.DELETEFILE)
GETFILEINFO ←(FUNCTION \LEAF.GETFILEINFO)
OPENFILE ←(FUNCTION \LEAF.OPENFILE)
READPAGES ←(FUNCTION \LEAF.READPAGES)
WRITEPAGES ←(FUNCTION \LEAF.WRITEPAGES)
SETFILEINFO ←(FUNCTION \LEAF.SETFILEINFO)
TRUNCATEFILE ←(FUNCTION \LEAF.TRUNCATEFILE)
GETFILENAME ←(FUNCTION \LEAF.GETFILENAME)
REOPENFILE ←(FUNCTION \LEAF.REOPENFILE)
GENERATEFILES ←(FUNCTION \LEAF.GENERATEFILES)
EVENTFN ←(FUNCTION \LEAF.EVENTFN)
DIRECTORYNAMEP ←(FUNCTION \LEAF.DIRECTORYNAMEP)
HOSTNAMEP ←(FUNCTION NILL)
READP ←(FUNCTION \PAGEDREADP)
BIN ←(FUNCTION \PAGEDBIN)
BOUT ←(FUNCTION \PAGEDBOUT)
PEEKBIN ←(FUNCTION \PAGEDPEEKBIN)
BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
SETFILEPTR ←(FUNCTION \PAGEDSETFILEPTR)
GETFILEPTR ←(FUNCTION \PAGEDGETFILEPTR)
GETEOFPTR ←(FUNCTION \PAGEDGETEOFPTR)
EOFP ←(FUNCTION \PAGEDEOFP)
BLOCKIN ←(FUNCTION \PAGEDBINS)
BLOCKOUT ←(FUNCTION \PAGEDBOUTS)
RENAMEFILE ←(FUNCTION \LEAF.RENAMEFILE)
DEVICEINFO ← SEQUIN)))
DEVICE)
((AND \FTPAVAILABLE (SETQ CONN (\FTP.OPEN.CONNECTION NAME)))
(\RELEASE.FTPCONNECTION CONN)
\BSPFDEV])
(VIDEORATE
[LAMBDA (TYPE) (* bvm: " 7-NOV-83 17:28")
(DECLARE (GLOBALVARS \VIDEORATE))
(PROG1 \VIDEORATE (* Return old setting)
(AND TYPE (SETQ \VIDEORATE (SELECTC \MACHINETYPE
(\DOLPHIN (SELECTQ TYPE
((NORMAL 77)
(\DSPRATE 9 0 0)
(QUOTE NORMAL))
((TAPE 60)
(\DSPRATE 139 0 0)
(QUOTE TAPE))
(\ILLEGAL.ARG TYPE)))
(\DORADO (SELECTQ TYPE
((NORMAL 77)
(\DSPRATE 18 14 430)
(QUOTE NORMAL))
((TAPE 60)
(\DSPRATE 18 14 560)
(QUOTE TAPE))
((PHILLIPS TAPEP)
(\DSPRATE 58 25 520)
(QUOTE PHILLIPS))
(\ILLEGAL.ARG TYPE)))
(\DANDELION (SELECTQ TYPE
((NORMAL 77)
(\DEVICE.OUTPUT 14 7)
(QUOTE NORMAL))
((TAPE 60)
(\DEVICE.OUTPUT 142 7)
(QUOTE TAPE))
(\ILLEGAL.ARG TYPE)))
(QUOTE NORMAL])
(\STARTPUP
[LAMBDA (EVENT) (* bvm: "28-OCT-83 12:27")
(for SOC in \PUPSOCKETS
do (* Flush any pups waiting on existing sockets.
Not only are they stale, but they will have the wrong
NDB)
(\FLUSHPUPSOCQUEUE SOC))
(PROG ((NDB \LOCALNDBS)
(PROC (FIND.PROCESS (QUOTE \PUPGATELISTENER)))
MYHOST#)
(COND
((NULL NDB)
(SETQ \LOCALPUPNETHOST 0)
(AND PROC (DEL.PROCESS PROC))
(RETURN)))
LP [COND
((NEQ (fetch NDBPUPHOST# of NDB)
0)
(SETQ MYHOST# (fetch NDBPUPHOST# of NDB)))
(T (replace NDBPUPHOST# of NDB with (OR MYHOST# (SETQ MYHOST# (\FIND.LOCALPUPHOSTNUMBER
NDB EVENT]
(COND
((SETQ NDB (fetch NDBNEXT of NDB))
(GO LP)))
(OR MYHOST# (SETQ MYHOST# 0))
(SETQ \LOCALPUPNETHOST (create PUPADDRESS
PUPNET# ←(fetch NDBPUPNET# of \LOCALNDBS)
PUPHOST# ← MYHOST#))
(SETQ \OLDPUPHOST# MYHOST#)
[COND
(\10MBFLG (\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.3TO10)))
(T (\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.3TO10]
(\LOCATE.PUPNET 0) (* Initiate a probe to find out where we are and get
routing)
(COND
(\GATEWAYFLG (AND PROC (DEL.PROCESS PROC)))
(PROC (* Restart proc because it contains local timer that is
now garbage)
(RESTART.PROCESS PROC))
(T (ADD.PROCESS (QUOTE (\PUPGATELISTENER))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE AFTEREXIT)
\PUP.READY.EVENT)))
(\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.PUP))
(SETQ \PUP.READY T)
(NOTIFY.EVENT \PUP.READY.EVENT)
(BLOCK])
(\NSINIT
[LAMBDA (EVENT MINI) (* bvm: "28-OCT-83 13:58")
(* MINI means just enough to broadcast packets and
receive answers. Used by \LOOKUPPUPNUMBER)
(for SOC in \NSOCKETS do (\FLUSHNSOCQUEUE SOC))
(\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.XIP))
[PROG [(PROC (FIND.PROCESS (QUOTE \NSGATELISTENER]
(OR \LOCALNDBS (RETURN))
(COND
((NULL MINI)
[COND
(\3MBLOCALNDB (* If we want to talk XIPs on 3mb net, we need to be
able to handle translations)
(\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.10TO3)))
(T (\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.10TO3]
(* Initiate router probe to find out what our net is)
(\LOCATE.NSNET 0)
(COND
(\GATEWAYFLG (AND PROC (DEL.PROCESS PROC)))
(PROC (RESTART.PROCESS PROC))
(T (ADD.PROCESS (QUOTE (\NSGATELISTENER))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE AFTEREXIT)
\NS.READY.EVENT)))
(SETQ \NSFLG T]
(SETQ \NS.READY T)
(NOTIFY.EVENT \NS.READY.EVENT])
(\FTP.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS) (* bvm: "10-NOV-83 21:35")
(RESETLST (PROG (CONNECTION HOST REMOTENAME INS OUTS DESIREDPLIST CODE VERSION EXTENSION NAME
DIRECTORY NAMEBODY OSTYPE INFO)
(for TAIL on (UNPACKFILENAME PATTERN) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
[HOST (SETQ HOST (\CANONICAL.HOSTNAME (CADR TAIL]
(DIRECTORY (SETQ DIRECTORY (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
(EXTENSION (SETQ EXTENSION (CADR TAIL)))
(VERSION (SETQ VERSION (CADR TAIL)))
(RETURN)))
(SETQ OSTYPE (GETOSTYPE HOST))
(SELECTQ OSTYPE
[(TENEX VMS)
[COND
((STRPOS (QUOTE *)
NAME)
(SETQ NAME (QUOTE *]
(COND
((AND EXTENSION (STRPOS (QUOTE *)
EXTENSION))
(SETQ EXTENSION (QUOTE *]
((TOPS20 D) (* No adjustment needed for these smart systems.)
)
[(NIL IFS)
(COND
((EQ EXTENSION (QUOTE *))
(SETQ EXTENSION NIL)
(COND
((NEQ (NTHCHARCODE NAME -1)
(CHARCODE *))
(SETQ NAME (PACK* NAME (QUOTE *]
[UNIX [COND
((EQ (NTHCHARCODE DIRECTORY -1)
(CHARCODE /))
(SETQ DIRECTORY (SUBSTRING DIRECTORY 1 -2]
(SETQ DIRECTORY (L-CASE (COND
((NEQ (NTHCHARCODE DIRECTORY 1)
(CHARCODE /))
(CONCAT (QUOTE /)
DIRECTORY))
(T DIRECTORY]
NIL)
[SETQ DESIREDPLIST (CONS [LIST (QUOTE USER-NAME)
(CAR (SETQ INFO (\INTERNAL/GETPASSWORD HOST]
(CONS (LIST (QUOTE USER-PASSWORD)
(CDR INFO))
(for PROP
in (NCONC (for PROP in DESIREDPROPS
collect
(SELECTQ PROP
(BYTESIZE (QUOTE
BYTE-SIZE))
(LENGTH (QUOTE SIZE))
((CREATIONDATE
ICREATIONDATE)
(QUOTE CREATION-DATE))
((WRITEDATE IWRITEDATE)
(QUOTE WRITE-DATE))
((READDATE IREADDATE)
(QUOTE READ-DATE))
(EOLCONVENTION
(QUOTE
END-OF-LINE-CONVENTION))
PROP))
(QUOTE (DIRECTORY NAME-BODY VERSION)))
collect (LIST (QUOTE DESIRED-PROPERTY)
PROP]
[COND
((NEQ VERSION (QUOTE *))
(push DESIREDPLIST (LIST (QUOTE VERSION)
(OR VERSION (SELECTQ OSTYPE
((TENEX TOPS20)
0)
(QUOTE H]
[SETQ NAMEBODY (COND
((NULL EXTENSION)
NAME)
(T (CONCAT NAME "." EXTENSION]
[push DESIREDPLIST (LIST (QUOTE NAME-BODY)
(COND
((EQ OSTYPE (QUOTE UNIX))
(L-CASE NAMEBODY))
(T NAMEBODY]
[COND
(DIRECTORY (push DESIREDPLIST (LIST (QUOTE DIRECTORY)
DIRECTORY]
NEWCONNECTION
(OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
(RETURN))
(SETQ INS (fetch FTPIN of CONNECTION))
(SETQ OUTS (fetch FTPOUT of CONNECTION))
RETRY
(FTPPUTMARK OUTS (MARK# ENUMERATE))
(\FTP.PRINTPLIST OUTS DESIREDPLIST)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
[(\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL CODE)
(COND
((BSPOPENP INS (QUOTE INPUT))
(GO RETRY))
(T (GO NEWCONNECTION]
(T (\RELEASE.FTPCONNECTION CONNECTION)
(RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION NILL]
((MARK# HERE-IS-PLIST)
(replace FTPBUSY of CONNECTION with (SETUPTIMER \FTP.IDLE.TIMEOUT))
(* This guy gets a timer because the generator could be
aborted out of our control. Blech)
(\FTP.ASSURE.CLEANUP)
(RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \FTP.NEXTFILE)
GENFILESTATE ← CONNECTION)))
((MARK# BROKEN)
(GO NEWCONNECTION))
(RETURN (\FTPERROR CONNECTION])
)
(RPAQ? NONLEAFHOSTS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS NONLEAFHOSTS)
)
(PUTPROPS NETPATCHES COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (437 13353 (\LEAF.EVENTFN 447 . 1706) (\REMOVEDEVICE 1708 . 2464) (\LEAF.DEVICEP 2466 .
4881) (VIDEORATE 4883 . 5989) (\STARTPUP 5991 . 7948) (\NSINIT 7950 . 9196) (\FTP.GENERATEFILES 9198
. 13351)))))
STOP