(FILECREATED "18-Dec-84 23:25:45" {ERIS}<LISPCORE>SOURCES>NSFILING.;18 74160
changes to: (FNS \NSFILING.GENERATEFILES \NSFILING.CONNECT \NSFILING.CLOSEFILE
\NSFILING.MAYBE.CREATE)
(VARS NSFILINGCOMS)
previous date: "28-Nov-84 18:01:05" {ERIS}<LISPCORE>SOURCES>NSFILING.;17)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NSFILINGCOMS)
(RPAQQ NSFILINGCOMS [(* Filing Protocol)
(COURIERPROGRAMS FILING OLDFILING)
(DECLARE: DONTCOPY (CONSTANTS * NSFILINGCONSTANTS)
(RECORDS NSFILINGSTREAM FILINGSESSION NSFILESERVER NSFILINGDEVICEINFO
\NSFILING.GENFILESTATE)
(MACROS FILING.CALL)
(GLOBALVARS \NSFILING.CONNECTIONS \NSFILING.DEVICE \NSFILING.NULL.HANDLE
\NSFILING.ATTRIBUTES \LISP.TO.NSFILING.ATTRIBUTES
\NSFILING.USEFUL.ATTRIBUTE.TYPES \NSFILING.PROGRAM.NAME
FILING.ENUMERATION.DEPTH))
(INITRECORDS FILINGSESSION)
[COMS (FNS \GET.FILING.ATTRIBUTE \PUT.FILING.ATTRIBUTE)
(PROP COURIERDEF FILING.ATTRIBUTE)
(DECLARE: EVAL@COMPILE DOCOPY
(VARS \NSFILING.NULL.HANDLE \NSFILING.ATTRIBUTES \LISP.TO.NSFILING.ATTRIBUTES
(\NSFILING.USEFUL.ATTRIBUTE.TYPES (\FILING.ATTRIBUTE.TYPE.SEQUENCE
(QUOTE (CREATED.ON FILE.ID
IS.DIRECTORY
MODIFIED.ON NAME
READ.ON
SIZE.IN.BYTES
FILE.TYPE
VERSION]
(INITVARS (FILING.ENUMERATION.DEPTH T)
(\NSFILING.LOCK (CREATE.MONITORLOCK (QUOTE NSFILING)))
(\NSFILING.CONNECTIONS NIL)
(\NSFILING.PROGRAM.NAME (QUOTE FILING)))
(FNS \GETFILINGCONNECTION \NSFILING.FINDSERVER \OPENFILINGCONNECTION \NSFILING.LOGIN
\NSFILING.SET.CONTINUANCE \CLOSEFILINGCONNECTION \NSFILING.LOGOUT \NSFILING.RESETCLOSE
\NSFILING.CLOSE.IF.ERROR \VALID.FILING.CONNECTIONP \NSFILING.CLOSE.CONNECTIONS
BREAK.NSFILING.CONNECTION)
(FNS \NSFILING.CONNECT \NSFILING.MAYBE.CREATE \PATHNAME.TO.DIRECTORY.LIST
\NSFILING.LISTVERSIONS \FILING.ATTRIBUTE.TYPE.SEQUENCE \FILING.ATTRIBUTE.TYPE
\LISP.TO.NSFILING.ATTRIBUTE)
(FNS \NSFILING.OPENFILE \NSFILING.GETFILE \NSFILING.MANIPULATE.HANDLE \NSFILING.FIND.VERSION
\NSFILING.OPENFILE.OPTIONS \NSFILING.CLOSEFILE \NSFILING.CLOSE.HANDLE \NSFILING.FULLNAME
\NSFILING.EVENTFN \NSFILING.DELETEFILE \NSFILING.HOSTNAMEP \NSFILING.DIRECTORYNAMEP
\NSFILING.GETFILENAME \NSFILING.GETFILEINFO \NSFILING.GET.ATTRIBUTES
\NSFILING.GETFILEINFO.FROM.PLIST \NSFILING.GDATE \NSFILING.SETFILEINFO
\NSFILING.GET/SETINFO \NSFILING.GENERATEFILES \NSFILING.NEXTFILE \NSFILING.FILEINFOFN
\NSFILING.GETEOFPTR)
(COMS (FNS \NSFILING.INIT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\NSFILING.INIT])
(* Filing Protocol)
(COURIERPROGRAM FILING (10 4)
TYPES
[(ATTRIBUTE.TYPE LONGCARDINAL)
(ATTRIBUTE.TYPE.SEQUENCE (SEQUENCE ATTRIBUTE.TYPE))
(ATTRIBUTE FILING.ATTRIBUTE)
(ATTRIBUTE.SEQUENCE (SEQUENCE FILING.ATTRIBUTE))
(CONTROL.TYPE (ENUMERATION (LOCK 0)
(TIMEOUT 1)))
(CONTROL.TYPE.SEQUENCE (SEQUENCE CONTROL.TYPE))
(CONTROL (CHOICE (LOCK 0 LOCK)
(TIMEOUT 1 TIMEOUT)))
(CONTROL.SEQUENCE (SEQUENCE CONTROL))
(LOCK (ENUMERATION (NONE 0)
(SHARE 1)
(EXCLUSIVE 2)))
(TIMEOUT CARDINAL)
(SCOPE.TYPE (ENUMERATION (COUNT 0)
(DIRECTION 1)
(FILTER 2)
(DEPTH 3)))
(SCOPE (CHOICE (COUNT 0 CARDINAL)
(DIRECTION 1 DIRECTION)
(FILTER 2 FILTER)
(DEPTH 4 CARDINAL)))
(SCOPE.SEQUENCE (SEQUENCE SCOPE))
(DIRECTION (ENUMERATION (FORWARD 0)
(BACKWARD 1)))
(FILTER (CHOICE (LT 0 FILTER.ATTRIBUTE)
(LE 1 FILTER.ATTRIBUTE)
(= 2 FILTER.ATTRIBUTE)
(~= 3 FILTER.ATTRIBUTE)
(GE 4 FILTER.ATTRIBUTE)
(GT 5 FILTER.ATTRIBUTE)
(AND 6 (SEQUENCE FILTER))
(OR 7 (SEQUENCE FILTER))
(NOT 8 FILTER)
(NONE 9 NIL)
(ALL 10 NIL)
(MATCHES 11 ATTRIBUTE)))
(FILTER.ATTRIBUTE (RECORD (ATTRIBUTE FILING.ATTRIBUTE)
(INTERPRETATION INTERPRETATION)))
(INTERPRETATION (ENUMERATION (NONE 0)
(BOOLEAN 1)
(CARDINAL 2)
(LONGCARDINAL 3)
(TIME 4)
(INTEGER 5)
(LONGINTEGER 6)
(STRING 7)))
(CREDENTIALS (AUTHENTICATION . CREDENTIALS))
(HANDLE (ARRAY 2 UNSPECIFIED))
(SESSION (RECORD (TOKEN (ARRAY 2 UNSPECIFIED))
(VERIFIER VERIFIER)))
(VERIFIER (AUTHENTICATION . VERIFIER))
(SIMPLE.VERIFIER (AUTHENTICATION . SIMPLE.VERIFIER))
(FILE.ID (ARRAY 5 UNSPECIFIED))
(USER (CLEARINGHOUSE . NAME))
(ORDERING (RECORD (KEY ATTRIBUTE.TYPE)
(ASCENDING BOOLEAN)
(INTERPRETATION INTERPRETATION)))
(ACCESS.LIST (RECORD (ENTRIES (SEQUENCE ACCESS.ENTRY))
(DEFAULTED BOOLEAN)))
(ACCESS.ENTRY (RECORD (KEY (CLEARINGHOUSE . NAME))
(TYPE (ENUMERATION (INDIVIDUAL 0)
(ALIAS 1)
(GROUP 2)
(OTHER 3)))
(ACCESS UNSPECIFIED)))
(ARGUMENT.PROBLEM (ENUMERATION (Illegal 0)
(Disallowed 1)
(Unreasonable 2)
(Unimplemented 3)
(Duplicated 4)
(Missing 5)))
(ACCESS.PROBLEM (ENUMERATION (AccessRightsInsufficient 0)
(AccessRightsIndeterminate 1)
(FileChanged 2)
(FileDamaged 3)
(FileInUse 4)
(FileNotFound 5)
(FileOpen 6)))
(CONNECTION.PROBLEM (ENUMERATION (NoRoute 0)
(NoResponse 1)
(TransmissionHardware 2)
(TransportTimeout 3)
(TooManyLocalConnections 4)
(TooManyRemoteConnections 5)
(MissingCourier 6)
(MissingProgram 7)
(MissingProcedure 8)
(ProtocolMismatch 9)
(ParameterInconsistency 10)
(InvalidMessage 11)
(ReturnTimedOut 12)
(Other 65535)))
(HANDLE.PROBLEM (ENUMERATION (Invalid 0)
(NullDisallowed 1)
(DirectoryRequired 2)))
(INSERTION.PROBLEM (ENUMERATION (PositionUnavailable 0)
(FileNotUnique 1)
(LoopInHierarchy 2)))
(SERVICE.PROBLEM (ENUMERATION (CannotAuthenticate 0)
(ServiceFull 1)
(ServiceUnavailable 2)
(SessionInUse 3)
(UnknownService 4)))
(SESSION.PROBLEM (ENUMERATION (TokenInvalid 0)))
(SPACE.PROBLEM (ENUMERATION (AllocationExceeded 0)
(AttributeAreaFull 1)
(MediumFull 2)))
(TRANSFER.PROBLEM (ENUMERATION (Aborted 0)
(ChecksumIncorrect 1)
(FormatIncorrect 2)
(NoRendezvous 3)
(WrongDirection 4]
PROCEDURES
((LOGON 0 ((CLEARINGHOUSE . NAME)
CREDENTIALS VERIFIER)
RETURNS
(SESSION)
REPORTS
(AUTHENTICATION.ERROR SERVICE.ERROR SESSION.ERROR UNDEFINED.ERROR))
(LOGOFF 1 (SESSION)
RETURNS NIL REPORTS (AUTHENTICATION.ERROR SERVICE.ERROR SESSION.ERROR UNDEFINED.ERROR))
(CONTINUE 19 (SESSION)
RETURNS
(CARDINAL)
REPORTS
(AUTHENTICATION.ERROR SESSION.ERROR UNDEFINED.ERROR))
(OPEN 2 (ATTRIBUTE.SEQUENCE HANDLE CONTROL.SEQUENCE SESSION)
RETURNS
(HANDLE)
REPORTS
(ACCESS.ERROR ATTRIBUTE.TYPE.ERROR ATTRIBUTE.VALUE.ERROR AUTHENTICATION.ERROR
CONTROL.TYPE.ERROR CONTROL.VALUE.ERROR HANDLE.ERROR SESSION.ERROR
UNDEFINED.ERROR))
(CLOSE 3 (HANDLE SESSION)
RETURNS NIL REPORTS (AUTHENTICATION.ERROR HANDLE.ERROR SESSION.ERROR UNDEFINED.ERROR))
(CREATE 4 (HANDLE ATTRIBUTE.SEQUENCE CONTROL.SEQUENCE SESSION)
RETURNS
(HANDLE)
REPORTS
(ACCESS.ERROR ATTRIBUTE.TYPE.ERROR ATTRIBUTE.VALUE.ERROR AUTHENTICATION.ERROR
CONTROL.TYPE.ERROR CONTROL.VALUE.ERROR HANDLE.ERROR INSERTION.ERROR
SESSION.ERROR SPACE.ERROR UNDEFINED.ERROR))
(DELETE 5 (HANDLE SESSION)
RETURNS NIL REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR HANDLE.ERROR SESSION.ERROR
UNDEFINED.ERROR))
(GET.ATTRIBUTES 8 (HANDLE ATTRIBUTE.TYPE.SEQUENCE SESSION)
RETURNS
(ATTRIBUTE.SEQUENCE)
REPORTS
(ACCESS.ERROR ATTRIBUTE.TYPE.ERROR AUTHENTICATION.ERROR HANDLE.ERROR
SESSION.ERROR UNDEFINED.ERROR))
(CHANGE.ATTRIBUTES 9 (HANDLE ATTRIBUTE.SEQUENCE SESSION)
RETURNS NIL REPORTS (ACCESS.ERROR ATTRIBUTE.TYPE.ERROR
ATTRIBUTE.VALUE.ERROR
AUTHENTICATION.ERROR HANDLE.ERROR
INSERTION.ERROR SESSION.ERROR SPACE.ERROR
UNDEFINED.ERROR))
(COPY 10 (HANDLE HANDLE ATTRIBUTE.SEQUENCE CONTROL.SEQUENCE SESSION)
RETURNS
(HANDLE)
REPORTS
(ACCESS.ERROR ATTRIBUTE.TYPE.ERROR ATTRIBUTE.VALUE.ERROR AUTHENTICATION.ERROR
CONTROL.TYPE.ERROR CONTROL.VALUE.ERROR HANDLE.ERROR INSERTION.ERROR
SESSION.ERROR SPACE.ERROR UNDEFINED.ERROR))
(MOVE 11 (HANDLE HANDLE ATTRIBUTE.SEQUENCE SESSION)
RETURNS NIL REPORTS (ACCESS.ERROR ATTRIBUTE.TYPE.ERROR ATTRIBUTE.VALUE.ERROR
AUTHENTICATION.ERROR HANDLE.ERROR INSERTION.ERROR
SESSION.ERROR SPACE.ERROR UNDEFINED.ERROR))
(STORE 12 (HANDLE ATTRIBUTE.SEQUENCE CONTROL.SEQUENCE BULK.DATA.SOURCE SESSION)
RETURNS
(HANDLE)
REPORTS
(ACCESS.ERROR ATTRIBUTE.TYPE.ERROR ATTRIBUTE.VALUE.ERROR AUTHENTICATION.ERROR
CONNECTION.ERROR CONTROL.TYPE.ERROR CONTROL.VALUE.ERROR HANDLE.ERROR
INSERTION.ERROR SESSION.ERROR SPACE.ERROR TRANSFER.ERROR UNDEFINED.ERROR))
(RETRIEVE 13 (HANDLE BULK.DATA.SINK SESSION)
RETURNS NIL REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR CONNECTION.ERROR HANDLE.ERROR
SESSION.ERROR TRANSFER.ERROR UNDEFINED.ERROR))
(REPLACE 14 (HANDLE ATTRIBUTE.SEQUENCE BULK.DATA.SOURCE SESSION)
RETURNS NIL REPORTS (ACCESS.ERROR ATTRIBUTE.TYPE.ERROR ATTRIBUTE.VALUE.ERROR
AUTHENTICATION.ERROR CONNECTION.ERROR HANDLE.ERROR
SESSION.ERROR SPACE.ERROR TRANSFER.ERROR
UNDEFINED.ERROR))
(FIND 17 (HANDLE SCOPE.SEQUENCE CONTROL.SEQUENCE SESSION)
RETURNS
(HANDLE)
REPORTS
(ACCESS.ERROR AUTHENTICATION.ERROR CONTROL.TYPE.ERROR CONTROL.VALUE.ERROR HANDLE.ERROR
SCOPE.TYPE.ERROR SCOPE.VALUE.ERROR SESSION.ERROR UNDEFINED.ERROR))
(LIST 18 (HANDLE ATTRIBUTE.TYPE.SEQUENCE SCOPE.SEQUENCE BULK.DATA.SINK SESSION)
RETURNS NIL REPORTS (ACCESS.ERROR ATTRIBUTE.TYPE.ERROR ATTRIBUTE.VALUE.ERROR
AUTHENTICATION.ERROR CONNECTION.ERROR HANDLE.ERROR
SCOPE.TYPE.ERROR SCOPE.VALUE.ERROR SESSION.ERROR
TRANSFER.ERROR UNDEFINED.ERROR)))
ERRORS
((ATTRIBUTE.TYPE.ERROR 0 (ARGUMENT.PROBLEM ATTRIBUTE.TYPE))
(ATTRIBUTE.VALUE.ERROR 1 (ARGUMENT.PROBLEM ATTRIBUTE.TYPE))
(CONTROL.TYPE.ERROR 2 (ARGUMENT.PROBLEM CONTROL.TYPE))
(CONTROL.VALUE.ERROR 3 (ARGUMENT.PROBLEM CONTROL.TYPE))
(SCOPE.TYPE.ERROR 4 (ARGUMENT.PROBLEM SCOPE.TYPE))
(SCOPE.VALUE.ERROR 5 (ARGUMENT.PROBLEM SCOPE.TYPE))
(ACCESS.ERROR 6 (ACCESS.PROBLEM))
(AUTHENTICATION.ERROR 7 ((AUTHENTICATION . PROBLEM)))
(CONNECTION.ERROR 8 (CONNECTION.PROBLEM))
(HANDLE.ERROR 9 (HANDLE.PROBLEM))
(INSERTION.ERROR 10 (INSERTION.PROBLEM))
(SERVICE.ERROR 11 (SERVICE.PROBLEM))
(SESSION.ERROR 12 (SESSION.PROBLEM))
(SPACE.ERROR 13 (SPACE.PROBLEM))
(TRANSFER.ERROR 14 (TRANSFER.PROBLEM))
(UNDEFINED.ERROR 15 (CARDINAL))))
(COURIERPROGRAM OLDFILING (10 2)
INHERITS
(FILING)
PROCEDURES
((LOGON 0 (CREDENTIALS VERIFIER)
RETURNS
(SESSION)
REPORTS
(AUTHENTICATION.ERROR SERVICE.ERROR SESSION.ERROR UNDEFINED.ERROR))))
(DECLARE: DONTCOPY
(RPAQQ NSFILINGCONSTANTS ((\NSFILING.ALL.ATTRIBUTE.TYPES (QUOTE (-1)))
(\NSFILING.DEFAULT.TIMEOUT -1)
(\FILING.UNLIMITED.COUNT -1)
(\NSFILING.NULL.FILTER (QUOTE (ALL)))
(\NSFILING.NULL.FILE.ID (QUOTE (0 0 0 0 0)))
(\NSFILING.LOWEST.VERSION 0)
(\NSFILING.HIGHEST.VERSION -1)
(\NSFILING.TYPE.BINARY 0)
(\NSFILING.TYPE.DIRECTORY 1)
(\NSFILING.TYPE.TEXT 2)))
(DECLARE: EVAL@COMPILE
(RPAQQ \NSFILING.ALL.ATTRIBUTE.TYPES (-1))
(RPAQQ \NSFILING.DEFAULT.TIMEOUT -1)
(RPAQQ \FILING.UNLIMITED.COUNT -1)
(RPAQQ \NSFILING.NULL.FILTER (ALL))
(RPAQQ \NSFILING.NULL.FILE.ID (0 0 0 0 0))
(RPAQQ \NSFILING.LOWEST.VERSION 0)
(RPAQQ \NSFILING.HIGHEST.VERSION -1)
(RPAQQ \NSFILING.TYPE.BINARY 0)
(RPAQQ \NSFILING.TYPE.DIRECTORY 1)
(RPAQQ \NSFILING.TYPE.TEXT 2)
(CONSTANTS (\NSFILING.ALL.ATTRIBUTE.TYPES (QUOTE (-1)))
(\NSFILING.DEFAULT.TIMEOUT -1)
(\FILING.UNLIMITED.COUNT -1)
(\NSFILING.NULL.FILTER (QUOTE (ALL)))
(\NSFILING.NULL.FILE.ID (QUOTE (0 0 0 0 0)))
(\NSFILING.LOWEST.VERSION 0)
(\NSFILING.HIGHEST.VERSION -1)
(\NSFILING.TYPE.BINARY 0)
(\NSFILING.TYPE.DIRECTORY 1)
(\NSFILING.TYPE.TEXT 2))
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS NSFILINGSTREAM ((NSFILING.CONNECTION (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))
(NSFILING.HANDLE (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE))
(NSFILING.ATTRIBUTES (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE))))
(DATATYPE FILINGSESSION ((FSBUSY FLAG) (* session in use)
(NIL BITS 7)
(FSPARSEDNAME POINTER) (* Canonical NSNAME of server)
(FSNAMESTRING POINTER) (* same as a Lisp string)
(FSADDRESS POINTER) (* NSADDRESS of server)
(FSCOURIERSTREAM POINTER) (* Courier stream open for this session, or NIL if
none)
(FSSESSIONHANDLE POINTER) (* Handle for this session)
(FSCURRENTPATH POINTER) (* For older servers, cached directory path)
(FSCURRENTDIRECTORY POINTER) (* Filing HANDLE for current path)
(FSCACHEDATTRIBUTES POINTER) (* Attributes from last lookup.)
(FSCONTINUANCE POINTER) (* Timer that expires when session is slated to time
out)
(FSPROTOCOLNAME POINTER) (* FILING or OLDFILING)
(FSVERSION WORD) (* Version of the protocol in use by this server)
(NIL WORD) (* Spares)
(NIL POINTER)
(NIL POINTER)
(NIL POINTER)))
(RECORD NSFILESERVER (NSFSPARSEDNAME . NSFSADDRESSES))
(RECORD NSFILINGDEVICEINFO (NSFILESERVER NSCACHE NSFILINGLOCK NSFILINGNAME . NSCONNECTIONS))
(RECORD \NSFILING.GENFILESTATE (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES))
]
(/DECLAREDATATYPE (QUOTE FILINGSESSION)
(QUOTE (FLAG (BITS 7)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER WORD WORD POINTER POINTER POINTER)))
(DECLARE: EVAL@COMPILE
(PUTPROPS FILING.CALL MACRO ((CONNECTION . ARGS)
(COURIER.CALL (fetch FSCOURIERSTREAM of CONNECTION)
(fetch FSPROTOCOLNAME of CONNECTION) . ARGS)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \NSFILING.CONNECTIONS \NSFILING.DEVICE \NSFILING.NULL.HANDLE \NSFILING.ATTRIBUTES
\LISP.TO.NSFILING.ATTRIBUTES \NSFILING.USEFUL.ATTRIBUTE.TYPES \NSFILING.PROGRAM.NAME
FILING.ENUMERATION.DEPTH)
)
)
(/DECLAREDATATYPE (QUOTE FILINGSESSION)
(QUOTE (FLAG (BITS 7)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER WORD WORD POINTER POINTER POINTER)))
(DEFINEQ
(\GET.FILING.ATTRIBUTE
[LAMBDA (STREAM PROGRAM TYPE) (* bvm: "17-Jul-84 12:43")
(* Reads a filing attribute value pair from STREAM, returning a list of two elements, (TYPE VALUE); if the
attribute is not a known attribute, TYPE is an integer and VALUE is a sequence of unspecified)
(bind (TYPE ←(COURIER.READ STREAM NIL (QUOTE LONGCARDINAL)))
VALUE for X in \NSFILING.ATTRIBUTES when (EQ (CADR X)
TYPE)
do [RETURN (LIST (CAR X)
(PROGN (\WIN STREAM) (* Skip sequence count)
(COURIER.READ STREAM PROGRAM (CADDR X]
finally (* TYPE not recognized)
(RETURN (LIST TYPE (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED])
(\PUT.FILING.ATTRIBUTE
[LAMBDA (STREAM ITEM PROGRAM TYPE) (* bvm: "17-Jul-84 12:39")
(* * Writes a filing attribute value pair to STREAM. ITEM is a list of two elements (TYPE VALUE))
(PROG ((TYPE (CAR ITEM))
(VALUE (CADR ITEM))
VALUETYPE)
[COND
((NOT (FIXP TYPE))
(for X in \NSFILING.ATTRIBUTES when (EQ (CAR X)
TYPE)
do (SETQ TYPE (CADR X))
(SETQ VALUETYPE (CADDR X))
(RETURN)
finally (ERROR "Unknown Filing attribute" TYPE]
(COURIER.WRITE STREAM TYPE NIL (QUOTE LONGCARDINAL))
(COND
(VALUETYPE (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE PROGRAM VALUETYPE))
(T (COURIER.WRITE.SEQUENCE STREAM VALUE PROGRAM (QUOTE UNSPECIFIED])
)
(PUTPROPS FILING.ATTRIBUTE COURIERDEF (\GET.FILING.ATTRIBUTE \PUT.FILING.ATTRIBUTE))
(DECLARE: EVAL@COMPILE DOCOPY
(RPAQQ \NSFILING.NULL.HANDLE (0 0))
(RPAQQ \NSFILING.ATTRIBUTES ((CHECKSUM 0 CARDINAL)
(CHILDREN.UNIQUELY.NAMED 1 BOOLEAN)
(CREATED.BY 2 USER)
(CREATED.ON 3 TIME)
(FILE.ID 4 FILE.ID)
(IS.DIRECTORY 5 BOOLEAN)
(IS.TEMPORARY 6 BOOLEAN)
(MODIFIED.BY 7 USER)
(MODIFIED.ON 8 TIME)
(NAME 9 STRING)
(NUMBER.OF.CHILDREN 10 CARDINAL)
(ORDERING 11 ORDERING)
(PARENT.ID 12 FILE.ID)
(POSITION 13 (SEQUENCE UNSPECIFIED))
(READ.BY 14 USER)
(READ.ON 15 TIME)
(SIZE.IN.BYTES 16 LONGCARDINAL)
(FILE.TYPE 17 LONGCARDINAL)
(VERSION 18 CARDINAL)
(ACCESS.LIST 19 ACCESS.LIST)
(DEFAULT.ACCESS.LIST 20 ACCESS.LIST)
(PATHNAME 21 STRING)))
(RPAQQ \LISP.TO.NSFILING.ATTRIBUTES ((IWRITEDATE MODIFIED.ON)
(IREADDATE READ.ON)
(ICREATIONDATE CREATED.ON)
(CREATIONDATE CREATED.ON)
(READDATE READ.ON)
(WRITEDATE MODIFIED.ON)
(LENGTH SIZE.IN.BYTES)
(AUTHOR CREATED.BY)
(PROTECTION ACCESS.LIST)
(SIZE SIZE.IN.BYTES)
(TYPE FILE.TYPE)
(FILETYPE FILE.TYPE)))
(RPAQ \NSFILING.USEFUL.ATTRIBUTE.TYPES (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (CREATED.ON FILE.ID
IS.DIRECTORY
MODIFIED.ON
NAME
READ.ON
SIZE.IN.BYTES
FILE.TYPE
VERSION))))
)
(RPAQ? FILING.ENUMERATION.DEPTH T)
(RPAQ? \NSFILING.LOCK (CREATE.MONITORLOCK (QUOTE NSFILING)))
(RPAQ? \NSFILING.CONNECTIONS NIL)
(RPAQ? \NSFILING.PROGRAM.NAME (QUOTE FILING))
(DEFINEQ
(\GETFILINGCONNECTION
[LAMBDA (DEVICE DORESETSAVE) (* bvm: "28-Sep-84 18:33")
(* Find an existing connection to this fileserver or
log in a new one.)
(PROG ((DEVINFO (fetch DEVICEINFO of DEVICE))
CONNECTION)
[if [SETQ CONNECTION (WITH.MONITOR (fetch NSFILINGLOCK of DEVINFO)
(bind (TAIL ←(fetch NSCONNECTIONS of DEVINFO))
CONNECTION while TAIL
unless (fetch FSBUSY of (SETQ CONNECTION
(pop TAIL)))
do (* Awkward control structure because of DREMOVE)
[COND
((\VALID.FILING.CONNECTIONP CONNECTION)
(RETURN CONNECTION))
(T (replace NSCONNECTIONS of DEVINFO
with (DREMOVE CONNECTION
(fetch NSCONNECTIONS
of DEVINFO]
finally (if (SETQ CONNECTION (\NSFILING.LOGIN DEVINFO)
)
then (push (fetch NSCONNECTIONS
of DEVINFO)
CONNECTION))
(RETURN CONNECTION]
then (COND
(DORESETSAVE (RESETSAVE NIL (LIST (if (EQ DORESETSAVE T)
then (FUNCTION \NSFILING.RESETCLOSE)
else DORESETSAVE)
CONNECTION]
(RETURN CONNECTION])
(\NSFILING.FINDSERVER
[LAMBDA (SERVERNAME) (* bvm: "20-Jul-84 12:30")
(LOOKUP.NS.SERVER SERVERNAME (QUOTE FILESERVER)
T])
(\OPENFILINGCONNECTION
[LAMBDA (CONNECTION) (* bvm: "15-Sep-84 15:14")
(* Open a Courier stream to the fileserver for this
connection, and mark the connection busy.
Returns T or NIL on success or failure.)
(PROG (STREAM)
(SPP.CLOSE (fetch FSCOURIERSTREAM of CONNECTION)
T)
[replace FSCOURIERSTREAM of CONNECTION with (SETQ STREAM
(COURIER.OPEN (fetch FSADDRESS of CONNECTION)
(QUOTE FILESERVER)
T
(PACK* (fetch NSOBJECT
of (fetch
FSPARSEDNAME
of CONNECTION))
" Filing"]
(RETURN (COND
((AND STREAM (\NSFILING.SET.CONTINUANCE CONNECTION))
(replace FSBUSY of CONNECTION with T])
(\NSFILING.LOGIN
[LAMBDA (DEVINFO) (* bvm: "28-Sep-84 20:01")
(PROG ((FILESERVER (fetch NSFILESERVER of DEVINFO))
(PROGRAM \NSFILING.PROGRAM.NAME)
ADDRESS SERVERNAME SERVERNSNAME STREAM SESSION CONNECTION CREDENTIALS NEEDLOGIN)
(SETQ SERVERNAME (MKATOM (NSNAME.TO.STRING (SETQ SERVERNSNAME (fetch NSFSPARSEDNAME
of FILESERVER))
T)))
(SETQ ADDRESS (CAR (fetch NSFSADDRESSES of FILESERVER)))
(RETURN
(if (do (if [NOT (SETQ CREDENTIALS (\INTERNAL/GETPASSWORD SERVERNAME NEEDLOGIN NIL
(AND NEEDLOGIN
"Login incorrect.")
NIL
(QUOTE NS]
then (RETURN NIL)
elseif (SETQ STREAM (COURIER.OPEN ADDRESS NIL T (fetch NSFILINGNAME
of DEVINFO)))
then (SETQ CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS CREDENTIALS))
[SETQ SESSION (if (EQ PROGRAM (QUOTE FILING))
then (COURIER.CALL STREAM PROGRAM (QUOTE LOGON)
SERVERNSNAME
(CAR CREDENTIALS)
(CDR CREDENTIALS)
(QUOTE RETURNERRORS))
else (COURIER.CALL STREAM (QUOTE OLDFILING)
(QUOTE LOGON)
(CAR CREDENTIALS)
(CDR CREDENTIALS)
(QUOTE RETURNERRORS]
(if (AND SESSION (NEQ (CAR SESSION)
(QUOTE ERROR)))
then (* Success)
(RETURN SESSION)
else (SPP.CLOSE STREAM)
(if (AND SESSION (NOT (SELECTQ (CADR SESSION)
[REJECT
(* Can't handle this call)
(if (EQ PROGRAM (QUOTE FILING))
then (SETQ PROGRAM
(QUOTE OLDFILING]
(AUTHENTICATION.ERROR (SETQ
NEEDLOGIN T))
(SERVICE.ERROR
(if (EQ (CADDR SESSION)
(QUOTE
CannotAuthenticate))
then (SETQ NEEDLOGIN T)))
NIL)))
then (ERROR (CONCAT "Error while logging on to " SERVERNAME)
(CDR SESSION))
(RETURN)))
else (printout PROMPTWINDOW T SERVERNSNAME
" not responding to connection attempt")))
then (SETQ CONNECTION
(create FILINGSESSION
FSADDRESS ← ADDRESS
FSPARSEDNAME ← SERVERNSNAME
FSNAMESTRING ← SERVERNAME
FSCOURIERSTREAM ← STREAM
FSSESSIONHANDLE ← SESSION
FSCURRENTDIRECTORY ← \NSFILING.NULL.HANDLE
FSBUSY ← T
FSPROTOCOLNAME ← PROGRAM))
(\NSFILING.SET.CONTINUANCE CONNECTION)
CONNECTION])
(\NSFILING.SET.CONTINUANCE
[LAMBDA (CONNECTION) (* bvm: "15-Sep-84 15:14")
(PROG NIL
(replace FSCONTINUANCE of CONNECTION
with (SETUPTIMER (LRSH (OR (FILING.CALL CONNECTION (QUOTE CONTINUE)
(fetch FSSESSIONHANDLE of CONNECTION)
(QUOTE NOERROR))
(RETURN))
1)
NIL
(QUOTE SECONDS)))
(RETURN T])
(\CLOSEFILINGCONNECTION
[LAMBDA (CONNECTION ABORT?) (* bvm: "17-Jul-84 16:09")
(PROG ((STREAM (fetch FSCOURIERSTREAM of CONNECTION)))
(replace FSCOURIERSTREAM of CONNECTION with NIL)
(SPP.CLOSE STREAM ABORT?)
(replace FSBUSY of CONNECTION with NIL])
(\NSFILING.LOGOUT
[LAMBDA (CONNECTION ABORT?) (* bvm: "20-Jul-84 12:23")
(NLSETQ (COND
([NOT (OR ABORT? (TIMEREXPIRED? (fetch FSCONTINUANCE of CONNECTION)
(QUOTE SECONDS))
(NULL (\OPENFILINGCONNECTION CONNECTION]
(RESETSAVE NIL (LIST (FUNCTION \NSFILING.RESETCLOSE)
CONNECTION))
(FILING.CALL CONNECTION (QUOTE LOGOFF)
(fetch FSSESSIONHANDLE of CONNECTION)
(QUOTE NOERROR])
(\NSFILING.RESETCLOSE
[LAMBDA (X) (* bvm: "16-NOV-83 17:11")
(\CLOSEFILINGCONNECTION X RESETSTATE])
(\NSFILING.CLOSE.IF.ERROR
[LAMBDA (CONNECTION) (* bvm: "19-Jul-84 11:57")
(AND RESETSTATE (\CLOSEFILINGCONNECTION CONNECTION])
(\VALID.FILING.CONNECTIONP
[LAMBDA (CONNECTION) (* bvm: "23-Aug-84 15:29")
(* true if this is a useable connection)
(COND
((TIMEREXPIRED? (fetch FSCONTINUANCE of CONNECTION)
(QUOTE SECONDS))
NIL)
([NOT (IEQP (CAR (COURIER.FETCH (FILING . SESSION)
VERIFIER of (fetch FSSESSIONHANDLE of CONNECTION)))
(HASH.PASSWORD (CDR (\INTERNAL/GETPASSWORD (fetch FSNAMESTRING of CONNECTION]
(* The user is logged in under a different name.)
(\NSFILING.LOGOUT CONNECTION)
NIL)
((\OPENFILINGCONNECTION CONNECTION) (* Reopened connection okay)
T)
(T (* This connection has timed out, or couldn't reconnect)
NIL])
(\NSFILING.CLOSE.CONNECTIONS
[LAMBDA (DEVINFO ABORT?) (* bvm: "20-Jul-84 12:22")
(WITH.MONITOR (fetch NSFILINGLOCK of DEVINFO)
(while (fetch NSCONNECTIONS of DEVINFO) do (\NSFILING.LOGOUT (pop (fetch
NSCONNECTIONS
of DEVINFO))
ABORT?])
(BREAK.NSFILING.CONNECTION
[LAMBDA (HOST) (* bvm: "28-Sep-84 19:45")
(PROG ((DEV (\GETDEVICEFROMNAME (\CANONICAL.NSHOSTNAME HOST)
T T)))
(RETURN (if DEV
then (\NSFILING.CLOSE.CONNECTIONS (fetch DEVICEINFO of DEV))
T])
)
(DEFINEQ
(\NSFILING.CONNECT
[LAMBDA (CONNECTION PATHNAME REALREQUIRED CREATE?) (* bvm: "18-Dec-84 22:33")
(* Follow the list of directories in PATHNAME and cache the handle for the final one in the connection record.
The special case when PATHNAME is NIL is equivalent to connecting to the root directory. Uses cached current path to
avoid useless reconnecting. WARNING: this may fail if there is ever more than one version of the same subdirectory
name. To fix this we could use the same hack that's in \NSFILING.GETFILE : first enumerate the versions
(also requiring the IS.DIRECTORY attribute) and then use the unique FILE.ID, but since it hasn't been a problem yet,
we don't bother.)
(PROG ((NEW.DIRLIST (OR (LISTP PATHNAME)
(\PATHNAME.TO.DIRECTORY.LIST PATHNAME)))
(OLD.DIRLIST (fetch FSCURRENTPATH of CONNECTION))
(SESSIONHANDLE (fetch FSSESSIONHANDLE of CONNECTION))
(OLD.HANDLE (fetch FSCURRENTDIRECTORY of CONNECTION))
NEW.HANDLE ADDITIONAL.DIRLIST NSPATHNAME)
(COND
((AND (EQUAL NEW.DIRLIST OLD.DIRLIST)
(OR NEW.DIRLIST (NOT REALREQUIRED)
(NEQ OLD.HANDLE \NSFILING.NULL.HANDLE)))
(* Nothing needs to be done because we're already
connected to this path.)
(RETURN T)))
(COND
((AND (CDR NEW.DIRLIST)
(EQ (fetch FSPROTOCOLNAME of CONNECTION)
(QUOTE FILING)))
[SETQ NSPATHNAME (CONCATLIST (CDR (for DIR in NEW.DIRLIST join (LIST (QUOTE /)
DIR]
(SETQ NEW.HANDLE (FILING.CALL CONNECTION (QUOTE OPEN)
(BQUOTE ((PATHNAME , NSPATHNAME)))
\NSFILING.NULL.HANDLE NIL SESSIONHANDLE (QUOTE
RETURNERRORS)))
(SELECTQ (CAR NEW.HANDLE)
(NIL (RETURN))
[ERROR (COND
((AND (EQ (CADDR NEW.HANDLE)
(QUOTE FileNotFound))
(SETQ NEW.HANDLE (\NSFILING.MAYBE.CREATE CREATE? NEW.DIRLIST
(CAR (LAST NEW.DIRLIST)
)
CONNECTION)))
(* Successfully created)
)
(T (RETURN]
NIL)
(UNINTERRUPTABLY
(SETQ OLD.HANDLE (fetch FSCURRENTDIRECTORY of CONNECTION))
(* Need to do this because recursive call to
\NSFILING.CONNECT might have changed it)
(replace FSCURRENTDIRECTORY of CONNECTION with NEW.HANDLE)
(replace FSCURRENTPATH of CONNECTION with NEW.DIRLIST))
(COND
((NEQ OLD.HANDLE \NSFILING.NULL.HANDLE) (* Close the old handle we're not using any more)
(FILING.CALL CONNECTION (QUOTE CLOSE)
OLD.HANDLE SESSIONHANDLE)))
(RETURN T)))
[COND
([AND (CDR NEW.DIRLIST)
(SETQ ADDITIONAL.DIRLIST NEW.DIRLIST)
(for OLD.DIR in OLD.DIRLIST always (STREQUAL OLD.DIR (pop ADDITIONAL.DIRLIST]
(* We're currently connected to a prefix of the desired
path, so we can save some remote calls.)
(SETQ NEW.DIRLIST ADDITIONAL.DIRLIST))
(T
(* We need to start again from the root. If we kept open the handles of all directories in the current path, we
would only have to go back to the nearest common ancestor, but it's probably not worth it.)
(COND
((NEQ OLD.HANDLE \NSFILING.NULL.HANDLE)
(FILING.CALL CONNECTION (QUOTE CLOSE)
(PROG1 OLD.HANDLE (UNINTERRUPTABLY
(replace FSCURRENTDIRECTORY of CONNECTION
with (SETQ OLD.HANDLE \NSFILING.NULL.HANDLE))
(replace FSCURRENTPATH of CONNECTION
with NIL)))
SESSIONHANDLE)))
(COND
((AND REALREQUIRED (NULL NEW.DIRLIST)) (* Caller wants handle of the root of the file system,
and can't use the "null handle" constant)
(replace FSCURRENTDIRECTORY of CONNECTION with (SETQ OLD.HANDLE
(FILING.CALL CONNECTION
(QUOTE OPEN)
NIL
\NSFILING.NULL.HANDLE NIL
SESSIONHANDLE
(QUOTE NOERROR]
(RETURN (for TAIL on NEW.DIRLIST
do (COND
((SETQ NEW.HANDLE (FILING.CALL CONNECTION (QUOTE OPEN)
[BQUOTE ((NAME , (SETQ NEW.DIR (CAR TAIL]
OLD.HANDLE NIL SESSIONHANDLE (QUOTE
RETURNERRORS)))
[COND
((EQ (CAR (LISTP NEW.HANDLE))
(QUOTE ERROR))
(COND
[(AND (NULL (CDR TAIL))
(EQ (CADDR NEW.HANDLE)
(QUOTE FileNotFound))
(SETQ NEW.HANDLE (\NSFILING.MAYBE.CREATE CREATE? NEW.DIRLIST
NEW.DIR CONNECTION T]
(T (RETURN]
(UNINTERRUPTABLY
(replace FSCURRENTDIRECTORY of CONNECTION with NEW.HANDLE)
(replace FSCURRENTPATH of CONNECTION
with (APPEND (fetch FSCURRENTPATH of CONNECTION)
(LIST NEW.DIR))))
(COND
((NEQ OLD.HANDLE \NSFILING.NULL.HANDLE)
(* Close the old handle we're not using any more)
(FILING.CALL CONNECTION (QUOTE CLOSE)
OLD.HANDLE SESSIONHANDLE)))
(SETQ OLD.HANDLE NEW.HANDLE))
(T (RETURN)))
finally (RETURN T])
(\NSFILING.MAYBE.CREATE
[LAMBDA (CREATE? DIRLST NEW.DIR CONNECTION CONNECTED) (* bvm: "18-Dec-84 22:27")
(* * Called to possibly create a nonexistent subdirectory. DIRLST is a list of directories down to the final
NEW.DIR. CONNECTED is true if CONNECTION is already connected to the penultimate dir)
(AND (SELECTQ CREATE?
[ASK (EQ (QUOTE Y)
(ASKUSER DWIMWAIT (QUOTE Y)
(CONCAT "Create subdirectory {" (fetch FSNAMESTRING of CONNECTION)
"}<"
[CONCATLIST (for DIR in DIRLST
join (LIST DIR (QUOTE >]
"? "]
(NIL NIL)
T)
(OR CONNECTED (\NSFILING.CONNECT CONNECTION (for TAIL on DIRLST collect (CAR TAIL)
while (CDR TAIL))
T T))
(FILING.CALL CONNECTION (QUOTE CREATE)
(fetch FSCURRENTDIRECTORY of CONNECTION)
(BQUOTE ((NAME , NEW.DIR)
(IS.DIRECTORY T)
(FILE.TYPE 1)))
NIL
(fetch FSSESSIONHANDLE of CONNECTION)
(QUOTE NOERROR])
(\PATHNAME.TO.DIRECTORY.LIST
[LAMBDA (PATHNAME) (* bvm: "22-Jul-84 23:11")
(* Return a list of the directory components of a
pathname. If the pathname is NIL it refers to the root
directory.)
(COND
([AND PATHNAME (OR (NEQ (CHCON1 PATHNAME)
(CHARCODE {))
(SETQ PATHNAME (FILENAMEFIELD PATHNAME (QUOTE DIRECTORY]
(for (START ← 1) bind END collect [SUBSTRING PATHNAME START (COND
((SETQ END (STRPOS ">" PATHNAME START))
(PROG1 (SUB1 END)
(SETQ START (ADD1 END]
repeatwhile END])
(\NSFILING.LISTVERSIONS
[LAMBDA (CONNECTION FILENAME DESIREDPROPS DESIREDVERSION)
(* bvm: "19-Jul-84 16:06")
(* * Enumerates the versions of FILENAME or just those versions equal to DESIREDVERSION if given.
Returned value is a list of attribute lists, containing those attributes in DESIREDPROPS)
(PROG [(SCOPE (BQUOTE (= , (COURIER.CREATE (FILING . FILTER.ATTRIBUTE)
ATTRIBUTE ←(LIST (QUOTE NAME)
FILENAME)
INTERPRETATION ←(QUOTE STRING]
[COND
((FIXP DESIREDVERSION)
(SETQ SCOPE (BQUOTE (AND (, SCOPE (= , (COURIER.CREATE (FILING . FILTER.ATTRIBUTE)
ATTRIBUTE ←(LIST (QUOTE VERSION)
DESIREDVERSION)
INTERPRETATION ←(QUOTE CARDINAL]
(RETURN (FILING.CALL CONNECTION (QUOTE LIST)
(fetch FSCURRENTDIRECTORY of CONNECTION)
DESIREDPROPS
(BQUOTE ((FILTER , SCOPE)))
(QUOTE (FILING . ATTRIBUTE.SEQUENCE))
(fetch FSSESSIONHANDLE of CONNECTION])
(\FILING.ATTRIBUTE.TYPE.SEQUENCE
[LAMBDA (ATTRIBUTETYPES) (* ecc " 3-AUG-83 16:39")
(for ATTR in ATTRIBUTETYPES collect (\FILING.ATTRIBUTE.TYPE ATTR])
(\FILING.ATTRIBUTE.TYPE
[LAMBDA (ATTR NOERRORFLG) (* bvm: " 3-May-84 11:16")
(for X in \NSFILING.ATTRIBUTES do [COND
((EQ (CAR X)
ATTR)
(RETURN (CADR X]
finally (OR NOERRORFLG (ERROR "Unknown Filing attribute" ATTR])
(\LISP.TO.NSFILING.ATTRIBUTE
[LAMBDA (ATTRIBUTE VALUE) (* bvm: "28-Sep-84 18:45")
(PROG (X)
[SELECTQ ATTRIBUTE
[WRITEDATE (SETQ ATTRIBUTE (QUOTE MODIFIED.ON))
(SETQ VALUE (OR (IDATE VALUE)
(LISPERROR "ILLEGAL ARG" VALUE]
[READDATE (SETQ ATTRIBUTE (QUOTE READ.ON))
(SETQ VALUE (OR (IDATE VALUE)
(LISPERROR "ILLEGAL ARG" VALUE]
[CREATIONDATE (SETQ ATTRIBUTE (QUOTE CREATED.ON))
(SETQ VALUE (OR (IDATE VALUE)
(LISPERROR "ILLEGAL ARG" VALUE]
[TYPE (SETQ ATTRIBUTE (QUOTE FILE.TYPE))
(SETQ VALUE (SELECTQ VALUE
(BINARY \NSFILING.TYPE.BINARY)
(DIRECTORY \NSFILING.TYPE.DIRECTORY)
(TEXT \NSFILING.TYPE.TEXT)
(NIL (* Unknown?)
(RETURN))
(LISPERROR "ILLEGAL ARG" VALUE]
(COND
((SETQ X (ASSOC ATTRIBUTE \LISP.TO.NSFILING.ATTRIBUTES))
(SETQ ATTRIBUTE (CADR X)))
((ASSOC ATTRIBUTE \NSFILING.ATTRIBUTES))
(T (RETURN]
(RETURN (LIST ATTRIBUTE VALUE])
)
(DEFINEQ
(\NSFILING.OPENFILE
[LAMBDA (FILENAME ACCESS RECOG PARAMETERS DEVICE) (* bvm: "20-Jul-84 12:32")
(\NSFILING.GETFILE DEVICE FILENAME ACCESS RECOG T NIL PARAMETERS])
(\NSFILING.GETFILE
[LAMBDA (DEVICE FILENAME ACCESS RECOG NOERROR OPTION PARAMETERS)
(* bvm: "12-Oct-84 18:09")
(* Opens FILENAME for specified ACCESS and RECOG, returning a stream. If NOERROR is non-NIL, returns NIL on errors.
If OPTION is NAME, ATTRIBUTES, or HANDLE, just return the appropriate information instead of a stream.
If OPTION is DIRECTORY, return T or NIL if FILENAME is a directory or not. If ACCESS is not NONE, then PARAMETERS
gives extra parameters for the open)
(RESETLST (PROG ((DEVINFO (fetch DEVICEINFO of DEVICE))
[RESETSAVER (COND
(OPTION (* Not going to really open the file, so close
connection on exit)
(FUNCTION \NSFILING.RESETCLOSE))
(T (* Close only on error)
(FUNCTION \NSFILING.CLOSE.IF.ERROR]
HOST DIRECTORY NAME VERSION CONNECTION CACHE DESIRED.INFO FILE.ID SESSIONHANDLE
HANDLE FILESTREAM FULLNAME)
[COND
((AND (SETQ CACHE (fetch NSCACHE of DEVINFO))
(EQ (CADAR CACHE)
FILENAME)) (* Cache hit)
(SELECTQ OPTION
(NAME (RETURN FILENAME))
(ATTRIBUTES (RETURN CACHE))
(DIRECTORY (* Should never happen)
(RETURN NIL))
NIL) (* Want to open file or at least get a handle)
(SETQ DESIRED.INFO CACHE)
(OR (SETQ CONNECTION (\GETFILINGCONNECTION DEVICE RESETSAVER))
(RETURN)))
(T (* Parse the name and go thru all this hassle)
(for TAIL on (UNPACKFILENAME.STRING FILENAME) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(DIRECTORY (SETQ DIRECTORY (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
[EXTENSION (AND (CADR TAIL)
(SETQ NAME (CONCAT NAME "." (CADR TAIL]
[VERSION (COND
([NOT (FIXP (SETQ VERSION (MKATOM (CADR TAIL]
(* Glitch in filename parser -- shouldn't be version)
(SETQ NAME (CONCAT NAME "." VERSION))
(SETQ VERSION NIL]
NIL))
[COND
((AND (NULL NAME)
(NEQ OPTION (QUOTE DIRECTORY)))
(RETURN (AND (NOT NOERROR)
(LISPERROR "BAD FILE NAME" FILENAME]
(SETQ CONNECTION (OR (\GETFILINGCONNECTION DEVICE RESETSAVER)
(RETURN)))
[COND
((EQ OPTION (QUOTE DIRECTORY)) (* Just return success or failure of attempt to follow
the directories in the pathname.)
(RETURN (\NSFILING.CONNECT CONNECTION DIRECTORY NIL (QUOTE ASK]
(COND
([NOT (\NSFILING.CONNECT CONNECTION DIRECTORY NIL
(COND
((AND (NEQ RECOG (QUOTE OLD))
(NEQ ACCESS (QUOTE INPUT)))
(QUOTE CREATE]
(GO FILE.NOT.FOUND]
(* * Find the FILE.ID of the appropriate version of the file. Uses the same algorithm that's in \FILESPEC in
MOD44IO)
(for PAIR in [OR DESIRED.INFO
(SETQ DESIRED.INFO
(OR (AND VERSION CACHE (EQ (\NSFILING.FULLNAME CONNECTION NAME
VERSION NIL T)
(CADAR CACHE))
CACHE)
(\NSFILING.FIND.VERSION CONNECTION NAME RECOG
\NSFILING.USEFUL.ATTRIBUTE.TYPES
VERSION]
do (SELECTQ (CAR PAIR)
(FILE.ID (SETQ FILE.ID (CADR PAIR)))
[VERSION (SETQ VERSION (SELECTQ RECOG
((OLD OLDEST OLD/NEW)
(CADR PAIR))
(NEW
(* Want one version higher, unless caller gave explicit
version)
[COND
((NOT VERSION)
(SETQ FILE.ID
(SETQ DESIRED.INFO NIL))
(SETQ VERSION
(ADD1 (CADR PAIR]
(* quit loop, don't want to set FILE.ID)
(RETURN))
(\ILLEGAL.ARG RECOG]
NIL))
(COND
((NOT VERSION) (* Completely new file gets version 1)
(SETQ VERSION 1)
(SETQ DESIRED.INFO NIL)))
[COND
((AND (EQ OPTION (QUOTE NAME))
(EQ RECOG (QUOTE NEW))) (* Only want name of file that doesn't exist;
we know enough now)
(RETURN (\NSFILING.FULLNAME CONNECTION NAME VERSION NIL T]
[COND
((SELECTQ OPTION
((NIL HANDLE)
T)
(NULL DESIRED.INFO)) (* We need to get an open file handle for the file.)
(SETQ SESSIONHANDLE (fetch FSSESSIONHANDLE of CONNECTION))
(OR [COND
(FILE.ID (* Try to open an existing file.)
(COND
((SETQ HANDLE (FILING.CALL CONNECTION (QUOTE OPEN)
(BQUOTE ((FILE.ID , FILE.ID)))
\NSFILING.NULL.HANDLE NIL
SESSIONHANDLE (QUOTE NOERROR)))
[COND
((NULL (CDDR DESIRED.INFO))
(* We had the FILE.ID but not the attributes?)
(SETQ DESIRED.INFO (FILING.CALL CONNECTION
(QUOTE GET.ATTRIBUTES)
HANDLE
\NSFILING.USEFUL.ATTRIBUTE.TYPES
SESSIONHANDLE]
T)))
([AND (EQ ACCESS (QUOTE OUTPUT))
(FMEMB RECOG (QUOTE (NIL NEW OLD/NEW]
(* Create a new file.)
(SETQ FILESTREAM (FILING.CALL CONNECTION (QUOTE STORE)
(fetch FSCURRENTDIRECTORY of CONNECTION)
(BQUOTE ((NAME , NAME)
(VERSION , VERSION)
,@(\NSFILING.OPENFILE.OPTIONS
PARAMETERS)))
NIL NIL SESSIONHANDLE (QUOTE
RETURNERRORS]
(GO FILE.NOT.FOUND]
[COND
((EQ (CAAR DESIRED.INFO)
(QUOTE FULLNAME))
(SETQ FULLNAME (CADAR DESIRED.INFO)))
(T (push DESIRED.INFO (LIST (QUOTE FULLNAME)
(SETQ FULLNAME (\NSFILING.FULLNAME CONNECTION NAME
VERSION NIL T]
(AND (CDR DESIRED.INFO)
(replace NSCACHE of DEVINFO with DESIRED.INFO))
[COND
(OPTION (RETURN (PROG1 (SELECTQ OPTION
(NAME FULLNAME)
(ATTRIBUTES DESIRED.INFO)
(HANDLE (APPLY* PARAMETERS CONNECTION HANDLE
(fetch FSCOURIERSTREAM
of CONNECTION)
DESIRED.INFO DEVICE))
(SHOULDNT))
(AND HANDLE (\NSFILING.CLOSE.HANDLE CONNECTION HANDLE]
(SETQ FILESTREAM (SELECTQ ACCESS
(INPUT (FILING.CALL CONNECTION (QUOTE RETRIEVE)
HANDLE NIL SESSIONHANDLE
(QUOTE RETURNERRORS)))
[OUTPUT (OR FILESTREAM (FILING.CALL CONNECTION
(QUOTE REPLACE)
HANDLE NIL NIL
SESSIONHANDLE
(QUOTE RETURNERRORS]
(LISPERROR "ILLEGAL ARG" ACCESS)))
(COND
((LISTP FILESTREAM)
(printout PROMPTWINDOW T (CADR FILESTREAM)
": "
(CDDR FILESTREAM))
(LISPERROR "FILE WON'T OPEN" FILENAME)))
(replace FULLFILENAME of FILESTREAM with FULLNAME)
(replace NSFILING.CONNECTION of FILESTREAM with CONNECTION)
(replace NSFILING.HANDLE of FILESTREAM with HANDLE)
(replace NSFILING.ATTRIBUTES of FILESTREAM with DESIRED.INFO)
(replace DEVICE of FILESTREAM with DEVICE)
(RETURN FILESTREAM)
FILE.NOT.FOUND
(COND
((NULL OPTION) (* Make sure to close connection, since we were
expecting to leave it open)
(\CLOSEFILINGCONNECTION CONNECTION)))
(RETURN (AND (NOT NOERROR)
(LISPERROR "FILE NOT FOUND" FILENAME])
(\NSFILING.MANIPULATE.HANDLE
[LAMBDA (CONNECTION HANDLE USERFN) (* bvm: "28-Sep-84 13:24")
(* * Called to perform a Filing operation in the same session as CONNECTION, but on a new Courier stream.
Applies USERFN to (CONNECTION HANDLE STREAM))
(RESETLST (PROG [(STREAM (COURIER.OPEN (fetch FSADDRESS of CONNECTION)
NIL T (fetch FSNAMESTRING of CONNECTION]
(RETURN (if STREAM
then (RESETSAVE NIL (LIST (FUNCTION SPP.CLOSE)
STREAM))
(APPLY* USERFN CONNECTION HANDLE STREAM])
(\NSFILING.FIND.VERSION
[LAMBDA (CONNECTION NAME RECOG DESIREDPROPS DESIREDVERSION)
(* bvm: "21-Jul-84 23:12")
(bind V [EXTREMAL.VERSION ←(OR DESIREDVERSION (COND
((EQ RECOG (QUOTE OLDEST))
MAX.SMALLP)
(T 0]
(NEWESTDATE ← 0)
DATE INFO DUPLICATE for ALST in (\NSFILING.LISTVERSIONS CONNECTION NAME DESIREDPROPS
DESIREDVERSION)
when [AND (SETQ V (CADR (ASSOC (QUOTE VERSION)
ALST)))
(COND
(DESIREDVERSION (EQ V DESIREDVERSION))
((EQ RECOG (QUOTE OLDEST))
(ILEQ V EXTREMAL.VERSION))
(T (IGEQ V EXTREMAL.VERSION]
do
(* NS fileservers don't support version numbers properly. As a work-around, we first list all versions of the
file. file, also getting back the internal FILE.ID for each of them. We make a pass over this list and find the
lowest and highest versions as well as the specified one, if any.)
(COND
[(AND INFO (EQ V EXTREMAL.VERSION)) (* Duplicate!)
(COND
((OR DESIREDVERSION (SELECTQ RECOG
(NEW NIL)
(OLDEST (SETQ DUPLICATE T)
NIL)
T)) (* Try disambiguating by creationdate;
for recog NEW it doesn't matter, for recog OLDEST we
panic)
(SETQ DUPLICATE T)
(COND
((AND (SETQ DATE (CADR (ASSOC (QUOTE CREATED.ON)
ALST)))
(IGREATERP DATE NEWESTDATE))
(SETQ NEWESTDATE DATE)
(SETQ INFO ALST]
(T (SETQ EXTREMAL.VERSION V)
(SETQ INFO ALST)))
finally [COND
(DUPLICATE (printout PROMPTWINDOW T "Multiple instances of file "
(\NSFILING.FULLNAME CONNECTION NAME EXTREMAL.VERSION)
" exist")
(COND
((EQ RECOG (QUOTE OLDEST))
(RETURN NIL))
(T (printout PROMPTWINDOW "; using most recent"]
(RETURN INFO])
(\NSFILING.OPENFILE.OPTIONS
[LAMBDA (ALIST) (* bvm: "17-NOV-83 16:10")
(for PAIR in ALIST bind ATTR/VAL when [AND (LISTP PAIR)
(SETQ ATTR/VAL (\LISP.TO.NSFILING.ATTRIBUTE
(CAR PAIR)
(CADR PAIR]
collect ATTR/VAL])
(\NSFILING.CLOSEFILE
[LAMBDA (FILESTREAM OPTIONS) (* bvm: "18-Dec-84 23:05")
(RESETLST (PROG ((ABORTFLG (EQMEMB (QUOTE ABORT)
OPTIONS))
NEWHANDLE HANDLE CONNECTION INFO)
[COND
((AND (SETQ NEWHANDLE (\BULK.DATA.CLOSE FILESTREAM ABORTFLG))
(NEQ (CAR NEWHANDLE)
(QUOTE ERROR)))
(SETQ HANDLE NEWHANDLE))
(T (SETQ HANDLE (fetch NSFILING.HANDLE of FILESTREAM]
(* Get the handle from the result of the STORE
(for OUTPUT) or from the handle already given to
RETRIEVE or REPLACE)
(OR (SETQ CONNECTION (fetch NSFILING.CONNECTION of FILESTREAM))
(RETURN))
(RESETSAVE NIL (LIST (FUNCTION \NSFILING.RESETCLOSE)
CONNECTION))
(COND
[(EQ (CAR NEWHANDLE)
(QUOTE ERROR))
(COND
((AND (WRITEABLE FILESTREAM)
(NOT ABORTFLG))
(ERROR (CONCAT "CLOSEF: File not written
" (CADR NEWHANDLE)
" -- "
(CADDR NEWHANDLE))
(fetch FULLFILENAME of FILESTREAM]
((AND HANDLE (SPP.OPENP (fetch FSCOURIERSTREAM of CONNECTION)))
(NLSETQ (* errorset protect this because SPP.OPENP can lie, if
we have not blocked recently)
[COND
([AND NEWHANDLE (SETQ INFO (FILING.CALL CONNECTION (QUOTE
GET.ATTRIBUTES)
NEWHANDLE
\NSFILING.USEFUL.ATTRIBUTE.TYPES
(fetch FSSESSIONHANDLE
of CONNECTION)
(QUOTE NOERROR]
(* Save attributes in case caller wants to look at
newly created file)
(replace NSCACHE of (fetch DEVICEINFO
of (fetch DEVICE of FILESTREAM))
with (CONS (LIST (QUOTE FULLNAME)
(fetch FULLFILENAME of FILESTREAM))
INFO]
(\NSFILING.CLOSE.HANDLE CONNECTION HANDLE)
(replace NSFILING.HANDLE of FILESTREAM with NIL])
(\NSFILING.CLOSE.HANDLE
[LAMBDA (CONNECTION HANDLE) (* bvm: "18-Jul-84 15:53")
(* Close the file with the given handle.)
(FILING.CALL CONNECTION (QUOTE CLOSE)
HANDLE
(fetch FSSESSIONHANDLE of CONNECTION)
(QUOTE NOERROR])
(\NSFILING.FULLNAME
[LAMBDA (CONNECTION NAMEORINFO VERSION DIRECTORYFLG ATOMFLG)
(* bvm: "29-Aug-84 12:20")
(PROG ((FILENAME "")
DIRLST FULLNAME PATHNAME)
(COND
((LISTP NAMEORINFO)
(for PAIR in NAMEORINFO do (SELECTQ (CAR PAIR)
(IS.DIRECTORY (SETQ DIRECTORYFLG (CADR PAIR)))
(VERSION (SETQ VERSION (CADR PAIR)))
[NAME (OR PATHNAME (SETQ FILENAME (CADR PAIR]
(PATHNAME (SETQ PATHNAME (CADR PAIR)))
NIL)))
(T (SETQ FILENAME NAMEORINFO)))
[COND
(PATHNAME (for CH instring PATHNAME as I from 1 bind (START ← 1)
VERS
do (SELCHARQ CH
(! (* Version marker)
(SETQ VERS I))
(/ (* Directory marker)
[push DIRLST
(SUBSTRING PATHNAME START
(if (AND VERS (EQ VERS (IDIFFERENCE I 2))
(EQ (NTHCHARCODE PATHNAME
(ADD1 VERS))
(CHARCODE 1)))
then
(* Version 1 in path, toss it out)
(SUB1 VERS)
else (SUB1 I]
(SETQ VERS)
(SETQ START (ADD1 I)))
NIL)
finally [SETQ PATHNAME
(SUBSTRING PATHNAME START
(if [AND VERS (OR (NULL DIRECTORYFLG)
(AND (EQ VERS (IDIFFERENCE I 2))
(NTHCHARCODE PATHNAME
(ADD1 VERS]
then (SUB1 VERS]
(if DIRECTORYFLG
then (push DIRLST PATHNAME)
else (SETQ FILENAME PATHNAME)))
(SETQ DIRLST (REVERSE DIRLST)))
(T (SETQ DIRLST (fetch FSCURRENTPATH of CONNECTION))
(COND
(DIRECTORYFLG (SETQ DIRLST (APPEND DIRLST (LIST FILENAME)))
(SETQ FILENAME ""]
[SETQ FULLNAME (CONCATLIST (NCONC (LIST (QUOTE {)
(fetch FSNAMESTRING of CONNECTION)
"}<")
(for DIR in DIRLST join (LIST DIR (QUOTE >)))
(LIST FILENAME (COND
((STRPOS "." FILENAME)
";")
(T ".;"))
(PROG1 (OR VERSION "")
(* For aesthetic reasons, you might want this only if
(NOT DIRECTORYFLG) but then DIR gets confused.)
]
(RETURN (COND
(ATOMFLG (MKATOM (U-CASE FULLNAME)))
(T FULLNAME])
(\NSFILING.EVENTFN
[LAMBDA (DEVICE EVENT) (* bvm: "20-Jul-84 12:30")
(SELECTQ EVENT
(BEFORELOGOUT (\NSFILING.CLOSE.CONNECTIONS (fetch DEVICEINFO of DEVICE)
T))
((AFTERLOGOUT AFTERSAVEVM AFTERMAKESYS AFTERSYSOUT)
(\REMOVEDEVICE DEVICE))
NIL])
(\NSFILING.DELETEFILE
[LAMBDA (FILENAME DEVICE) (* bvm: "28-Sep-84 19:35")
(\NSFILING.GETFILE DEVICE FILENAME (QUOTE NONE)
(QUOTE OLDEST)
T
(QUOTE HANDLE)
(FUNCTION (LAMBDA (CONNECTION HANDLE STREAM ATTRS DEVICE)
(COND
((FILING.CALL CONNECTION (QUOTE DELETE)
HANDLE
(fetch FSSESSIONHANDLE of CONNECTION)
(QUOTE RETURNERRORS))
NIL)
(T (COND
((EQ ATTRS (fetch NSCACHE of (fetch DEVICEINFO of DEVICE)))
(* Invalidate cache now that file is deleted)
(replace NSCACHE of (fetch DEVICEINFO of DEVICE) with NIL)))
(\NSFILING.FULLNAME CONNECTION ATTRS NIL NIL T])
(\NSFILING.HOSTNAMEP
[LAMBDA (HOST DEVICE) (* bvm: "24-Sep-84 17:25")
(PROG ((SERVER (AND (STRPOS ":" HOST)
(\NSFILING.FINDSERVER HOST)))
FILINGNAME FULLHOSTNAME) (* To avoid useless lookups of PUP names, require
Clearinghouse names to have a colon.)
(RETURN (COND
((NOT SERVER)
NIL)
((\GETDEVICEFROMNAME [SETQ FULLHOSTNAME
(MKATOM (U-CASE (NSNAME.TO.STRING (fetch NSFSPARSEDNAME
of SERVER)
T]
T T))
(T (SETQ FILINGNAME (PACK* (fetch NSOBJECT of (fetch NSFSPARSEDNAME of SERVER))
" Filing"))
[\DEFINEDEVICE FULLHOSTNAME
(SETQ DEVICE
(create FDEV
using \SPP.BULKDATA.DEVICE DEVICENAME ← FULLHOSTNAME
OPENFILE ←(FUNCTION \NSFILING.OPENFILE)
REOPENFILE ←(FUNCTION NILL)
CLOSEFILE ←(FUNCTION \NSFILING.CLOSEFILE)
GETFILEINFO ←(FUNCTION \NSFILING.GETFILEINFO)
SETFILEINFO ←(FUNCTION \NSFILING.SETFILEINFO)
GETEOFPTR ←(FUNCTION \NSFILING.GETEOFPTR)
DELETEFILE ←(FUNCTION \NSFILING.DELETEFILE)
HOSTNAMEP ←(FUNCTION NILL)
GETFILENAME ←(FUNCTION \NSFILING.GETFILENAME)
DIRECTORYNAMEP ←(FUNCTION \NSFILING.DIRECTORYNAMEP)
GENERATEFILES ←(FUNCTION \NSFILING.GENERATEFILES)
EVENTFN ←(FUNCTION \NSFILING.EVENTFN)
DEVICEINFO ←(create NSFILINGDEVICEINFO
NSFILESERVER ← SERVER
NSCACHE ← NIL
NSFILINGLOCK ←(
CREATE.MONITORLOCK FILINGNAME)
NSFILINGNAME ← FILINGNAME
NSCONNECTIONS ← NIL]
DEVICE])
(\NSFILING.DIRECTORYNAMEP
[LAMBDA (HOST/DIR DEVICE) (* bvm: "20-Jul-84 12:32")
(* Returns T or NIL according to whether or not HOST/DIR
is a valid host/directory specification.)
(\NSFILING.GETFILE DEVICE HOST/DIR (QUOTE NONE)
NIL T (QUOTE DIRECTORY])
(\NSFILING.GETFILENAME
[LAMBDA (NAME RECOG DEVICE) (* bvm: "20-Jul-84 12:32")
(* Returns full file name of file or NIL if not found.)
(\NSFILING.GETFILE DEVICE NAME (QUOTE NONE)
RECOG T (QUOTE NAME])
(\NSFILING.GETFILEINFO
[LAMBDA (STREAM ATTRIBUTE DEVICE) (* bvm: "28-Sep-84 18:52")
(PROG (DESIREDPROPS INFO)
(DECLARE (SPECVARS DESIREDPROPS)) (* Used by \NSFILING.GET.ATTRIBUTES)
(RETURN (COND
((EQ ATTRIBUTE (QUOTE ALL))
(SETQ DESIREDPROPS \NSFILING.ALL.ATTRIBUTE.TYPES)
(\NSFILING.GET/SETINFO DEVICE STREAM (FUNCTION \NSFILING.GET.ATTRIBUTES)))
((NULL (SETQ DESIREDPROPS (\FILING.ATTRIBUTE.TYPE (OR (CADR (ASSOC ATTRIBUTE
\LISP.TO.NSFILING.ATTRIBUTES))
ATTRIBUTE)
T)))
NIL)
(T [SETQ INFO (if (NOT (MEMB DESIREDPROPS \NSFILING.USEFUL.ATTRIBUTE.TYPES))
then (* Need to fetch this attribute explicitly)
(SETQ DESIREDPROPS (LIST DESIREDPROPS))
(\NSFILING.GET/SETINFO DEVICE STREAM
(FUNCTION \NSFILING.GET.ATTRIBUTES))
elseif (NOT (type? STREAM STREAM))
then (\NSFILING.GETFILE DEVICE STREAM (QUOTE NONE)
(QUOTE OLD)
T
(QUOTE ATTRIBUTES))
elseif (fetch NSFILING.ATTRIBUTES of STREAM)
else (replace NSFILING.ATTRIBUTES of STREAM
with (\NSFILING.GETFILE DEVICE (fetch FULLFILENAME
of STREAM)
(QUOTE NONE)
(QUOTE OLD)
T
(QUOTE ATTRIBUTES]
(\NSFILING.GETFILEINFO.FROM.PLIST INFO ATTRIBUTE])
(\NSFILING.GET.ATTRIBUTES
[LAMBDA (CONNECTION HANDLE STREAM) (* bvm: "28-Sep-84 18:12")
(* * Fetches the DESIREDPROPS of the file whose HANDLE is open on this STREAM and CONNECTION)
(DECLARE (USEDFREE DESIREDPROPS))
(COURIER.CALL (OR STREAM (fetch FSCOURIERSTREAM of CONNECTION))
(fetch FSPROTOCOLNAME of CONNECTION)
(QUOTE GET.ATTRIBUTES)
HANDLE DESIREDPROPS (fetch FSSESSIONHANDLE of CONNECTION])
(\NSFILING.GETFILEINFO.FROM.PLIST
[LAMBDA (PLIST ATTRIBUTE) (* bvm: "28-Sep-84 18:45")
(COND
(PLIST (SELECTQ ATTRIBUTE
[WRITEDATE (\NSFILING.GDATE (CADR (ASSOC (QUOTE MODIFIED.ON)
PLIST]
[READDATE (\NSFILING.GDATE (CADR (ASSOC (QUOTE READ.ON)
PLIST]
[CREATIONDATE (\NSFILING.GDATE (CADR (ASSOC (QUOTE CREATED.ON)
PLIST]
[SIZE (PROG [(LENGTH (CADR (ASSOC (QUOTE SIZE.IN.BYTES)
PLIST]
(RETURN (AND LENGTH (FOLDHI LENGTH BYTESPERPAGE]
[AUTHOR (PROG [(CHNAME (CADR (ASSOC (QUOTE CREATED.BY)
PLIST]
(RETURN (AND CHNAME (NSNAME.TO.STRING CHNAME]
[PROTECTION (PROG [(PROT (CADR (ASSOC (QUOTE ACCESS.LIST)
PLIST]
(* PROT = ((ENTRIES SEQUENCE)
(DEFAULTED BOOLEAN)))
(* (COND ((COURIER.FETCH (FILING . ACCESS.LIST)
DEFAULTED of PROT) (push RESULT "(defaulted)"))))
(RETURN (AND PROT (COURIER.FETCH (FILING . ACCESS.LIST)
ENTRIES of PROT]
(TYPE (SELECTC (CADR (ASSOC (QUOTE FILE.TYPE)
PLIST))
(\NSFILING.TYPE.DIRECTORY (QUOTE DIRECTORY))
(\NSFILING.TYPE.TEXT (QUOTE TEXT))
(NIL NIL)
(QUOTE BINARY)))
(CADR (ASSOC (OR (CADR (ASSOC ATTRIBUTE \LISP.TO.NSFILING.ATTRIBUTES))
ATTRIBUTE)
PLIST])
(\NSFILING.GDATE
[LAMBDA (DATE) (* bvm: "15-Aug-84 17:07")
(COND
((AND DATE (NOT (IEQP DATE MIN.INTEGER)))
(GDATE DATE])
(\NSFILING.SETFILEINFO
[LAMBDA (NAME.OR.STREAM ATTRIBUTE VALUE DEVICE) (* bvm: "28-Sep-84 19:33")
(PROG ((ATTR/VAL (\LISP.TO.NSFILING.ATTRIBUTE ATTRIBUTE VALUE))
RESULT)
(DECLARE (SPECVARS NAME.OR.STREAM ATTR/VAL))
(COND
((NULL ATTR/VAL) (* Unsupported attribute)
(RETURN)))
[SETQ RESULT (\NSFILING.GET/SETINFO DEVICE NAME.OR.STREAM
(FUNCTION (LAMBDA (CONNECTION HANDLE COURIERSTREAM INFO
DEVICE)
(DECLARE (USEDFREE NAME.OR.STREAM ATTR/VAL))
(COND
((COURIER.CALL (OR COURIERSTREAM
(fetch FSCOURIERSTREAM
of CONNECTION))
(fetch FSPROTOCOLNAME
of CONNECTION)
(QUOTE CHANGE.ATTRIBUTES)
HANDLE
(LIST ATTR/VAL)
(fetch FSSESSIONHANDLE
of CONNECTION)
(QUOTE RETURNERRORS)))
(T (COND
((type? STREAM NAME.OR.STREAM)
(* Set the attributes to NIL so that the next call to
GETFILEINFO will go back to the fileserver for them.)
(replace NSFILING.ATTRIBUTES of
NAME.OR.STREAM
with NIL))
([AND DEVICE
(EQ INFO (fetch NSCACHE
of (fetch DEVICEINFO
of DEVICE]
(replace NSCACHE
of (fetch DEVICEINFO of DEVICE)
with NIL)))
T]
(RETURN (if (LISTP RESULT)
then (printout PROMPTWINDOW T (if (type? STREAM NAME.OR.STREAM)
then (fetch FULLFILENAME of NAME.OR.STREAM)
else NAME.OR.STREAM)
" -- "
(CADDR RESULT))
NIL
else RESULT])
(\NSFILING.GET/SETINFO
[LAMBDA (DEVICE STREAM INFOFN) (* bvm: "28-Sep-84 18:51")
(PROG ((FILENAME STREAM)
HANDLE)
(RETURN (if [AND (type? STREAM STREAM)
(PROGN (SETQ FILENAME (fetch FULLFILENAME of STREAM))
(SETQ HANDLE (fetch NSFILING.HANDLE of STREAM]
then (\NSFILING.MANIPULATE.HANDLE (fetch NSFILING.CONNECTION of STREAM)
HANDLE INFOFN)
else (\NSFILING.GETFILE DEVICE FILENAME (QUOTE NONE)
(QUOTE OLD)
T
(QUOTE HANDLE)
INFOFN])
(\NSFILING.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* bvm: "18-Dec-84 21:48")
(PROG (CONNECTION BULKSTREAM RESULT)
[SETQ RESULT
(RESETLST (PROG ((STAR "*")
HOST NAME VERSION DIRECTORY FILTERLIST SCOPELIST INFINITE.DEPTH N)
(for TAIL on (UNPACKFILENAME.STRING PATTERN) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(HOST (SETQ HOST (CADR TAIL)))
(DIRECTORY (SETQ DIRECTORY (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
[EXTENSION (COND
((NOT (CADR TAIL))
NIL)
[(NOT (STREQUAL (CADR TAIL)
STAR))
(SETQ NAME (CONCAT NAME "." (CADR TAIL]
((NEQ (NTHCHARCODE NAME -1)
(CHARCODE *))
(SETQ NAME (CONCAT NAME STAR]
[VERSION (SETQ VERSION (MKATOM (CADR TAIL]
NIL))
[COND
((SETQ N (STRPOS (QUOTE *)
DIRECTORY)) (* Wild card in directory part is hard.
Get as far down in the tree as possible, then enumerate
everything)
(bind (BROKET ← 0)
X while (AND (SETQ X (STRPOS (QUOTE >)
DIRECTORY
(ADD1 BROKET)))
(ILESSP X N))
do (SETQ BROKET X)
finally (SETQ NAME (SUBSTRING DIRECTORY (ADD1 BROKET)
N))
(SETQ DIRECTORY (AND (NEQ BROKET 0)
(SUBSTRING DIRECTORY 1 (SUB1 BROKET]
(SETQ CONNECTION (OR (\GETFILINGCONNECTION DEVICE)
(RETURN NIL)))
(RESETSAVE NIL (LIST (FUNCTION \NSFILING.CLOSE.IF.ERROR)
CONNECTION))
(RETURN (COND
((\NSFILING.CONNECT CONNECTION DIRECTORY T)
[COND
((SETQ DESIREDPROPS
(for PROP in DESIREDPROPS
when (SETQ PROP
(\FILING.ATTRIBUTE.TYPE
(OR (CADR (ASSOC PROP
\LISP.TO.NSFILING.ATTRIBUTES))
PROP)
T))
collect PROP))
(* make sure there are no duplicates, since File server
can object to that)
(SETQ DESIREDPROPS (INTERSECTION DESIREDPROPS
DESIREDPROPS]
(SETQ DESIREDPROPS
(CONS [COND
[(EQ (fetch FSPROTOCOLNAME of CONNECTION)
(QUOTE FILING))
(CONSTANT (\FILING.ATTRIBUTE.TYPE (QUOTE PATHNAME]
(T (CONSTANT (\FILING.ATTRIBUTE.TYPE (QUOTE NAME]
(APPEND [CONSTANT (\FILING.ATTRIBUTE.TYPE.SEQUENCE
(QUOTE (VERSION IS.DIRECTORY]
DESIREDPROPS)))
[COND
[(STRPOS (QUOTE *)
NAME) (* Enumerate entire directory, matching against any
wild cards.)
(COND
((NOT (STREQUAL NAME STAR))
(* The following doesn't quite work because the fileserver won't match against subdirectory names.
So we always enumerate the whole directory, regardless of the pattern.)
(push FILTERLIST (BQUOTE (MATCHES (NAME , NAME]
(T (* Only enumerate versions.)
(push FILTERLIST
(BQUOTE (= , (COURIER.CREATE (FILING .
FILTER.ATTRIBUTE)
ATTRIBUTE ←(LIST
(QUOTE NAME)
NAME)
INTERPRETATION ←(
QUOTE STRING]
[COND
((FIXP VERSION)
(push FILTERLIST
(BQUOTE (= , (COURIER.CREATE (FILING .
FILTER.ATTRIBUTE)
ATTRIBUTE ←(LIST
(QUOTE VERSION)
VERSION)
INTERPRETATION ←(QUOTE
CARDINAL]
[COND
(FILTERLIST (push SCOPELIST (LIST (QUOTE FILTER)
(COND
((CDR FILTERLIST)
(LIST (QUOTE
AND)
FILTERLIST))
(T (CAR FILTERLIST]
[COND
((AND FILING.ENUMERATION.DEPTH DIRECTORY
(EQ (fetch FSPROTOCOLNAME of CONNECTION)
(QUOTE FILING)))
(* Controls how many levels in hierarchy to show.
If FILING.ENUMERATION.DEPTH is infinite, then let's
also ignore the "files" that are subdirectories)
(push SCOPELIST (BQUOTE (DEPTH ,
(OR (SMALLP
FILING.ENUMERATION.DEPTH)
(PROGN (SETQ
INFINITE.DEPTH T)
65535]
(SETQ BULKSTREAM (FILING.CALL CONNECTION (QUOTE LIST)
(fetch FSCURRENTDIRECTORY
of CONNECTION)
DESIREDPROPS SCOPELIST NIL
(fetch FSSESSIONHANDLE
of CONNECTION)))
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \NSFILING.NEXTFILE)
FILEINFOFN ←(FUNCTION \NSFILING.FILEINFOFN)
GENFILESTATE ←(create \NSFILING.GENFILESTATE
NSGENERATOR ←(
BULKDATA.GENERATOR
BULKSTREAM
(QUOTE FILING)
(QUOTE ATTRIBUTE.SEQUENCE))
NSFILTER ←(
DIRECTORY.MATCH.SETUP PATTERN)
NSCONNECTION ← CONNECTION
NSIGNOREDIRECTORIES ←
INFINITE.DEPTH]
(COND
((NULL CONNECTION))
((EQMEMB (QUOTE RESETLST)
OPTIONS)
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (CONNECTION STREAM)
(CLOSEF STREAM)
(\CLOSEFILINGCONNECTION CONNECTION RESETSTATE])
CONNECTION BULKSTREAM)))
((NULL BULKSTREAM)
(\CLOSEFILINGCONNECTION CONNECTION)))
(RETURN (OR RESULT (\NULLFILEGENERATOR])
(\NSFILING.NEXTFILE
[LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* bvm: "28-Sep-84 15:36")
(PROG ((GENERATOR (fetch NSGENERATOR of GENFILESTATE))
(CONNECTION (fetch NSCONNECTION of GENFILESTATE))
(FILTER (fetch NSFILTER of GENFILESTATE))
(IGNOREDIRS (fetch NSIGNOREDIRECTORIES of GENFILESTATE))
INFO NAME)
LP (COND
((NULL (SETQ INFO (BULKDATA.GENERATE.NEXT GENERATOR)))
(RETURN NIL))
((AND IGNOREDIRS (CADR (ASSOC (QUOTE IS.DIRECTORY)
INFO))) (* Skip directory files)
(GO LP)))
(SETQ NAME (\NSFILING.FULLNAME CONNECTION INFO))
(COND
((AND FILTER (NOT (DIRECTORY.MATCH FILTER NAME)))
(GO LP)))
(replace CURRENTINFO of GENFILESTATE with INFO)
(RETURN (COND
(NAMEONLY (NAMEFIELD NAME T))
(T NAME])
(\NSFILING.FILEINFOFN
[LAMBDA (GENFILESTATE ATTRIBUTE) (* bvm: " 1-May-84 14:04")
(\NSFILING.GETFILEINFO.FROM.PLIST (fetch CURRENTINFO of GENFILESTATE)
ATTRIBUTE])
(\NSFILING.GETEOFPTR
[LAMBDA (STREAM) (* bvm: "24-Sep-84 16:31")
(if (DIRTYABLE STREAM)
then (* Open for output, must be at eof)
(GETFILEPTR STREAM)
else (* Not randaccessp, but we can fake it with the length
server gave us on opening)
(\NSFILING.GETFILEINFO STREAM (QUOTE LENGTH])
)
(DEFINEQ
(\NSFILING.INIT
[LAMBDA NIL (* bvm: "20-Jul-84 12:36")
(\DEFINEDEVICE NIL (create FDEV
DEVICENAME ←(QUOTE NSFILING)
HOSTNAMEP ←(FUNCTION \NSFILING.HOSTNAMEP)
EVENTFN ←(FUNCTION NILL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\NSFILING.INIT)
)
(PUTPROPS NSFILING COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (15600 17242 (\GET.FILING.ATTRIBUTE 15610 . 16440) (\PUT.FILING.ATTRIBUTE 16442 . 17240)
) (19046 27970 (\GETFILINGCONNECTION 19056 . 20528) (\NSFILING.FINDSERVER 20530 . 20711) (
\OPENFILINGCONNECTION 20713 . 21690) (\NSFILING.LOGIN 21692 . 24627) (\NSFILING.SET.CONTINUANCE 24629
. 25107) (\CLOSEFILINGCONNECTION 25109 . 25465) (\NSFILING.LOGOUT 25467 . 25954) (
\NSFILING.RESETCLOSE 25956 . 26120) (\NSFILING.CLOSE.IF.ERROR 26122 . 26304) (
\VALID.FILING.CONNECTIONP 26306 . 27246) (\NSFILING.CLOSE.CONNECTIONS 27248 . 27623) (
BREAK.NSFILING.CONNECTION 27625 . 27968)) (27971 38588 (\NSFILING.CONNECT 27981 . 33890) (
\NSFILING.MAYBE.CREATE 33892 . 35017) (\PATHNAME.TO.DIRECTORY.LIST 35019 . 35716) (
\NSFILING.LISTVERSIONS 35718 . 36825) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 36827 . 37041) (
\FILING.ATTRIBUTE.TYPE 37043 . 37351) (\LISP.TO.NSFILING.ATTRIBUTE 37353 . 38586)) (38589 73734 (
\NSFILING.OPENFILE 38599 . 38789) (\NSFILING.GETFILE 38791 . 47367) (\NSFILING.MANIPULATE.HANDLE 47369
. 47994) (\NSFILING.FIND.VERSION 47996 . 49984) (\NSFILING.OPENFILE.OPTIONS 49986 . 50316) (
\NSFILING.CLOSEFILE 50318 . 52600) (\NSFILING.CLOSE.HANDLE 52602 . 52957) (\NSFILING.FULLNAME 52959 .
55454) (\NSFILING.EVENTFN 55456 . 55792) (\NSFILING.DELETEFILE 55794 . 56659) (\NSFILING.HOSTNAMEP
56661 . 58497) (\NSFILING.DIRECTORYNAMEP 58499 . 58890) (\NSFILING.GETFILENAME 58892 . 59214) (
\NSFILING.GETFILEINFO 59216 . 60861) (\NSFILING.GET.ATTRIBUTES 60863 . 61376) (
\NSFILING.GETFILEINFO.FROM.PLIST 61378 . 63090) (\NSFILING.GDATE 63092 . 63277) (\NSFILING.SETFILEINFO
63279 . 65269) (\NSFILING.GET/SETINFO 65271 . 65911) (\NSFILING.GENERATEFILES 65913 . 72012) (
\NSFILING.NEXTFILE 72014 . 73002) (\NSFILING.FILEINFOFN 73004 . 73229) (\NSFILING.GETEOFPTR 73231 .
73732)) (73735 74025 (\NSFILING.INIT 73745 . 74023)))))
STOP