(FILECREATED "27-Jun-85 15:27:06" {ERIS}<LISPCORE>SOURCES>NSFILING.;31 84220 changes to: (FNS \NSFILING.DIRECTORYNAMEP \NSFILING.GETFILE1 \NSFILING.GETFILE) previous date: "18-Jun-85 18:35:44" {ERIS}<LISPCORE>SOURCES>NSFILING.;28) (* Copyright (c) 1983, 1984, 1985 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 NSFILING.SHOW.STATUS)) (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 PATHNAME NAME READ.ON SIZE.IN.BYTES FILE.TYPE VERSION))))))) (INITVARS (NSFILING.SHOW.STATUS T) (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 \NSFILING.REMOVEQUOTES \FILING.ATTRIBUTE.TYPE.SEQUENCE \FILING.ATTRIBUTE.TYPE \LISP.TO.NSFILING.ATTRIBUTE) (FNS \NSFILING.OPENFILE \NSFILING.GETFILE \NSFILING.GETFILE1 \NSFILING.ERRORHANDLER \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.GENERATEFILES1 \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)) (QUOTE ((FILINGSESSION 0 (FLAGBITS . 0)) (FILINGSESSION 0 (BITS . 22)) (FILINGSESSION 0 POINTER) (FILINGSESSION 2 POINTER) (FILINGSESSION 4 POINTER) (FILINGSESSION 6 POINTER) (FILINGSESSION 8 POINTER) (FILINGSESSION 10 POINTER) (FILINGSESSION 12 POINTER) (FILINGSESSION 14 POINTER) (FILINGSESSION 16 POINTER) (FILINGSESSION 18 POINTER) (FILINGSESSION 20 (BITS . 15)) (FILINGSESSION 21 (BITS . 15)) (FILINGSESSION 22 POINTER) (FILINGSESSION 24 POINTER) (FILINGSESSION 26 POINTER))) (QUOTE 28)) (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 NSFILING.SHOW.STATUS) ) ) (/DECLAREDATATYPE (QUOTE FILINGSESSION) (QUOTE (FLAG (BITS 7) POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER)) (QUOTE ((FILINGSESSION 0 (FLAGBITS . 0)) (FILINGSESSION 0 (BITS . 22)) (FILINGSESSION 0 POINTER) (FILINGSESSION 2 POINTER) (FILINGSESSION 4 POINTER) (FILINGSESSION 6 POINTER) (FILINGSESSION 8 POINTER) (FILINGSESSION 10 POINTER) (FILINGSESSION 12 POINTER) (FILINGSESSION 14 POINTER) (FILINGSESSION 16 POINTER) (FILINGSESSION 18 POINTER) (FILINGSESSION 20 (BITS . 15)) (FILINGSESSION 21 (BITS . 15)) (FILINGSESSION 22 POINTER) (FILINGSESSION 24 POINTER) (FILINGSESSION 26 POINTER))) (QUOTE 28)) (DEFINEQ (\GET.FILING.ATTRIBUTE [LAMBDA (STREAM PROGRAM) (* bvm: "15-Jan-85 17:41") (* Reads a filing attribute value pair from STREAM, returning a list of two elements, (ATTR VALUE); if the attribute is not a known attribute, ATTR is an integer and VALUE is a sequence of unspecified) (bind (ATTR ←(COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) VALUE for X in \NSFILING.ATTRIBUTES when (EQ (CADR X) ATTR) do [RETURN (LIST (CAR X) (PROGN (\WIN STREAM) (* Skip sequence count) (COURIER.READ STREAM PROGRAM (CADDR X] finally (* ATTR not recognized) (RETURN (LIST ATTR (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED]) (\PUT.FILING.ATTRIBUTE [LAMBDA (STREAM ITEM PROGRAM) (* bvm: "15-Jan-85 16:29") (* * Writes a filing attribute value pair to STREAM. ITEM is a list of two elements (ATTR VALUE)) (PROG ((ATTR (CAR ITEM)) (VALUE (CADR ITEM)) VALUETYPE) [COND ((NOT (FIXP ATTR)) (for X in \NSFILING.ATTRIBUTES when (EQ (CAR X) ATTR) do (SETQ ATTR (CADR X)) (SETQ VALUETYPE (CADDR X)) (RETURN) finally (ERROR "Unknown Filing attribute" ATTR] (COURIER.WRITE STREAM ATTR 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 PATHNAME NAME READ.ON SIZE.IN.BYTES FILE.TYPE VERSION)))) ) (RPAQ? NSFILING.SHOW.STATUS T) (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: "10-Mar-85 16:37") (* 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") NIL (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSFILING.ERRORHANDLER] (RETURN (COND ((AND STREAM (\NSFILING.SET.CONTINUANCE CONNECTION)) (replace FSBUSY of CONNECTION with T]) (\NSFILING.LOGIN [LAMBDA (DEVINFO) (* bvm: "10-Mar-85 16:37") (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 (COND ([do (COND ([NOT (SETQ CREDENTIALS (\INTERNAL/GETPASSWORD SERVERNAME NEEDLOGIN NIL (AND NEEDLOGIN "Login incorrect.") NIL (QUOTE NS] (RETURN NIL)) [[SETQ STREAM (COURIER.OPEN ADDRESS NIL T (fetch NSFILINGNAME of DEVINFO) NIL (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSFILING.ERRORHANDLER] (SETQ CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS CREDENTIALS)) [SETQ SESSION (COND ((EQ PROGRAM (QUOTE FILING)) (COURIER.CALL STREAM PROGRAM (QUOTE LOGON) SERVERNSNAME (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (T (COURIER.CALL STREAM (QUOTE OLDFILING) (QUOTE LOGON) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS] (COND ((AND SESSION (NEQ (CAR SESSION) (QUOTE ERROR))) (* Success) (RETURN SESSION)) (T (SPP.CLOSE STREAM) (COND ((AND SESSION (NOT (SELECTQ (CADR SESSION) [REJECT (* Can't handle this call) (COND ((EQ PROGRAM (QUOTE FILING)) (SETQ PROGRAM (QUOTE OLDFILING] (AUTHENTICATION.ERROR (SETQ NEEDLOGIN T)) [SERVICE.ERROR (COND ((EQ (CADDR SESSION) (QUOTE CannotAuthenticate)) (SETQ NEEDLOGIN T] NIL))) (ERROR (CONCAT "Error while logging on to " SERVERNAME) (CDR SESSION)) (RETURN] (T (printout PROMPTWINDOW T SERVERNSNAME " not responding to connection attempt"] (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: " 1-Feb-85 19:49") (* 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.DIR 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) (* lmm "11-Jan-85 16:07") (* 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 I from 1 bind CH (START ← 1) VERS VAL while (SETQ CH (NTHCHARCODE PATHNAME I)) do (SELCHARQ CH (! (* Version marker) (SETQ VERS I)) (' (* quote mark, skip it and next char) (add I 1)) ((/ >) (* Directory marker) [SETQ VAL (NCONC1 VAL (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 (RETURN (NCONC1 VAL (SUBSTRING PATHNAME START (if [AND VERS (OR (AND (EQ VERS (IDIFFERENCE I 2)) (NTHCHARCODE PATHNAME (ADD1 VERS] then (SUB1 VERS]) (\NSFILING.LISTVERSIONS [LAMBDA (CONNECTION FILENAME DESIREDPROPS DESIREDVERSION) (* lmm "11-Jan-85 16:02") (* * 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) (\NSFILING.REMOVEQUOTES 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]) (\NSFILING.REMOVEQUOTES [LAMBDA (X) (CONCATCODES (for (Y ←(CHCON X)) while Y collect (PROG1 (SELCHARQ (CAR Y) (' (pop Y) (CAR Y)) (CAR Y)) (pop Y]) (\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: "26-Jan-85 15:04") (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 (OR (\FILETYPE.FROM.TYPE (OR VALUE (RETURN))) \NSFILING.TYPE.BINARY))) (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 DIROK) (* jwo: "27-Jun-85 13:28") (* 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, and PARAMETERS gives the CREATE? option in case the directory doesn't exist. If ACCESS is not NONE, then PARAMETERS gives extra parameters for the open.) (RESETLST (\NSFILING.GETFILE1 DEVICE FILENAME ACCESS RECOG NOERROR OPTION PARAMETERS DIROK)))) (\NSFILING.GETFILE1 (LAMBDA (DEVICE FILENAME ACCESS RECOG NOERROR OPTION PARAMETERS DIROK) (* jwo: "27-Jun-85 13:14") (* * Separate function so error handler can restart it) (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)))) (NAME "") DIRECTORY HOST VERSION CONNECTION CACHE DESIRED.INFO FILE.ID SESSIONHANDLE HANDLE FILESTREAM FULLNAME) (COND ((AND (LISTP FILENAME) (EQ (CAR FILENAME) (QUOTE FILE.ID))) (* Identifying file by ID, take shortcut) (OR (SETQ CONNECTION (\GETFILINGCONNECTION DEVICE RESETSAVER)) (RETURN)) (SETQ FILE.ID (CADR FILENAME)) (GO GOT.ID)) ((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 NIL (EQ OPTION (QUOTE DIRECTORY))) by (CDDR TAIL) do (SELECTQ (CAR TAIL) (DIRECTORY (SETQ DIRECTORY (CADR TAIL))) (NAME (SETQ NAME (CADR TAIL))) (EXTENSION (AND (CADR TAIL) (NOT (EQUAL (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 (EQ (NCHARS NAME) 0) (NEQ OPTION (QUOTE DIRECTORY))) (RETURN (COND (DIROK (AND (SETQ CONNECTION (\GETFILINGCONNECTION DEVICE RESETSAVER)) (\NSFILING.CONNECT CONNECTION DIRECTORY) (SETQ DESIRED.INFO (FILING.CALL CONNECTION (QUOTE GET.ATTRIBUTES) (SETQ HANDLE (fetch FSCURRENTDIRECTORY of CONNECTION)) (CONS (\FILING.ATTRIBUTE.TYPE (QUOTE NUMBER.OF.CHILDREN)) \NSFILING.USEFUL.ATTRIBUTE.TYPES) (fetch FSSESSIONHANDLE of CONNECTION) (QUOTE NOERROR))) (APPLY* PARAMETERS CONNECTION HANDLE (fetch FSCOURIERSTREAM of CONNECTION) DESIRED.INFO DEVICE))) ((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 PARAMETERS)))) (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)))) GOT.ID (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 (OR DESIRED.INFO 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.ERRORHANDLER [LAMBDA (STREAM ERRCODE) (* bvm: "13-Mar-85 16:46") (* * Called when error encountered on STREAM. If STREAM.LOST on an input file, we try to re-establish the connection) (PROG ((PRINTFLG NSFILING.SHOW.STATUS) (FAILCNT 0) NEWSTREAM FULLNAME OLDPTR CON POS) (COND ((NEQ ERRCODE (QUOTE STREAM.LOST)) (GO EXIT)) [(NOT (SETQ FULLNAME (fetch FULLFILENAME of STREAM))) (* Not a bulk stream with a file in it, maybe in midst of Courier call) (COND ([SETQ POS (OR (STKPOS (FUNCTION \NSFILING.GETFILE1)) (STKPOS (FUNCTION \NSFILING.GENERATEFILES1] (AND PRINTFLG (printout PROMPTWINDOW T "[Lost connection, restarting]")) (RETAPPLY POS (STKNAME POS) (STKARGS POS) T)) (T (GO EXIT] ((NEQ (fetch ACCESS of STREAM) (QUOTE INPUT)) (* No help for output files) (GO EXIT))) (AND PRINTFLG (printout PROMPTWINDOW T "[Reestablishing connection to " FULLNAME " at byte " (SETQ OLDPTR (GETFILEPTR STREAM)) ,)) RETRY (COND ((SETQ NEWSTREAM (\NSFILING.GETFILE (fetch DEVICE of STREAM) (OR (AND (EQ (fetch FSPROTOCOLNAME of (fetch NSFILING.CONNECTION of STREAM)) (QUOTE FILING)) (ASSOC (QUOTE FILE.ID) (fetch NSFILING.ATTRIBUTES of STREAM))) FULLNAME) (QUOTE INPUT) (QUOTE OLD) T)) (* Reopen using ID if possible) (AND PRINTFLG (printout PROMPTWINDOW "...")) (replace SPPERRORHANDLER of (SETQ CON (fetch SPP.CONNECTION of NEWSTREAM)) with (FUNCTION ERROR!)) (COND ((NLSETQ (SETFILEPTR NEWSTREAM OLDPTR)) (* Succeeded in advancing file ptr) ) ((GREATERP (add FAILCNT 1) 3) (GO FAIL)) (T (AND PRINTFLG (printout PROMPTWINDOW "failed, retrying ")) (GO RETRY))) (replace SPPERRORHANDLER of CON with (FUNCTION \NSFILING.ERRORHANDLER)) (UNINTERRUPTABLY (* Smash new stream into old) (replace F1 of STREAM with (fetch F1 of NEWSTREAM)) (replace F2 of STREAM with (fetch F2 of NEWSTREAM)) (replace F3 of STREAM with (fetch F3 of NEWSTREAM)) (replace F4 of STREAM with (fetch F4 of NEWSTREAM)) (replace F5 of STREAM with (fetch F5 of NEWSTREAM)) (replace FW6 of STREAM with (fetch FW6 of NEWSTREAM)) (replace FW7 of STREAM with (fetch FW7 of NEWSTREAM)) (replace SPPSUBSTREAM of CON with STREAM) (replace CBUFPTR of STREAM with (fetch CBUFPTR of NEWSTREAM)) (replace CBUFSIZE of STREAM with (fetch CBUFSIZE of NEWSTREAM)) (replace COFFSET of STREAM with (fetch COFFSET of NEWSTREAM))) (AND PRINTFLG (printout PROMPTWINDOW "done.]")) (RETURN T))) FAIL(AND PRINTFLG (printout PROMPTWINDOW "...failed.]")) EXIT(RETURN (\SPP.DEFAULT.ERRORHANDLER STREAM ERRCODE]) (\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: "13-Mar-85 17:49") (RESETLST (PROG ((CON (fetch SPP.CONNECTION of FILESTREAM)) (ABORTFLG (EQMEMB (QUOTE ABORT) OPTIONS)) NEWHANDLE HANDLE CONNECTION INFO) [COND ((AND CON (SETQ NEWHANDLE (PROGN (replace SPPERRORHANDLER of CON with (FUNCTION ERROR!)) (* If any errors in bulk close, just blast out) (\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) (* edited: "15-Jun-85 18:33") (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 I from 1 bind CH (START ← 1) VERS while (SETQ CH (NTHCHARCODE PATHNAME I)) do (SELCHARQ CH (! (* Version marker) (SETQ VERS I)) (' (* quote mark, skip it and next char) (add I 1)) (/ (* Directory marker) [push DIRLST (SUBSTRING PATHNAME START (COND ((AND VERS (EQ VERS (IDIFFERENCE I 2)) (EQ (NTHCHARCODE PATHNAME (ADD1 VERS)) (CHARCODE 1))) (* Version 1 in path, toss it out) (SUB1 VERS)) (T (SUB1 I] (SETQ VERS) (SETQ START (ADD1 I))) NIL) finally [SETQ PATHNAME (SUBSTRING PATHNAME START (COND ([AND VERS (OR (NULL DIRECTORYFLG) (AND (EQ VERS (IDIFFERENCE I 2)) (NTHCHARCODE PATHNAME (ADD1 VERS] (SUB1 VERS] (COND (DIRECTORYFLG (push DIRLST PATHNAME)) (T (SETQ FILENAME PATHNAME] (SETQ DIRLST (REVERSE DIRLST))) (T (SETQ DIRLST (fetch FSCURRENTPATH of CONNECTION)) (COND (DIRECTORYFLG (COND (FILENAME (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 (OR 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 (\NSFILING.REMOVEQUOTES (U-CASE FULLNAME] (T (\NSFILING.REMOVEQUOTES 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: " 1-Feb-85 18:33") (\NSFILING.GETFILE DEVICE FILENAME (QUOTE NONE) (QUOTE OLDEST) T (QUOTE HANDLE) [FUNCTION (LAMBDA (CONNECTION HANDLE STREAM ATTRS DEVICE) (PROG [(DIRP (CADR (ASSOC (QUOTE IS.DIRECTORY) ATTRS] (RETURN (COND ((AND DIRP (NEQ (CADR (ASSOC (QUOTE NUMBER.OF.CHILDREN) ATTRS)) 0)) (* Is a directory with children, can't delete) NIL) ((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))) [COND (DIRP (* Avoid having \NSFILING.FULLNAME get the last dir name twice. Ugly) (SETQ ATTRS (DREMOVE (ASSOC (QUOTE NAME) ATTRS) ATTRS] (PROG1 (\NSFILING.FULLNAME CONNECTION ATTRS NIL NIL T) (COND ((AND DIRP (EQUAL HANDLE (fetch FSCURRENTDIRECTORY of CONNECTION))) (* Invalidate current handle) (replace FSCURRENTDIRECTORY of CONNECTION with \NSFILING.NULL.HANDLE) (replace FSCURRENTPATH of CONNECTION with 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 CREATE?) (* jwo: "27-Jun-85 15:25") (* 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) (COND (CREATE? (QUOTE ASK)))))) (\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: "15-Jan-85 17:43") (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 (\TYPE.FROM.FILETYPE (CADR (ASSOC (QUOTE FILE.TYPE) PLIST] (FILETYPE (CADR (ASSOC (QUOTE FILE.TYPE) PLIST))) (CADR (ASSOC (OR (CADR (ASSOC ATTRIBUTE \LISP.TO.NSFILING.ATTRIBUTES)) ATTRIBUTE) PLIST]) (\NSFILING.GDATE [LAMBDA (DATE) (* lmm "15-Apr-85 16:16") (COND ((AND DATE (NOT (EQUAL DATE MIN.FIXP))) (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: " 1-Feb-85 18:39") (PROG ((FILENAME STREAM) HANDLE) (RETURN (COND ([AND (type? STREAM STREAM) (PROGN (SETQ FILENAME (fetch FULLFILENAME of STREAM)) (SETQ HANDLE (fetch NSFILING.HANDLE of STREAM] (\NSFILING.MANIPULATE.HANDLE (fetch NSFILING.CONNECTION of STREAM) HANDLE INFOFN)) (T (\NSFILING.GETFILE DEVICE FILENAME (QUOTE NONE) (QUOTE OLD) T (QUOTE HANDLE) INFOFN T]) (\NSFILING.GENERATEFILES [LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* bvm: "10-Mar-85 16:27") (DECLARE (SPECVARS CONNECTION BULKSTREAM)) (PROG (CONNECTION BULKSTREAM RESULT) (SETQ RESULT (RESETLST (\NSFILING.GENERATEFILES1 DEVICE PATTERN DESIREDPROPS OPTIONS))) (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.GENERATEFILES1 [LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* bvm: "10-Mar-85 16:27") (DECLARE (USEDFREE CONNECTION BULKSTREAM)) (* * Separate function here so error handler can retry it) (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]) (\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 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (16880 18657 (\GET.FILING.ATTRIBUTE 16890 . 17775) (\PUT.FILING.ATTRIBUTE 17777 . 18655) ) (20519 29561 (\GETFILINGCONNECTION 20529 . 22001) (\NSFILING.FINDSERVER 22003 . 22184) ( \OPENFILINGCONNECTION 22186 . 23238) (\NSFILING.LOGIN 23240 . 26218) (\NSFILING.SET.CONTINUANCE 26220 . 26698) (\CLOSEFILINGCONNECTION 26700 . 27056) (\NSFILING.LOGOUT 27058 . 27545) ( \NSFILING.RESETCLOSE 27547 . 27711) (\NSFILING.CLOSE.IF.ERROR 27713 . 27895) ( \VALID.FILING.CONNECTIONP 27897 . 28837) (\NSFILING.CLOSE.CONNECTIONS 28839 . 29214) ( BREAK.NSFILING.CONNECTION 29216 . 29559)) (29562 41351 (\NSFILING.CONNECT 29572 . 35489) ( \NSFILING.MAYBE.CREATE 35491 . 36616) (\PATHNAME.TO.DIRECTORY.LIST 36618 . 38298) ( \NSFILING.LISTVERSIONS 38300 . 39503) (\NSFILING.REMOVEQUOTES 39505 . 39759) ( \FILING.ATTRIBUTE.TYPE.SEQUENCE 39761 . 39975) (\FILING.ATTRIBUTE.TYPE 39977 . 40285) ( \LISP.TO.NSFILING.ATTRIBUTE 40287 . 41349)) (41352 83789 (\NSFILING.OPENFILE 41362 . 41552) ( \NSFILING.GETFILE 41554 . 42335) (\NSFILING.GETFILE1 42337 . 51915) (\NSFILING.ERRORHANDLER 51917 . 55508) (\NSFILING.MANIPULATE.HANDLE 55510 . 56135) (\NSFILING.FIND.VERSION 56137 . 58125) ( \NSFILING.OPENFILE.OPTIONS 58127 . 58457) (\NSFILING.CLOSEFILE 58459 . 61022) (\NSFILING.CLOSE.HANDLE 61024 . 61379) (\NSFILING.FULLNAME 61381 . 64290) (\NSFILING.EVENTFN 64292 . 64628) ( \NSFILING.DELETEFILE 64630 . 66549) (\NSFILING.HOSTNAMEP 66551 . 68387) (\NSFILING.DIRECTORYNAMEP 68389 . 68841) (\NSFILING.GETFILENAME 68843 . 69165) (\NSFILING.GETFILEINFO 69167 . 70812) ( \NSFILING.GET.ATTRIBUTES 70814 . 71327) (\NSFILING.GETFILEINFO.FROM.PLIST 71329 . 72982) ( \NSFILING.GDATE 72984 . 73190) (\NSFILING.SETFILEINFO 73192 . 75182) (\NSFILING.GET/SETINFO 75184 . 75813) (\NSFILING.GENERATEFILES 75815 . 76593) (\NSFILING.GENERATEFILES1 76595 . 82067) ( \NSFILING.NEXTFILE 82069 . 83057) (\NSFILING.FILEINFOFN 83059 . 83284) (\NSFILING.GETEOFPTR 83286 . 83787)) (83790 84080 (\NSFILING.INIT 83800 . 84078))))) STOP