(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "15-Dec-87 12:33:03" {ERIS}<VANMELLE>LISP>NSRANDOM.;21
 195086 

      changes to%:  (FNS \SPP.NOT.RESPONDING \NSFILING.PARSE.FILENAME \NSFILING.COPY/RENAME \NSFILING.DESERIALIZE1 \NSFILING.HANDLE.ERROR \NSFILING.COPYFILE \NSFILING.DESERIALIZE \NSFILING.GETFILE \NSFILING.OPEN.HANDLE \NSFILING.GENERATEFILES \NSFILING.DELETEFILE \NSFILING.RENAMEFILE \NSFILING.CHILDLESS-P)
 (VARS NSFILINGCOMS)

      previous date%: "30-Nov-87 14:18:48" {ERIS}<VANMELLE>LISP>NSRANDOM.;16)


(* "
Copyright (c) 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT NSRANDOMCOMS)

(RPAQQ NSRANDOMCOMS
 ((COMS * NSFILINGCOMS) (COMS (FNS COURIER.SIGNAL.ERROR COURIER.CALL COURIER.EXECUTE.CALL COURIER.EXECUTE.EXPEDITED.CALL \COURIER.RESULTS \COURIER.HANDLE.BULKDATA \COURIER.OUTPUT.ABORTED \BULK.DATA.STREAM \BULK.DATA.CLOSE COURIER.OPEN COURIER.ABORT.BULKDATA COURIER.SKIP COURIER.SKIP.SEQUENCE) (FNS COURIER.READ.STRING COURIER.WRITE.STRING COURIER.WRITE.FAT.STRING COURIER.WRITE.SEQUENCE.UNSPECIFIED COURIER.REP.LENGTH COURIER.NSNAME.LENGTH) (COMS (FNS SPP.OPEN \SPP.DEFAULT.ERRORHANDLER \SPP.HANDLE.DATA SPPOUTPUTSTREAM \SPP.SENDPKT \SPP.RETRANSMIT.NEXT \SPPWATCHER \SPP.NOT.RESPONDING PPSPP) (VARS (SPP.INACTIVITY.TIMEOUT 120000) (SPP.MAX.FAILED.PROBES 5))) (FNS \DEFPRINT.BY.NAME) (FNS \PAGEDSETFILEPTR \PAGED.INCFILEPTR) (INITVARS (*UPPER-CASE-FILE-NAMES* T))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (CHANGENAME (QUOTE \NSMAIL.READ.SERIALIZED.TREE) (QUOTE ERROR!) (QUOTE COURIER.ABORT.BULKDATA)))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA COURIER.CALL FILING.CALL))))
)

(RPAQQ NSFILINGCOMS
 ((COMS (* ; "Filing Protocol") (COURIERPROGRAMS FILING FILING.4) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS * NSFILINGCONSTANTS) (RECORDS NSFILINGSTREAM FILINGSESSION FILINGHANDLE NSFILESERVER NSFILINGDEVICEINFO \NSFILING.GENFILESTATE NSFILINGPARSE NSPAGECACHE) (MACROS WITHOUT.SESSION.MONITOR) (GLOBALVARS \NSFILING.CONNECTIONS \NSFILING.DEVICE \NSFILING.NULL.HANDLE \NSFILING.ATTRIBUTES \LISP.TO.NSFILING.ATTRIBUTES \NSFILING.USEFUL.ATTRIBUTE.TYPES \NSFILING.PROGRAM.NAME \NSFILING.ACTIVE.SESSIONS FILING.CACHE.LIMIT *NSFILING-PAGE-CACHE-INCREMENT* *NSFILING-PAGE-CACHE-LIMIT* *NSFILING-RANDOM-ACCESS* *NSFILING-SESSION-TIMEOUT* \NSRANDOM.CHECK.CACHE \NSFILING.PROTECTION.BITS \FILEDEVICES) (FILES (SOURCE) SPPDECLS) (FILES (LOADCOMP) COURIER)) (INITRECORDS FILINGSESSION FILINGHANDLE) (FNS \FILINGSESSION.DEFPRINT \FILINGHANDLE.DEFPRINT)) (COMS (FNS \GET.FILING.ATTRIBUTE \PUT.FILING.ATTRIBUTE \GET.SESSION.HANDLE \PUT.SESSION.HANDLE) (PROP COURIERDEF FILING.SESSION FILING.ATTRIBUTE) (DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSFILING.NULL.HANDLE \NSFILING.PROTECTION.BITS \NSFILING.ATTRIBUTES \LISP.TO.NSFILING.ATTRIBUTES (\NSFILING.USEFUL.ATTRIBUTE.TYPES (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (CREATED.ON FILE.ID IS.DIRECTORY PATHNAME SIZE.IN.BYTES FILE.TYPE VERSION))))))) (INITVARS (FILING.CACHE.LIMIT 6) (NSFILING.SHOW.STATUS T) (FILING.ENUMERATION.DEPTH T) (\NSFILING.LOCK (CREATE.MONITORLOCK (QUOTE NSFILING))) (\NSFILING.PROGRAM.NAME (QUOTE FILING)) (\NSFILING.ACTIVE.SESSIONS) (*NSFILING-RANDOM-ACCESS* T) (*NSFILING-PAGE-CACHE-LIMIT* 8) (*NSFILING-PAGE-CACHE-INCREMENT* 4) (*NSFILING-SESSION-TIMEOUT* (QUOTE (900 . 21600))) (\NSRANDOM.CHECK.CACHE)) (COMS (* ; "Connection maintenance") (FNS \GETFILINGCONNECTION \NSFILING.GET.NEW.SESSION \NSFILING.GET.STREAM \NSFILING.COURIER.OPEN \NSFILING.CLOSE.BULKSTREAM \NSFILING.RELEASE.BULKSTREAM FILING.CALL \NSFILING.LOGIN \NSFILING.AFTER.LOGIN \NSFILING.SET.CONTINUANCE \NSFILING.LOGOUT \NSFILING.DISCARD.SESSION \VALID.FILING.CONNECTIONP \NSFILING.CLOSE.CONNECTIONS BREAK.NSFILING.CONNECTION) (ADDVARS (\AFTERLOGINFNS \NSFILING.AFTER.LOGIN))) (COMS (* ; "Support") (FNS \NSFILING.CONNECT \NSFILING.MAYBE.CREATE \NSFILING.REMOVEQUOTES \NSFILING.ADDQUOTES \FILING.ATTRIBUTE.TYPE.SEQUENCE \FILING.ATTRIBUTE.TYPE \LISP.TO.NSFILING.ATTRIBUTE)) (COMS (* ; "FILINGHANDLE stuff") (FNS \NSFILING.GETFILE \NSFILING.LOOKUP.CACHE \NSFILING.ADD.TO.CACHE \NSFILING.OPEN.HANDLE \NSFILING.CONFLICTP \NSFILING.CHECK.ACCESS \NSFILING.FILLIN.ATTRIBUTES \NSFILING.COMPOSE.PATHNAME \NSFILING.PARSE.FILENAME \NSFILING.ERRORHANDLER \NSFILING.WHENCLOSED \NSFILING.CLOSE.HANDLE \NSFILING.FULLNAME)) (COMS (* ; "NSFILING device") (FNS \NSFILING.OPENFILE \NSFILING.HANDLE.ERROR \NSFILING.CLOSEFILE \NSFILING.EVENTFN \NSFILING.DELETEFILE \NSFILING.CHILDLESS-P \NSFILING.DIRECTORYNAMEP \NSFILING.HOSTNAMEP \NSFILING.GETFILENAME \NSFILING.GETFILEINFO \NSFILING.GET.ATTRIBUTES \NSFILING.GETFILEINFO.FROM.PLIST \NSFILING.GDATE \NSFILING.SETFILEINFO \NSFILING.GET/SETINFO \NSFILING.UPDATE.ATTRIBUTES \NSFILING.GETEOFPTR \NSFILING.GENERATEFILES \NSFILING.GENERATE.STARS \NSFILING.NEXTFILE \NSFILING.FILEINFOFN \NSFILING.RENAMEFILE \NSFILING.COPYFILE \NSFILING.COPY/RENAME)) (COMS (* ; "Random access methods") (FNS \NSRANDOM.CLOSEFILE \NSRANDOM.RELEASE.HANDLE \NSRANDOM.RELEASE.LOCK \NSRANDOM.RELEASE.IF.ERROR \NSRANDOM.CREATE.STREAM \NSRANDOM.READPAGES \NSRANDOM.READ.SEGMENT \NSRANDOM.PREPARE.CACHE \NSRANDOM.FETCH.CACHE \NSRANDOM.CHECK.CACHE \NSRANDOM.WRITEPAGES \NSRANDOM.WRITE.SEGMENT \NSRANDOM.WROTE.HANDLE \NSRANDOM.SETEOFPTR \NSRANDOM.TRUNCATEFILE \NSRANDOM.UPDATE.VALIDATION) (* ; "error handling") (FNS \NSRANDOM.HANDLE.ERROR \NSRANDOM.PROCEEDABLE.ERROR \NSRANDOM.REESTABLISH \NSRANDOM.STREAM.CHANGED \NSRANDOM.DESTROY.STREAM \NSRANDOM.SESSION.WATCHER \NSRANDOM.ENSURE.WATCHER)) (COMS (* ; "Cleaning up directories") (FNS GC-FILING-DIRECTORY \NSGC.COLLECT.DIRECTORIES)) (COMS (* ; "Deserialize (special for NSMAIL)") (FNS \NSFILING.DESERIALIZE \NSFILING.DESERIALIZE1)) (COMS (FNS \NSFILING.INIT) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NSFILING.INIT)))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA FILING.CALL))))
)



(* ; "Filing Protocol")



(COURIERPROGRAM FILING
 (10 5)
    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) (ACCESS 2))) (CONTROL.TYPE.SEQUENCE (SEQUENCE CONTROL.TYPE)) (CONTROL (CHOICE (LOCK 0 LOCK) (TIMEOUT 1 TIMEOUT) (ACCESS 2 ACCESS.SEQUENCE))) (CONTROL.SEQUENCE (SEQUENCE CONTROL)) (LOCK (ENUMERATION (NONE 0) (SHARE 1) (EXCLUSIVE 2))) (TIMEOUT CARDINAL) (ACCESS.TYPE (ENUMERATION (READ 0) (WRITE 1) (OWNER 2) (ADD 3) (REMOVE 4) (ALL 65535))) (ACCESS.SEQUENCE (SEQUENCE ACCESS.TYPE)) (ACCESS.ENTRY (RECORD (KEY (CLEARINGHOUSE . NAME)) (ACCESS ACCESS.SEQUENCE))) (ACCESS.LIST (RECORD (ENTRIES (SEQUENCE ACCESS.ENTRY)) (DEFAULTED BOOLEAN))) (SCOPE.TYPE (ENUMERATION (COUNT 0) (DIRECTION 1) (FILTER 2) (DEPTH 3))) (SCOPE (CHOICE (COUNT 0 CARDINAL) (DIRECTION 1 DIRECTION) (FILTER 2 FILTER) (DEPTH 3 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))) (BYTE.RANGE (RECORD (FIRSTBYTE LONGCARDINAL) (COUNT LONGCARDINAL))) (CREDENTIALS (AUTHENTICATION . CREDENTIALS)) (HANDLE (ARRAY 2 UNSPECIFIED)) (SESSION FILING.SESSION) (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))) (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.CONTROLS 6 (HANDLE CONTROL.TYPE.SEQUENCE SESSION) RETURNS (CONTROL.SEQUENCE) REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR CONTROL.TYPE.ERROR HANDLE.ERROR SESSION.ERROR UNDEFINED.ERROR)) (CHANGE.CONTROLS 7 (HANDLE CONTROL.SEQUENCE SESSION) RETURNS NIL REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR CONTROL.TYPE.ERROR CONTROL.VALUE.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)) (SERIALIZE 15 (HANDLE BULK.DATA.SINK SESSION) RETURNS NIL REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR CONNECTION.ERROR HANDLE.ERROR SESSION.ERROR TRANSFER.ERROR UNDEFINED.ERROR)) (DESERIALIZE 16 (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)) (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)) (RETRIEVE.BYTES 22 (HANDLE BYTE.RANGE BULK.DATA.SINK SESSION) RETURNS NIL REPORTS (ACCESS.ERROR HANDLE.ERROR RANGE.ERROR SESSION.ERROR UNDEFINED.ERROR)) (REPLACE.BYTES 23 (HANDLE BYTE.RANGE BULK.DATA.SOURCE SESSION) RETURNS NIL REPORTS (ACCESS.ERROR HANDLE.ERROR RANGE.ERROR SESSION.ERROR SPACE.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)) (RANGE.ERROR 16 (ARGUMENT.PROBLEM)))
)

(COURIERPROGRAM FILING.4
 (10 4)
    INHERITS

      (FILING)
    TYPES

      ((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))) (ACCESS.LIST (RECORD (ENTRIES (SEQUENCE ACCESS.ENTRY)) (DEFAULTED BOOLEAN))) (ACCESS.ENTRY (RECORD (KEY (CLEARINGHOUSE . NAME)) (TYPE (ENUMERATION (INDIVIDUAL 0) (ALIAS 1) (GROUP 2) (-- 3))) (ACCESS UNSPECIFIED))))
)
(DECLARE%: EVAL@COMPILE DONTCOPY 

(RPAQQ NSFILINGCONSTANTS
 ((\NSFILING.ALL.ATTRIBUTE.TYPES (QUOTE (-1))) (\NSFILING.DEFAULT.TIMEOUT -1) (\NSFILING.NULL.FILTER (QUOTE (ALL))) (\NSFILING.NULL.FILE.ID (QUOTE (0 0 0 0 0))) (\NSFILING.LOWEST.VERSION 0) (\NSFILING.HIGHEST.VERSION 65535) (\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 \NSFILING.NULL.FILTER
 (ALL))

(RPAQQ \NSFILING.NULL.FILE.ID
 (0 0 0 0 0))

(RPAQQ \NSFILING.LOWEST.VERSION
 0)

(RPAQQ \NSFILING.HIGHEST.VERSION
 65535)

(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) (\NSFILING.NULL.FILTER (QUOTE (ALL))) (\NSFILING.NULL.FILE.ID (QUOTE (0 0 0 0 0))) (\NSFILING.LOWEST.VERSION 0) (\NSFILING.HIGHEST.VERSION 65535) (\NSFILING.TYPE.BINARY 0) (\NSFILING.TYPE.DIRECTORY 1) (\NSFILING.TYPE.TEXT 2))
)

(DECLARE%: EVAL@COMPILE

(ACCESSFNS NSFILINGSTREAM
 ((* ; "Overlays STREAM.  F1-2 and FW6-8 are used by the bulkdata device") (NSFILING.CONNECTION (fetch F3 of DATUM) (replace F3 of DATUM with NEWVALUE)) (* ; "Session on which this stream is open") (NSFILING.HANDLE (fetch F4 of DATUM) (replace F4 of DATUM with NEWVALUE)) (* ; "Filing HANDLE") (NSFILING.NEW.ATTRIBUTES (fetch F5 of DATUM) (replace F5 of DATUM with NEWVALUE)) (* ; "For output sequential files, the attributes to install after we write the file") (NSFILING.PAGE.CACHE (fetch F1 of DATUM) (replace F1 of DATUM with NEWVALUE)) (* ; "Cache of pages read from server but not yet read by client") (NSFILING.SERVER.LENGTH (fetch F2 of DATUM) (replace F2 of DATUM with NEWVALUE)) (* ; "For random-access streams, actual length of file on server") (NSFILING.LAST.REQUEST (fetch FW6 of DATUM) (replace FW6 of DATUM with NEWVALUE)) (* ; "Last page requested to be read or written"))
)

(DATATYPE FILINGSESSION
 ((FSLOGINCHANGED FLAG) (* ; "True if login info changes for this host") (FSREALACTIVITY FLAG) (* ; "Set true when there have been non-CONTINUE calls made on this session") (NIL BITS 6) (FSPARSEDNAME POINTER) (* ; "Canonical NSNAME of server") (FSNAMESTRING POINTER) (* ; "same as a Lisp string") (FSADDRESS POINTER) (* ; "NSADDRESS of server") (FSPROCESSNAME POINTER) (* ; "Courier stream open for this session, or NIL if none") (FSSESSIONHANDLE POINTER) (* ; "Handle for this session") (FSSESSIONLOCK POINTER) (FSLASTREALACTIVITYTIMER POINTER) (* ; "Time of last interesting activity") (FSDEVICENAME POINTER) (FSCOURIERSTREAMS POINTER) (* ; "Courier streams usable by session") (FSCACHEDHANDLES POINTER) (* ; "Zero or more instances of FILINGHANDLE describing handles we have open in this session") (FSLOGINNAME POINTER) (* ; "Name under which this session is logged in") (FSPROTOCOLNAME POINTER) (* ; "FILING or OLDFILING") (FSPROTOCOLDEF POINTER) (* ; "Courier def for FILING.CALL to use") (FSSESSIONTIMER POINTER) (* ; "Time we last did anything at all in this session") (FSCONTINUANCE WORD) (* ; "How long in msecs we can be idle without having server close session") (FSVERSION WORD) (* ; "Version of the protocol in use by this server") (* ; "Spares") (NIL POINTER) (NIL POINTER) (NIL POINTER))
)

(DATATYPE FILINGHANDLE
 ((NSHDIRECTORYP FLAG) (* ; "Handle is a directory") (NSHWASREAD FLAG) (* ; "True if we have read file since we obtained the handle (in which case read date has been updated)") (NSHWASWRITTEN FLAG) (NSHWASMODIFIED FLAG) (NIL BITS 4) (NSHDATUM POINTER) (* ; "The file handle datum used in Courier calls") (NSHFILEID POINTER) (* ; "FILE.ID of file") (NSHNAME POINTER) (* ; "Full name of the file referenced") (NSHPATHNAME POINTER) (* ; "Canonical pathname of file") (NSHATTRIBUTES POINTER) (* ; "Cached attributes") (NSHACCESS POINTER) (* ; "Current access controls on handle") (NSHTIMER POINTER) (* ; "Last reference to this handle") (NSHBUSYCOUNT WORD) (* ; "Number of current users of handle") (NIL WORD) (NSHDIRECTORYPATH POINTER) (* ; "For directories, the list of component dirs") (NIL POINTER))
 NSHTIMER ← (SETUPTIMER 0) NSHDIRECTORYPATH ← T)

(RECORD NSFILESERVER
 (NSFSPARSEDNAME . NSFSADDRESSES))

(RECORD NSFILINGDEVICEINFO
 (NSFILESERVER NSWATCHERPROC NSFILINGLOCK NSFILINGNAME NSRANDOMDEVICE . NSCONNECTIONS)
)

(RECORD \NSFILING.GENFILESTATE
 (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES NSBULKSTREAM)
)

(RECORD NSFILINGPARSE
 (NSDIRECTORIES NSROOTNAME NSVERSION NSDIRECTORYP NSHASPERIOD))

(RECORD NSPAGECACHE
 (NSPSIZE . NSPHEADER) (RECORD NSPHEADER (NSPTAIL . NSPBUFFERS)))
)
(/DECLAREDATATYPE (QUOTE FILINGSESSION) (QUOTE (FLAG FLAG (BITS 6) POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER)) (QUOTE ((FILINGSESSION 0 (FLAGBITS . 0)) (FILINGSESSION 0 (FLAGBITS . 16)) (FILINGSESSION 0 (BITS . 37)) (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 POINTER) (FILINGSESSION 22 POINTER) (FILINGSESSION 24 POINTER) (FILINGSESSION 26 POINTER) (FILINGSESSION 28 (BITS . 15)) (FILINGSESSION 29 (BITS . 15)) (FILINGSESSION 30 POINTER) (FILINGSESSION 32 POINTER) (FILINGSESSION 34 POINTER))) (QUOTE 36))
(/DECLAREDATATYPE (QUOTE FILINGHANDLE) (QUOTE (FLAG FLAG FLAG FLAG (BITS 4) POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER)) (QUOTE ((FILINGHANDLE 0 (FLAGBITS . 0)) (FILINGHANDLE 0 (FLAGBITS . 16)) (FILINGHANDLE 0 (FLAGBITS . 32)) (FILINGHANDLE 0 (FLAGBITS . 48)) (FILINGHANDLE 0 (BITS . 67)) (FILINGHANDLE 0 POINTER) (FILINGHANDLE 2 POINTER) (FILINGHANDLE 4 POINTER) (FILINGHANDLE 6 POINTER) (FILINGHANDLE 8 POINTER) (FILINGHANDLE 10 POINTER) (FILINGHANDLE 12 POINTER) (FILINGHANDLE 14 (BITS . 15)) (FILINGHANDLE 15 (BITS . 15)) (FILINGHANDLE 16 POINTER) (FILINGHANDLE 18 POINTER))) (QUOTE 20))

(DECLARE%: EVAL@COMPILE 
(PUTPROPS WITHOUT.SESSION.MONITOR MACRO ((SESSION . FORMS) (LET ((LOCK (fetch FSSESSIONLOCK of SESSION))) (DECLARE (LOCALVARS LOCK)) (RELEASE.MONITORLOCK LOCK) (PROG1 (PROGN . FORMS) (OBTAIN.MONITORLOCK LOCK)))))
)

(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 \NSFILING.ACTIVE.SESSIONS FILING.CACHE.LIMIT *NSFILING-PAGE-CACHE-INCREMENT* *NSFILING-PAGE-CACHE-LIMIT* *NSFILING-RANDOM-ACCESS* *NSFILING-SESSION-TIMEOUT* \NSRANDOM.CHECK.CACHE \NSFILING.PROTECTION.BITS \FILEDEVICES)
)

(FILESLOAD (SOURCE) SPPDECLS)

(FILESLOAD (LOADCOMP) COURIER)
)
(/DECLAREDATATYPE (QUOTE FILINGSESSION) (QUOTE (FLAG FLAG (BITS 6) POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER)) (QUOTE ((FILINGSESSION 0 (FLAGBITS . 0)) (FILINGSESSION 0 (FLAGBITS . 16)) (FILINGSESSION 0 (BITS . 37)) (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 POINTER) (FILINGSESSION 22 POINTER) (FILINGSESSION 24 POINTER) (FILINGSESSION 26 POINTER) (FILINGSESSION 28 (BITS . 15)) (FILINGSESSION 29 (BITS . 15)) (FILINGSESSION 30 POINTER) (FILINGSESSION 32 POINTER) (FILINGSESSION 34 POINTER))) (QUOTE 36))
(/DECLAREDATATYPE (QUOTE FILINGHANDLE) (QUOTE (FLAG FLAG FLAG FLAG (BITS 4) POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER)) (QUOTE ((FILINGHANDLE 0 (FLAGBITS . 0)) (FILINGHANDLE 0 (FLAGBITS . 16)) (FILINGHANDLE 0 (FLAGBITS . 32)) (FILINGHANDLE 0 (FLAGBITS . 48)) (FILINGHANDLE 0 (BITS . 67)) (FILINGHANDLE 0 POINTER) (FILINGHANDLE 2 POINTER) (FILINGHANDLE 4 POINTER) (FILINGHANDLE 6 POINTER) (FILINGHANDLE 8 POINTER) (FILINGHANDLE 10 POINTER) (FILINGHANDLE 12 POINTER) (FILINGHANDLE 14 (BITS . 15)) (FILINGHANDLE 15 (BITS . 15)) (FILINGHANDLE 16 POINTER) (FILINGHANDLE 18 POINTER))) (QUOTE 20))
(DEFINEQ

(\FILINGSESSION.DEFPRINT

(LAMBDA (SESSION STREAM) (* ; "Edited  1-Jun-87 16:58 by bvm:") (COND ((AND COURIERTRACEFILE (TYPENAMEP COURIERTRACEFILE (QUOTE WINDOW)) (EQ (ffetch (WINDOW DSP) of COURIERTRACEFILE) STREAM)) (* ; "Want it curt in trace output") NIL) (T (\DEFPRINT.BY.NAME SESSION STREAM (fetch FSNAMESTRING of SESSION) "Filing Session on"))))
)

(\FILINGHANDLE.DEFPRINT

(LAMBDA (HANDLE STREAM) (* ; "Edited 15-May-87 17:10 by bvm:") (\DEFPRINT.BY.NAME HANDLE STREAM (OR (fetch NSHNAME of HANDLE) (fetch NSHPATHNAME of HANDLE)) "Filing Handle on"))
)
)
(DEFINEQ

(\GET.FILING.ATTRIBUTE

(LAMBDA (STREAM PROGRAM) (* bvm%: "25-Jul-86 16:48") (* ;; "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 (CONS (CAR X) (COND ((EQ (\WIN STREAM) 0) (* ; "sequence count zero means no value is here") NIL) (T (* ; "Ignore sequence count, read as known kind of data") (LIST (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))))))
)

(\GET.SESSION.HANDLE

(LAMBDA (STREAM PROGRAM) (* ; "Edited  1-Jun-87 15:52 by bvm:") (* ;; "Read an object of type Filing.Session, which consists of a token (array 2 unspecified) and a verifier.") (CONS (COURIER.READ STREAM NIL (QUOTE UNSPECIFIED)) (CONS (COURIER.READ STREAM NIL (QUOTE UNSPECIFIED)) (COURIER.READ STREAM (QUOTE AUTHENTICATION) (QUOTE VERIFIER)))))
)

(\PUT.SESSION.HANDLE

(LAMBDA (STREAM ITEM PROGRAM) (* ; "Edited  1-Jun-87 15:52 by bvm:") (* ;; "Write a session handle.  This is where we can stick hook to increment verifier when we start using strong authentication.  Handle = (token token . verifier).") (LET ((HANDLE (OR (LISTP ITEM) (LISTP (ffetch FSSESSIONHANDLE of (\DTEST ITEM (QUOTE FILINGSESSION)))) (ERROR "Attempt to use obsolete session" ITEM)))) (COURIER.WRITE STREAM (pop HANDLE) NIL (QUOTE UNSPECIFIED)) (COURIER.WRITE STREAM (pop HANDLE) NIL (QUOTE UNSPECIFIED)) (COURIER.WRITE STREAM HANDLE (QUOTE AUTHENTICATION) (QUOTE VERIFIER)) ITEM))
)
)

(PUTPROPS FILING.SESSION COURIERDEF
 (\GET.SESSION.HANDLE \PUT.SESSION.HANDLE))

(PUTPROPS FILING.ATTRIBUTE COURIERDEF
 (\GET.FILING.ATTRIBUTE \PUT.FILING.ATTRIBUTE))
(DECLARE%: EVAL@COMPILE DOCOPY 

(RPAQQ \NSFILING.NULL.HANDLE
 (0 0))

(RPAQQ \NSFILING.PROTECTION.BITS
 ((READ . 16) (WRITE . 8) (DELETE . 1) (CREATE . 2) (MODIFY . 4)))

(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) (BACKED.UP.ON 23 TIME) (FILED.BY 24 USER) (FILED.ON 25 TIME) (STORED.SIZE 26 LONGCARDINAL) (SUBTREE.SIZE 27 LONGCARDINAL) (SUBTREE.SIZE.LIMIT 28 LONGCARDINAL) (OWNER 4351 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) (READER READ.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 PATHNAME SIZE.IN.BYTES FILE.TYPE VERSION)))
)
)

(RPAQ? FILING.CACHE.LIMIT
 6)

(RPAQ? NSFILING.SHOW.STATUS
 T)

(RPAQ? FILING.ENUMERATION.DEPTH
 T)

(RPAQ? \NSFILING.LOCK
 (CREATE.MONITORLOCK (QUOTE NSFILING)))

(RPAQ? \NSFILING.PROGRAM.NAME
 (QUOTE FILING))

(RPAQ? \NSFILING.ACTIVE.SESSIONS
 )

(RPAQ? *NSFILING-RANDOM-ACCESS*
 T)

(RPAQ? *NSFILING-PAGE-CACHE-LIMIT*
 8)

(RPAQ? *NSFILING-PAGE-CACHE-INCREMENT*
 4)

(RPAQ? *NSFILING-SESSION-TIMEOUT*
 (QUOTE (900 . 21600)))

(RPAQ? \NSRANDOM.CHECK.CACHE
 )



(* ; "Connection maintenance")


(DEFINEQ

(\GETFILINGCONNECTION

(LAMBDA (DEVICE OLDSTREAM NOLOCK) (* ; "Edited 18-May-87 17:53 by bvm:") (* ;;; "Find an existing session on this fileserver or log in a new one.  Returns the session, after obtaining its monitor lock.  Caller must have a RESETLST") (LET* ((DEVINFO (fetch DEVICEINFO of DEVICE)) (SESSION (WITH.MONITOR (fetch NSFILINGLOCK of DEVINFO) (bind SESSION while (SETQ SESSION (CAR (fetch NSCONNECTIONS of DEVINFO))) do (* ; "Awkward control structure because of DREMOVE") (COND ((WITH.MONITOR (fetch FSSESSIONLOCK of SESSION) (\VALID.FILING.CONNECTIONP SESSION)) (* ; "If good, returned session.  If bad, returned possibly an open courier stream") (RETURN SESSION)) (T (SETQ OLDSTREAM (\NSFILING.DISCARD.SESSION SESSION DEVICE (NULL OLDSTREAM))))) finally (RETURN (\NSFILING.LOGIN DEVINFO DEVICE OLDSTREAM)))))) (COND (SESSION (COND ((NOT NOLOCK) (* ; "Grab lock here outside of our own WITH.MONITOR.  Unwindsave info goes on caller's reset") (OBTAIN.MONITORLOCK (fetch FSSESSIONLOCK of SESSION) NIL T))) SESSION))))
)

(\NSFILING.GET.NEW.SESSION

(LAMBDA (OLDSESSION DEVICE NOLOCK) (* ; "Edited 22-May-87 14:42 by bvm:") (* ;; "Called when OLDSESSION has encountered a session error (TokenInvalid).  Discards knowledge of OLDSESSION and establishes a new one.  Unless NOLOCK is true, a lock is obtained on the new session (caller must have RESETLST).") (\GETFILINGCONNECTION DEVICE (\NSFILING.DISCARD.SESSION OLDSESSION DEVICE T) NOLOCK))
)

(\NSFILING.GET.STREAM

(LAMBDA (CONNECTION KEEPSTREAM) (* ; "Edited  9-Jun-87 15:41 by bvm:") (* ;;; "Get a Courier stream for CONNECTION and return it.  If KEEPSTREAM is true, we want the stream to persist after the enclosing RESETLST exits, else we release the stream on its exit") (PROG ((STREAMPAIR (find PAIR in (fetch FSCOURIERSTREAMS of CONNECTION) suchthat (NULL (CDR PAIR))))) (COND (STREAMPAIR (RPLACD STREAMPAIR T)) ((SETQ STREAMPAIR (\NSFILING.COURIER.OPEN (fetch FSADDRESS of CONNECTION) (fetch FSPROCESSNAME of CONNECTION))) (push (fetch FSCOURIERSTREAMS of CONNECTION) (SETQ STREAMPAIR (CONS STREAMPAIR T)))) (T (RETURN NIL))) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (CONNECTION PAIR KEEPSTREAM) (COND (RESETSTATE (SPP.CLOSE (CAR PAIR) T) (replace FSCOURIERSTREAMS of CONNECTION with (DREMOVE PAIR (fetch FSCOURIERSTREAMS of CONNECTION)))) ((NOT KEEPSTREAM) (RPLACD PAIR NIL))))) CONNECTION STREAMPAIR KEEPSTREAM)) (RETURN STREAMPAIR)))
)

(\NSFILING.COURIER.OPEN

(LAMBDA (ADDRESS NAME) (* bvm%: "11-Dec-85 12:57") (COURIER.OPEN ADDRESS NIL T NAME (FUNCTION \NSFILING.WHENCLOSED) (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSFILING.ERRORHANDLER)))))
)

(\NSFILING.CLOSE.BULKSTREAM

(LAMBDA (CONNECTION STREAM) (* ; "Edited 20-Nov-87 18:47 by bvm:") (COND ((AND STREAM (OPENP STREAM)) (CLOSEF STREAM) (\NSFILING.RELEASE.BULKSTREAM CONNECTION STREAM RESETSTATE))))
)

(\NSFILING.RELEASE.BULKSTREAM

(LAMBDA (CONNECTION STREAM ABORT?) (* bvm%: "11-Dec-85 14:42") (LET ((STREAMS (fetch FSCOURIERSTREAMS of CONNECTION))) (for PAIR in STREAMS when (EQ (CDR PAIR) STREAM) do (COND (ABORT? (* ; "Unknown state, bag it") (SPP.CLOSE (CAR PAIR) T) (replace FSCOURIERSTREAMS of CONNECTION with (DREMOVE PAIR STREAMS))) (T (* ; "Stream now free") (RPLACD PAIR NIL))) (RETURN))))
)

(FILING.CALL

(LAMBDA ARGS (* ; "Edited  5-Aug-87 12:39 by bvm:") (* ;; "Call a FILING procedure.  procedure, in a style similar to COURIER.CALL --- (FILING.CALL session procedure-name arg1 ...  argN) --- Returns the result of the remote procedure, or a list of such results if it returns more than one.  A single flag NoErrorFlg can be optionally appended to the arglist -- If NoErrorFlg is NOERROR, return NIL if the Courier program aborts with an error;  if RETURNERRORS, then return an expression (ERROR ERRNAME . args) on error.") (* ;; "Copied from COURIER.CALL") (PROG (SESSION PROCEDURE PROGRAM STREAM NARGS ARGLIST NOERRORFLG PGMDEF PROCDEF ARGTYPES KEEPSTREAM ABSOLUTELY-NO-ERROR) (COND ((< ARGS 2) (RETURN (ERROR "Malformed FILING.CALL")))) (if (NULL (SETQ SESSION (ARG ARGS 1))) then (* ; "session killed, don't even try") (RETURN (QUOTE (ERROR SESSION.ERROR TokenInvalid)))) (SETQ PGMDEF (fetch FSPROTOCOLDEF of SESSION)) (SETQ PROCDEF (\GET.COURIER.DEFINITION (SETQ PROGRAM (fetch FSPROTOCOLNAME of SESSION)) (SETQ PROCEDURE (ARG ARGS 2)) (QUOTE PROCEDURES) PGMDEF)) (SETQ NARGS (LENGTH (SETQ ARGTYPES (fetch (COURIERFN ARGS) of PROCDEF)))) (OR (SELECTQ (- ARGS NARGS) (2 (* ; "Exactly right") T) ((3 4) (* ; "Extra arg is errorflg") (AND (SELECTQ (SETQ NOERRORFLG (ARG ARGS (+ NARGS 3))) (NOERROR (* ; "Caller wants not to hassle with errors, but we always want to see session errors") (SETQ NOERRORFLG (QUOTE RETURNERRORS)) (SETQ ABSOLUTELY-NO-ERROR T)) ((NOERROR RETURNERRORS NIL) T) NIL) (COND ((EQ (- ARGS NARGS) 4) (SETQ KEEPSTREAM (EQ (ARG ARGS (+ NARGS 4)) (QUOTE KEEPSTREAM)))) (T T)))) NIL) (RETURN (ERROR "Wrong number of arguments to Courier procedure" (CONS PROGRAM PROCEDURE)))) (SETQ ARGLIST (for I from 3 to (+ NARGS 2) collect (ARG ARGS I))) (RETURN (WITH.MONITOR (fetch FSSESSIONLOCK of SESSION) (* ; "Note: implicit RESETLST") (PROG ((FAILED 0) STREAM RESULT) NEWSTREAM (COND ((NOT (LISTP (fetch FSSESSIONHANDLE of SESSION))) (* ; "Session is dead, don't even try the call") (RETURN (QUOTE (ERROR SESSION.ERROR TokenInvalid)))) ((NULL (SETQ STREAM (\NSFILING.GET.STREAM SESSION KEEPSTREAM))) (COND (ABSOLUTELY-NO-ERROR (RETURN NIL)) (T (COND ((EQ (add FAILED 1) 2) (* ; "Don't complain the first time--it seems like it often takes a while to wake up a sleepy server.  Perhaps should adjust this in SPP.OPEN.") (PRINTOUT PROMPTWINDOW T "No response from " (fetch FSNAMESTRING of SESSION) ";" " will keep trying."))) (GO NEWSTREAM))))) (SETQ RESULT (COURIER.EXECUTE.CALL (CAR STREAM) PROGRAM PGMDEF PROCEDURE PROCDEF ARGLIST ARGTYPES NOERRORFLG)) (COND ((EQ RESULT (QUOTE STREAM.LOST)) (GO NEWSTREAM)) ((AND (LISTP RESULT) (EQ (CAR RESULT) (QUOTE ERROR)) (SELECTQ (CADR RESULT) (SESSION.ERROR (* ; "Dead session") T) (REJECT (SELECTQ (CAADDR RESULT) ((NoSuchService WrongVersionOfService) (* ;; "Server not responding to Filing?  Could happen if server crashed and has just come back.  In any case, our old session is clearly dead--we masquerade here as session error and let LOGIN worry about proceeding.") (SETQ RESULT (QUOTE (ERROR SESSION.ERROR TokenInvalid)))) NIL)) NIL)) (* ;; "Session is dead, don't let anybody even think about using it again.  If caller is clever, however, he may reuse the stream to login afresh.") (replace FSSESSIONHANDLE of SESSION with :CLOSED)) (T (COND ((NEQ PROCEDURE (QUOTE CONTINUE)) (* ; "Note real activity") (replace FSREALACTIVITY of SESSION with T)) ((fetch FSREALACTIVITY of SESSION) (* ; "transfer activity timer to real timer") (\BLT (OR (fetch FSLASTREALACTIVITYTIMER of SESSION) (replace FSLASTREALACTIVITYTIMER of SESSION with (\CREATECELL \FIXP))) (fetch FSSESSIONTIMER of SESSION) WORDSPERCELL) (replace FSREALACTIVITY of SESSION with NIL))) (\DAYTIME0 (fetch FSSESSIONTIMER of SESSION)) (* ; "Note time of last activity") (COND (KEEPSTREAM (RPLACD STREAM (COND ((TYPENAMEP RESULT (QUOTE STREAM)) (* ; "Save bulk stream for later linkup") RESULT) (T (* ; "Were expecting bulk stream but failed, so release main stream") NIL))))))) (RETURN (COND ((AND ABSOLUTELY-NO-ERROR (LISTP RESULT) (EQ (CAR RESULT) (QUOTE ERROR))) (* ; "Manually suppress this error.") NIL) (T RESULT))))))))
)

(\NSFILING.LOGIN

(LAMBDA (DEVINFO DEVICE STREAM) (* ; "Edited 29-Jun-87 16:16 by bvm:") (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL (* ; "Close any open stream on error") (AND STREAM RESETSTATE (SPP.CLOSE STREAM)))))) (LET ((FILESERVER (fetch NSFILESERVER of DEVINFO)) (PROCNAME (fetch NSFILINGNAME of DEVINFO)) (PROGRAM \NSFILING.PROGRAM.NAME) ADDRESS SERVERNAME SERVERNSNAME SESSIONHANDLE SESSION CREDENTIALS NEEDLOGIN PROBLEM OLDPROBLEM LOGINNAME RANDEVICE) (SETQ SERVERNAME (MKATOM (NSNAME.TO.STRING (SETQ SERVERNSNAME (fetch NSFSPARSEDNAME of FILESERVER)) T))) (SETQ ADDRESS (CAR (fetch NSFSADDRESSES of FILESERVER))) (COND ((when (COND ((NOT (SETQ CREDENTIALS (\INTERNAL/GETPASSWORD SERVERNAME NEEDLOGIN NIL (COND (NEEDLOGIN (PROG1 (SELECTQ NEEDLOGIN (VerifierInvalid "Incorrect Password") (CredentialsInvalid "Invalid User Name") (CONCAT "Login failed -- " NEEDLOGIN)) (SETQ NEEDLOGIN NIL)))) NIL (QUOTE NS)))) (* ; "User aborted") (RETURN NIL)) ((NOT (OR STREAM (SETQ STREAM (\NSFILING.COURIER.OPEN ADDRESS PROCNAME)))) (* ; "No response") (SETQ PROBLEM T)) (T (SETQ LOGINNAME (CAR CREDENTIALS)) (SETQ CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS CREDENTIALS)) (SETQ SESSIONHANDLE (COURIER.CALL STREAM PROGRAM (QUOTE LOGON) SERVERNSNAME (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (COND ((EQ SESSIONHANDLE (QUOTE STREAM.LOST)) (* ; "Stream was idle too long before we made that call, so toss it and get a new one.") (SETQ STREAM NIL)) ((NULL SESSIONHANDLE) (* ; "Shouldn't happen, treat as no response") (SETQ PROBLEM T)) ((NEQ (CAR SESSIONHANDLE) (QUOTE ERROR)) (* ; "Success") (RETURN SESSIONHANDLE)) (T (SELECTQ (CADR SESSIONHANDLE) (REJECT (* ; "Can't handle this call") (SELECTQ (CAR (CADDR SESSIONHANDLE)) (WrongVersionOfService (COND ((EQ PROGRAM (QUOTE FILING)) (SETQ PROGRAM (QUOTE FILING.4)) (* ; "Quietly try older version next time around") NIL) (T (* ; "Doesn't run any version we talk") T))) (NoSuchService (* ; "Can happen when you boot a file server.  Keep trying") (SETQ PROBLEM (QUOTE NoSuchService))) T)) (AUTHENTICATION.ERROR (SETQ NEEDLOGIN (CADDR SESSIONHANDLE)) (* ; "Login incorrect, prompt next time around") NIL) (SERVICE.ERROR (SELECTQ (SETQ PROBLEM (CADDR SESSIONHANDLE)) ((CannotAuthenticate ServiceFull) (* ; "hopefully transient problems") T) (UnknownService (* ; "No service by that name at this node.  This is quite transient in the case where the server was just booted") (if (NEQ OLDPROBLEM (QUOTE NoSuchService)) then (SETQ PROBLEM NIL)) T) (PROGN (SETQ PROBLEM NIL) (* ; "Let other problems cause a break") T))) T))))) do (* ; "Some sort of problem encountered.  PROBLEM set non-nil if it's worthwhile to keep trying, else an unexpected problem is stored in SESSIONHANDLE") (COND ((NULL PROBLEM) (SPP.CLOSE STREAM) (SETQ STREAM NIL) (CL:CERROR "Try again to connect" "Error while logging on to ~A: ~A~%%(Type OK to try again)" SERVERNAME (CDR SESSIONHANDLE))) (T (COND ((NEQ PROBLEM OLDPROBLEM) (PRINTOUT PROMPTWINDOW T "Can't connect to " SERVERNAME " because: " (SELECTQ (SETQ OLDPROBLEM PROBLEM) (T "No response") (NoSuchService "File Service not running") OLDPROBLEM) ";" " will keep trying."))) (SETQ PROBLEM NIL) (DISMISS (COND ((EQ OLDPROBLEM T) (* ; "No explicit response, just try soon") 5000) (T (* ; "It's likely to take a while to get going") 30000)))))) (* ;; "Succeeded in logging in") (if (AND OLDPROBLEM (NEQ OLDPROBLEM T)) then (* ; "Let us know when successful") (PRINTOUT PROMPTWINDOW T "Got connection to " SERVERNAME)) (push \NSFILING.ACTIVE.SESSIONS (SETQ SESSION (create FILINGSESSION FSADDRESS ← ADDRESS FSPARSEDNAME ← SERVERNSNAME FSNAMESTRING ← SERVERNAME FSPROCESSNAME ← PROCNAME FSCOURIERSTREAMS ← (LIST (CONS STREAM)) FSSESSIONHANDLE ← SESSIONHANDLE FSPROTOCOLNAME ← PROGRAM FSDEVICENAME ← (fetch (FDEV DEVICENAME) of DEVICE) FSPROTOCOLDEF ← (\GET.COURIERPROGRAM PROGRAM) FSSESSIONLOCK ← (CREATE.MONITORLOCK SERVERNAME) FSSESSIONTIMER ← (\CREATECELL \FIXP) FSLOGINNAME ← LOGINNAME))) (\NSFILING.SET.CONTINUANCE SESSION) (push (fetch NSCONNECTIONS of DEVINFO) SESSION) (COND ((AND (EQ PROGRAM (QUOTE FILING)) (NOT (fetch NSRANDOMDEVICE of DEVINFO))) (* ; "Create a second device to use for random-access streams.  This is an invisible device, so only needs methods for things you can do to open streams") (replace NSRANDOMDEVICE of DEVINFO with (SETQ RANDEVICE (\MAKE.PMAP.DEVICE (create FDEV DEVICENAME ← (fetch FSNAMESTRING of SESSION) REOPENFILE ← (FUNCTION NILL) CLOSEFILE ← (FUNCTION \NSRANDOM.CLOSEFILE) GETFILEINFO ← (FUNCTION \NSFILING.GETFILEINFO) SETFILEINFO ← (FUNCTION \NSFILING.SETFILEINFO) REGISTERFILE ← (FUNCTION NILL) UNREGISTERFILE ← (FUNCTION NILL) READPAGES ← (FUNCTION \NSRANDOM.READPAGES) WRITEPAGES ← (FUNCTION \NSRANDOM.WRITEPAGES) TRUNCATEFILE ← (FUNCTION \NSRANDOM.TRUNCATEFILE) DEVICEINFO ← DEVICE REMOTEP ← T SUBDIRECTORIES ← T)))) (replace SETEOFPTR of RANDEVICE with (FUNCTION \NSRANDOM.SETEOFPTR)) (* ; "Have to do this after \make.pmap.device"))) SESSION)))))
)

(\NSFILING.AFTER.LOGIN

(LAMBDA (HOST USER) (* bvm%: "31-Jan-86 17:45") (for SESSION in \NSFILING.ACTIVE.SESSIONS when (OR (NULL HOST) (STRING-EQUAL HOST (fetch FSNAMESTRING of SESSION))) do (* ; "Note that the login has changed for this host") (replace FSLOGINCHANGED of SESSION with T)))
)

(\NSFILING.SET.CONTINUANCE

(LAMBDA (SESSION) (* ; "Edited  5-Jun-87 18:11 by bvm:") (LET ((SECONDS (FILING.CALL SESSION (QUOTE CONTINUE) SESSION (QUOTE RETURNERRORS)))) (COND ((FIXP SECONDS) (* ;; "Continue value is number of seconds we can be idle.  Take 3/4 of what the server says, just to be conservative") (replace FSCONTINUANCE of SESSION with (IMIN (IQUOTIENT (ITIMES SECONDS 3) 4) MAX.SMALLP)) T))))
)

(\NSFILING.LOGOUT

(LAMBDA (SESSION) (* ; "Edited  5-Jun-87 17:54 by bvm:") (FILING.CALL SESSION (QUOTE LOGOFF) SESSION (QUOTE NOERROR)))
)

(\NSFILING.DISCARD.SESSION

(LAMBDA (SESSION DEVICE KEEPSTREAM) (* ; "Edited  2-Jun-87 17:55 by bvm:") (* ;; "Called when SESSION is known to be dead.  If KEEPSTREAM is true, we return some active stream, if any, otherwise all streams are closed.") (SETQ \NSFILING.ACTIVE.SESSIONS (DREMOVE SESSION \NSFILING.ACTIVE.SESSIONS)) (change (fetch NSCONNECTIONS of (fetch DEVICEINFO of DEVICE)) (DREMOVE SESSION DATUM)) (PROG1 (for PAIR in (fetch FSCOURIERSTREAMS of SESSION) bind KEPT do (COND ((AND KEEPSTREAM (NULL KEPT) (NULL (CDR PAIR))) (* ; "Keep this stream for caller") (SETQ KEPT (CAR PAIR))) (T (CLOSEF (CAR PAIR)))) finally (replace FSCOURIERSTREAMS of SESSION with NIL) (RETURN KEPT)) (replace FSSESSIONHANDLE of SESSION with :CLOSED) (* ; "Let no one be tempted to use it again.") (* ;; "Finally, release lock if we have it.  This avoids deadlock in the case where we try to get a new session, but somebody before us is already inside \GETFILINGCONNECTION holding on to this session lock.") (RELEASE.MONITORLOCK (fetch FSSESSIONLOCK of SESSION))))
)

(\VALID.FILING.CONNECTIONP

(LAMBDA (SESSION) (* ; "Edited  5-Jun-87 18:11 by bvm:") (* ;; "true if this is a useable connection") (COND ((AND (fetch FSLOGINCHANGED of SESSION) (NOT (STRING-EQUAL (CAR (\INTERNAL/GETPASSWORD (fetch FSNAMESTRING of SESSION))) (fetch FSLOGINNAME of SESSION)))) (* ; "Want new session because credentials changed") (COND ((NOT (for PAIR in (fetch FSCOURIERSTREAMS of SESSION) thereis (CDR PAIR))) (* ;; "Can't do this if someone is using the session!") (\NSFILING.LOGOUT SESSION))) NIL) ((\SECONDSCLOCKGREATERP (fetch FSSESSIONTIMER of SESSION) (fetch FSCONTINUANCE of SESSION)) (* ; "Our conservative timer has expired, but try to use session anyway") (BLOCK) (BLOCK) (* ; "Let spp process run, possibly purge streams") (COND ((\NSFILING.SET.CONTINUANCE SESSION) SESSION))) (T (* ; "Timer not expired, so we're safe, it says here") SESSION)))
)

(\NSFILING.CLOSE.CONNECTIONS

(LAMBDA (DEVICE ABORT?) (* ; "Edited 30-Nov-87 13:18 by bvm:") (* ;; "ABORT? = {NIL | :TEST | :ABORT}, meaning {do logout | logout if we haven't timed out | never bother logging out}.") (RESETLST (OBTAIN.MONITORLOCK (fetch NSFILINGLOCK of (fetch (FDEV DEVICEINFO) of DEVICE)) (EQ ABORT? :ABORT) T) (* ; "Note that if ABORT = :ABORT we don't ever wait for the lock--we're probably screwed anyway if some other process has the session lock at the instant the SAVEVM, etc. happened.") (LET ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE)) SESSION) (if (fetch NSWATCHERPROC of DEVINFO) then (* ; "Don't need a watcher any more") (DEL.PROCESS (fetch NSWATCHERPROC of DEVINFO))) (while (SETQ SESSION (CAR (fetch NSCONNECTIONS of DEVINFO))) do (COND ((SELECTQ ABORT? (NIL T) (:ABORT (* ; "don't bother trying to LOGOUT, we know it's futile") NIL) (PROGN (* ; "Assume session is timed out if session timer expired much longer ago than stated continuance.") (NOT (\SECONDSCLOCKGREATERP (fetch FSSESSIONTIMER of SESSION) (TIMES 2 (fetch FSCONTINUANCE of SESSION)))))) (for PAIR in (APPEND (fetch FSCOURIERSTREAMS of SESSION)) when (CDR PAIR) do (* ; "Someone has a courier stream open on this session, e.g., a bulk data retrieve or write.  If we try to LOGOUT now we will hang, so bash the stream") (SPP.CLOSE (CAR PAIR) T) (BLOCK)) (\NSFILING.LOGOUT SESSION))) (\NSFILING.DISCARD.SESSION SESSION DEVICE))) (for STREAM in (fetch (FDEV OPENFILELST) of DEVICE) do (* ; "invalidate stream's sessions") (replace NSFILING.CONNECTION of STREAM with NIL))))
)

(BREAK.NSFILING.CONNECTION

(LAMBDA (HOST DEVICE) (* ; "Edited 26-May-87 17:06 by bvm:") (COND ((EQ HOST T) (for DEV in \FILEDEVICES when (AND (EQ (fetch (FDEV OPENFILE) of DEV) (FUNCTION \NSFILING.OPENFILE)) (fetch NSCONNECTIONS of (fetch (FDEV DEVICEINFO) of DEV))) collect (\NSFILING.CLOSE.CONNECTIONS DEV) (fetch (FDEV DEVICENAME) of DEV))) (T (LET ((DEV (OR DEVICE (\GETDEVICEFROMNAME (\CANONICAL.NSHOSTNAME HOST) T T)))) (COND (DEV (\NSFILING.CLOSE.CONNECTIONS DEV) T))))))
)
)

(ADDTOVAR \AFTERLOGINFNS
 \NSFILING.AFTER.LOGIN)



(* ; "Support")


(DEFINEQ

(\NSFILING.CONNECT

(LAMBDA (SESSION DIRPATH REALREQUIRED CREATE?) (* ; "Edited 14-Sep-87 14:06 by bvm:") (* ;; "Follow the list of directories in DIRPATH and return the handle for the final one.  The special case when DIRPATH is NIL is equivalent to connecting to the root directory.  Uses cached paths to avoid useless reconnecting.") (PROG (NEW.HANDLE NSPATHNAME) (COND ((SETQ NEW.HANDLE (\NSFILING.LOOKUP.CACHE SESSION DIRPATH)) (* ; "Nothing needs to be done because we're already connected to this path.") (RETURN (AND NEW.HANDLE (fetch NSHDIRECTORYP of NEW.HANDLE) NEW.HANDLE)))) (SETQ NSPATHNAME (COND ((CDR DIRPATH) (CONCATLIST (CDR (for DIR in DIRPATH join (LIST (QUOTE /) DIR))))) (T (CAR DIRPATH)))) (SETQ NEW.HANDLE (FILING.CALL SESSION (QUOTE OPEN) (AND NSPATHNAME (BQUOTE ((PATHNAME (\, NSPATHNAME))))) \NSFILING.NULL.HANDLE NIL SESSION (QUOTE RETURNERRORS))) (SELECTQ (CAR NEW.HANDLE) (NIL (* ; "Utter failure") (RETURN)) (ERROR (COND ((AND (EQ (CADDR NEW.HANDLE) (QUOTE FileNotFound)) (SETQ NEW.HANDLE (\NSFILING.MAYBE.CREATE SESSION DIRPATH CREATE?))) (* ; "Successfully created")) (T (* ; "Failed for some other reason") (RETURN)))) NIL) (RETURN (AND (NLISTP (SETQ NEW.HANDLE (\NSFILING.ADD.TO.CACHE SESSION (create FILINGHANDLE NSHDIRECTORYPATH ← DIRPATH NSHDATUM ← NEW.HANDLE)))) (fetch NSHDIRECTORYP of NEW.HANDLE) NEW.HANDLE))))
)

(\NSFILING.MAYBE.CREATE

(LAMBDA (SESSION DIRLST CREATE?) (* ; "Edited  1-Jun-87 16:06 by bvm:") (* ;;; "Called to possibly create a nonexistent subdirectory.  DIRLST is a list of subdirectories from root to leaf.") (LET (OLDHANDLE NEW.DIR) (AND (SELECTQ CREATE? (:ASK (SETQ CREATE? :ASKED) (* ; "flag needed on recursive calls to show we asked up here") (EQ (QUOTE Y) (ASKUSER DWIMWAIT (QUOTE Y) (CONCAT "Create subdirectory {" (fetch FSNAMESTRING of SESSION) "}<" (CONCATLIST (for DIR in DIRLST join (LIST DIR (QUOTE >)))) "? ")))) (NIL NIL) T) (SETQ OLDHANDLE (\NSFILING.CONNECT SESSION (for TAIL on DIRLST collect (CAR TAIL) while (CDR TAIL) finally (SETQ NEW.DIR (CAR TAIL))) T CREATE?)) (COND ((AND (SETQ OLDHANDLE (FILING.CALL SESSION (QUOTE CREATE) (fetch NSHDATUM of OLDHANDLE) (BQUOTE ((NAME (\, (\NSFILING.REMOVEQUOTES NEW.DIR))) (IS.DIRECTORY T) (FILE.TYPE 1))) NIL SESSION (QUOTE RETURNERRORS))) (NEQ (CAR OLDHANDLE) (QUOTE ERROR))) (* ; "Success") OLDHANDLE) (T (SELECTQ CREATE? ((:ASK :ASKED) (* ; "Interactive use--let user know why we failed.") (CL:ERROR "Could not create ~A because of ~A: ~A" (CONCATLIST (LIST* "{" (fetch FSNAMESTRING of SESSION) "}<" (for DIR in DIRLST join (LIST DIR (QUOTE >))))) (CADR OLDHANDLE) (STRING (CADDR OLDHANDLE))) NIL) NIL))))))
)

(\NSFILING.REMOVEQUOTES

(LAMBDA (NAME) (* bvm%: "24-Sep-85 15:17") (* ;;; "Removes quoting characters from NAME") (COND ((STRPOS "'" NAME) (CONCATCODES (bind (I ← 0) CH while (SETQ CH (NTHCHARCODE NAME (add I 1))) collect (COND ((EQ CH (CHARCODE %')) (OR (NTHCHARCODE NAME (add I 1)) CH)) (T CH))))) (T NAME)))
)

(\NSFILING.ADDQUOTES

(LAMBDA (NAME ALREADYQUOTED) (* bvm%: "27-Jun-86 11:16") (* ;;; "Returns NAME with funny characters (file name delimeters) quoted.  If ALREADYQUOTED is true, then any quote characters in NAME are interpreted as quoting the next char, rather than being a funny char that needs to be quoted") (COND ((for CH instring (OR (STRINGP NAME) (SETQ NAME (MKSTRING NAME))) bind QUOTED do (COND (QUOTED (SETQ QUOTED (SETQ CH NIL))) (T (SELCHARQ CH ((%: ; < > } %] /) (RETURN T)) (%' (COND (ALREADYQUOTED (SETQ QUOTED T)) (T (RETURN T)))) NIL))) finally (COND ((EQ CH (CHARCODE ".")) (* ;; "Name ending in period, the period is significant and must be quoted, else we would leave it out as being an extensionless file indicator") (RETURN T)))) (* ; "Yes, there is something funny, so it's worth constructing a whole new name") (CONCATCODES (for CH instring NAME bind QUOTED NAMECHARS LASTCH do (COND (QUOTED (SETQ QUOTED NIL)) (T (SELCHARQ (SETQ LASTCH CH) ((%: ; < > } %] /) (push NAMECHARS (CHARCODE %'))) (%' (COND (ALREADYQUOTED (SETQ QUOTED T)) (T (push NAMECHARS (CHARCODE %'))))) NIL))) (push NAMECHARS CH) finally (COND ((EQ LASTCH (CHARCODE ".")) (* ; "See ugliness above") (RPLACD NAMECHARS (CONS (CHARCODE %') (CDR NAMECHARS))))) (RETURN (REVERSE NAMECHARS))))) (T NAME)))
)

(\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) (* ; "Edited  3-Jun-87 16:34 by bvm:") (OR (FIXP ATTR) (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) (* ; "Edited  9-Jun-87 14:11 by bvm:") (* ;; "Convert a Lisp file attribute and its value to a filing attr/val pair (list of two elements), or NIL if we can't figure it out.") (LET (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 VALUE) \NSFILING.TYPE.BINARY))) (SIZE (SETQ ATTRIBUTE (QUOTE SIZE.IN.BYTES)) (SETQ VALUE (UNFOLD VALUE BYTESPERPAGE))) (COND ((SETQ X (ASSOC ATTRIBUTE \LISP.TO.NSFILING.ATTRIBUTES)) (SETQ ATTRIBUTE (CADR X))))) (COND ((SETQ X (CADDR (ASSOC ATTRIBUTE \NSFILING.ATTRIBUTES))) (* ; "Check that the value is reasonable before we die deep in a courier call.  X = courier type.") (LET ((COERCEDVALUE VALUE)) (OR (SELECTQ X ((CARDINAL UNSPECIFIED) (AND (SMALLP VALUE) (>= X 0))) (INTEGER (SMALLP VALUE)) ((LONGCARDINAL LONGINTEGER TIME) (FIXP VALUE)) (USER (SETQ COERCEDVALUE (PARSE.NSNAME VALUE))) (ACCESS.LIST (* ; "A protection value is complicated") (AND (OR (NULL VALUE) (LISTP VALUE)) (SETQ COERCEDVALUE (for ENTRY in VALUE collect (LIST (PARSE.NSNAME (CAR ENTRY)) (COND ((AND (LISTP (CADR ENTRY)) (for ACCESS in (CADR ENTRY) always (MEMB ACCESS (QUOTE (ALL READ WRITE OWNER ADD REMOVE))))) (CADR ENTRY)) (T (RETURN)))) finally (RETURN (COURIER.CREATE (FILING . ACCESS.LIST) ENTRIES ← $$VAL DEFAULTED ← NIL)))))) (PROGN (* ; "accept anything, hope for the best") T)) (\ILLEGAL.ARG VALUE)) (LIST ATTRIBUTE COERCEDVALUE))) ((FIXP ATTRIBUTE) (* ; "This is how to get raw, unregistered attributes.  Value must be sequence unspecified") (COND ((for (TL ← VALUE) by (CDR TL) while TL always (AND (LISTP TL) (SMALLP (CAR TL)))) (LIST ATTRIBUTE VALUE)) (T (\ILLEGAL.ARG VALUE)))))))
)
)



(* ; "FILINGHANDLE stuff")


(DEFINEQ

(\NSFILING.GETFILE

(LAMBDA (DEVICE FILENAME ACCESS RECOG OPTION PARAMETERS DIROK SEQUENTIAL OLDSTREAM) (* ; "Edited  8-Dec-87 15:06 by bvm:") (* ;; "Opens FILENAME for specified ACCESS and RECOG, returning a stream.  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 -- 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 (PROG ((NAME "") VERSION EXPLICIT-VERSION SESSION OLDHANDLE FILE.ID HANDLE FILESTREAM FULLNAME PARSE ROOTNAME DIRPATH RANDEVICE HAVELOCK SERIALIZE) (COND ((NOT (SETQ SESSION (\GETFILINGCONNECTION DEVICE))) (RETURN NIL))) (COND ((EQ ACCESS (QUOTE SERIALIZE)) (* ; "Like INPUT, but retrieve a serialized stream on file") (SETQ ACCESS (QUOTE INPUT)) (SETQ SERIALIZE (QUOTE SERIALIZE)) (SETQ SEQUENTIAL T)) ((AND (NOT SEQUENTIAL) (NOT OPTION) *NSFILING-RANDOM-ACCESS*) (* ; "RANDEVICE set if we want to open a randaccess stream") (SETQ RANDEVICE (fetch NSRANDOMDEVICE of (fetch DEVICEINFO of DEVICE))))) RETRY (COND ((SETQ HANDLE (\NSFILING.LOOKUP.CACHE SESSION FILENAME)) (* ; "Cache hit") (COND (OPTION (* ; "Got handle, so just do what the option said (else fall thru and try to open a file)") (GO HANDLE.OPTION)))) ((AND (LISTP FILENAME) (EQ (CAR FILENAME) (QUOTE FILE.ID))) (* ; "Identifying file by ID, take shortcut.  Do this second just in case we have cached this file already") (SETQ FILE.ID (CADR FILENAME))) (T (* ; "Parse the name and go thru all this hassle") (SETQ PARSE (\NSFILING.PARSE.FILENAME FILENAME)) (SETQ DIRPATH (fetch NSDIRECTORIES of PARSE)) (COND ((NULL DIRPATH) (* ; "No directories specified, so is illegal name") (GO FILE.NOT.FOUND)) ((EQ OPTION (QUOTE DIRECTORY)) (RETURN (AND (fetch NSDIRECTORYP of PARSE) (SETQ HANDLE (\NSFILING.CONNECT SESSION DIRPATH T PARAMETERS)) (GO HANDLE.OPTION)))) ((AND (fetch NSDIRECTORYP of PARSE) (NOT DIROK)) (* ; "No name, just a directory.  Failure unless caller said a directory file is ok") (GO FILE.NOT.FOUND))) (SETQ EXPLICIT-VERSION (fetch NSVERSION of PARSE)) (SETQ ROOTNAME (fetch NSROOTNAME of PARSE)))) (COND (HANDLE (* ; "We have an open file handle from the cache")) (FILE.ID (* ; "Try to open an existing file by ID.") (COND ((SETQ HANDLE (\NSFILING.OPEN.HANDLE SESSION (BQUOTE ((FILE.ID (\, FILE.ID)))) (AND RANDEVICE ACCESS))) (SETQ HAVELOCK RANDEVICE)) (T (GO FILE.NOT.FOUND)))) (T (* ; "open by name") (SETQ OLDHANDLE (\NSFILING.OPEN.HANDLE SESSION (\NSFILING.COMPOSE.PATHNAME DIRPATH ROOTNAME (OR EXPLICIT-VERSION (SELECTQ RECOG (OLDEST (QUOTE -)) (QUOTE +)))) (AND RANDEVICE (SETQ HAVELOCK (SELECTQ ACCESS ((OUTPUT BOTH) (* ; "When opening for output, only get lock right now if we know we will be playing with the old file.") (AND (OR EXPLICIT-VERSION (NEQ RECOG (QUOTE NEW))) (QUOTE OUTPUT))) (INPUT ACCESS) NIL))) (QUOTE RETURNERRORS))) (COND ((OR (NULL OLDHANDLE) (AND (LISTP OLDHANDLE) (EQ (CADR OLDHANDLE) (QUOTE ACCESS.ERROR)) (EQ (CADDR OLDHANDLE) (QUOTE FileNotFound)))) (* ; "No file of any version exists by this name") (SETQ HAVELOCK NIL) (SELECTQ RECOG ((OLD OLDEST) (* ; "No version exists, so certainly this one doesn't") (RETURN NIL)) (COND ((EQ ACCESS (QUOTE INPUT)) (* ; "Version given explicitly, file does not exist") (RETURN NIL)) ((NULL EXPLICIT-VERSION) (* ; "No extant version, so create number 1") (OR RANDEVICE (SETQ VERSION 1))) (T (SETQ VERSION EXPLICIT-VERSION))))) ((LISTP OLDHANDLE) (* ; "Error case") (SETQ HAVELOCK NIL) (SETQ FILESTREAM OLDHANDLE) (GO HANDLE.ERROR)) ((AND (fetch NSHDIRECTORYP of OLDHANDLE) (NOT DIROK)) (* ; "It's a directory, don't try to treat as ordinary file") (GO FILE.NOT.FOUND)) ((OR EXPLICIT-VERSION (NEQ RECOG (QUOTE NEW))) (* ; "Old file exists, use it unless we explicitly requested a new version") (SETQ HANDLE OLDHANDLE) (COND (EXPLICIT-VERSION (SETQ VERSION EXPLICIT-VERSION)))) ((NOT RANDEVICE) (* ; "RECOG = NEW -- write a file version one higher.  Don't do this in random access case, because we can get the server to tell us the version there.") (SETQ VERSION (ADD1 (OR (CADR (ASSOC (QUOTE VERSION) (OR (fetch NSHATTRIBUTES of OLDHANDLE) (\NSFILING.FILLIN.ATTRIBUTES SESSION OLDHANDLE)))) (GO FILE.NOT.FOUND)))))))) (* ;; "At this point, HANDLE is an open handle on the file we want, or is NIL in the case where we are to create a new version, in which case VERSION has been set correctly.") (SETQ FULLNAME (\NSFILING.FULLNAME SESSION (OR HANDLE PARSE) VERSION)) (COND (OPTION (* ; "Not opening file, something simpler") (GO HANDLE.OPTION)) ((AND HANDLE (NOT OLDSTREAM) (\NSFILING.CONFLICTP DEVICE SESSION HANDLE ACCESS)) (GO FILE.BUSY))) (SELECTQ ACCESS (INPUT (COND ((NULL HANDLE) (* ; "Odd to get here.  E.g., open for INPUT recog NEW.") (GO FILE.NOT.FOUND)) (RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION HANDLE (QUOTE INPUT) HAVELOCK OLDSTREAM))) ((NEQ (fetch NSHACCESS of HANDLE) (QUOTE OUTPUT)) (* ; "Just retrieve old file") (SETQ FILESTREAM (FILING.CALL SESSION (OR SERIALIZE (QUOTE RETRIEVE)) (fetch NSHDATUM of HANDLE) NIL SESSION (QUOTE RETURNERRORS) (QUOTE KEEPSTREAM)))) (T (GO FILE.BUSY)))) ((OUTPUT BOTH) (COND ((AND (EQ ACCESS (QUOTE BOTH)) (NOT RANDEVICE)) (* ; "Sequential + BOTH are incompatible") (GO FILE.WONT.OPEN))) (COND (HANDLE (* ; "File already exists, need to overwrite") (COND (RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION HANDLE ACCESS HAVELOCK OLDSTREAM T))) ((NULL (fetch NSHACCESS of HANDLE)) (* ; "Overwrite existing file sequentially") (SETQ FILESTREAM (OR (\NSFILING.CHECK.ACCESS SESSION HANDLE (QUOTE WRITE)) (FILING.CALL SESSION (QUOTE REPLACE) (fetch NSHDATUM of HANDLE) NIL NIL SESSION (QUOTE RETURNERRORS) (QUOTE KEEPSTREAM)))) (COND ((type? STREAM FILESTREAM) (* ; "Cache of saved attributes is now wrong") (replace NSHATTRIBUTES of HANDLE with NIL) (* ; "Save attributes to change after file is stored") (replace NSFILING.NEW.ATTRIBUTES of FILESTREAM with PARAMETERS)))) (T (GO FILE.BUSY)))) (OLDSTREAM (* ; "Trying to reopen old stream, failed.") (RETURN NIL)) ((SETQ OLDHANDLE (\NSFILING.CONNECT SESSION DIRPATH T T)) (* ; "Need to create the file, so first had to get a handle on the parent (CREATE and STORE procedures do not permit PATHNAME as one of the specifying attributes).") (COND (RANDEVICE (* ; "Create a new, empty file, then start writing pages to it.  Lucky us, we can do this right for a change.") (SETQ HANDLE (FILING.CALL SESSION (QUOTE CREATE) (fetch NSHDATUM of OLDHANDLE) (BQUOTE ((NAME (\, (\NSFILING.REMOVEQUOTES (fetch NSROOTNAME of PARSE)))) (\,@ (AND VERSION (BQUOTE ((VERSION (\, VERSION)))))) (\,@ PARAMETERS))) (QUOTE ((LOCK EXCLUSIVE))) SESSION (QUOTE RETURNERRORS))) (COND ((OR (NLISTP HANDLE) (EQ (CAR HANDLE) (QUOTE ERROR)) (LISTP (SETQ HANDLE (\NSFILING.ADD.TO.CACHE SESSION (create FILINGHANDLE NSHDATUM ← HANDLE NSHACCESS ← (QUOTE OUTPUT)))))) (* ; "Create failed or we can't read its attributes!  Fall thru to error handler") (SETQ FILESTREAM HANDLE) (GO HANDLE.ERROR)) ((type? STREAM (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION HANDLE ACCESS T))) (* ; "Succeeded in opening stream, i.e., no further conflicts detected.") (SETQ FULLNAME (\NSFILING.FULLNAME SESSION HANDLE))) (T (GO HANDLE.ERROR)))) (T (* ; "Start writing new file, guessing the version.  Ideally we shouldn't guess the version, but Lisp wants a full file name NOW (grumble).") (SETQ FILESTREAM (OR (\NSFILING.CHECK.ACCESS SESSION OLDHANDLE (QUOTE ADD)) (FILING.CALL SESSION (QUOTE STORE) (fetch NSHDATUM of OLDHANDLE) (BQUOTE ((NAME (\, (\NSFILING.REMOVEQUOTES (fetch NSROOTNAME of PARSE)))) (VERSION (\, VERSION)) (\,@ PARAMETERS))) NIL NIL SESSION (QUOTE RETURNERRORS) (QUOTE KEEPSTREAM))))))) (T (GO FILE.NOT.FOUND)))) (\ILLEGAL.ARG ACCESS)) (COND ((NOT (type? STREAM FILESTREAM)) (* ; "Had handle, but failed to open it.") (GO HANDLE.ERROR))) (replace FULLFILENAME of FILESTREAM with (COND (*UPPER-CASE-FILE-NAMES* (MKATOM (U-CASE FULLNAME))) (T FULLNAME))) (replace NSFILING.CONNECTION of FILESTREAM with SESSION) (replace NSFILING.HANDLE of FILESTREAM with HANDLE) (replace DEVICE of FILESTREAM with (OR RANDEVICE DEVICE)) (COND (HANDLE (add (fetch NSHBUSYCOUNT of HANDLE) 1))) (RETURN FILESTREAM) HANDLE.OPTION (* ;; "Come here when we have obtained the handle on the file in question, but OPTION is non-NIL, so we want to do something other than open a file.") (RETURN (SELECTQ OPTION (NAME (if HANDLE then (\NSFILING.FULLNAME SESSION HANDLE NIL *UPPER-CASE-FILE-NAMES*) else (* ; "OUTFILEP case: no handle, but we have computed the name") FULLNAME)) (DIRECTORY (* ; "I'm pretty sure HANDLE can't be NIL at this point, but a little test never hurt anyone.") (AND HANDLE (fetch NSHDIRECTORYP of HANDLE) (\NSFILING.FULLNAME SESSION HANDLE NIL *UPPER-CASE-FILE-NAMES*))) (ATTRIBUTES (OR (fetch NSHATTRIBUTES of HANDLE) (\NSFILING.FILLIN.ATTRIBUTES SESSION HANDLE))) (HANDLE (CL:FUNCALL PARAMETERS SESSION HANDLE)) (SHOULDNT))) HANDLE.ERROR (* ;; "Come here with FILESTREAM set to an error returned from some courier call") (COND ((NOT (EQUAL FILESTREAM (QUOTE (ERROR SESSION.ERROR TokenInvalid)))) (COND (HAVELOCK (\NSRANDOM.RELEASE.LOCK SESSION HANDLE))) (RETURN (\NSFILING.HANDLE.ERROR SESSION FILESTREAM FILENAME))) ((SETQ SESSION (\NSFILING.GET.NEW.SESSION SESSION DEVICE)) (* ; "Got new session, so start over.  Note that we may have to reparse, since the first time thru we might have gotten the cached handle.") (SETQ HAVELOCK (SETQ HANDLE (SETQ VERSION NIL))) (GO RETRY)) (T (* ; "Can't get connection at all?  OH well, die as if it were true from the start.") (RETURN NIL))) FILE.NOT.FOUND (COND (HAVELOCK (\NSRANDOM.RELEASE.LOCK SESSION HANDLE))) (RETURN NIL) FILE.BUSY (COND (HAVELOCK (\NSRANDOM.RELEASE.LOCK SESSION HANDLE))) FILE.WONT.OPEN (RETURN (WITHOUT.SESSION.MONITOR SESSION (LISPERROR "FILE WON'T OPEN" FULLNAME))))))
)

(\NSFILING.LOOKUP.CACHE

(LAMBDA (CONNECTION FILENAME) (* ; "Edited  9-Jun-87 22:55 by bvm:") (LET ((CACHE (fetch FSCACHEDHANDLES of CONNECTION)) ENTRY) (COND ((COND ((EQ (CAR (LISTP FILENAME)) (QUOTE FILE.ID)) (* ; "Look by id") (find old ENTRY in CACHE bind (ID ← (CADR FILENAME)) suchthat (EQUAL (fetch NSHFILEID of ENTRY) ID))) ((OR (NULL FILENAME) (LISTP FILENAME)) (* ; "Looking for directory match") (find old ENTRY in CACHE bind NAME (PATHLENGTH ← (LENGTH FILENAME)) suchthat (AND (NEQ (SETQ NAME (fetch NSHDIRECTORYPATH of ENTRY)) T) (EQ (LENGTH NAME) PATHLENGTH) (for X in FILENAME always (STRING-EQUAL X (pop NAME)))))) (T (* ; "Looking for file name match") (find old ENTRY in CACHE suchthat (STRING-EQUAL (fetch NSHNAME of ENTRY) FILENAME)))) (COND ((CDR CACHE) (* ; "Promote to front of cache") (replace FSCACHEDHANDLES of CONNECTION with (CONS ENTRY (DREMOVE ENTRY CACHE))))) ENTRY))))
)

(\NSFILING.ADD.TO.CACHE

(LAMBDA (SESSION HANDLE NOERRORFLG) (* ; "Edited  1-Sep-87 11:42 by bvm:") (* ;;; "Add file HANDLE to the cache for SESSION and return it, or an earlier cached version of the same handle if there is one") (PROG ((CACHE (fetch FSCACHEDHANDLES of SESSION)) (ID (fetch NSHFILEID of HANDLE)) OLDHANDLE) (COND ((NULL ID) (COND ((OR (NLISTP (SETQ ID (\NSFILING.FILLIN.ATTRIBUTES SESSION HANDLE NOERRORFLG))) (EQ (CAR ID) (QUOTE ERROR))) (* ; "Pass error up") (RETURN ID))) (SETQ ID (fetch NSHFILEID of HANDLE)))) (COND ((AND ID (SETQ OLDHANDLE (find H in CACHE suchthat (EQUAL (fetch NSHFILEID of H) ID)))) (* ; "Don't keep duplicates--flush the new one and return the old one") (\NSFILING.CLOSE.HANDLE SESSION HANDLE) (RETURN OLDHANDLE))) (while (GREATERP (LENGTH CACHE) FILING.CACHE.LIMIT) do (* ; "Flush old unused handles to keep the cache within limits") (for H in CACHE when (EQ (fetch NSHBUSYCOUNT of H) 0) do (SETQ OLDHANDLE H)) (COND (OLDHANDLE (* ; "The least recently referenced unused handle") (SETQ CACHE (DREMOVE OLDHANDLE CACHE)) (\NSFILING.CLOSE.HANDLE SESSION OLDHANDLE) (SETQ OLDHANDLE NIL)) (T (* ; "All handles are busy") (RETURN)))) (replace FSCACHEDHANDLES of SESSION with (CONS HANDLE CACHE)) (RETURN HANDLE)))
)

(\NSFILING.OPEN.HANDLE

(LAMBDA (SESSION PNAME.OR.PROPS CONTROLS NOERRORFLG PARENT) (* ; "Edited  8-Dec-87 15:18 by bvm:") (COND ((EQ CONTROLS (QUOTE BOTH)) (* ; "Access BOTH needs no more rights than OUTPUT, so this is the canonical form") (SETQ CONTROLS (QUOTE OUTPUT)))) (LET ((HANDLE (FILING.CALL SESSION (QUOTE OPEN) (OR (LISTP PNAME.OR.PROPS) (BQUOTE ((PATHNAME (\, PNAME.OR.PROPS))))) (if PARENT then (fetch NSHDATUM of PARENT) else \NSFILING.NULL.HANDLE) (AND CONTROLS (BQUOTE ((LOCK (\, (SELECTQ CONTROLS (INPUT (QUOTE SHARE)) (OUTPUT (QUOTE EXCLUSIVE)) (SHOULDNT))))))) SESSION (OR NOERRORFLG (QUOTE NOERROR))))) (COND ((OR (NLISTP HANDLE) (EQ (CAR HANDLE) (QUOTE ERROR))) (* ; "Failure return") HANDLE) (T (LET ((RESULT (\NSFILING.ADD.TO.CACHE SESSION (SETQ HANDLE (create FILINGHANDLE NSHDATUM ← HANDLE NSHACCESS ← CONTROLS)) NOERRORFLG))) (COND ((NOT (TYPENAMEP RESULT (QUOTE FILINGHANDLE))) (* ; "Error trying to get attributes--close the handle altogether now, since it's not going into the cache.") (\NSFILING.CLOSE.HANDLE SESSION HANDLE)) (CONTROLS (* ; "May need to release lock if there's an error later.") (RESETSAVE NIL (LIST (FUNCTION \NSRANDOM.RELEASE.IF.ERROR) SESSION HANDLE)))) RESULT)))))
)

(\NSFILING.CONFLICTP

(LAMBDA (DEVICE SESSION HANDLE ACCESS) (* ; "Edited 10-Jun-87 14:06 by bvm:") (* ;; "True if opening HANDLE on SESSION for specified ACCESS would present an access conflict for streams already open on DEVICE.  We need this as an explicit check because we might have files open on expired sessions where we haven't yet reestablished their streams on the new session, and hence the handle conflict would not be apparent.") (LET ((OPENFILES (fetch (FDEV OPENFILELST) of DEVICE))) (AND OPENFILES (for S in OPENFILES bind (NAME ← (\NSFILING.FULLNAME SESSION HANDLE)) when (STRING-EQUAL NAME (fetch FULLFILENAME of S)) do (* ; "Note that looking at one stream on the file is sufficient for conflict check.") (RETURN (SELECTQ ACCESS ((OUTPUT BOTH) (* ; "Always a conflict") T) (INPUT (* ; "Ok if only input") (DIRTYABLE S)) (\ILLEGAL.ARG ACCESS)))))))
)

(\NSFILING.CHECK.ACCESS

(LAMBDA (SESSION HANDLE TYPE) (* ; "Edited 30-Nov-87 10:39 by bvm:") (* ;; "Check that user has TYPE access to the specified file handle.  TYPE is one of the values of the ACCESS control: READ, WRITE, OWNER, ADD, REMOVE, ALL.  If user has access, returns NIL; otherwise, returns some sort of courier error.") (* ;; "In Filing 4 (Services 8.0) this can't work, so we pretend it succeeds.") (AND (NEQ (fetch FSPROTOCOLNAME of SESSION) (QUOTE FILING.4)) (LET ((RESULT (FILING.CALL SESSION (QUOTE GET.CONTROLS) (fetch NSHDATUM of HANDLE) (QUOTE (ACCESS)) SESSION (QUOTE RETURNERRORS)))) (COND ((EQ (CAR RESULT) (QUOTE ERROR)) RESULT) ((NOT (for A in (CADR (ASSOC (QUOTE ACCESS) RESULT)) thereis (OR (EQ A TYPE) (EQ A (QUOTE ALL))))) (* ;; "Fake a protection error.  Don't generate the error here, because caller may need to release a lock first.  The ASSOC is because filing returns a list of controls, even though I only asked for one (bug).") (QUOTE (ERROR ACCESS.ERROR AccessRightsInsufficient)))))))
)

(\NSFILING.FILLIN.ATTRIBUTES

(LAMBDA (SESSION HANDLE NOERRORFLG) (* ; "Edited  3-Jun-87 19:25 by bvm:") (OR (fetch NSHATTRIBUTES of HANDLE) (LET ((ATTRS (FILING.CALL SESSION (QUOTE GET.ATTRIBUTES) (fetch NSHDATUM of HANDLE) \NSFILING.USEFUL.ATTRIBUTE.TYPES SESSION (OR NOERRORFLG (QUOTE RETURNERRORS))))) (COND ((AND (LISTP ATTRS) (NEQ (CAR ATTRS) (QUOTE ERROR))) (replace NSHATTRIBUTES of HANDLE with ATTRS) (for X in ATTRS do (* ;; "Fill in interesting attributes that we might want to get at quickly and not lose if a SETFILEINFO is done") (SELECTQ (CAR X) (PATHNAME (replace NSHPATHNAME of HANDLE with (CADR X))) (FILE.ID (replace NSHFILEID of HANDLE with (CADR X))) (IS.DIRECTORY (replace NSHDIRECTORYP of HANDLE with (CADR X))) NIL))) ((NOT NOERRORFLG) (COURIER.SIGNAL.ERROR (fetch FSPROTOCOLNAME of SESSION) (QUOTE GET.ATTRIBUTES) ATTRS))) ATTRS)))
)

(\NSFILING.COMPOSE.PATHNAME

(LAMBDA (DIRPATH NAME VERSION) (* bvm%: "19-Dec-85 16:55") (* ;;; "Makes a NS pathname out of the file name with given components.  All components are assumed to be quoted as needed.  NAME and/or VERSION can be NIL") (CONCATLIST (NCONC (CDR (for DIR in DIRPATH join (LIST (QUOTE /) DIR))) (AND NAME (LIST (QUOTE /) (\NSFILING.ADDQUOTES NAME T))) (AND VERSION (LIST (QUOTE !) VERSION)))))
)

(\NSFILING.PARSE.FILENAME

(LAMBDA (FILENAME PATTERNP) (* ; "Edited 10-Dec-87 11:09 by bvm:") (* ;;; "Parses FILENAME into an NSFILINGPARSE record.  Hate to do this independent of UNPACKFILENAME, but there's too much to worry about -- need to parse the directories individually, require periods not to mean version, ignore colon as a device delimeter, etc.") (* ;;; "PATTERNP is true when parsing a directory pattern.  Main difference is we preserve final dot in name so caller knows it has to be extensionless.") (* ;;; "Returns NIL if filename is bad.") (bind CH (I ← 1) (NC ← (NCHARS FILENAME)) START VERSION SEMI DOTSEEN DIRS END LASTHOST NAME first (COND ((OR (NULL (SETQ LASTHOST (SELCHARQ (CHCON1 FILENAME) ({ (CHARCODE })) (%( (CHARCODE %))) (%[ (CHARCODE %])) NIL))) (until (EQ (SETQ CH (NTHCHARCODE FILENAME (add I 1))) LASTHOST) do (COND ((NULL CH) (* ; "end of file name") (RETURN T))))) (* ; "Bad file name") (RETURN NIL))) (SETQ START (+ I (SELCHARQ (NTHCHARCODE FILENAME (ADD1 I)) ((/ <) 2) (PROGN (* ; "No directory") 1)))) while (<= (add I 1) NC) do (SELCHARQ (NTHCHARCODE FILENAME I) (; (* ; "Version marker maybe") (SETQ SEMI I)) (%. (OR DOTSEEN (SETQ DOTSEEN I))) (%' (* ; "quote mark, skip it and next char") (add I 1)) ((/ >) (* ; "Directory marker") (if SEMI then (* ; "Version marker inside directory?") (RETURN NIL)) (SETQ DIRS (NCONC1 DIRS (SUBSTRING FILENAME START (SUB1 I)))) (SETQ SEMI (SETQ DOTSEEN NIL)) (SETQ START (ADD1 I))) (* (if (NOT PATTERNP) then (RETURN NIL))) NIL) finally (COND ((NEQ START I) (SETQ END (COND (SEMI (SUB1 SEMI)) (T (SUB1 I)))) (COND ((AND (EQ END DOTSEEN) (NOT PATTERNP)) (* ; "Don't include final dot of extensionless files in actual name on server") (SETQ DOTSEEN NIL) (SETQ END (SUB1 END)))) (COND ((GEQ END START) (SETQ NAME (SUBSTRING FILENAME START END)))))) (if (AND SEMI (NEQ SEMI NC)) then (* ; "Parse version as integer.  Note: PARSE-INTEGER demands a string, but FILENAME might be a symbol.") (CL:MULTIPLE-VALUE-SETQ (VERSION END) (CL:PARSE-INTEGER (SUBSTRING FILENAME (ADD1 SEMI)) :JUNK-ALLOWED T)) (if (NEQ END (- NC SEMI)) then (* ; "Junk found") (if (AND PATTERNP (EQ SEMI (SUB1 NC)) (EQ (NTHCHARCODE FILENAME NC) (CHARCODE *))) then (* ; "Version * ok for patterns") (SETQ VERSION (QUOTE *)) else (RETURN NIL)) elseif (NOT (AND (> VERSION 0) (<= VERSION MAX.SMALLP))) then (* ; "Bad version--negative or out of range") (RETURN NIL))) (RETURN (create NSFILINGPARSE NSDIRECTORIES ← DIRS NSROOTNAME ← NAME NSVERSION ← VERSION NSDIRECTORYP ← (OR (NULL NAME) (EQ (NCHARS NAME) 0)) NSHASPERIOD ← DOTSEEN))))
)

(\NSFILING.ERRORHANDLER

(LAMBDA (STREAM ERRCODE) (* ; "Edited 20-Nov-87 17:03 by bvm:") (* ;;; "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 HANDLE FULLNAME OLDPTR CON POS) (COND ((AND (NEQ ERRCODE (QUOTE STREAM.LOST)) (NEQ ERRCODE (QUOTE END))) (* ; "Not a stream lost type of error.  END can occur if you try to make a call on a Courier stream at the same time that the other end decided to time you out.") (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 (STKPOS (FUNCTION COURIER.EXECUTE.CALL))) (BLOCK 500) (* ;; "Tell courier caller that the stream went away.  Wait a moment for connection process to clean up the mess if there is any") (RETFROM POS (QUOTE STREAM.LOST) T)) (T (GO EXIT)))) ((SETQ POS (STKPOS (FUNCTION \COURIER.RESULTS))) (* ; "Error trying to close the file -- convert this to an error return") (BLOCK 500) (RETFROM POS (QUOTE (ERROR STREAM.LOST)) T)) ((NEQ (fetch ACCESS of STREAM) (QUOTE INPUT)) (* ; "No help for output files") (GO EXIT)) ((NOT (SETQ HANDLE (fetch NSFILING.HANDLE of STREAM))) (* ; "Stream already blown away?") (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) (LET ((ID (fetch NSHFILEID of HANDLE))) (OR (AND ID (LIST (QUOTE FILE.ID) ID)) FULLNAME)) (QUOTE INPUT) (QUOTE OLD) NIL NIL NIL 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.WHENCLOSED

(LAMBDA (STREAM) (* ; "Edited  2-Jun-87 18:42 by bvm:") (* ;;; "Called when Courier STREAM is closed, by whatever means") (for SESSION in \NSFILING.ACTIVE.SESSIONS bind STREAMPAIRS DEV thereis (for PAIR in (SETQ STREAMPAIRS (fetch FSCOURIERSTREAMS of SESSION)) when (EQ (CAR PAIR) STREAM) do (replace FSCOURIERSTREAMS of SESSION with (DREMOVE PAIR STREAMPAIRS)) (COND ((AND (SETQ DEV (\GETDEVICEFROMHOSTNAME (fetch FSDEVICENAME of SESSION) T)) (fetch (FDEV OPENFILELST) of DEV)) (\NSRANDOM.ENSURE.WATCHER DEV))) (RETURN T))))
)

(\NSFILING.CLOSE.HANDLE

(LAMBDA (SESSION HANDLE) (* ; "Edited  5-Jun-87 17:59 by bvm:") (* ;; "Release the given file handle.") (FILING.CALL SESSION (QUOTE CLOSE) (fetch NSHDATUM of HANDLE) SESSION (QUOTE NOERROR)))
)

(\NSFILING.FULLNAME

(LAMBDA (CONNECTION HANDLE.OR.PARSE VERSION ATOMFLG) (* ; "Edited 20-Nov-87 18:40 by bvm:") (PROG (FILENAME DIRLST DIRECTORYFLG FULLNAME PATHNAME FUNNYCHAR DOTSEEN ALREADYQUOTED INFO HANDLE QUOTEDDIRS) (COND ((SETQ INFO (COND ((type? FILINGHANDLE HANDLE.OR.PARSE) (COND ((SETQ FULLNAME (fetch NSHNAME of (SETQ HANDLE HANDLE.OR.PARSE))) (GO EXIT))) (OR (fetch NSHATTRIBUTES of HANDLE) (\NSFILING.FILLIN.ATTRIBUTES CONNECTION HANDLE))) ((LISTP (CADR HANDLE.OR.PARSE)) (* ; "Assume is attribute list itself") HANDLE.OR.PARSE))) (for PAIR in INFO do (SELECTQ (CAR PAIR) (IS.DIRECTORY (SETQ DIRECTORYFLG (CADR PAIR))) (VERSION (SETQ VERSION (CADR PAIR))) (PATHNAME (SETQ PATHNAME (CADR PAIR))) NIL)) (for I from 1 while (<= I NC) bind CH VERS (START ← 1) (NC ← (NCHARS PATHNAME)) PREVDOT do (SELCHARQ (SETQ CH (NTHCHARCODE PATHNAME I)) (! (* ; "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 (- 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)) (SETQ DOTSEEN (SETQ PREVDOT NIL))) (%. (SETQ PREVDOT DOTSEEN) (SETQ DOTSEEN I)) ((; %: < > } %]) (* ; "Funny characters that filing doesn't care about but we do -- need to quote these") (SETQ FUNNYCHAR T)) NIL) finally (SETQ PATHNAME (SUBSTRING PATHNAME START (COND ((NULL VERS) NIL) ((NULL DIRECTORYFLG) (* ; "ordinary file, here's the version") (SETQ VERSION (SUBSTRING PATHNAME (ADD1 VERS))) (SUB1 VERS)) ((AND (EQ VERS (- I 2)) (EQ (NTHCHARCODE PATHNAME (ADD1 VERS)) (CHARCODE 1))) (* ; "Version 1 in path, toss it out") (SUB1 VERS))))) (SETQ FILENAME (COND (DIRECTORYFLG (SETQ DOTSEEN NIL) (push DIRLST PATHNAME) NIL) ((OR (if (AND DOTSEEN (EQ DOTSEEN (if VERS then (SUB1 VERS) else NC))) then (* ; "Ugh--the pathname ended in an actual period, which we usually toss out.  I.e. we prefer extensionless files to have no period at the end.  So if the server thinks there is one, we'd better say FOO'..;1 instead of FOO.;1.") (SETQ DOTSEEN PREVDOT) T) FUNNYCHAR) (* ; "May need to quote chars that the server didn't find worth quoting. ") (\NSFILING.ADDQUOTES PATHNAME T)) (T PATHNAME)))) (* ;; "DIRLST is in reverse order now.") (for DIR in DIRLST do (push QUOTEDDIRS (COND (FUNNYCHAR (\NSFILING.ADDQUOTES DIR T)) (T DIR)) (QUOTE >))) (SETQ ALREADYQUOTED T) (* ;; "Since everything came from a valid (from the server's point of view) pathname, we won't have to add quotes except for characters that WE care about (for unpackfilename and friends)")) (T (SETQ FILENAME (fetch NSROOTNAME of HANDLE.OR.PARSE)) (SETQ QUOTEDDIRS (for DIR in (fetch NSDIRECTORIES of HANDLE.OR.PARSE) join (LIST (\NSFILING.ADDQUOTES DIR ALREADYQUOTED) (QUOTE >)))) (SETQ DIRECTORYFLG (fetch NSDIRECTORYP of HANDLE.OR.PARSE)) (OR VERSION (SETQ VERSION (fetch NSVERSION of HANDLE.OR.PARSE))) (SETQ DOTSEEN (fetch NSHASPERIOD of HANDLE.OR.PARSE)) (SETQ ALREADYQUOTED T))) (SETQ FULLNAME (CONCATLIST (NCONC (LIST (QUOTE {) (fetch FSNAMESTRING of CONNECTION) "}<") QUOTEDDIRS (AND (NOT DIRECTORYFLG) (LIST (OR FILENAME "") (COND (DOTSEEN ";") (T ".;")) (OR VERSION "")))))) (COND (HANDLE (replace NSHNAME of HANDLE with FULLNAME))) EXIT (RETURN (COND ((AND ATOMFLG *UPPER-CASE-FILE-NAMES*) (* ; "Return in 'Lisp file name' form") (MKATOM (U-CASE FULLNAME))) (T FULLNAME)))))
)
)



(* ; "NSFILING device")


(DEFINEQ

(\NSFILING.OPENFILE

(LAMBDA (FILENAME ACCESS RECOG PARAMETERS DEVICE) (* ; "Edited 17-Jul-87 17:15 by bvm:") (LET (ATTRIBUTES ATVAL OTHER SEQUENTIAL STREAM) (COND ((SETQ STREAM (\NSFILING.GETFILE DEVICE FILENAME (SELECTQ ACCESS ((INPUT OUTPUT BOTH) ACCESS) (\ILLEGAL.ARG ACCESS)) (SELECTQ RECOG ((OLD NEW OLDEST OLD/NEW) (* ; "explicit recog values") RECOG) (NIL (* ; "Default according to access.  I think maybe the generic system does this anyway.") (SELECTQ ACCESS (INPUT (QUOTE OLD)) (OUTPUT (QUOTE NEW)) (BOTH (QUOTE OLD/NEW)) NIL)) (\ILLEGAL.ARG RECOG)) NIL (PROGN (* ; "Convert caller's PARAMETERS list to OPENSTREAM to a list of filing attributes") (for PAIR in PARAMETERS do (COND ((NLISTP PAIR) (COND ((EQ PAIR (QUOTE SEQUENTIAL)) (* ; "Obsolete way of asking for sequential access") (SETQ SEQUENTIAL T)))) ((EQ (CAR PAIR) (QUOTE SEQUENTIAL)) (SETQ SEQUENTIAL (CADR PAIR))) ((EQ ACCESS (QUOTE INPUT)) (* ; "Nothing interesting to do")) ((NULL (SETQ ATVAL (\LISP.TO.NSFILING.ATTRIBUTE (CAR PAIR) (CADR PAIR)))) (* ; "Unrecognized attribute, ignore")) ((SETQ OTHER (ASSOC (CAR ATVAL) ATTRIBUTES)) (* ; "Duplicate attribute.  If not consistent, complain") (COND ((NOT (EQUAL (CADR OTHER) (CADR ATVAL))) (ERROR "Inconsistent attributes specified to OPENSTREAM" PARAMETERS)))) (T (push ATTRIBUTES ATVAL)))) (COND ((AND (NEQ ACCESS (QUOTE INPUT)) DEFAULTFILETYPE (NOT (ASSOC (QUOTE FILE.TYPE) ATTRIBUTES))) (* ; "If no type specified, use default") (push ATTRIBUTES (BQUOTE (FILE.TYPE (\, (OR (\FILETYPE.FROM.TYPE DEFAULTFILETYPE) \NSFILING.TYPE.BINARY))))))) ATTRIBUTES) NIL SEQUENTIAL)) (* ;; "Register stream manually in the main device so that there is only one place to look, independent of whether the stream itself uses the random or sequential device") (push (fetch (FDEV OPENFILELST) of DEVICE) STREAM) STREAM))))
)

(\NSFILING.HANDLE.ERROR

(LAMBDA (SESSION ERROR FILENAME) (* ; "Edited  8-Dec-87 12:42 by bvm:") (if ERROR then (PRINTOUT PROMPTWINDOW T (CADR ERROR) "--" (CADDR ERROR))) (WITHOUT.SESSION.MONITOR SESSION (CL:ERROR (COND ((AND (EQ (CADR ERROR) (QUOTE ACCESS.ERROR)) (STRPOS "ACCESS" (CADDR ERROR) NIL NIL NIL NIL UPPERCASEARRAY)) (QUOTE XCL:FS-PROTECTION-VIOLATION)) (T (QUOTE XCL:FILE-WONT-OPEN))) :PATHNAME FILENAME)))
)

(\NSFILING.CLOSEFILE

(LAMBDA (FILESTREAM OPTIONS) (* ; "Edited 20-Nov-87 17:01 by bvm:") (PROG ((ABORTFLG (LISTGET (QUOTE :ABORT) OPTIONS)) NEWHANDLE HANDLE SESSION INFO) (\GENERIC-UNREGISTER-STREAM (fetch DEVICE of FILESTREAM) FILESTREAM) (COND ((NOT (SETQ SESSION (fetch NSFILING.CONNECTION of FILESTREAM))) (GO EXIT))) (* ;; "Get the handle from the result of the STORE (for OUTPUT) or from the handle already given to RETRIEVE or REPLACE") (SETQ NEWHANDLE (\BULK.DATA.CLOSE FILESTREAM ABORTFLG)) (\NSFILING.RELEASE.BULKSTREAM SESSION FILESTREAM) (* ; "Courier stream now available for use by others") (COND ((SETQ HANDLE (fetch NSFILING.HANDLE of FILESTREAM)) (\NSRANDOM.RELEASE.HANDLE FILESTREAM))) (COND ((EQ (CAR NEWHANDLE) (QUOTE ERROR)) (COND ((AND (DIRTYABLE FILESTREAM) (NOT ABORTFLG)) (ERROR (CONCAT "CLOSEF: File not written
" (CADR NEWHANDLE) " -- " (CADDR NEWHANDLE)) (fetch FULLFILENAME of FILESTREAM))))) ((OR HANDLE NEWHANDLE) (COND (NEWHANDLE (SETQ HANDLE (\NSFILING.ADD.TO.CACHE SESSION (create FILINGHANDLE NSHDATUM ← NEWHANDLE NSHNAME ← (fetch FULLFILENAME of FILESTREAM)))))) (COND ((SETQ INFO (fetch NSFILING.NEW.ATTRIBUTES of FILESTREAM)) (* ;; "Caller of OPENFILE specified new attributes for this file, so change them now that we've stored the file") (\NSFILING.UPDATE.ATTRIBUTES HANDLE INFO) (FILING.CALL SESSION (QUOTE CHANGE.ATTRIBUTES) (fetch NSHDATUM of HANDLE) INFO SESSION (QUOTE RETURNERRORS)))))) EXIT (* ;; "just return")))
)

(\NSFILING.EVENTFN

(LAMBDA (DEVICE EVENT) (* ; "Edited 30-Nov-87 13:18 by bvm:") (SELECTQ EVENT (BEFORELOGOUT (for S in (fetch (FDEV OPENFILELST) of DEVICE) when (NEQ (fetch (STREAM DEVICE) of S) DEVICE) do (* ; "Force output on random streams, flush page cache") (\CLEARMAP S)) (* ; "Dispose of any open sessions.") (\NSFILING.CLOSE.CONNECTIONS DEVICE :TEST)) ((AFTERLOGOUT AFTERSAVEVM AFTERMAKESYS AFTERSYSOUT) (\NSFILING.CLOSE.CONNECTIONS DEVICE :ABORT) (for S in (APPEND (fetch (FDEV OPENFILELST) of DEVICE)) do (COND ((AND (EQ (fetch (STREAM DEVICE) of S) DEVICE) (DIRTYABLE S)) (* ; "Files open for sequential write cannot be recovered.  For now we also don't recover input files.") (PRINTOUT T T "***Warning: sequential " (COND ((DIRTYABLE S) "output to") (T "input from")) " the file " (fetch FULLFILENAME of S) " has been aborted and cannot be resumed." T T) (CLOSEF S)) (T (* ; "Let other streams recover if and when anyone touches them.")))) (COND ((NULL (fetch (FDEV OPENFILELST) of DEVICE)) (* ; "If no open files, dispose of the device") (LET ((RANDEVICE (fetch NSRANDOMDEVICE of (fetch DEVICEINFO of DEVICE)))) (COND (RANDEVICE (* ; "Have to break this circularity") (replace DEVICEINFO of RANDEVICE with NIL)))) (\REMOVEDEVICE DEVICE)))) NIL))
)

(\NSFILING.DELETEFILE

(LAMBDA (FILENAME DEVICE) (* ; "Edited  8-Dec-87 15:40 by bvm:") (\NSFILING.GETFILE DEVICE FILENAME (QUOTE NONE) (QUOTE OLDEST) (QUOTE HANDLE) (FUNCTION (LAMBDA (SESSION HANDLE) (COND ((OR (NEQ (fetch NSHBUSYCOUNT of HANDLE) 0) (\NSFILING.CONFLICTP DEVICE SESSION HANDLE (QUOTE OUTPUT))) (* ; "File is in use, can't delete") NIL) ((AND (fetch NSHDIRECTORYP of HANDLE) (NOT (\NSFILING.CHILDLESS-P SESSION HANDLE))) (* ; "Is a directory with children, can't delete") NIL) ((FILING.CALL SESSION (QUOTE DELETE) (fetch NSHDATUM of HANDLE) SESSION (QUOTE RETURNERRORS)) (* ; "Failed to delete it") NIL) (T (* ; "Delete succeeded, handle now invalid") (replace FSCACHEDHANDLES of SESSION with (DREMOVE HANDLE (fetch FSCACHEDHANDLES of SESSION))) (\NSFILING.FULLNAME SESSION HANDLE NIL T))))) T))
)

(\NSFILING.CHILDLESS-P

(LAMBDA (SESSION HANDLE) (* ; "Edited  8-Dec-87 15:40 by bvm:") (* ;; "True if we can tell for sure that directory HANDLE has no children.  Errors return nil") (EQ (CADR (ASSOC (QUOTE NUMBER.OF.CHILDREN) (FILING.CALL SESSION (QUOTE GET.ATTRIBUTES) (fetch NSHDATUM of HANDLE) (CONSTANT (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (NUMBER.OF.CHILDREN)))) SESSION (QUOTE NOERROR)))) 0))
)

(\NSFILING.DIRECTORYNAMEP

(LAMBDA (HOST/DIR DEVICE CREATE?) (* ; "Edited  4-May-87 17:21 by bvm:") (* ;; "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 (QUOTE DIRECTORY) (COND (CREATE? :ASK))))
)

(\NSFILING.HOSTNAMEP

(LAMBDA (HOST DEVICE) (* ; "Edited 11-Jun-87 14:49 by bvm:") (LET ((SERVER (AND (STRPOS ":" HOST) (LOOKUP.NS.SERVER HOST NIL T))) FILINGNAME FULLHOSTNAME) (* ; "To avoid useless lookups of PUP names, require Clearinghouse names to have a colon.") (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 REMOTEP ← T SUBDIRECTORIES ← T 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) RENAMEFILE ← (FUNCTION \NSFILING.RENAMEFILE) EVENTFN ← (FUNCTION \NSFILING.EVENTFN) OPENP ← (FUNCTION \GENERIC.OPENP) REGISTERFILE ← (FUNCTION NILL) UNREGISTERFILE ← (FUNCTION NILL) BREAKCONNECTION ← (FUNCTION BREAK.NSFILING.CONNECTION) DEVICEINFO ← (create NSFILINGDEVICEINFO NSFILESERVER ← SERVER NSFILINGLOCK ← (CREATE.MONITORLOCK FILINGNAME) NSFILINGNAME ← FILINGNAME NSCONNECTIONS ← NIL)))) DEVICE))))
)

(\NSFILING.GETFILENAME

(LAMBDA (NAME RECOG DEVICE) (* ; "Edited  4-May-87 17:21 by bvm:") (* ;; "Returns full file name of file or NIL if not found.") (\NSFILING.GETFILE DEVICE NAME (QUOTE NONE) RECOG (QUOTE NAME)))
)

(\NSFILING.GETFILEINFO

(LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited  5-May-87 13:12 by bvm:") (LET (DESIREDPROPS INFO HANDLE) (DECLARE (SPECVARS DESIREDPROPS)) (* ; "Used by \NSFILING.GET.ATTRIBUTES") (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) ((AND (EQ DESIREDPROPS (CONSTANT (\FILING.ATTRIBUTE.TYPE (QUOTE SIZE.IN.BYTES)))) (type? STREAM STREAM) (LET ((LEN (COND ((fetch RANDOMACCESSP of DEVICE) (* ; "We know for sure") (GETEOFPTR STREAM)) ((DIRTYABLE STREAM) (* ; "sequential output stream's length is current fileptr") (GETFILEPTR STREAM))))) (AND LEN (SELECTQ ATTRIBUTE (SIZE (FOLDHI LEN BYTESPERPAGE)) LEN))))) (T (SETQ INFO (COND ((NOT (MEMB DESIREDPROPS \NSFILING.USEFUL.ATTRIBUTE.TYPES)) (* ; "Need to fetch this attribute explicitly") (SETQ DESIREDPROPS (LIST DESIREDPROPS)) (\NSFILING.GET/SETINFO DEVICE STREAM (FUNCTION \NSFILING.GET.ATTRIBUTES))) ((NOT (type? STREAM STREAM)) (* ; "Not an open stream, so have to look it up") (\NSFILING.GETFILE DEVICE STREAM (QUOTE NONE) (QUOTE OLD) (QUOTE ATTRIBUTES))) ((NULL (SETQ HANDLE (fetch NSFILING.HANDLE of STREAM))) (* ; "Open for output, don't know attributes yet") NIL) ((fetch NSHATTRIBUTES of HANDLE)) (T (* ; "Stream open but its attributes wiped--retrieve them again") (\NSFILING.FILLIN.ATTRIBUTES (fetch NSFILING.CONNECTION of STREAM) HANDLE)))) (\NSFILING.GETFILEINFO.FROM.PLIST INFO ATTRIBUTE)))))
)

(\NSFILING.GET.ATTRIBUTES

(LAMBDA (SESSION HANDLE) (* ; "Edited  1-Jun-87 16:08 by bvm:") (* ;;; "Fetches the DESIREDPROPS of the file whose HANDLE is open on this CONNECTION") (DECLARE (USEDFREE DESIREDPROPS)) (FILING.CALL SESSION (QUOTE GET.ATTRIBUTES) (fetch NSHDATUM of HANDLE) DESIREDPROPS SESSION (QUOTE RETURNERRORS)))
)

(\NSFILING.GETFILEINFO.FROM.PLIST

(LAMBDA (PLIST ATTRIBUTE) (* bvm%: "26-Jun-86 15:36") (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 (LET ((LENGTH (CADR (ASSOC (QUOTE SIZE.IN.BYTES) PLIST)))) (AND LENGTH (FOLDHI LENGTH BYTESPERPAGE)))) (AUTHOR (LET ((CHNAME (CADR (ASSOC (QUOTE CREATED.BY) PLIST)))) (AND CHNAME (NSNAME.TO.STRING CHNAME)))) (PROTECTION (LET ((PROT (CADR (ASSOC (QUOTE ACCESS.LIST) PLIST)))) (* ; "PROT = ((ENTRIES SEQUENCE) (DEFAULTED BOOLEAN))") (* (COND ((COURIER.FETCH (FILING . ACCESS.LIST) DEFAULTED of PROT) (push RESULT "(defaulted)")))) (AND PROT (for ENTRY in (COURIER.FETCH (FILING . ACCESS.LIST) ENTRIES of PROT) collect (COND ((SMALLP (SETQ PROT (CADDR ENTRY))) (BQUOTE ((\, (CAR ENTRY)) (\, (CADR ENTRY)) (\,@ (COND ((EQ PROT (CONSTANT (APPLY (QUOTE LOGOR) (for PAIR in \NSFILING.PROTECTION.BITS collect (CDR PAIR))))) (* ; "All bits on") (QUOTE (ALL))) (T (for PAIR in \NSFILING.PROTECTION.BITS collect (CAR PAIR) when (BITTEST PROT (CDR PAIR))))))))) (T (* ; "Must be some other kind of entry, perhaps new filing") ENTRY)))))) (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) (* ; "Edited  9-Jun-87 15:17 by bvm:") (PROG ((ATTR/VAL (\LISP.TO.NSFILING.ATTRIBUTE ATTRIBUTE VALUE)) RESULT) (DECLARE (SPECVARS NAME.OR.STREAM ATTR/VAL)) (COND ((NULL ATTR/VAL) (* ; "Unsupported attribute") (RETURN NIL)) ((AND (EQ (CAR ATTR/VAL) (QUOTE SIZE.IN.BYTES)) (type? STREAM NAME.OR.STREAM)) (* ; "Changing the length on an open stream requires a little more than just changing the attribute") (RETURN (AND (fetch RANDOMACCESSP of DEVICE) (\NSRANDOM.SETEOFPTR NAME.OR.STREAM (CADR ATTR/VAL)))))) (SETQ RESULT (\NSFILING.GET/SETINFO DEVICE NAME.OR.STREAM (FUNCTION (LAMBDA (SESSION HANDLE) (DECLARE (USEDFREE NAME.OR.STREAM ATTR/VAL)) (COND ((AND (OR (NOT (type? STREAM NAME.OR.STREAM)) (NEQ HANDLE (fetch NSFILING.HANDLE of NAME.OR.STREAM))) (\NSFILING.CONFLICTP DEVICE SESSION HANDLE (QUOTE OUTPUT))) (* ; "We have a stream open on this file, can't change attributes out from under it") NIL) ((FILING.CALL SESSION (QUOTE CHANGE.ATTRIBUTES) (fetch NSHDATUM of HANDLE) (LIST ATTR/VAL) SESSION (QUOTE RETURNERRORS))) (T (* ; "Change attributes succeeded.  Update cached attributes.") (\NSFILING.UPDATE.ATTRIBUTES HANDLE (LIST ATTR/VAL)) T)))))) (RETURN (COND ((LISTP RESULT) (printout PROMPTWINDOW T (COND ((type? STREAM NAME.OR.STREAM) (fetch FULLFILENAME of NAME.OR.STREAM)) (T NAME.OR.STREAM)) " -- " (CADDR RESULT)) NIL) (T RESULT)))))
)

(\NSFILING.GET/SETINFO

(LAMBDA (DEVICE STREAM INFOFN) (* ; "Edited 22-May-87 13:09 by bvm:") (COND ((type? STREAM STREAM) (PROG (SESSION RESULT) RETRY (COND ((AND (SETQ SESSION (fetch NSFILING.CONNECTION of STREAM)) (OR (NLISTP (SETQ RESULT (CL:FUNCALL INFOFN (fetch NSFILING.CONNECTION of STREAM) (fetch NSFILING.HANDLE of STREAM)))) (NEQ (CAR RESULT) (QUOTE ERROR)) (NEQ (CADR RESULT) (QUOTE SESSION.ERROR)))) (RETURN RESULT))) (COND ((fetch RANDOMACCESSP of DEVICE) (* ; "Get new session") (\NSRANDOM.REESTABLISH STREAM) (GO RETRY)) (T (* ; "Sequential stream that was lost.  Hmm.  Just punt out to the file name itself") (\NSFILING.GETFILE DEVICE (fetch FULLFILENAME of STREAM) (QUOTE NONE) (QUOTE OLD) (QUOTE HANDLE) INFOFN T))))) (T (\NSFILING.GETFILE DEVICE STREAM (QUOTE NONE) (QUOTE OLD) (QUOTE HANDLE) INFOFN T))))
)

(\NSFILING.UPDATE.ATTRIBUTES

(LAMBDA (HANDLE NEWATTRS) (* ; "Edited  9-Jun-87 22:11 by bvm:") (* ;; "Update HANDLE's attribute cache with the set of possibly changed NEWATTRS.  Return the new attribute cache.") (replace NSHATTRIBUTES of HANDLE with (NCONC (for X in NEWATTRS collect X unless (PROGN (* ; "Don't cache attributes that are in a different form, or that could easily change without our knowledge") (MEMB (CAR X) (QUOTE (ACCESS.LIST DEFAULT.ACCESS.LIST NUMBER.OF.CHILDREN))))) (for X in (fetch NSHATTRIBUTES of HANDLE) collect X unless (ASSOC (CAR X) NEWATTRS)))))
)

(\NSFILING.GETEOFPTR

(LAMBDA (STREAM) (* ; "Edited 11-Jun-87 14:42 by bvm:") (COND ((DIRTYABLE STREAM) (* ; "Open for output, must be at eof") (GETFILEPTR STREAM)) (T (* ; "Not randaccessp, but we can fake it with the length server gave us on opening") (\NSFILING.GETFILEINFO STREAM (QUOTE LENGTH) (fetch DEVICE of STREAM)))))
)

(\NSFILING.GENERATEFILES

(LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* ; "Edited  8-Dec-87 15:05 by bvm:") (* ;; "Device method for file enumeration.  Return a generator that enumerates files matching PATTERN.  DESIREDPROPS is set of attributes caller may ask for.  If OPTIONS includes RESETLST, caller promises to be wrapped in a RESETLST that we can use to kill an aborted bulk listing.") (LET (SESSION BULKSTREAM RESULT) (* ; "Need these outside of scope of RESETLST in order to process the RESETLST option.") (RESETLST (* ; "Need RESETLST for \getfilingconnection") (PROG ((PARSE (\NSFILING.PARSE.FILENAME PATTERN T)) NAME VERSION DIRPATH DIR N FILTERNEEDED PATHREQUIRED FILTERLIST SCOPELIST INFINITE.DEPTH HANDLE VERSIONFILTER RETURNPROPS) (if (OR (NULL PARSE) (NULL (SETQ SESSION (\GETFILINGCONNECTION DEVICE)))) then (RETURN NIL)) (for TAIL on (SETQ DIRPATH (fetch NSDIRECTORIES of PARSE)) when (SETQ N (STRPOS (QUOTE *) (SETQ DIR (CAR TAIL)))) do (* ; "Wildcard in directory part, e.g., <foo>b*r>baz.  By Lisp's rules, we want to include <foo>b>r>baz but not <foo>barbaz.tedit.") (if (EQ (fetch FSPROTOCOLNAME of SESSION) (QUOTE FILING)) then (* ; "New filing lets us say ** to match arbitrary components in pathname") (SETQ PATHREQUIRED T) (RPLACA TAIL (\NSFILING.GENERATE.STARS DIR)) else (* ; "This is hard.  Get as far down in the tree as possible, then enumerate everything") (SETQ FILTERNEEDED (SETQ DIRPATH (for D in DIRPATH collect D until (EQ D DIR)))) (SETQ NAME (COND ((NEQ N 1) (* ; "If asked to enumerate <foo>b*r>baz, we can at least enumerate <foo>b* and filter the rest") (SUBSTRING DIR 1 N)))) (RETURN)) finally (* ;; "Directories are fine, so all the matching happens on the name") (COND ((STREQUAL (SETQ NAME (fetch NSROOTNAME of PARSE)) "*.*") (* ; "Trivial match") (SETQ NAME NIL)) (T (COND ((STRPOS ".*" NAME -2 NIL T) (* ; "If name is foo.*, need to enumerate foo* in order to include extensionless foo") (COND ((NEQ (NTHCHARCODE (SETQ NAME (SUBSTRING NAME 1 -3)) -1) (CHARCODE *)) (SETQ NAME (CONCAT NAME "*")) (* ; "foo*.* is ok as foo*, but foo.* needs filtering of foo*") (SETQ FILTERNEEDED T)))) ((EQ (NTHCHARCODE NAME -1) (CHARCODE ".")) (* ; "If have explicitly null extension, remove period and filter -- ns file server doesn't understand %"extension%"") (SETQ NAME (SUBSTRING NAME 1 -2)) (SETQ FILTERNEEDED T))) (COND ((AND (SETQ N (STRPOS "*" NAME)) (EQ (fetch FSPROTOCOLNAME of SESSION) (QUOTE FILING))) (* ;; "Interior * needs to be replaced with ** so that server will match subdirectories along the path.  May only work in version 5 (Services 10)") (SETQ NAME (\NSFILING.GENERATE.STARS NAME)) (SETQ PATHREQUIRED T)))))) (if (NULL (SETQ HANDLE (\NSFILING.CONNECT SESSION (if PATHREQUIRED then (* ; "get root directory") NIL else DIRPATH) T))) then (RETURN NIL)) (SETQ RETURNPROPS (CL:REMOVE-DUPLICATES (APPEND (CONSTANT (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (PATHNAME IS.DIRECTORY)))) (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") (COND (PATHREQUIRED (* ; "Match a full path name") (push FILTERLIST (BQUOTE (MATCHES (PATHNAME (\, (\NSFILING.COMPOSE.PATHNAME DIRPATH (OR NAME (QUOTE *))))))))) ((NULL NAME) (* ; "Enumerate everything")) ((STRPOS (QUOTE *) NAME) (* ;; "The following doesn't quite work in Services 8 because the fileserver won't match against subdirectory names.") (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)))))))) (SETQ VERSION (fetch NSVERSION of PARSE)) (COND ((NEQ VERSION (QUOTE *)) (* ; "An interesting version -- either a specific one, or none, meaning highest") (* ; "Highest version matching seems not to work in Services 8") (push FILTERLIST (SETQ VERSIONFILTER (BQUOTE (= (\, (COURIER.CREATE (FILING . FILTER.ATTRIBUTE) ATTRIBUTE ← (LIST (QUOTE VERSION) (OR VERSION \NSFILING.HIGHEST.VERSION)) INTERPRETATION ← (QUOTE CARDINAL))))))))) (COND ((AND FILING.ENUMERATION.DEPTH DIRPATH) (* ;; "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)))))))) (COND (FILTERLIST (push SCOPELIST (LIST (QUOTE FILTER) (COND ((CDR FILTERLIST) (LIST (QUOTE AND) FILTERLIST)) (T (CAR FILTERLIST))))))) (PROG NIL RETRY (SETQ BULKSTREAM (FILING.CALL SESSION (QUOTE LIST) (fetch NSHDATUM of HANDLE) RETURNPROPS SCOPELIST NIL SESSION (QUOTE RETURNERRORS) (QUOTE KEEPSTREAM))) (COND ((AND (LISTP BULKSTREAM) VERSIONFILTER (EQUAL BULKSTREAM (QUOTE (ERROR SCOPE.VALUE.ERROR Illegal FILTER))) (NULL VERSION)) (* ; "old versions of Services didn't handle filtering on highest version.  Compromise and return ALL versions") (LET ((SCOPE (ASSOC (QUOTE FILTER) SCOPELIST))) (COND ((EQ (CADR SCOPE) VERSIONFILTER) (SETQ SCOPELIST (DREMOVE SCOPE SCOPELIST))) (T (* ; "SCOPE = (FILTER (AND filters))") (CL:SETF (CADADR SCOPE) (DREMOVE VERSIONFILTER (CADADR SCOPE))))) (SETQ VERSIONFILTER NIL) (GO RETRY)))) (COND ((STREAMP BULKSTREAM) (SETQ RESULT (create FILEGENOBJ NEXTFILEFN ← (FUNCTION \NSFILING.NEXTFILE) FILEINFOFN ← (FUNCTION \NSFILING.FILEINFOFN) GENFILESTATE ← (create \NSFILING.GENFILESTATE NSGENERATOR ← (BULKDATA.GENERATOR BULKSTREAM (fetch FSPROTOCOLNAME of SESSION) (QUOTE ATTRIBUTE.SEQUENCE)) NSFILTER ← (AND FILTERNEEDED (DIRECTORY.MATCH.SETUP PATTERN)) NSCONNECTION ← SESSION NSIGNOREDIRECTORIES ← INFINITE.DEPTH NSBULKSTREAM ← BULKSTREAM)))) (T (COND ((AND (LISTP BULKSTREAM) (EQ (pop BULKSTREAM) (QUOTE ERROR))) (PRINTOUT PROMPTWINDOW T "Can't enumerate " PATTERN " because " (pop BULKSTREAM) ": ") (MAPRINT BULKSTREAM PROMPTWINDOW))) (SETQ BULKSTREAM NIL)))))) (* ;; "We now have either a bulk data listing stream, or we failed.  Outside of the RESETLST, let's arrange to kill the listing stream on error") (COND ((AND RESULT (EQMEMB (QUOTE RESETLST) OPTIONS)) (RESETSAVE NIL (LIST (FUNCTION \NSFILING.CLOSE.BULKSTREAM) SESSION BULKSTREAM)))) (OR RESULT (\NULLFILEGENERATOR))))
)

(\NSFILING.GENERATE.STARS

(LAMBDA (NAME) (* ; "Edited 15-Sep-87 13:09 by bvm:") (bind N while (SETQ N (STRPOS "*" NAME N)) do (SETQ NAME (CONCAT (SUBSTRING NAME 1 N) (QUOTE *) (OR (SUBSTRING NAME (+ N 1)) ""))) (SETQ N (+ N 3)) (* ; "Skip past the * we found, the * we added, and the next char (since if it's a *, we don't care).") finally (RETURN NAME)))
)

(\NSFILING.NEXTFILE

(LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* ; "Edited 20-Nov-87 18:34 by bvm:") (PROG ((GENERATOR (fetch NSGENERATOR of GENFILESTATE)) (SESSION (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))) (* ; "Generator exhausted, so close the bulkdata.") (LET ((RESETSTATE NIL)) (* ; "normal close") (\NSFILING.CLOSE.BULKSTREAM SESSION (fetch NSBULKSTREAM of GENFILESTATE))) (RETURN NIL)) ((AND IGNOREDIRS (CADR (ASSOC (QUOTE IS.DIRECTORY) INFO))) (* ; "Skip directory files") (GO LP))) (SETQ NAME (\NSFILING.FULLNAME SESSION 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.RENAMEFILE

(LAMBDA (DEVICE OLDNAME NEWDEVICE NEWNAME) (* ; "Edited  8-Dec-87 20:05 by bvm:") (COND ((EQ (fetch OPENFILE of NEWDEVICE) (FUNCTION \NSFILING.OPENFILE)) (\NSFILING.COPY/RENAME DEVICE OLDNAME NEWDEVICE NEWNAME)) (T (* ; "Different devices, can't rename cleverly.  Ideally we should make sure that oldname is deletable, but what follows is at least not worse than the old behavior") (\GENERIC.RENAMEFILE DEVICE OLDNAME NEWDEVICE NEWNAME))))
)

(\NSFILING.COPYFILE

(LAMBDA (DEVICE FROMFILE NEWDEVICE TOFILE) (* ; "Edited  8-Dec-87 17:12 by bvm:") (COND ((EQ (fetch OPENFILE of NEWDEVICE) (FUNCTION \NSFILING.OPENFILE)) (\NSFILING.COPY/RENAME DEVICE FROMFILE NEWDEVICE TOFILE T)) (T (* ; "Different devices, can't rename cleverly.  Ideally we should make sure that oldname is deletable, but what follows is at least not worse than the old behavior") (\GENERIC.COPYFILE DEVICE FROMFILE NEWDEVICE TOFILE))))
)

(\NSFILING.COPY/RENAME

(LAMBDA (DEVICE FROMFILE NEWDEVICE TOFILE COPYFLG) (* ; "Edited  9-Dec-87 18:18 by bvm:") (* ;; "Perform a COPY or RENAME (according to whether COPYFLG is T or NIL) of FROMFILE to TOFILE.  DEVICE and NEWDEVICE are NS Filing devices, but not necessarily the same.") (* ;; "Between NS servers we can do a copy/rename that preserves maximal information.  However, there are some unpleasantnesses: if the destination already exists, we have to delete it before starting; as far as errors go, Lisp wants RENAMEFILE to just return NIL, but COPYFILE must error.") (RESETLST (PROG ((OLDPARSE (\NSFILING.PARSE.FILENAME FROMFILE)) (NEWPARSE (\NSFILING.PARSE.FILENAME TOFILE)) SESSION NEWSESSION NEWDIR OLDDIR NEWPARENT HANDLE NEWHANDLE NEWATTRS VERSION NAME RESULT SERIALSTREAM OLDHANDLE SAME-DIR-P DEST-UNIQUE-P) (* ;; "The preliminary work is all the same--parse the source and destination, get a handle on the source name and the destination directory, check to make sure the source isn't busy and the destination doesn't yet exist.") (COND ((NULL OLDPARSE) (* ; "Bad name") (RETURN (AND COPYFLG (CL:ERROR (QUOTE XCL:INVALID-PATHNAME) :PATHNAME FROMFILE)))) ((NULL NEWPARSE) (RETURN (AND COPYFLG (CL:ERROR (QUOTE XCL:INVALID-PATHNAME) :PATHNAME TOFILE)))) ((OR (NULL (SETQ SESSION (\GETFILINGCONNECTION DEVICE))) (NULL (SETQ HANDLE (OR (\NSFILING.LOOKUP.CACHE SESSION FROMFILE) (\NSFILING.OPEN.HANDLE SESSION (\NSFILING.COMPOSE.PATHNAME (fetch NSDIRECTORIES of OLDPARSE) (fetch NSROOTNAME of OLDPARSE) (OR (fetch NSVERSION of OLDPARSE) (QUOTE +)))))))) (* ; "Can't get to server, or can't get handle on FROMFILE") (RETURN (AND COPYFLG (CL:ERROR (QUOTE XCL:FILE-NOT-FOUND) :PATHNAME FROMFILE)))) ((OR (AND (NULL COPYFLG) (NEQ (fetch NSHBUSYCOUNT of HANDLE) 0)) (\NSFILING.CONFLICTP DEVICE SESSION HANDLE (if COPYFLG then (QUOTE INPUT) else (QUOTE OUTPUT)))) (* ; "File is in use") (RETURN (AND COPYFLG (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME FROMFILE)))) ((NULL (SETQ NEWSESSION (if (EQ DEVICE NEWDEVICE) then (* ; "Same session will do") SESSION else (\GETFILINGCONNECTION NEWDEVICE)))) (* ; "Can't get to destination") (RETURN (AND COPYFLG (CL:ERROR (QUOTE XCL:FILE-NOT-FOUND) :PATHNAME TOFILE))))) (SETQ NEWDIR (fetch NSDIRECTORIES of NEWPARSE)) (SETQ VERSION (fetch NSVERSION of NEWPARSE)) (if (OR VERSION (fetch NSHDIRECTORYP of HANDLE)) then (* ; "Destination is uniquely specified, down to the version.  Directories try hard to be version 1.") (SETQ DEST-UNIQUE-P T)) (if (NULL (SETQ NAME (fetch NSROOTNAME of NEWPARSE))) then (* ; "Interpret last directory as the name") (SETQ NAME (CAR (LAST NEWDIR))) (SETQ NEWDIR (CL:BUTLAST NEWDIR))) (if (AND (NULL COPYFLG) (EQ DEVICE NEWDEVICE) (EQ (LENGTH NEWDIR) (LET ((N (LENGTH (SETQ OLDDIR (fetch NSDIRECTORIES of OLDPARSE))))) (if (fetch NSHDIRECTORYP of HANDLE) then (* ; "Don't count the last directory--it's the %"file%"") (- N 1) else N))) (for DIR in NEWDIR always (STRING-EQUAL DIR (pop OLDDIR)))) then (* ; "RENAME uses a simpler call in the case where the source and destination directories are identical") (SETQ SAME-DIR-P T)) (SETQ NEWATTRS (BQUOTE ((NAME (\, (\NSFILING.REMOVEQUOTES NAME))) (\,@ (AND VERSION (BQUOTE ((VERSION (\, VERSION))))))))) (COND ((AND (OR (NOT SAME-DIR-P) DEST-UNIQUE-P) (NULL (SETQ NEWPARENT (\NSFILING.CONNECT NEWSESSION NEWDIR T T)))) (* ; "Couldn't get handle on destination directory.  Don't bother if we don't need this handle (we don't need it for rename on same dir unless there is a uniqueness question)") (RETURN (AND COPYFLG (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME TOFILE))))) (COND ((AND DEST-UNIQUE-P (SETQ OLDHANDLE (\NSFILING.OPEN.HANDLE NEWSESSION NEWATTRS NIL (QUOTE NOERROR) NEWPARENT))) (* ; "Destination already exists, so we'll get a NotUnique error if we COPY/MOVE/SERIALIZE directly.") (if (if (fetch NSHDIRECTORYP of OLDHANDLE) then (* ; "Old directory ok if it has children or we're copying a non-directory") (OR (NOT (fetch NSHDIRECTORYP of HANDLE)) (NOT (\NSFILING.CHILDLESS-P NEWSESSION OLDHANDLE))) else (* ; "Not file to directory, please") (fetch NSHDIRECTORYP of HANDLE)) then (* ; "Don't try to overwrite") (CL:FORMAT PROMPTWINDOW "~%%Destination ~A already exists." TOFILE) (RETURN (AND COPYFLG (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME TOFILE)))))) (if (AND (NULL COPYFLG) (OR OLDHANDLE (NEQ DEVICE NEWDEVICE))) then (* ; "RENAME case: we are about to do something we'd rather not do (delete destination or copy file) if in the end we're not going to have delete access to the source, so check now.") (if (SETQ RESULT (\NSFILING.CHECK.ACCESS SESSION HANDLE (QUOTE WRITE))) then (* ; "No access to delete source") (RETURN (AND COPYFLG (\NSFILING.HANDLE.ERROR SESSION RESULT FROMFILE))))) (if OLDHANDLE then (* ; "To overwrite old file, have to delete current file first") (if (SETQ RESULT (FILING.CALL NEWSESSION (QUOTE DELETE) (fetch NSHDATUM of OLDHANDLE) NEWSESSION (QUOTE RETURNERRORS))) then (* ; "Failed to delete it") (RETURN (AND COPYFLG (\NSFILING.HANDLE.ERROR NEWSESSION RESULT TOFILE)))) (* ; "Delete succeeded, handle now invalid") (replace FSCACHEDHANDLES of NEWSESSION with (DREMOVE OLDHANDLE (fetch FSCACHEDHANDLES of NEWSESSION)))) (if (NOT SAME-DIR-P) then (* ; "Be sure not to copy protection along with the file.  Only exception is a same-dir rename.  You might want the protection to come along, but it's likely to cause confusion.") (SETQ NEWATTRS (APPEND NEWATTRS (BQUOTE ((ACCESS.LIST (\, (COURIER.CREATE (FILING . ACCESS.LIST) ENTRIES ← NIL DEFAULTED ← T))) (\,@ (AND (fetch NSHDIRECTORYP of HANDLE) (BQUOTE ((DEFAULT.ACCESS.LIST (\, (COURIER.CREATE (FILING . ACCESS.LIST) ENTRIES ← NIL DEFAULTED ← T)))))))))))) (* ;; "Ok, we should be ready to do the copy.  If it's the same server, can just use the COPY command, else have to serialize and deserialize") (SETQ RESULT (if (EQ DEVICE NEWDEVICE) then (* ; "Easy case") (if COPYFLG then (FILING.CALL SESSION (QUOTE COPY) (fetch NSHDATUM of HANDLE) (fetch NSHDATUM of NEWPARENT) NEWATTRS NIL SESSION (QUOTE RETURNERRORS)) elseif SAME-DIR-P then (* ; "Same directories, just change attributes") (FILING.CALL SESSION (QUOTE CHANGE.ATTRIBUTES) (fetch NSHDATUM of HANDLE) NEWATTRS SESSION (QUOTE RETURNERRORS)) else (* ; "Move file to new directory and change its name at the same time") (FILING.CALL SESSION (QUOTE MOVE) (fetch NSHDATUM of HANDLE) (fetch NSHDATUM of NEWPARENT) NEWATTRS SESSION (QUOTE RETURNERRORS))) elseif (SETQ RESULT (\NSFILING.CHECK.ACCESS NEWSESSION NEWPARENT (QUOTE ADD))) then (* ; "No access to write destination") (RETURN (AND COPYFLG (\NSFILING.HANDLE.ERROR SESSION RESULT FROMFILE))) else (* ; "Copy with serialize-deserialize") (if (TYPENAMEP (SETQ SERIALSTREAM (FILING.CALL SESSION (QUOTE SERIALIZE) (fetch NSHDATUM of HANDLE) NIL SESSION (QUOTE RETURNERRORS) (QUOTE KEEPSTREAM))) (QUOTE STREAM)) then (CL:UNWIND-PROTECT (PROGN (add (fetch NSHBUSYCOUNT of HANDLE) 1) (RELEASE.MONITORLOCK (fetch FSSESSIONLOCK of SESSION)) (* ; "we don't need this lock while transferring--don't keep the session busy") (PROG1 (\NSFILING.DESERIALIZE1 NEWSESSION NEWPARENT NEWATTRS SERIALSTREAM (FUNCTION \BULK.DATA.CLOSE)) (if (NOT COPYFLG) then (* ; "we need to get the source lock back in order to delete the source.") (OBTAIN.MONITORLOCK (fetch FSSESSIONLOCK of SESSION))))) (* ;; "Cleanup after the SERIALIZE finishes") (add (fetch NSHBUSYCOUNT of HANDLE) -1) (\BULK.DATA.CLOSE SERIALSTREAM) (\NSFILING.RELEASE.BULKSTREAM SESSION SERIALSTREAM)) else (RETURN (AND COPYFLG (\NSFILING.HANDLE.ERROR SESSION HANDLE FROMFILE)))))) (RETURN (COND ((NEQ (CAR (LISTP RESULT)) (QUOTE ERROR)) (* ; "Success--note new file in cache") (SETQ NEWHANDLE (if (OR COPYFLG (NEQ DEVICE NEWDEVICE)) then (\NSFILING.ADD.TO.CACHE NEWSESSION (create FILINGHANDLE NSHDATUM ← RESULT)) else (* ; "In place move invalidates our knowledge about handle") (replace NSHATTRIBUTES of HANDLE with (replace NSHNAME of HANDLE with NIL)) HANDLE)) (if (AND (NULL COPYFLG) (NEQ DEVICE NEWDEVICE)) then (* ; "Now have to delete the source") (if (SETQ RESULT (FILING.CALL SESSION (QUOTE DELETE) (fetch NSHDATUM of HANDLE) SESSION (QUOTE RETURNERRORS))) then (* ; "Failed to delete it.  Unclear what we should do about the destination at this point.  I planned on not getting this error, so tell user.  Typical case: I tried to move a directory one of whose children I do not have delete access to") (RELEASE.MONITORLOCK (fetch FSSESSIONLOCK of SESSION)) (RELEASE.MONITORLOCK (fetch FSSESSIONLOCK of NEWSESSION)) (* ; "Release locks so not tied up while in error") (RETURN (CL:ERROR "Successfully copied ~A to ~A, but failed to delete the source because ~A: ~A." (\NSFILING.FULLNAME SESSION HANDLE) (\NSFILING.FULLNAME NEWSESSION NEWHANDLE) (CADR RESULT) (CADDR RESULT))))) (\NSFILING.FULLNAME NEWSESSION NEWHANDLE)) (COPYFLG (* ; "Failure--signal some error") (\NSFILING.HANDLE.ERROR NEWSESSION RESULT TOFILE)))))))
)
)



(* ; "Random access methods")


(DEFINEQ

(\NSRANDOM.CLOSEFILE

(LAMBDA (STREAM) (* ; "Edited 20-Nov-87 17:28 by bvm:") (* ;; "Close method for a stream open on the random access Filing device") (RESETLST (PROG ((SESSION (fetch NSFILING.CONNECTION of STREAM))) (if SESSION then (* ;; "We ought not have to do this, but sometimes ill-disciplined folk try to close the same stream twice, by lazily calling CLOSEF? and getting in here while we're talking to the server.  We don't have monitor locks per stream (though we probably should), so use the session's lock.  This is obviously inadequate in general, since the session might have died, but it should handle the average case.") (OBTAIN.MONITORLOCK (fetch FSSESSIONLOCK of SESSION) NIL T)) (if (NULL (fetch (STREAM ACCESS) of STREAM)) then (* ; "Somebody else already closed us") (RETURN)) (\CLEARMAP STREAM) (* ; "Force out dirty buffers") (COND ((DIRTYABLE STREAM) (* ; "Truncate to current length") (\NSRANDOM.TRUNCATEFILE STREAM))) (\NSRANDOM.RELEASE.HANDLE STREAM) (* ; "Release controls") (\GENERIC-UNREGISTER-STREAM (fetch DEVICEINFO of (fetch DEVICE of STREAM)) STREAM) (replace (STREAM ACCESS) of STREAM with NIL))) STREAM)
)

(\NSRANDOM.RELEASE.HANDLE

(LAMBDA (STREAM) (* ; "Edited 20-Nov-87 17:00 by bvm:") (* ;; "Release STREAM's hold on its file handle.  We also remove the HANDLE and CONNECTION from the stream, etc.") (LET ((HANDLE (fetch NSFILING.HANDLE of STREAM)) (SESSION (fetch NSFILING.CONNECTION of STREAM))) (replace NSFILING.HANDLE of STREAM with NIL) (replace NSFILING.CONNECTION of STREAM with NIL) (COND ((NULL HANDLE)) ((NEQ (fetch NSHBUSYCOUNT of HANDLE) 1) (* ;; "More than one user, so keep controls") (add (fetch NSHBUSYCOUNT of HANDLE) -1)) (T (replace NSHBUSYCOUNT of HANDLE with 0) (COND ((AND SESSION (fetch NSHACCESS of HANDLE)) (* ; "Release lock held on the handle.  Session may have been dropped, in which case no need to change control") (\NSRANDOM.RELEASE.LOCK SESSION HANDLE)))))))
)

(\NSRANDOM.RELEASE.LOCK

(LAMBDA (SESSION HANDLE) (* ; "Edited  3-Jun-87 18:22 by bvm:") (FILING.CALL SESSION (QUOTE CHANGE.CONTROLS) (fetch NSHDATUM of HANDLE) (QUOTE ((LOCK NONE))) SESSION (QUOTE RETURNERRORS)) (replace NSHACCESS of HANDLE with NIL))
)

(\NSRANDOM.RELEASE.IF.ERROR

(LAMBDA (SESSION HANDLE) (* ; "Edited 26-Aug-87 15:30 by bvm:") (AND RESETSTATE (\NSRANDOM.RELEASE.LOCK SESSION HANDLE)))
)

(\NSRANDOM.CREATE.STREAM

(LAMBDA (SESSION HANDLE ACCESS GOTCONTROLS OLDSTREAM CHECKACCESS) (* ; "Edited 26-Aug-87 15:30 by bvm:") (PROG NIL (COND ((NOT GOTCONTROLS) (* ;; "Acquire lock on file for duration of open stream.  Need this so that nobody can get in between calls to RetrieveBytes or ReplaceBytes") (LET ((OLDACCESS (fetch NSHACCESS of HANDLE)) ERROR) (COND ((SELECTQ OLDACCESS ((NIL) (* ; "Just a cached handle, no controls") NIL) (OUTPUT (* ; "Handle already open for write, can't do anything else") T) (INPUT (* ; "Open for input, so only other input streams allowed.") (NEQ ACCESS (QUOTE INPUT))) (SHOULDNT)) (RETURN (LISPERROR "FILE WON'T OPEN" (\NSFILING.FULLNAME SESSION HANDLE))))) (COND ((NEQ OLDACCESS (QUOTE INPUT)) (* ; "Get a share/exclusive control.  If OLDACCESS is INPUT, we have already obtained this control") (COND ((SETQ ERROR (FILING.CALL SESSION (QUOTE CHANGE.CONTROLS) (fetch NSHDATUM of HANDLE) (BQUOTE ((LOCK (\, (SELECTQ ACCESS (INPUT (QUOTE SHARE)) (QUOTE EXCLUSIVE)))))) SESSION (QUOTE RETURNERRORS))) (RETURN ERROR))) (RESETSAVE NIL (LIST (FUNCTION \NSRANDOM.RELEASE.IF.ERROR) SESSION HANDLE)) (* ; "If this open doesn't succeed, be sure to release this lock.") (replace NSHACCESS of HANDLE with (SELECTQ ACCESS (BOTH (QUOTE OUTPUT)) ACCESS))))))) (COND (CHECKACCESS (* ;; "Problem: How can we tell NOW whether we have access rights to write this file?  At least in the case of a new file, the CREATE procedure will tell us if we had ADD access, but even then we might perversely not have WRITE access.") (LET ((ERROR (\NSFILING.CHECK.ACCESS SESSION HANDLE (QUOTE WRITE)))) (AND ERROR (RETURN ERROR))))) (LET* ((ATTRS (OR (fetch NSHATTRIBUTES of HANDLE) (\NSFILING.FILLIN.ATTRIBUTES SESSION HANDLE))) (LEN (CADR (ASSOC (QUOTE SIZE.IN.BYTES) ATTRS))) S EOF) (COND (OLDSTREAM (LET ((OLDATTRS (fetch NSHATTRIBUTES of (fetch NSFILING.HANDLE of OLDSTREAM)))) (COND ((OR (NOT (EQUAL LEN (fetch NSFILING.SERVER.LENGTH of OLDSTREAM))) (NOT (EQUAL (CADR (ASSOC (QUOTE CREATED.ON) ATTRS)) (CADR (ASSOC (QUOTE CREATED.ON) OLDATTRS))))) (* ; "file has changed!") (\NSRANDOM.STREAM.CHANGED OLDSTREAM HANDLE)))) (* ; "If got here, user let us continue") (replace NSFILING.HANDLE of (SETQ S OLDSTREAM) with HANDLE)) (T (SETQ EOF (SELECTQ ACCESS (OUTPUT 0) LEN)) (SETQ S (create STREAM CPAGE ← 0 COFFSET ← 0 EPAGE ← (FOLDLO EOF BYTESPERPAGE) EOFFSET ← (IMOD EOF BYTESPERPAGE) MULTIBUFFERHINT ← T)))) (replace NSFILING.SERVER.LENGTH of S with LEN) (RETURN S))))
)

(\NSRANDOM.READPAGES

(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* ; "Edited  3-Sep-87 12:03 by bvm:") (* ;; "Read pages method for NSFIling Random access device.") (COND ((LISTP BUFFERS) (\NSRANDOM.READ.SEGMENT STREAM FIRSTPAGE# BUFFERS)) (T (* ;; "Single buffer. We special case this because we want to in general fetch several pages at once to improve performance") (COND ((NULL (fetch NSFILING.CONNECTION of STREAM)) (* ; "Session lost, e.g., after logout.  Want to reestablish stream immediately, even if all we're going to do is clear the buffer.") (\NSRANDOM.REESTABLISH STREAM))) (LET ((EP (fetch (STREAM EPAGE) of STREAM)) (EO (fetch (STREAM EOFFSET) of STREAM)) CACHE NMORE EXTRABUFFERS) (COND ((OR (> FIRSTPAGE# EP) (AND (EQ FIRSTPAGE# EP) (EQ EO 0))) (* ; "Past eof.  This is silly") (\CLEARBYTES BUFFERS 0 BYTESPERPAGE)) ((SETQ CACHE (\NSRANDOM.FETCH.CACHE STREAM FIRSTPAGE#)) (* ; "We fetched it earlier, so this is easy") (\BLT BUFFERS (CADR CACHE) WORDSPERPAGE) (COND (\NSRANDOM.CHECK.CACHE (\NSRANDOM.CHECK.CACHE (fetch NSFILING.PAGE.CACHE of STREAM))))) (T (* ; "Have to fetch it.  Get next few pages while we're at it.") (COND ((AND (>= FIRSTPAGE# (fetch NSFILING.LAST.REQUEST of STREAM)) (PROGN (for I from 1 to (SETQ NMORE (IMIN *NSFILING-PAGE-CACHE-INCREMENT* (- (if (DIRTYABLE STREAM) then (* ; "For output files, it is possible for our local eof to be greater than the server's, in which case we'd better not try to read.") (FOLDLO (SUB1 (fetch NSFILING.SERVER.LENGTH of STREAM)) BYTESPERPAGE) elseif (EQ EO 0) then (SUB1 EP) else EP) FIRSTPAGE#))) when (\NSRANDOM.FETCH.CACHE STREAM (+ FIRSTPAGE# I) T) do (* ;; "This page already cached, so don't bother fetching it again.  Notice that this algorithm is pessimal for reading a file backward, but it's hard for me to do better without more knowledge of what's already buffered in the stream.") (RETURN (SETQ NMORE (SUB1 I)))) (NEQ NMORE 0))) (* ;; "Ok, have a range to read.  First check says don't read multiple if going backward in file (I don't know how to do this well--there are many common cases, such as Lafite get mail and backward searches, that would be handled pessimally if I retrieve multiple pages here).") (SETQ EXTRABUFFERS (\NSRANDOM.PREPARE.CACHE STREAM NMORE)))) (\NSRANDOM.READ.SEGMENT STREAM FIRSTPAGE# BUFFERS EXTRABUFFERS NMORE) (COND (\NSRANDOM.CHECK.CACHE (\NSRANDOM.CHECK.CACHE (fetch NSFILING.PAGE.CACHE of STREAM) T)))))) (replace NSFILING.LAST.REQUEST of STREAM with FIRSTPAGE#))))
)

(\NSRANDOM.READ.SEGMENT

(LAMBDA (STREAM FIRSTPAGE# BUFFERS EXTRABUFFERS NEXTRA) (* ; "Edited 27-Aug-87 11:30 by bvm:") (* ;; "Read contents of STREAM starting at FIRSTPAGE# into successive members of BUFFERS.  In the case that BUFFERS is a single buffer, read additional NEXTRA pages into page cache entries EXTRABUFFERS.") (PROG (SESSION) RETRY (COND ((NULL (SETQ SESSION (fetch NSFILING.CONNECTION of STREAM))) (* ; "Session lost, e.g., after logout") (\NSRANDOM.REESTABLISH STREAM) (GO RETRY))) (LET* ((EP (fetch (STREAM EPAGE) of STREAM)) (EO (fetch (STREAM EOFFSET) of STREAM)) (BYTESTOFETCH (COND (EXTRABUFFERS (* ; "Caller assures us that at worst, the last extra buffer is the end of file.") (+ (UNFOLD NEXTRA BYTESPERPAGE) (COND ((EQ (+ FIRSTPAGE# NEXTRA) EP) EO) (T BYTESPERPAGE)))) (T (* ; "Just a single list of buffers") (for BUF inside BUFFERS as PAGE from FIRSTPAGE# sum (COND ((< PAGE EP) BYTESPERPAGE) ((EQ PAGE EP) EO) (T 0)))))) (HANDLE (fetch NSFILING.HANDLE of STREAM)) BYTES-TIL-EOF) (COND ((AND (NEQ BYTESTOFETCH 0) (OR (NOT (DIRTYABLE STREAM)) (COND ((> BYTESTOFETCH (SETQ BYTES-TIL-EOF (- (fetch NSFILING.SERVER.LENGTH of STREAM) (UNFOLD FIRSTPAGE# BYTESPERPAGE)))) (* ; "For output files, it is possible for our local eof to be greater than the server's, in which case we'd better not try to read.") (> (SETQ BYTESTOFETCH BYTES-TIL-EOF) 0)) (T T)))) (* ; "There is something to retrieve") (LET ((ERROR (FILING.CALL SESSION (QUOTE RETRIEVE.BYTES) (fetch NSHDATUM of HANDLE) (COURIER.CREATE (FILING . BYTE.RANGE) FIRSTBYTE ← (UNFOLD FIRSTPAGE# BYTESPERPAGE) COUNT ← BYTESTOFETCH) (FUNCTION (LAMBDA (BULKSTREAM) (* ;; "What to do with the bulk data") (LET ((PAGENO FIRSTPAGE#) (TOTALBYTES BYTESTOFETCH)) (* ; "Note that we must keep local copy of the number of bytes expected, since FILING.CALL can iterate (when stream lost).") (for BUF inside BUFFERS do (COND ((>= TOTALBYTES BYTESPERPAGE) (* ; "Fetch a whole page") (\BINS BULKSTREAM BUF 0 BYTESPERPAGE) (SETQ TOTALBYTES (- TOTALBYTES BYTESPERPAGE))) ((> TOTALBYTES 0) (* ; "Fetch remaining bytes of last page") (\BINS BULKSTREAM BUF 0 TOTALBYTES) (\CLEARBYTES BUF TOTALBYTES (- BYTESPERPAGE TOTALBYTES)) (SETQ TOTALBYTES 0)) (T (* ; "At end of actual file, so just clear buffer") (\CLEARBYTES BUF 0 BYTESPERPAGE))) (add PAGENO 1)) (from 1 to NEXTRA as PAIR in EXTRABUFFERS do (RPLACA PAIR -1) (* ; "Temporarily make invalid") (COND ((>= TOTALBYTES BYTESPERPAGE) (* ; "Fetch a whole page") (\BINS BULKSTREAM (CADR PAIR) 0 BYTESPERPAGE) (SETQ TOTALBYTES (- TOTALBYTES BYTESPERPAGE))) ((> TOTALBYTES 0) (* ; "Fetch remaining bytes of last page") (\BINS BULKSTREAM (CADR PAIR) 0 TOTALBYTES) (\CLEARBYTES (CADR PAIR) TOTALBYTES (- BYTESPERPAGE TOTALBYTES)) (SETQ TOTALBYTES 0)) (T (* ; "This better never happen") (HELP "Inconsistency in READPAGE byte count"))) (RPLACA PAIR PAGENO) (add PAGENO 1)) (COND ((NOT (EOFP BULKSTREAM)) (* ; "RetrieveBytes returned more data than we requested.") (COURIER.ABORT.BULKDATA (QUOTE (ERROR TRANSFER.ERROR FormatIncorrect)))))))) SESSION (QUOTE RETURNERRORS)))) (COND (ERROR (\NSRANDOM.HANDLE.ERROR ERROR STREAM SESSION (QUOTE RETRIEVE.BYTES)) (GO RETRY))) (COND ((NOT (fetch NSHWASREAD of HANDLE)) (* ;; "Reading file has changed its  read date.  We assume this happens only once per handle, that the file service does not change the date on every read!") (LET ((ATTR (ASSOC (QUOTE READ.ON) (fetch NSHATTRIBUTES of HANDLE)))) (COND (ATTR (replace NSHATTRIBUTES of HANDLE with (DREMOVE ATTR (fetch NSHATTRIBUTES of HANDLE))))) (replace NSHWASREAD of HANDLE with T)))))) (T (* ; "Nothing to retrieve, just clear buffers (pmap code ought to catch this)") (for BUF inside BUFFERS do (\CLEARBYTES BUF 0 BYTESPERPAGE)))))))
)

(\NSRANDOM.PREPARE.CACHE

(LAMBDA (STREAM NPAGES) (* ; "Edited 10-Jun-87 20:33 by bvm:") (LET ((CACHE (fetch NSFILING.PAGE.CACHE of STREAM))) (COND ((NULL CACHE) (* ; "No cache yet, so create one with n pages in it") (SETQ CACHE (for I from 1 to NPAGES collect (LIST -1 (NCREATE (QUOTE VMEMPAGEP))))) (replace NSFILING.PAGE.CACHE of STREAM with (create NSPAGECACHE NSPSIZE ← NPAGES NSPTAIL ← (LAST CACHE) NSPBUFFERS ← CACHE)) CACHE) (T (COND (\NSRANDOM.CHECK.CACHE (\NSRANDOM.CHECK.CACHE CACHE))) (PROG ((OLDSIZE (fetch NSPSIZE of CACHE)) (HEAD (fetch NSPHEADER of CACHE)) PREV FREETAIL NAVAIL NCREATED NNEEDED) RETRY (SETQ FREETAIL HEAD) (* ; "Find first free cache page.  (CDR HEAD) is the first buffer.") (while (SETQ FREETAIL (CDR (SETQ PREV FREETAIL))) when (EQ (CAAR FREETAIL) -1) do (* ; "This buffer is free") (SETQ NAVAIL 1) (bind PREVFREE (MORETAIL ← FREETAIL) while (SETQ MORETAIL (CDR (SETQ PREVFREE MORETAIL))) do (COND ((EQ (CAAR MORETAIL) -1) (add NAVAIL 1)) (T (* ; "Not all empty's are at end.  Move these there and try again.") (UNINTERRUPTABLY (* ;; "Want to transform PREV.FREETAIL...PREVFREE.MORETAIL...LAST to be PREV.MORETAIL...LAST.FREETAIL...PREVFREE") (RPLACD PREV MORETAIL) (* ; "Splice out") (RPLACD PREVFREE NIL) (RPLACD (fetch (NSPAGECACHE NSPTAIL) of CACHE) FREETAIL) (* ; "Attach to end of list") (replace (NSPAGECACHE NSPTAIL) of CACHE with PREVFREE) (* ; "Update end pointer")) (GO RETRY)))) (RETURN) finally (* ; "No free buffers found") (SETQ NAVAIL 0)) (* ;; "There are now NAVAIL free buffers, the first of which is in NEWTAIL") (COND ((<= NPAGES NAVAIL) (* ; "That's enough, don't need to allocate any") (SETQ NCREATED 0) (RPTQ (- NAVAIL NPAGES) (* ; "Want to use the LAST n pages in the case where there are more free pages than we need") (SETQ FREETAIL (CDR (SETQ PREV FREETAIL))))) ((<= (SETQ NNEEDED (- NPAGES NAVAIL)) (SETQ NCREATED (- *NSFILING-PAGE-CACHE-LIMIT* OLDSIZE))) (* ; "NCREATED (Maximum buffers we can add) is more than we need, so use free buffers found above plus just what we need") (SETQ NCREATED NNEEDED) (COND ((NULL FREETAIL) (* ; "All the created buffers get used, no old ones, so they all go on front.") (SETQ FREETAIL (CDR (SETQ PREV HEAD)))))) ((< NPAGES *NSFILING-PAGE-CACHE-LIMIT*) (* ; "Create as buffers to get up to limit, and additionally use as many old buffers as needed to get n.") (SETQ PREV (CL:NTHCDR (- OLDSIZE (- NPAGES NCREATED)) HEAD)) (* ; "Fast version of (NLEFT Buffers NPAGES-NCREATED)") (SETQ FREETAIL (CDR PREV))) (T (* ; "Perverse case--usually increment < limit.  But do it anyway: use all existing buffers, and allocate enough new ones to satisfy request.") (SETQ NCREATED (- NPAGES OLDSIZE)) (SETQ PREV HEAD) (SETQ FREETAIL (CDR PREV)))) (* ;; "Have HEAD-->FIRST...PREV.FREETAIL...LAST and want to turn it into HEAD-->NewBufs.FREETAIL...LAST.FIRST...PREV") (to NCREATED do (push FREETAIL (LIST -1 (NCREATE (QUOTE VMEMPAGEP))))) (* ; "Create new buffers as needed") (UNINTERRUPTABLY (* ; "Need to maintain consistency here...") (COND ((AND (NEQ PREV HEAD) (NOT (NULL (CDR PREV)))) (* ; "There is non-trivial rearrangement to be done.") (RPLACD PREV NIL) (* ; "PREV is new end of list") (RPLACD (fetch NSPTAIL of CACHE) (CDR HEAD)) (* ; "Splice old head onto old last") (replace NSPTAIL of CACHE with PREV) (* ; "PREV is new last"))) (RPLACD HEAD FREETAIL) (* ; "New buffer list") (COND ((NEQ NCREATED 0) (replace NSPSIZE of CACHE with (+ OLDSIZE NCREATED))))) (RETURN FREETAIL))))))
)

(\NSRANDOM.FETCH.CACHE

(LAMBDA (STREAM PAGENO KEEP) (* ; "Edited  3-Sep-87 12:03 by bvm:") (LET ((CACHE (fetch NSFILING.PAGE.CACHE of STREAM))) (COND (CACHE (LET ((TAIL (fetch (NSPAGECACHE NSPHEADER) of CACHE)) PREV PAIR) (* ;; "Cache is constructed so that there is always a header node we can rplacd to change first element of real list.  Contents of header node happens to be the pointer to the tail of the list.") (while (SETQ TAIL (CDR (SETQ PREV TAIL))) when (EQ (CAR (SETQ PAIR (CAR TAIL))) PAGENO) do (* ; "Found it.  ") (COND ((NOT KEEP) (* ; "Removing it from cache, so move node to end of list.") (COND ((CDR TAIL) (* ; "Not already at end") (UNINTERRUPTABLY (RPLACD PREV (CDR TAIL)) (* ; "Splice out") (RPLACD TAIL NIL) (RPLACD (fetch (NSPAGECACHE NSPTAIL) of CACHE) TAIL) (* ; "Attach to end of list") (replace (NSPAGECACHE NSPTAIL) of CACHE with TAIL) (* ; "Update end pointer")))) (* ; "Mark pair with impossible page number -1") (RPLACA PAIR -1))) (RETURN PAIR)))))))
)

(\NSRANDOM.CHECK.CACHE

(LAMBDA (CACHE CHECKORDER) (* ; "Edited 10-Jun-87 19:21 by bvm:") (COND ((NULL CACHE) (* ; "Empty cache") NIL) ((NEQ (fetch NSPSIZE of CACHE) (LENGTH (fetch NSPBUFFERS of CACHE))) (HELP "Cache length is wrong")) ((NEQ (fetch (NSPAGECACHE NSPTAIL) of CACHE) (LAST (fetch NSPBUFFERS of CACHE))) (HELP "Cache tail pointer is wrong")) (CHECKORDER (for X in (fetch NSPBUFFERS of CACHE) bind EMPTY do (COND (EMPTY (COND ((NEQ (CAR X) -1) (HELP "Cache empty elements not all at end")))) ((EQ (CAR X) -1) (SETQ EMPTY T)))))))
)

(\NSRANDOM.WRITEPAGES

(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* ; "Edited  9-Oct-87 15:52 by bvm:") (* ;; "Write pages method for NS random access file.") (PROG (SESSION) (for BUF inside BUFFERS as P from FIRSTPAGE# do (* ;; "Flush these pages from cache if they happen to have been prefetched.  Problem is that prefetch doesn't see what the stream itself has buffered in its pmap buffers, so could have fetched a page even though there is a local copy, possibly dirty even.") (\NSRANDOM.FETCH.CACHE STREAM P)) RETRY (COND ((NULL (SETQ SESSION (fetch NSFILING.CONNECTION of STREAM))) (* ; "Session lost, e.g., after logout") (\NSRANDOM.REESTABLISH STREAM) (GO RETRY))) (LET ((CURRENTEOF (fetch NSFILING.SERVER.LENGTH of STREAM)) (HANDLE (fetch NSFILING.HANDLE of STREAM)) (FIRSTBYTE (UNFOLD FIRSTPAGE# BYTESPERPAGE)) BYTES-TIL-EOF BYTESTOSTORE ATTRS ERROR LASTPAGE) (SETQ BYTESTOSTORE (for BUF inside BUFFERS as old LASTPAGE from FIRSTPAGE# bind (EP ← (fetch (STREAM EPAGE) of STREAM)) sum (COND ((EQ LASTPAGE EP) (fetch (STREAM EOFFSET) of STREAM)) (T BYTESPERPAGE)))) (COND ((EQ BYTESTOSTORE 0) (* ; "Nothing to write.  Stupid of pmap to call us.") (RETURN))) (COND ((fetch REVALIDATEFLG of STREAM) (* ;; "Need to update creationdate, since a SAVEVM etc has occurred since the last write.  Otherwise, it is possible to see a change to the file but no change to the creationdate") (OR (\NSRANDOM.UPDATE.VALIDATION STREAM SESSION HANDLE) (GO RETRY)))) (COND ((< (SETQ BYTES-TIL-EOF (- CURRENTEOF FIRSTBYTE)) 0) (* ; "Writing past end of file?") (\NSRANDOM.TRUNCATEFILE STREAM (FOLDLO FIRSTBYTE BYTESPERPAGE) (IMOD FIRSTBYTE BYTESPERPAGE)) (SETQ CURRENTEOF FIRSTBYTE) (SETQ BYTES-TIL-EOF 0))) (SETQ ERROR (COND ((AND (< BYTES-TIL-EOF BYTESTOSTORE) (NEQ BYTES-TIL-EOF 0)) (* ; "Range to write overlaps eof.  Filing doesn't like this, so write the first part, then the last part") (OR (\NSRANDOM.WRITE.SEGMENT SESSION HANDLE BUFFERS FIRSTBYTE BYTES-TIL-EOF) (\NSRANDOM.WRITE.SEGMENT SESSION HANDLE (COND ((NLISTP BUFFERS) BUFFERS) (T (CL:NTHCDR (FOLDLO BYTES-TIL-EOF BYTESPERPAGE) BUFFERS))) CURRENTEOF (- BYTESTOSTORE BYTES-TIL-EOF)))) (T (* ; "Ok to write in one segment") (\NSRANDOM.WRITE.SEGMENT SESSION HANDLE BUFFERS FIRSTBYTE BYTESTOSTORE)))) (COND (ERROR (\NSRANDOM.HANDLE.ERROR ERROR STREAM SESSION (QUOTE REPLACE.BYTES)) (GO RETRY))) (\NSRANDOM.WROTE.HANDLE SESSION HANDLE) (* ; "Writing data to file has (potentially) changed its creationdate.") (COND ((< (- CURRENTEOF FIRSTBYTE) BYTESTOSTORE) (* ; "Wrote to eof, so update remote eof") (replace NSFILING.SERVER.LENGTH of STREAM with (SETQ CURRENTEOF (+ FIRSTBYTE BYTESTOSTORE))) (COND ((SETQ ATTRS (ASSOC (QUOTE SIZE.IN.BYTES) (fetch NSHATTRIBUTES of HANDLE))) (* ; "Update cached info about size of file") (CL:SETF (CADR ATTRS) CURRENTEOF))))) (replace NSFILING.LAST.REQUEST of STREAM with LASTPAGE))))
)

(\NSRANDOM.WRITE.SEGMENT

(LAMBDA (SESSION HANDLE BUFFERS FIRSTBYTE BYTESTOSTORE) (* ; "Edited  1-Jun-87 16:45 by bvm:") (* ;; "Write data from BUFFERS, a set of page buffers.  FIRSTBYTE is the first byte in file to replace, BYTESTOSTORE the count.  If FIRSTBYTE is not on a page boundary, start in the middle of a page.") (FILING.CALL SESSION (QUOTE REPLACE.BYTES) (fetch NSHDATUM of HANDLE) (COURIER.CREATE (FILING . BYTE.RANGE) FIRSTBYTE ← FIRSTBYTE COUNT ← BYTESTOSTORE) (FUNCTION (LAMBDA (BULKSTREAM) (* ;; "What to store as the bulk data") (for BUF inside BUFFERS bind (OFFSET ← (IMOD FIRSTBYTE BYTESPERPAGE)) (BYTESLEFT ← BYTESTOSTORE) CNT do (SETQ BYTESLEFT (COND ((> (SETQ CNT (- BYTESPERPAGE OFFSET)) BYTESLEFT) (SETQ CNT BYTESLEFT) 0) (T (- BYTESLEFT CNT)))) (\BOUTS BULKSTREAM BUF OFFSET CNT) (SETQ OFFSET 0) repeatuntil (EQ BYTESLEFT 0)))) SESSION (QUOTE RETURNERRORS)))
)

(\NSRANDOM.WROTE.HANDLE

(LAMBDA (SESSION HANDLE) (* ; "Edited  9-Oct-87 15:52 by bvm:") (* ;; "Called when we did something (e.g., ReplaceBytes) that would cause the creation date to change.  We assume this happens only once per handle, that the file service does not change the date on every write!  Since validation depends on creationdate, we have to actually refetch it, not just zap it.") (COND ((NOT (fetch NSHWASWRITTEN of HANDLE)) (LET ((NEWINFO (FILING.CALL SESSION (QUOTE GET.ATTRIBUTES) (fetch NSHDATUM of HANDLE) (CONSTANT (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (CREATED.ON)))) SESSION (QUOTE RETURNERRORS)))) (COND ((AND NEWINFO (NEQ (CAR NEWINFO) (QUOTE ERROR))) (* ; "If error occurred, we don't care, since the handle is then trash.") (\NSFILING.UPDATE.ATTRIBUTES HANDLE NEWINFO) (replace NSHWASWRITTEN of HANDLE with T)))))) (COND ((NOT (fetch NSHWASMODIFIED of HANDLE)) (* ; "Ditto write date.") (LET ((ATTR (ASSOC (QUOTE MODIFIED.ON) (fetch NSHATTRIBUTES of HANDLE)))) (COND (ATTR (replace NSHATTRIBUTES of HANDLE with (DREMOVE ATTR (fetch NSHATTRIBUTES of HANDLE))))) (replace NSHWASMODIFIED of HANDLE with T)))))
)

(\NSRANDOM.SETEOFPTR

(LAMBDA (STREAM NBYTES) (* ; "Edited  9-Jun-87 14:03 by bvm:") (* ;; "Change open stream length to be NBYTES.  This is our own version of SETEOFPTR, since we have no need to remap the last page.") (LET ((NEWEP (fetch (BYTEPTR PAGE) of NBYTES)) (NEWEO (fetch (BYTEPTR OFFSET) of NBYTES))) (SELECTQ (\NEWLENGTHIS STREAM NEWEP NEWEO) (SHORTER (COND ((OVERWRITEABLE STREAM) (FORGETPAGES STREAM (ADD1 NEWEP) (PROG1 (fetch EPAGE of STREAM) (* ; "\seteof changes EPAGE") (\SETEOF STREAM NEWEP NEWEO))) (* ;; "FORGETPAGES tells PMAP to throw away the extra pages.  The \SETEOF is done first so that an interrupt will not leave STREAM pointing to old and possibly partially overwritten pages.") (\NSRANDOM.TRUNCATEFILE STREAM NEWEP NEWEO) (* ; "Shorten the real file") T))) (SAME (* ; "Nothing to do") T) (LONGER (COND ((APPENDABLE STREAM) (\SETEOF STREAM NEWEP NEWEO) T))) (SHOULDNT))))
)

(\NSRANDOM.TRUNCATEFILE

(LAMBDA (STREAM LP LO) (* ; "Edited  9-Oct-87 15:52 by bvm:") (* ;; "Resets the length of the file to LP page and LO offset.  Can both shorten and lengthen files.") (PROG (SESSION CURRENTEOF NEWEOF) RETRY (COND ((NOT (= (SETQ CURRENTEOF (fetch NSFILING.SERVER.LENGTH of STREAM)) (SETQ NEWEOF (COND (LP (create BYTEPTR PAGE ← LP OFFSET ← LO)) (T (\GETEOFPTR STREAM)))))) (* ; "There's something to do") (COND ((NULL (SETQ SESSION (fetch NSFILING.CONNECTION of STREAM))) (* ; "Session lost, e.g., after logout") (\NSRANDOM.REESTABLISH STREAM) (GO RETRY))) (LET ((HANDLE (fetch NSFILING.HANDLE of STREAM)) ERROR ATTRS) (COND ((fetch REVALIDATEFLG of STREAM) (* ;; "Need to update creationdate, since a SAVEVM etc has occurred since the last write.  Otherwise, it is possible to see a change to the file but no change to the creationdate") (OR (\NSRANDOM.UPDATE.VALIDATION STREAM SESSION HANDLE) (GO RETRY)))) (* ;; "Although you might think the right way to shorten a file is to do a ReplaceBytes on the range [newEof,EndOfFile] with zero bytes, the server rejects that.  Instead, explicitly change the LENGTH attribute.") (SETQ ERROR (FILING.CALL SESSION (QUOTE CHANGE.ATTRIBUTES) (fetch NSHDATUM of HANDLE) (BQUOTE ((SIZE.IN.BYTES (\, NEWEOF)))) SESSION (QUOTE RETURNERRORS))) (COND (ERROR (\NSRANDOM.HANDLE.ERROR ERROR STREAM SESSION (QUOTE CHANGE.ATTRIBUTES)) (GO RETRY))) (replace NSFILING.SERVER.LENGTH of STREAM with NEWEOF) (COND ((SETQ ATTRS (ASSOC (QUOTE SIZE.IN.BYTES) (fetch NSHATTRIBUTES of HANDLE))) (* ; "Update cached info about size of file") (CL:SETF (CADR ATTRS) NEWEOF))) (\NSRANDOM.WROTE.HANDLE SESSION HANDLE))))) STREAM)
)

(\NSRANDOM.UPDATE.VALIDATION

(LAMBDA (STREAM SESSION HANDLE) (* ; "Edited  1-Jun-87 16:45 by bvm:") (* ;; "Called when STREAM's REVALIDATEFLG is true, meaning we need to update its creationdate to ensure that what we are about to write is noticeable if we were to boot back to the last savevm.") (LET* ((NEWATTRS (BQUOTE ((CREATED.ON (\, (IDATE)))))) (ERROR (FILING.CALL SESSION (QUOTE CHANGE.ATTRIBUTES) (fetch NSHDATUM of HANDLE) NEWATTRS SESSION (QUOTE RETURNERRORS)))) (COND (ERROR (\NSRANDOM.HANDLE.ERROR ERROR STREAM SESSION (QUOTE CHANGE.ATTRIBUTES)) (* ; "Return NIL on failure") NIL) (T (replace REVALIDATEFLG of STREAM with NIL) (\NSFILING.UPDATE.ATTRIBUTES HANDLE NEWATTRS)))))
)
)



(* ; "error handling")


(DEFINEQ

(\NSRANDOM.HANDLE.ERROR

(LAMBDA (ERROR STREAM SESSION PROCEDURE) (* ; "Edited 27-Aug-87 11:30 by bvm:") (* ;; "Handle error in call to filing random access procedure.  Most interesting one now is session error, which happens when the session times out.") (SELECTQ (CADR ERROR) (SESSION.ERROR (LET ((DEVICE (fetch DEVICEINFO of (fetch DEVICE of STREAM)))) (for S in (fetch OPENFILELST of DEVICE) when (EQ (fetch NSFILING.CONNECTION of S) SESSION) do (* ; "Invalidate all streams on this connection so we're not tempted to use it again.") (replace NSFILING.CONNECTION of S with NIL)) (AND (\NSFILING.GET.NEW.SESSION SESSION DEVICE T) (\NSRANDOM.REESTABLISH STREAM)))) (SPACE.ERROR (* ; "Ran out of space writing the file") (\NSRANDOM.PROCEEDABLE.ERROR STREAM (QUOTE XCL:FS-RESOURCES-EXCEEDED) (LIST :PATHNAME (fetch FULLFILENAME of STREAM)))) (ACCESS.ERROR (* ; "Grumble.  Can happen if you open an old file for output, or create a file in a directory to which you have ADD but not WRITE access.") (\NSRANDOM.PROCEEDABLE.ERROR STREAM "Attempt to ~:[read~;write to~] file ~A failed because: ~A.  How shall I proceeed?" (LIST (NEQ PROCEDURE (QUOTE RETRIEVE.BYTES)) (FULLNAME STREAM) (CADDR ERROR)))) (TRANSFER.ERROR (* ; "Something went wrong in transit.  let's try it again.") (PRINTOUT PROMPTWINDOW T "Access to " (FULLNAME STREAM) " failed because: " (CADDR ERROR) "; " "will retry.")) (COURIER.SIGNAL.ERROR (fetch FSPROTOCOLNAME of SESSION) PROCEDURE ERROR)))
)

(\NSRANDOM.PROCEEDABLE.ERROR

(LAMBDA (STREAM ERROR ERRORARGS PROCEED-DETAILS) (* ; "Edited  5-Aug-87 14:55 by bvm:") (* ;; "Enter the debugger because of a problem with STREAM.  ERROR and ERRORARGS are passed to CL:ERROR.  PROCEED-DETAILS, if non-NIL, is a format string describing what will happen if you choose the proceed option PROCEED (or OK).  Returns only if PROCEED was selected.") (PROCEED-CASE (CL:APPLY (FUNCTION CL:ERROR) ERROR ERRORARGS) (PROCEED NIL :REPORT (CL:FORMAT T (OR PROCEED-DETAILS "Try again") ERRORARGS)) (GIVEUP NIL :REPORT "Abort: close the stream and abort the computation" (\NSRANDOM.DESTROY.STREAM STREAM) (* ; "Blow away the stream.") (ERROR!))))
)

(\NSRANDOM.REESTABLISH

(LAMBDA (STREAM) (* ; "Edited 20-Nov-87 17:08 by bvm:") (PROG (HANDLE) RETRY (RETURN (if (NULL (SETQ HANDLE (fetch NSFILING.HANDLE of STREAM))) then (* ; "Somebody's already blown away this stream") (\NSRANDOM.PROCEEDABLE.ERROR STREAM "Trying to operate on stream after it's closed: ~S" (LIST STREAM)) (GO RETRY) elseif (\NSFILING.GETFILE (fetch DEVICEINFO of (fetch DEVICE of STREAM)) (LET ((ID (fetch NSHFILEID of HANDLE))) (OR (AND ID (LIST (QUOTE FILE.ID) ID)) (fetch FULLFILENAME of STREAM))) (fetch ACCESS of STREAM) (QUOTE OLD) NIL NIL NIL NIL STREAM) else (\NSRANDOM.PROCEEDABLE.ERROR STREAM "Lost connection to file ~A, can't reestablish" (LIST (fetch FULLFILENAME of STREAM))) (GO RETRY)))))
)

(\NSRANDOM.STREAM.CHANGED

(LAMBDA (OLDSTREAM NEWHANDLE) (* ; "Edited  5-Aug-87 16:35 by bvm:") (* ;; "Called when trying to reestablish OLDSTREAM.  NEWHANDLE is a new handle on the file, which shows that the file has changed with respect to OLDSTREAM's handle.  Returning from this function will continue by using the new handle. ") (\NSRANDOM.PROCEEDABLE.ERROR OLDSTREAM "The file ~A has been modified since you last accessed it.  How shall I proceed?" (LIST (FULLNAME OLDSTREAM)) (COND ((DIRTYABLE OLDSTREAM) "Continue output to the file, possibly overwriting its more recent contents") (T "Continue, reading the new contents of the file"))) (COND ((NEQ (fetch ACCESS of OLDSTREAM) (QUOTE OUTPUT)) (* ; "reset eof to correct value") (LET ((LEN (IMAX (CADR (ASSOC (QUOTE SIZE.IN.BYTES) (fetch NSHATTRIBUTES of NEWHANDLE)))))) (replace EPAGE of OLDSTREAM with (FOLDLO LEN BYTESPERPAGE)) (replace EOFFSET of OLDSTREAM with (IMOD LEN BYTESPERPAGE))))) (replace NSFILING.PAGE.CACHE of OLDSTREAM with NIL))
)

(\NSRANDOM.DESTROY.STREAM

(LAMBDA (STREAM) (* ; "Edited  3-Jun-87 18:58 by bvm:") (* ;; "Blow away stream in a way that we won't keep dying.  CLOSEF will just keep trying to write pages otherwise.") (UNINTERRUPTABLY (\RELEASECPAGE STREAM)) (FORGETPAGES STREAM) (* ; "Discard buffers before closing file, so that CLOSEF doesn't try to write anything.") (replace NSFILING.SERVER.LENGTH of STREAM with (\GETEOFPTR STREAM)) (* ; "Wrong, but it keeps truncatefile from trying to resize the file.") (CLOSEF STREAM))
)

(\NSRANDOM.SESSION.WATCHER

(LAMBDA (DEVICE) (* ; "Edited 10-Jun-87 17:57 by bvm:") (* ;; "Process that makes sure sessions stay open on DEVICE if they are needed.  There are two notions of timeout here: (1) the server has an inactivity timeout; if no courier calls in that time, the session is discarded. (2) we have a timeout for open streams; if no stream activity happens within that time, we are willing to let session die.  Our timeout is, in general, greater than the servers; it is chosen to obtain a balance between the expense of opening a new session and reestablishing open streams on it and the load we place on the server by keeping a session open that we aren't actively using.") (LET ((DEVINFO (fetch DEVICEINFO of DEVICE))) (replace NSWATCHERPROC of DEVINFO with (THIS.PROCESS)) (* ; "Redundant ordinarily (ensure.watcher does this itself to avoid races), but important to redo it after HARDRESET.") (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (DEVINFO) (* ; "Remove this pointer when process goes away") (replace NSWATCHERPROC of DEVINFO with NIL))) DEVINFO)) (do (LET (WRITING? SESSION TIMEOUT CONTINUANCE BASICTIMER) (* ; "See if any random access files are open") (COND ((NULL (SETQ SESSION (CAR (fetch NSCONNECTIONS of DEVINFO)))) (* ; "No live sessions, so nothing to watch") (RETURN)) ((NOT (for S in (fetch (FDEV OPENFILELST) of DEVICE) when (NEQ (fetch (STREAM DEVICE) of S) DEVICE) do (* ; "Stream is open on random device") (SETQ $$VAL T) (COND ((DIRTYABLE S) (SETQ WRITING? T))))) (* ; "No randaccess files are open, so nothing to watch") (RETURN)) ((EQ 0 (SETQ TIMEOUT (COND ((NLISTP *NSFILING-SESSION-TIMEOUT*) *NSFILING-SESSION-TIMEOUT*) (WRITING? (CDR *NSFILING-SESSION-TIMEOUT*)) (T (CAR *NSFILING-SESSION-TIMEOUT*))))) (* ; "timeout is zero (i.e., timeout immediately), so don't need to stick around.") (RETURN)) ((NOT (\SECONDSCLOCKGREATERP (SETQ BASICTIMER (fetch FSSESSIONTIMER of SESSION)) (SETQ CONTINUANCE (fetch FSCONTINUANCE of SESSION)))) (* ; "Ho hum, we have lots of time before we need to worry about keeping session alive.")) ((AND TIMEOUT (\SECONDSCLOCKGREATERP (LET ((REALTIMER (fetch FSLASTREALACTIVITYTIMER of SESSION))) (COND ((AND REALTIMER (NOT (fetch FSREALACTIVITY of SESSION))) (* ; "nothing's happened since the last CONTINUE") REALTIMER) (T BASICTIMER))) TIMEOUT)) (* ; "Real timeout has passed, so give up") (RETURN)) ((NOT (FILING.CALL SESSION (QUOTE CONTINUE) SESSION (QUOTE NOERROR))) (* ; "Failed to keep the session alive, go away") (RETURN))) (BLOCK (TIMES 1000 (IMAX (- CONTINUANCE (- (\DAYTIME0 (\CREATECELL \FIXP)) BASICTIMER)) 0))) (* ; "Dismiss until the time we next worry about session going away.")))))
)

(\NSRANDOM.ENSURE.WATCHER

(LAMBDA (DEVICE) (* ; "Edited  2-Jun-87 15:33 by bvm:") (* ;; "Create a watcher process for this device, if one does not already exist, to make sure that sessions stay open.") (LET ((DEVINFO (fetch DEVICEINFO of DEVICE))) (OR (fetch NSWATCHERPROC of DEVINFO) (replace NSWATCHERPROC of DEVINFO with (ADD.PROCESS (LIST (FUNCTION \NSRANDOM.SESSION.WATCHER) DEVICE) (QUOTE RESTARTABLE) (QUOTE HARDRESET) (QUOTE NAME) (CONCAT (fetch NSFILINGNAME of DEVINFO) " Watcher") (QUOTE AFTEREXIT) (QUOTE DELETE))))))
)
)



(* ; "Cleaning up directories")


(DEFINEQ

(GC-FILING-DIRECTORY

(LAMBDA (DIRNAME CONFIRM?) (* ; "Edited  5-Aug-87 15:20 by bvm:") (* ;; "Device method for file enumeration.  Return a generator that enumerates files matching PATTERN.  DESIREDPROPS is set of attributes caller may ask for.  If OPTIONS includes RESETLST, caller promises to be wrapped in a RESETLST that we can use to kill an aborted bulk listing.") (if (OR (NULL DIRNAME) (NEQ (CHCON1 DIRNAME) (CHARCODE "{"))) then (* ; "add defaults") (SETQ DIRNAME (\ADD.CONNECTED.DIR DIRNAME))) (PROG ((DEVICE (\GETDEVICEFROMNAME DIRNAME)) (PARSE (\NSFILING.PARSE.FILENAME DIRNAME T)) (NDELETED 0) CANDIDATES HOST DIRINDEX TOPID) (COND ((NEQ (fetch OPENFILE of DEVICE) (FUNCTION \NSFILING.OPENFILE)) (RETURN "Not an NS File Server")) ((NOT (fetch NSDIRECTORYP of PARSE)) (RETURN "Not a directory name")) ((OR (NLISTP (SETQ CANDIDATES (\NSGC.COLLECT.DIRECTORIES DEVICE (fetch NSDIRECTORIES of PARSE) T))) (EQ (CAR CANDIDATES) (QUOTE ERROR))) (* ; "Some sort of failure") (RETURN CANDIDATES))) (SETQ TOPID (pop CANDIDATES)) (COND ((NULL CANDIDATES) (RETURN "No empty directories"))) (* ;; "Now have list of file id's that are directories with no children.") (PRINTOUT T "{" (SETQ HOST (fetch FSNAMESTRING of (CAR (fetch NSCONNECTIONS of (fetch DEVICEINFO of DEVICE))))) "}" T) (SETQ DIRINDEX (+ 3 (NCHARS HOST))) (* ; "Index of where directory name will start in full names.") (for ID in CANDIDATES do (while (AND (SETQ ID (\NSFILING.GETFILE DEVICE (BQUOTE (FILE.ID (\, ID))) (QUOTE NONE) NIL (QUOTE HANDLE) (FUNCTION (LAMBDA (SESSION HANDLE) (COND ((EQ (fetch NSHBUSYCOUNT of HANDLE) 0) (* ; "Directory not in use, ok to delete.  Ordinarily nobody holds on to directories, so this may be superfluous today") (for PAIR in (FILING.CALL SESSION (QUOTE GET.ATTRIBUTES) (fetch NSHDATUM of HANDLE) (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (NUMBER.OF.CHILDREN PARENT.ID))) SESSION) bind PARENT ERROR do (SELECTQ (CAR PAIR) (NUMBER.OF.CHILDREN (COND ((NEQ (CADR PAIR) 0) (* ; "Has children now, skip it.  Note that this could be true for any directory collected above, because we didn't obtain handles then.") (RETURN NIL)))) (PARENT.ID (SETQ PARENT (CADR PAIR))) (SHOULDNT)) finally (* ; "Ready to try deleting it.") (PRINTOUT T (SUBSTRING (\NSFILING.FULLNAME SESSION HANDLE) DIRINDEX) %,) (COND ((AND CONFIRM? (NEQ (QUOTE Y) (ASKUSER NIL NIL "delete? " (QUOTE ((Y "es ") (N "o "))) T))) (* ; "disconfirmed")) ((SETQ ERROR (FILING.CALL SESSION (QUOTE DELETE) (fetch NSHDATUM of HANDLE) SESSION (QUOTE RETURNERRORS))) (COND ((EQ (CADDR ERROR) (QUOTE TokenInvalid)) (* ; "sigh, could get this if the ASKUSER took a long time.  Go around again") (PRINTOUT T "connection lost" T) (RETURN ID))) (PRINTOUT T (CADDR ERROR))) (T (* ; "success") (PRINTOUT T "deleted." T) (add NDELETED 1) (replace FSCACHEDHANDLES of SESSION with (DREMOVE HANDLE (fetch FSCACHEDHANDLES of SESSION))) (* ; "return parent id for another go around in case deleting this directory emptied the parent.") (RETURN PARENT))) (TERPRI T) (RETURN NIL)))))) T)) (NOT (EQUAL ID TOPID))) do (* ; "Keep trying to delete dirs until we get back to the root."))) (RETURN (CONCAT NDELETED " directories deleted"))))
)

(\NSGC.COLLECT.DIRECTORIES

(LAMBDA (DEVICE DIRPATH NOCHILDREN) (* ; "Edited  5-Aug-87 15:20 by bvm:") (* ;; "Return a list of directory id's below DIRPATH, with the root directory's id consed on the front.  If NOCHILDREN is true, only directories with zero children are included.") (RESETLST (* ; "Need RESETLST for \getfilingconnection") (PROG ((SCOPELIST (BQUOTE ((DEPTH 65535) (FILTER (AND ((= ((IS.DIRECTORY T) BOOLEAN)) (\,@ (AND NOCHILDREN (QUOTE ((= ((NUMBER.OF.CHILDREN 0) CARDINAL)))))))))))) (SESSION (\GETFILINGCONNECTION DEVICE)) BULKSTREAM HANDLE GENERATOR) (COND ((NULL SESSION) (RETURN NIL)) ((NULL (SETQ HANDLE (\NSFILING.CONNECT SESSION DIRPATH T))) (RETURN "No such directory"))) RETRY (SETQ BULKSTREAM (FILING.CALL SESSION (QUOTE LIST) (fetch NSHDATUM of HANDLE) (if NOCHILDREN then (CONSTANT (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (FILE.ID IS.DIRECTORY NUMBER.OF.CHILDREN)))) else (CONSTANT (\FILING.ATTRIBUTE.TYPE.SEQUENCE (QUOTE (FILE.ID IS.DIRECTORY))))) SCOPELIST NIL SESSION (QUOTE RETURNERRORS) (QUOTE KEEPSTREAM))) (COND ((AND (LISTP BULKSTREAM) (CDR SCOPELIST) (EQUAL BULKSTREAM (QUOTE (ERROR SCOPE.VALUE.ERROR Unimplemented FILTER)))) (* ; "Would be nice to have a filter on IS.DIRECTORY and NUMBER.OF.CHILDREN, but servers don't implement that.") (SETQ SCOPELIST (QUOTE ((DEPTH 65535)))) (GO RETRY))) (COND ((NOT (STREAMP BULKSTREAM)) (RETURN BULKSTREAM))) (RESETSAVE NIL (LIST (FUNCTION \NSFILING.CLOSE.BULKSTREAM) SESSION BULKSTREAM)) (SETQ GENERATOR (BULKDATA.GENERATOR BULKSTREAM (fetch FSPROTOCOLNAME of SESSION) (QUOTE ATTRIBUTE.SEQUENCE))) (RETURN (CONS (fetch NSHFILEID of HANDLE) (bind ID INFO eachtime (SETQ ID NIL) while (SETQ INFO (BULKDATA.GENERATE.NEXT GENERATOR)) when (for PAIR in INFO always (SELECTQ (CAR PAIR) (FILE.ID (SETQ ID (CADR PAIR))) (IS.DIRECTORY (CADR PAIR)) (NUMBER.OF.CHILDREN (EQ 0 (CADR PAIR))) NIL)) collect ID))))))
)
)



(* ; "Deserialize (special for NSMAIL)")


(DEFINEQ

(\NSFILING.DESERIALIZE

(LAMBDA (FILENAME SERIALSTREAM DEVICE) (* ; "Edited  8-Dec-87 13:05 by bvm:") (RESETLST (LET ((PARSE (\NSFILING.PARSE.FILENAME FILENAME)) DIRHANDLE HANDLE SESSION VERSION NAME) (COND ((NULL PARSE) (* ; "Bad name") (CL:ERROR (QUOTE XCL:INVALID-PATHNAME) :PATHNAME FILENAME)) ((NULL (SETQ SESSION (\GETFILINGCONNECTION DEVICE))) (CL:ERROR (QUOTE XCL:FILE-NOT-FOUND) :PATHNAME FILENAME)) ((NULL (SETQ DIRHANDLE (\NSFILING.CONNECT SESSION (fetch NSDIRECTORIES of PARSE) T T))) (* ; "Couldn't get handle on destination") (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME FILENAME)) ((AND (LISTP (SETQ HANDLE (\NSFILING.DESERIALIZE1 SESSION DIRHANDLE (BQUOTE ((\,@ (AND (SETQ NAME (fetch NSROOTNAME of PARSE)) (BQUOTE ((NAME (\, (\NSFILING.REMOVEQUOTES NAME))))))) (\,@ (AND (SETQ VERSION (fetch NSVERSION of PARSE)) (BQUOTE ((VERSION (\, (MKATOM VERSION))))))))) SERIALSTREAM))) (NEQ (CAR HANDLE) (QUOTE ERROR))) (* ; "Success") (\NSFILING.FULLNAME SESSION (\NSFILING.ADD.TO.CACHE SESSION (create FILINGHANDLE NSHDATUM ← HANDLE)))) (T (* ; "Failure") (COURIER.SIGNAL.ERROR (fetch FSPROTOCOLNAME of SESSION) (QUOTE DESERIALIZE) HANDLE))))))
)

(\NSFILING.DESERIALIZE1

(LAMBDA (SERIALSESSION DIRHANDLE NEWATTRS SERIALSTREAM CLOSEFN) (* ; "Edited  9-Dec-87 18:27 by bvm:") (* ;; "Perform the DESERIALIZE call on SESSION, handle of parent directory, attributes to change, and the source of the serialized file.  The awful contorted structure is so we don't tie up the session while the transfer is in progress.") (LET ((BULKSTREAM (FILING.CALL SERIALSESSION (QUOTE DESERIALIZE) (fetch NSHDATUM of DIRHANDLE) NEWATTRS NIL NIL SERIALSESSION (QUOTE RETURNERRORS) (QUOTE KEEPSTREAM)))) (CL:UNWIND-PROTECT (LET (EXPLICIT-RESULT BULKRESULT) (RELEASE.MONITORLOCK (fetch FSSESSIONLOCK of SERIALSESSION)) (* ; "Don't let this serial transfer tie up the session forever.") (SETQ EXPLICIT-RESULT (if (TYPENAMEP SERIALSTREAM (QUOTE STREAM)) then (* ; "a stream containing the serialized data") (COPYBYTES SERIALSTREAM BULKSTREAM) (* ; "Normally want to return NIL from here so we see the real courier results.") (AND CLOSEFN (CL:FUNCALL CLOSEFN BULKSTREAM)) else (* ; "A function to store the file.") (CL:FUNCALL SERIALSTREAM BULKSTREAM))) (SETQ BULKRESULT (\BULK.DATA.CLOSE BULKSTREAM (AND (LISTP EXPLICIT-RESULT) (EQ (CAR EXPLICIT-RESULT) (QUOTE ERROR))))) (OBTAIN.MONITORLOCK (fetch FSSESSIONLOCK of SERIALSESSION)) (OR EXPLICIT-RESULT BULKRESULT)) (* ;; "Cleanups: Abort bulk data if there's a problem, release bulk stream") (\BULK.DATA.CLOSE BULKSTREAM T) (\NSFILING.RELEASE.BULKSTREAM SERIALSESSION BULKSTREAM))))
)
)
(DEFINEQ

(\NSFILING.INIT

(LAMBDA NIL (* ; "Edited 15-May-87 17:15 by bvm:") (\DEFINEDEVICE NIL (create FDEV DEVICENAME ← (QUOTE NSFILING) HOSTNAMEP ← (FUNCTION \NSFILING.HOSTNAMEP) EVENTFN ← (FUNCTION NILL))) (DEFPRINT (QUOTE FILINGSESSION) (FUNCTION \FILINGSESSION.DEFPRINT)) (DEFPRINT (QUOTE FILINGHANDLE) (FUNCTION \FILINGHANDLE.DEFPRINT)))
)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 
(\NSFILING.INIT)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 FILING.CALL)
)
(DEFINEQ

(COURIER.SIGNAL.ERROR

(LAMBDA (PROGRAM PROCEDURE ERRORFORM) (* ; "Edited  1-May-87 11:33 by bvm:") (* ;; "Signals the error returned from PROCEDURE of PROGRAM.  ERRORFORM is a form starting with the symbol ERROR from a Courier result. ") (LET ((ARGS (CDR ERRORFORM))) (ERROR (CONCAT (COND ((EQ (CAR ARGS) (QUOTE REJECT)) (* ; "Reject errors of form (ERROR REJECT reason)") (SETQ ARGS (CADR ARGS)) "Courier rejected call to ") (T (* ; "Other errors of form (ERROR type . args)") (COND ((NULL (CDR ARGS)) (* ; "For errors with no arguments, make the error call slighly prettier by just naming the error") (SETQ ARGS (CAR ARGS)))) "Error in Courier procedure ")) PROGRAM "." PROCEDURE) ARGS)))
)

(COURIER.CALL

(LAMBDA ARGS (* ; "Edited 31-Jul-87 13:48 by bvm:") (* ;; "Call a Courier procedure: (COURIER.CALL stream program-name procedure-name arg1 ... argN)") (* ;; "Returns the result of the remote procedure, or a list of such results if it returns more than one.  A single flag NoErrorFlg can be optionally appended to the arglist -- If NoErrorFlg is NOERROR, return NIL if the Courier program aborts with an error;  if RETURNERRORS, then return an expression (ERROR ERRNAME . args) on error.  If the Courier procedure takes a Bulk Data parameter, then the result of COURIER.CALL is a stream for the transfer.  When the stream is closed, the results will be read and the functional argument that was supplied in the call, if any, will be applied to the results.") (LET ((STREAM (ARG ARGS 1)) (PROGRAM (ARG ARGS 2)) (PROCEDURE (ARG ARGS 3)) NARGS ARGLIST NOERRORFLG PGMDEF PROCDEF ARGTYPES) (SETQ PGMDEF (OR (\GET.COURIERPROGRAM PROGRAM) (ERROR "No such Courier program" PROGRAM))) (SETQ PROCDEF (\GET.COURIER.DEFINITION PROGRAM PROCEDURE (QUOTE PROCEDURES) PGMDEF)) (SETQ NARGS (LENGTH (SETQ ARGTYPES (fetch (COURIERFN ARGS) of PROCDEF)))) (OR (SELECTQ (- ARGS NARGS) (3 (* ; "Exactly right") T) (4 (* ; "Extra arg is errorflg") (SELECTQ (SETQ NOERRORFLG (ARG ARGS (+ NARGS 4))) ((NOERROR RETURNERRORS T) (* ; "The only valid values") T) NIL)) NIL) (ERROR "Wrong number of arguments to Courier procedure" (CONS PROGRAM PROCEDURE))) (SETQ ARGLIST (for I from 4 to (+ NARGS 3) collect (ARG ARGS I))) (COND ((type? STREAM STREAM) (COURIER.EXECUTE.CALL STREAM PROGRAM PGMDEF PROCEDURE PROCDEF ARGLIST ARGTYPES NOERRORFLG)) ((type? NSADDRESS STREAM) (* ; "Means to make a single call to this address") (RESETLST (LET ((STREAM (COURIER.OPEN STREAM NIL NOERRORFLG))) (COND (STREAM (RESETSAVE NIL (LIST (STREAMTYPECASE STREAM (SPP (FUNCTION \SPP.RESETCLOSE)) (TCP (FUNCTION \TCP.RESETCLOSE)) (FUNCTION CLOSEF)) STREAM)) (COURIER.EXECUTE.CALL STREAM PROGRAM PGMDEF PROCEDURE PROCDEF ARGLIST ARGTYPES NOERRORFLG)) ((EQ NOERRORFLG (QUOTE RETURNERRORS)) (QUOTE (ERROR CONNECTION.PROBLEM NoResponse))))))) ((NEQ NOERRORFLG (QUOTE NOERROR)) (\ILLEGAL.ARG STREAM)))))
)

(COURIER.EXECUTE.CALL

(LAMBDA (STREAM PROGRAM PGMDEF PROCEDURE PROCDEF ARGLIST ARGTYPES NOERRORFLG) (* ; "Edited 21-Jul-87 14:44 by bvm:") (* ;; "Send the arguments for a Courier call to the remote program.  Returns NIL if none of the formal parameters are of type BULK.DATA.SOURCE or BULK.DATA.SINK, otherwise returns a stream for the Bulk Data transfer.") (COND (COURIERTRACEFLG (\COURIER.TRACE (QUOTE CALL) PROGRAM PROCEDURE ARGLIST))) (PROG ((OUTSTREAM STREAM) SOURCEFLG SINKFLG BULKDATAFN DATASTREAM) (STREAMTYPECASE STREAM (SPP (SPP.DSTYPE (SETQ OUTSTREAM (SPPOUTPUTSTREAM STREAM)) \SPPDSTYPE.COURIER)) NIL) (PUTWORD OUTSTREAM \COURIERMSG.CALL) (PUTWORD OUTSTREAM 0) (* ; "Transaction ID, ignored for now.") (PUTLONG OUTSTREAM (fetch (COURIERPGM PROGRAM#) of PGMDEF)) (PUTWORD OUTSTREAM (fetch (COURIERPGM VERSION#) of PGMDEF)) (PUTWORD OUTSTREAM (fetch (COURIERFN FN#) of PROCDEF)) (for VALUE in ARGLIST as TYPE in ARGTYPES do (SELECTQ TYPE (BULK.DATA.SOURCE (SETQ SOURCEFLG T) (SETQ BULKDATAFN VALUE) (PUTWORD OUTSTREAM 1)) (BULK.DATA.SINK (SETQ SINKFLG T) (SETQ BULKDATAFN VALUE) (PUTWORD OUTSTREAM 1)) (COURIER.WRITE OUTSTREAM VALUE PROGRAM TYPE))) (STREAMTYPECASE OUTSTREAM (SPP (SPP.SENDEOM OUTSTREAM)) (TCP (\TCP.FORCEOUTPUT OUTSTREAM)) (FORCEOUTPUT OUTSTREAM)) (CHECK (NOT (AND SOURCEFLG SINKFLG))) (RETURN (COND ((AND (OR SOURCEFLG SINKFLG) (SETQ DATASTREAM (\BULK.DATA.STREAM STREAM (COND (SINKFLG (QUOTE INPUT)) (T (QUOTE OUTPUT))) PROGRAM PROCEDURE PGMDEF PROCDEF NOERRORFLG BULKDATAFN))) (COND (BULKDATAFN (\COURIER.HANDLE.BULKDATA DATASTREAM BULKDATAFN NOERRORFLG)) (T (* ; "Return the stream to caller") DATASTREAM))) (T (\COURIER.RESULTS STREAM PROGRAM PGMDEF PROCEDURE PROCDEF NOERRORFLG))))))
)

(COURIER.EXECUTE.EXPEDITED.CALL

(LAMBDA (ADDRESS SOCKET# PROGRAM PGMDEF PROCEDURE PROCDEF ARGLIST ARGTYPES NOERRORFLG) (* ; "Edited 31-Jul-87 14:19 by bvm:") (* ;;; "Attempts the actual expedited call") (COND (COURIERTRACEFLG (\COURIER.TRACE (QUOTE CALL) PROGRAM PROCEDURE ARGLIST))) (RESETLST (PROG ((NSOC (OPENNSOCKET)) XIP STREAM RESULT) (RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET) NSOC)) (SETQ XIP (CREATE.PACKET.EXCHANGE.XIP NSOC ADDRESS SOCKET# \EXTYPE.EXPEDITED.COURIER)) (OR (\BUILD.EXPEDITED.XIP XIP PROGRAM PGMDEF PROCDEF ARGLIST ARGTYPES) (GO USECOURIER)) (COND ((NEQ (SETQ RESULT (\SEND.EXPEDITED.XIP XIP NSOC PROGRAM PGMDEF PROCEDURE PROCDEF NOERRORFLG)) (QUOTE USE.COURIER)) (RETURN RESULT))) USECOURIER (RETURN (COND ((SETQ STREAM (COURIER.OPEN ADDRESS NIL NOERRORFLG (QUOTE COURIER))) (* ; "Use regular courier") (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) STREAM)) (COURIER.EXECUTE.CALL STREAM PROGRAM PGMDEF PROCEDURE PROCDEF ARGLIST ARGTYPES NOERRORFLG)) ((EQ NOERRORFLG (QUOTE RETURNERRORS)) (QUOTE (ERROR CONNECTION.PROBLEM NoResponse))))))))
)

(\COURIER.RESULTS

(LAMBDA (STREAM PROGRAM PGMDEF PROCEDURE PROCDEF NOERRORFLG EXPEDITEDFLG) (* ; "Edited  1-May-87 11:39 by bvm:") (LET (MSGTYPE RESULT) (SETQ RESULT (SELECTC (SETQ MSGTYPE (GETWORD STREAM)) (\COURIERMSG.RETURN (LET ((RESULTTYPES (fetch (COURIERFN RESULTS) of PROCDEF))) (GETWORD STREAM) (* ; "Skip the Transaction ID.") (COND ((AND RESULTTYPES (NOT (CDR RESULTTYPES))) (* ; "Single-valued procedures return conventionally") (COURIER.READ STREAM PROGRAM (CAR RESULTTYPES))) (T (for TYPE in RESULTTYPES collect (COURIER.READ STREAM PROGRAM TYPE)))))) (\COURIERMSG.ABORT (GETWORD STREAM) (* ; "Skip the Transaction ID.") (LET ((NUMBER (GETWORD STREAM)) ERRORDEF) (CONS (QUOTE ERROR) (COND ((SETQ ERRORDEF (find ERR in (OR (fetch (COURIERPGM ERRORS) of PGMDEF) (for OTHER in (fetch (COURIERPGM INHERITS) of PGMDEF) when (SETQ $$VAL (fetch (COURIERPGM ERRORS) of (\GET.COURIERPROGRAM OTHER))) do (RETURN $$VAL))) suchthat (IEQP (fetch (COURIERERR ERR#) of (CDR ERR)) NUMBER))) (CONS (CAR ERRORDEF) (for TYPE in (fetch (COURIERERR ARGS) of (CDR ERRORDEF)) collect (COURIER.READ STREAM PROGRAM TYPE)))) (T (LIST NUMBER)))))) (\COURIERMSG.REJECT (GETWORD STREAM) (* ; "Skip the Transaction ID.") (LIST (QUOTE ERROR) (QUOTE REJECT) (COURIER.READ STREAM PROGRAM (QUOTE (CHOICE (NoSuchService 0) (WrongVersionOfService 1 (RECORD (lowest CARDINAL) (highest CARDINAL))) (NoSuchProcedure 2) (invalidArguments 3) (unspecifiedError 65535)))))) (LIST (QUOTE ERROR) (QUOTE UnknownResponseType) MSGTYPE))) (COND ((NOT EXPEDITEDFLG) (STREAMTYPECASE STREAM (SPP (SPP.CLEAREOM STREAM)) NIL))) (COND (COURIERTRACEFLG (\COURIER.TRACE (QUOTE RETURN) PROGRAM PROCEDURE RESULT))) (COND ((EQ MSGTYPE \COURIERMSG.RETURN) (* ; "Normal return") RESULT) ((AND EXPEDITEDFLG (EQ (CADDR RESULT) (QUOTE USE.COURIER))) (* ; "Special flag on expedited courier call saying to use regular Courier") (QUOTE USE.COURIER)) (T (SELECTQ NOERRORFLG (RETURNERRORS (* ; "Caller wants to handle errors") RESULT) (NIL (* ; "Default--signal the error") (COURIER.SIGNAL.ERROR PROGRAM PROCEDURE RESULT)) (PROGN (* ; "Caller wants no errors") (\COURIER.HANDLE.ERROR PROGRAM PROCEDURE RESULT) NIL))))))
)

(\COURIER.HANDLE.BULKDATA

(LAMBDA (DATASTREAM BULKDATAFN NOERRORFLG) (* ; "Edited 27-Aug-87 11:26 by bvm:") (* ;;; "Called when a Courier call has a bulkdata argument.  BULKDATAFN is a function to apply to the bulk data stream.  If it returns a non-NIL result, that is returned as the value of the Courier call, ignoring the Courier results, if any.  As a special case, a BULKDATAFN of (Program . Type) interprets the bulk data stream as a `Stream of Program.Type'") (CL:UNWIND-PROTECT (CL:MULTIPLE-VALUE-BIND (BULKRESULTS ERROR) (CL:CATCH :BULKDATA (COND ((AND (LISTP BULKDATAFN) (SELECTQ (CAR BULKDATAFN) ((LAMBDA CL:LAMBDA) (* ; "Handler is not a type, just an interpreted fn") NIL) T)) (* ; "Special case, interpret as a type") (COURIER.READ.BULKDATA DATASTREAM (CAR BULKDATAFN) (CDR BULKDATAFN) T)) (T (CL:FUNCALL BULKDATAFN DATASTREAM)))) (* ;; "Bulk data handled now.  If handler wanted to abort, then BULKRESULTS is :ABORT, in which case we send an abort packet (if necessary), and the second value ERROR is optional error value to return.") (LET ((MAINRESULTS (\BULK.DATA.CLOSE DATASTREAM (AND (EQ BULKRESULTS :ABORT) (OR NOERRORFLG T))))) (OR (AND (NEQ BULKRESULTS :ABORT) BULKRESULTS) ERROR MAINRESULTS))) (* ;; "Be sure bulk stream is closed on exit.  This is a no-op on normal exit, since the stream has already been closed.  On error exit, we send an abort.") (\BULK.DATA.CLOSE DATASTREAM T)))
)

(\COURIER.OUTPUT.ABORTED

(LAMBDA (STREAM) (* ; "Edited 18-May-87 17:07 by bvm:") (* ;; "Called when attempt is made to write data on STREAM when output has been aborted, or to read from a stream that is at ATTN (bulk data abort).") (LET (FILENAME CONTINUATION RESULT) (COND ((AND (SETQ CONTINUATION (fetch BULK.DATA.CONTINUATION of STREAM)) (NOT (fetch INTERNALFLG of CONTINUATION))) (* ; "This was a standalone bulkdata stream") (SETQ RESULT (\BULK.DATA.CLOSE STREAM (QUOTE RETURNERRORS))) (COND ((AND (SETQ FILENAME (fetch FULLFILENAME of STREAM)) (EQ (CADR RESULT) (QUOTE SPACE.ERROR))) (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" FILENAME)) (T (ERROR (CONCAT (COND ((DIRTYABLE STREAM) "Output") (T "Input")) " aborted: " (CADR RESULT) " -- " (CADDR RESULT)) (OR FILENAME STREAM))))) (T (* ; "Inside of \COURIER.HANDLE.BULKDATA") (CL:THROW :BULKDATA :ABORT)))))
)

(\BULK.DATA.STREAM

(LAMBDA (STREAM MODE PROGRAM PROCEDURE PGMDEF PROCDEF NOERRORFLG INTERNALFLG) (* ; "Edited 20-May-87 12:33 by bvm:") (* ;; "Return a specialized version of an SPP stream suitable for sending or receiving a Bulk Data object.  Uses the Bulk Data device, which redefines the EOFP and CLOSE functions.  Save the program, procedure, and result function in the stream record for use by \BULK.DATA.CLOSE.") (STREAMTYPECASE STREAM (SPP (PROG ((CON (GETSPPCON STREAM)) SUBSTREAM NEXTPKT) (COND ((EQ MODE (QUOTE INPUT)) (* ; "Preview the incoming stream to see if there's any data there") (COND ((NOT (SETQ NEXTPKT (\GETSPP CON NIL T))) (* ; "Connection died") (RETURN NIL)) ((NEQ (fetch (SPPXIP DSTYPE) of NEXTPKT) \SPPDSTYPE.BULKDATA) (* ; "Bulkdata not coming, must be error") (RETURN NIL)) ((fetch (SPPXIP ATTENTION) of NEXTPKT) (* ; "Immediately aborted, must be nothing coming") (\GETSPP CON) (* ; "Eat the packet") (RETURN NIL))))) (COND ((type? STREAM (SETQ SUBSTREAM (fetch F10 of STREAM))) (* ; "reuse old substream") (replace F10 of STREAM with NIL) (replace SPPFILEPTRHI of SUBSTREAM with 0) (replace SPPFILEPTRLO of SUBSTREAM with 0) (replace SPPEOFP of SUBSTREAM with NIL)) (T (SETQ SUBSTREAM (create STREAM DEVICE ← \SPP.BULKDATA.DEVICE)) (replace SPP.CONNECTION of SUBSTREAM with CON))) (replace BULK.DATA.CONTINUATION of SUBSTREAM with (create \BULK.DATA.CONTINUATION PROGRAM ← PROGRAM PROCEDURE ← PROCEDURE PGMDEF ← PGMDEF PROCDEF ← PROCDEF NOERRORFLG ← NOERRORFLG INTERNALFLG ← INTERNALFLG)) (replace (STREAM ACCESS) of SUBSTREAM with MODE) (replace SPPSUBSTREAM of CON with SUBSTREAM) (replace SPPATTENTIONFN of CON with (FUNCTION \COURIER.ATTENTIONFN)) (COND (COURIERTRACEFLG (\COURIER.TRACE (QUOTE BEGIN.BULK.DATA) PROGRAM PROCEDURE))) (SPP.DSTYPE SUBSTREAM \SPPDSTYPE.BULKDATA) (RETURN SUBSTREAM))) (ERROR "Courier bulk data not supported on stream of type" (fetch (FDEV DEVICENAME) of (fetch (STREAM DEVICE) of STREAM)))))
)

(\BULK.DATA.CLOSE

(LAMBDA (STREAM ABORTFLG) (* ; "Edited 27-Aug-87 11:29 by bvm:") (* ;; "Close a Bulk Data stream after the transfer has taken place.  If a result function was specified in COURIER.CALL, call it on the stream and the result or list of results.") (PROG ((CON (GETSPPCON STREAM)) (CONTINUATION (fetch BULK.DATA.CONTINUATION of STREAM))) (replace SPPATTENTIONFN of CON with NIL) (COND ((NULL (fetch SPPSUBSTREAM of CON)) (* ; "This stream has already been closed.  We don't want to try to read the Courier results twice") (RETURN))) (COND (COURIERTRACEFLG (\COURIER.TRACE (QUOTE END.BULK.DATA) (fetch PROGRAM of CONTINUATION) (fetch PROCEDURE of CONTINUATION)))) (COND ((WRITEABLE STREAM) (COND (ABORTFLG (SPP.SENDATTENTION STREAM 1)) (T (SPP.SENDEOM STREAM)))) ((NOT (\EOFP STREAM)) (* ; "Closing before all the data has been read -- abort the transfer.") (OR ABORTFLG (SETQ ABORTFLG T)) (\ABORT.BULK.DATA STREAM))) (replace BULK.DATA.CONTINUATION of STREAM with NIL) (* ; "Tell SPP handler not to take any more bulk data packets.") (replace SPPINPKT of CON with NIL) (* ;; "This stream is closing;  make sure there aren't any dangling pointers into the middle of ether packets.") (replace CBUFPTR of STREAM with NIL) (replace CBUFSIZE of STREAM with 0) (RETURN (CAR (ERSETQ (RESETLST (* ;; "The result of the Courier call may be an error which the user should see;  however, we still need to clean up the substream, so we wrap it in this RESETLST.") (LET ((COURIERSTREAM (fetch SPPINPUTSTREAM of CON))) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STRM ABORTFLG) (COND (ABORTFLG (replace ENDOFSTREAMOP of STRM with (FUNCTION \COURIER.EOF)))) (COND (RESETSTATE (SPP.CLOSE STRM T))))) COURIERSTREAM ABORTFLG)) (COND (ABORTFLG (replace ENDOFSTREAMOP of COURIERSTREAM with (FUNCTION ERROR!)))) (replace SPPSUBSTREAM of CON with NIL) (PROG1 (\COURIER.RESULTS COURIERSTREAM (fetch PROGRAM of CONTINUATION) (fetch PGMDEF of CONTINUATION) (fetch PROCEDURE of CONTINUATION) (fetch PROCDEF of CONTINUATION) (OR ABORTFLG (fetch NOERRORFLG of CONTINUATION))) (COND ((NOT (fetch FULLFILENAME of STREAM)) (* ; "On normal exit, save the substream for later reuse.") (replace F10 of COURIERSTREAM with STREAM)))))))))))
)

(COURIER.OPEN

(LAMBDA (HOSTNAME OBSOLETE NOERRORFLG NAME WHENCLOSEDFN OTHERPROPS) (* ; "Edited 24-Nov-87 12:16 by bvm:") (* ; "Open a Courier connection to the specified host.") (RESETLST (PROG (ADDRESS STREAM LOW.VERSION HIGH.VERSION) (COND ((NOT (SETQ ADDRESS (\COERCE.TO.NSADDRESS HOSTNAME))) (RETURN (AND (NOT NOERRORFLG) (ERROR "Unknown host" HOSTNAME)))) ((NULL (SETQ STREAM (SPP.OPEN ADDRESS \NS.WKS.Courier T NAME (BQUOTE (CLOSEFN (\, (CONS (FUNCTION \COURIER.WHENCLOSED) (MKLIST WHENCLOSEDFN))) (\,@ OTHERPROPS)))))) (RETURN (AND (NOT NOERRORFLG) (ERROR "Host not responding" HOSTNAME))))) (RESETSAVE NIL (LIST (FUNCTION \SPP.CLOSE.IF.ERROR) STREAM)) (replace ENDOFSTREAMOP of STREAM with (FUNCTION \COURIER.EOF)) (SPP.DSTYPE STREAM \SPPDSTYPE.COURIER) (COND (COURIERTRACEFLG (printout COURIERTRACEFILE T "Opened " (OR NAME "") " with " (SPP.DESTADDRESS STREAM)))) (PUTWORD STREAM (SUB1 COURIER.VERSION#)) (* ; "Lie about knowing an older version so as to demand a reply immediately") (PUTWORD STREAM COURIER.VERSION#) (SPP.SENDEOM STREAM) (SETQ LOW.VERSION (GETWORD STREAM)) (SETQ HIGH.VERSION (GETWORD STREAM)) (COND ((NOT (AND (ILEQ LOW.VERSION COURIER.VERSION#) (ILEQ COURIER.VERSION# HIGH.VERSION))) (SPP.CLOSE STREAM) (RETURN (AND (NOT NOERRORFLG) (ERROR "Server supports wrong version of Courier" (LIST HOSTNAME LOW.VERSION HIGH.VERSION)))))) (RETURN STREAM))))
)

(COURIER.ABORT.BULKDATA

(LAMBDA (ERROR) (* ; "Edited 27-Aug-87 11:18 by bvm:") (* ;; "Called from within a bulkdata handler to abort the bulk data operation.  The corresponding CATCH is in \COURIER.HANDLE.BULKDATA.  Optional ERROR should be returned from the courier call, instead of what the procedure returns (typically (error transfer.error Aborted)).") (COND (ERROR (CL:THROW :BULKDATA (CL:VALUES :ABORT ERROR))) (T (CL:THROW :BULKDATA :ABORT))))
)

(COURIER.SKIP

(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 30-Jun-87 17:40 by bvm:") (LET (X) (COND ((LITATOM TYPE) (SELECTQ TYPE ((BOOLEAN CARDINAL UNSPECIFIED INTEGER) (* ; "2 bytes") (\BIN STREAM) (\BIN STREAM)) ((LONGCARDINAL LONGINTEGER TIME) (* ; "4 bytes") (\BIN STREAM) (\BIN STREAM) (\BIN STREAM) (\BIN STREAM)) (STRING (* ; "Count followed by number of bytes, padded to even byte") (RPTQ (CEIL (GETWORD STREAM) BYTESPERWORD) (\BIN STREAM))) (COND ((SETQ X (GETPROP TYPE (QUOTE COURIERDEF))) (* ; "User-defined type") (CL:FUNCALL (CAR X) STREAM PROGRAM TYPE)) ((SETQ X (\GET.COURIER.TYPE PROGRAM TYPE)) (COURIER.SKIP STREAM PROGRAM X)) (T (\COURIER.UNKNOWN.TYPE PROGRAM TYPE))))) ((AND (LISTP TYPE) (LITATOM (CAR TYPE))) (SELECTQ (CAR TYPE) (ENUMERATION (* ; "2 bytes") (\BIN STREAM) (\BIN STREAM)) (ARRAY (bind (BASETYPE ← (CADDR TYPE)) to (CADR TYPE) DO (COURIER.SKIP STREAM PROGRAM BASETYPE))) (SEQUENCE (* ; "We ignore the maximum length of the sequence.") (COURIER.SKIP.SEQUENCE STREAM PROGRAM (OR (CADDR TYPE) (CADR TYPE)))) ((RECORD NAMEDRECORD) (for NAMEANDTYPE in (CDR TYPE) DO (COURIER.SKIP STREAM PROGRAM (CADR NAMEANDTYPE)))) (CHOICE (bind (WHICH ← (GETWORD STREAM)) for DEF in (CDR TYPE) do (* ; "DEF = (tag choice# type);  type = NIL is shorthand for type null record") (COND ((IEQP WHICH (CADR DEF)) (RETURN (AND (CADDR DEF) (COURIER.SKIP STREAM PROGRAM (CADDR DEF)))))))) (COND ((LITATOM (CDR TYPE)) (* ; "Qualified name") (COURIER.SKIP STREAM (CAR TYPE) (CDR TYPE))) ((SETQ X (GETPROP (CAR TYPE) (QUOTE COURIERDEF))) (CL:FUNCALL (CAR X) STREAM PROGRAM TYPE)) (T (\COURIER.UNKNOWN.TYPE PROGRAM TYPE))))) (T (\COURIER.UNKNOWN.TYPE PROGRAM TYPE)))))
)

(COURIER.SKIP.SEQUENCE

(LAMBDA (STREAM PROGRAM BASETYPE) (* ; "Edited 30-Jun-87 17:40 by bvm:") (* ;;; "Reads a Courier SEQUENCE, returning it as a list of objects of type BASETYPE") (to (GETWORD STREAM) do (COURIER.SKIP STREAM PROGRAM BASETYPE)))
)
)
(DEFINEQ

(COURIER.READ.STRING

(LAMBDA (STREAM) (* ; "Edited 21-Jul-87 14:47 by bvm:") (LET* ((LENGTH (GETWORD STREAM)) (STRING (ALLOCSTRING LENGTH)) (BASE (fetch (STRINGP BASE) of STRING)) (OFFSET (fetch (STRINGP OFFST) of STRING))) (\BINS STREAM BASE OFFSET LENGTH) (COND ((ODDP LENGTH) (BIN STREAM))) (if (for I from OFFSET to (+ OFFSET LENGTH -1) thereis (EQ (\GETBASEBYTE BASE I) 255)) then (* ; "String had NS encoding, so have to read it more carefully") (CONCATCODES (bind (STRSTREAM ← (OPENSTRINGSTREAM STRING)) until (\EOFP STRSTREAM) collect (READCCODE STRSTREAM))) else STRING)))
)

(COURIER.WRITE.STRING

(LAMBDA (STREAM STRING) (* ; "Edited 21-Jul-87 14:36 by bvm:") (if (fetch (STRINGP FATSTRINGP) of (OR (STRINGP STRING) (SETQ STRING (MKSTRING STRING)))) then (* ; "Have to produce NS encoding") (COURIER.WRITE.FAT.STRING STREAM STRING) else (LET ((LENGTH (NCHARS STRING))) (PUTWORD STREAM LENGTH) (\BOUTS STREAM (fetch (STRINGP BASE) of STRING) (fetch (STRINGP OFFST) of STRING) LENGTH) (COND ((ODDP LENGTH) (BOUT STREAM 0))))))
)

(COURIER.WRITE.FAT.STRING

(LAMBDA (STREAM STRING UNSPECIFIED) (* ; "Edited 21-Jul-87 15:24 by bvm:") (* ;; "Write the fat string STRING to courier STREAM.  If UNSPECIFIED is true, encode it as a sequence unspecified, else as a string.") (LET ((CORE (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) LENGTH) (PRIN3 STRING CORE) (* ; "Write out string to get encoding and length, then copy the bytes") (SETQ LENGTH (GETFILEPTR CORE)) (if UNSPECIFIED then (* ; "writing sequence unspecified, so include length of sequence") (PUTWORD STREAM (ADD1 (FOLDHI LENGTH BYTESPERWORD)))) (PUTWORD STREAM LENGTH) (COPYBYTES CORE STREAM 0 LENGTH) (COND ((ODDP LENGTH) (BOUT STREAM 0)))))
)

(COURIER.WRITE.SEQUENCE.UNSPECIFIED

(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 21-Jul-87 14:27 by bvm:") (* ;;; "Write ITEM on STREAM as a (SEQUENCE UNSPECIFIED) interpreted as a (PROGRAM  . TYPE);  this means figuring out how long ITEM is so we can write the appropriate word count before sending ITEM") (PROG (X FN) (COND ((LITATOM TYPE) (SELECTQ TYPE (BOOLEAN (PUTWORD STREAM 1) (PUTWORD STREAM (COND (ITEM 1) (T 0)))) ((CARDINAL UNSPECIFIED) (PUTWORD STREAM 1) (PUTWORD STREAM ITEM)) (INTEGER (PUTWORD STREAM 1) (PUTWORD STREAM (UNSIGNED ITEM BITSPERWORD))) ((LONGCARDINAL LONGINTEGER) (PUTWORD STREAM 2) (PUTLONG STREAM ITEM)) (STRING (if (fetch (STRINGP FATSTRINGP) of (OR (STRINGP ITEM) (SETQ ITEM (MKSTRING ITEM)))) then (* ; "Have to produce NS encoding") (COURIER.WRITE.FAT.STRING STREAM ITEM T) else (PUTWORD STREAM (ADD1 (FOLDHI (NCHARS ITEM) BYTESPERWORD))) (COURIER.WRITE.STRING STREAM ITEM))) (TIME (PUTWORD STREAM 2) (PUTLONG STREAM (LISP.TO.ALTO.DATE ITEM))) (COND ((SETQ X (GETPROP TYPE (QUOTE COURIERDEF))) (* ; "User-defined type") (GO USERTYPE)) ((SETQ X (\GET.COURIER.TYPE PROGRAM TYPE)) (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM ITEM PROGRAM X)) (T (\CWSU.DEFAULT STREAM ITEM PROGRAM TYPE))))) ((AND (LISTP TYPE) (LITATOM (CAR TYPE))) (SELECTQ (CAR TYPE) (ENUMERATION (PUTWORD STREAM 1) (COURIER.WRITE STREAM ITEM PROGRAM TYPE)) ((ARRAY SEQUENCE RECORD NAMEDRECORD CHOICE) (PROG ((LENGTH (COURIER.REP.LENGTH ITEM PROGRAM TYPE))) (COND (LENGTH (PUTWORD STREAM LENGTH) (COURIER.WRITE STREAM ITEM PROGRAM TYPE)) (T (\CWSU.DEFAULT STREAM ITEM PROGRAM TYPE))))) (COND ((LITATOM (CDR TYPE)) (* ; "Qualified name") (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM ITEM (CAR TYPE) (CDR TYPE))) ((SETQ X (GETPROP (CAR TYPE) (QUOTE COURIERDEF))) (* ; "User-defined type") (GO USERTYPE)) (T (\CWSU.DEFAULT STREAM ITEM PROGRAM TYPE))))) (T (\COURIER.UNKNOWN.TYPE PROGRAM TYPE))) (RETURN) USERTYPE (* ; "X = (readFn writeFn lengthFn writeSequenceFn)") (COND ((SETQ FN (CADDDR X)) (CL:FUNCALL FN STREAM ITEM PROGRAM TYPE)) ((AND (SETQ FN (CADDR X)) (OR (FIXP FN) (SETQ FN (CL:FUNCALL FN ITEM PROGRAM TYPE)))) (* ; "Says how long it is") (PUTWORD STREAM FN) (CL:FUNCALL (CADR X) STREAM ITEM PROGRAM TYPE)) (T (\CWSU.DEFAULT STREAM ITEM PROGRAM TYPE)))))
)

(COURIER.REP.LENGTH

(LAMBDA (ITEM PROGRAM TYPE) (* ; "Edited 21-Jul-87 14:35 by bvm:") (* ;;; "Returns the number of words that the Courier rep of ITEM as a (PROGRAM  . TYPE) would occupy or NIL if we can't easily figure it out") (LET (X) (COND ((LITATOM TYPE) (SELECTQ TYPE ((BOOLEAN CARDINAL INTEGER UNSPECIFIED) 1) ((LONGCARDINAL LONGINTEGER TIME) 2) (STRING (if (NOT (fetch (STRINGP FATSTRINGP) of (OR (STRINGP ITEM) (SETQ ITEM (MKSTRING ITEM))))) then (* ; "Too hard to figure out fat length") (ADD1 (FOLDHI (NCHARS ITEM) BYTESPERWORD)))) (COND ((SETQ X (GETPROP TYPE (QUOTE COURIERDEF))) (* ; "User-defined type") (AND (SETQ X (CADDR X)) (OR (FIXP X) (CL:FUNCALL X ITEM PROGRAM TYPE)))) ((SETQ X (\GET.COURIER.TYPE PROGRAM TYPE)) (COURIER.REP.LENGTH ITEM PROGRAM X))))) ((AND (LISTP TYPE) (LITATOM (CAR TYPE))) (SELECTQ (CAR TYPE) (ENUMERATION 1) (ARRAY (for X in ITEM bind (BASETYPE ← (CADDR TYPE)) sum (OR (COURIER.REP.LENGTH X PROGRAM BASETYPE) (RETURN)))) (SEQUENCE (for X in ITEM bind (BASETYPE ← (OR (CADDR TYPE) (CADR TYPE))) sum (OR (COURIER.REP.LENGTH X PROGRAM BASETYPE) (RETURN)) finally (* ; "Count the word which is the sequence length") (RETURN (ADD1 $$VAL)))) (RECORD (for NAMEANDTYPE in (CDR TYPE) as VALUE in ITEM sum (OR (COURIER.REP.LENGTH VALUE PROGRAM (CADR NAMEANDTYPE)) (RETURN)))) (NAMEDRECORD (for NAMEANDTYPE in (CDR TYPE) as NAMEANDVALUE in ITEM sum (OR (COURIER.REP.LENGTH (CADR NAMEANDVALUE) PROGRAM (CADR NAMEANDTYPE)) (RETURN)))) (CHOICE (LET* ((WHICH (OR (ASSOC (CAR ITEM) (CDR TYPE)) (\COURIER.TYPE.ERROR ITEM (QUOTE CHOICE)))) (N (COND ((CADDR WHICH) (COURIER.REP.LENGTH (CADR ITEM) PROGRAM (CADDR WHICH))) (T 0)))) (AND N (ADD1 N)))) (COND ((LITATOM (CDR TYPE)) (* ; "Qualified name") (COURIER.REP.LENGTH ITEM (CAR TYPE) (CDR TYPE))) ((SETQ X (GETPROP (CAR TYPE) (QUOTE COURIERDEF))) (* ; "User-defined type") (AND (SETQ X (CADDR X)) (OR (FIXP X) (CL:FUNCALL X ITEM PROGRAM TYPE))))))) (T (\COURIER.UNKNOWN.TYPE PROGRAM TYPE)))))
)

(COURIER.NSNAME.LENGTH

(LAMBDA (NSNAME PROGRAM TYPE) (* ; "Edited 21-Jul-87 17:00 by bvm:") (* ;; "Return the representation length of an NSNAME, or NIL if we can't cheaply.") (PROG NIL (RETURN (+ (COND ((EQ TYPE (QUOTE NSNAME2)) 0) (T (OR (COURIER.REP.LENGTH (fetch NSOBJECT of NSNAME) NIL (QUOTE STRING)) (RETURN NIL)))) (OR (COURIER.REP.LENGTH (fetch NSDOMAIN of NSNAME) NIL (QUOTE STRING)) (RETURN NIL)) (OR (COURIER.REP.LENGTH (fetch NSORGANIZATION of NSNAME) NIL (QUOTE STRING)) (RETURN NIL))))))
)
)
(DEFINEQ

(SPP.OPEN

(LAMBDA (HOST SOCKET PROBEP NAME PROPS) (* ; "Edited 25-Nov-87 17:29 by bvm:") (RESETLST (LET ((CON (\SPPCONNECTION HOST SOCKET NAME))) (OBTAIN.MONITORLOCK (fetch SPPLOCK of CON) NIL T) (RESETSAVE (fetch (SPPCON SPPMYNSOCKET) of CON) (QUOTE (AND RESETSTATE (CLOSENSOCKET OLDVALUE T)))) (* ; "Close socket if we abort out of SPP.OPEN") (COND ((COND ((NULL HOST) (* ; "Server connection") (LET ((SERVERFN (LISTGET PROPS (QUOTE SERVER.FUNCTION)))) (COND (SERVERFN (* ; "Handler for each of multiple possible connections to this server socket") (replace SPPSERVERFLAG of CON with T) (replace SPPSERVERFN of CON with SERVERFN) T) (T (* ; "Wait for single user to connect, then return it") (until (fetch SPPESTABLISHEDP of CON) do (MONITOR.AWAIT.EVENT (fetch SPPLOCK of CON) (fetch SPPINPUTEVENT of CON))) T)))) ((OR (fetch SPPESTABLISHEDP of CON) (NOT PROBEP)) (* ; "User connection") T) (T (\SPP.PROBE CON) (bind (TIMER ← (SETUPTIMER (IMAX (TIMES 3000 (NSNET.DISTANCE (fetch SPPDESTNSNET of CON))) SPP.USER.TIMEOUT))) do (COND ((fetch SPPESTABLISHEDP of CON) (RETURN T)) ((TIMEREXPIRED? TIMER) (* ; "We've waited long enough without response.  Wait period based on hop count. Kill the watcher and get out of here.") (replace SPPTERMINATEDP of CON with T) (RELEASE.MONITORLOCK (fetch SPPLOCK of CON)) (* ; "So that watcher will be able to run") (WAKE.PROCESS (fetch SPPPROCESS of CON)) (BLOCK) (* ; "Give watcher a chance to clean up.") (RETURN NIL)) ((fetch SPPTERMINATEDP of CON) (* ; "It died quickly?  Probably no such socket") (RETURN NIL)) (T (MONITOR.AWAIT.EVENT (fetch SPPLOCK of CON) (fetch SPPINPUTEVENT of CON) TIMER T)))))) (* ;; "CON is okay to use -- either established, or willing to be") (for TAIL on PROPS by (CDDR TAIL) do (SELECTQ (CAR TAIL) (CLOSEFN (replace SPPWHENCLOSEDFN of CON with (CADR TAIL))) (ATTENTIONFN (replace SPPATTENTIONFN of CON with (CADR TAIL))) (ERRORHANDLER (replace SPPERRORHANDLER of CON with (CADR TAIL))) (EOM.ON.FORCEOUT (replace SPPEOMONFORCEOUT of CON with (CADR TAIL))) (OTHERXIPHANDLER (COND ((FNTYP (CADR TAIL)) (replace SPPOTHERXIPHANDLER of CON with (CADR TAIL))))) NIL)) (\SPP.CREATE.STREAMS CON))))))
)

(\SPP.DEFAULT.ERRORHANDLER

(LAMBDA (STREAM CONDITION) (* ; "Edited 13-May-87 13:50 by bvm:") (SELECTQ CONDITION (STREAM.LOST (ERROR "Connection lost" (OR (fetch FULLFILENAME of STREAM) STREAM))) (ATTENTION (LET ((CON (GETSPPCON STREAM))) (COND ((AND CON (EQ (fetch (SPPCON SPPINPUTDSTYPE) of CON) \SPPDSTYPE.BULKDATA)) (* ; "Bulk data abort") (\COURIER.OUTPUT.ABORTED STREAM)) (T (\EOF.ACTION STREAM))))) (\EOF.ACTION STREAM)))
)

(\SPP.HANDLE.DATA

(LAMBDA (CON XIP) (* ; "Edited 28-Aug-87 16:08 by bvm:") (* ;; "This function is called when a non-System packet has arrived for a connection.  It inserts the packet in the proper place in the queue, ordered by sequence number.  If the packet is a duplicate, it is dropped.") (PROG ((ACKNO (fetch SPPACKNO of CON)) (INQ (fetch SPPINPUTQ of CON)) (XIPNO (fetch (SPPXIP SEQNO) of XIP)) CURRENT NEXT PKTNO) (CHECK (\SPP.CHECK.INPUT.QUEUE CON)) (COND ((SEQ.GREATERP ACKNO XIPNO) (* ; "This packet is a duplicate, so drop it.") (RELEASE.XIP XIP) (RETURN)) ((OR (NULL (SETQ CURRENT (\QUEUEHEAD INQ))) (SEQ.GREATERP XIPNO (fetch (SPPXIP SEQNO) of (fetch SYSQUEUETAIL of INQ)))) (* ; "Goes at tail end of queue.") (\ENQUEUE INQ XIP)) ((SEQ.GREATERP (SETQ PKTNO (fetch (SPPXIP SEQNO) of CURRENT)) XIPNO) (* ; "Goes right at head of queue.") (replace QLINK of XIP with CURRENT) (replace SYSQUEUEHEAD of INQ with XIP)) (T (do (* ; "Loop until the correct place is found for this packet.") (COND ((EQ XIPNO PKTNO) (* ; "This packet is a duplicate, so drop it.") (RELEASE.XIP XIP) (RETURN))) (SETQ NEXT (fetch QLINK of CURRENT)) (SETQ PKTNO (fetch (SPPXIP SEQNO) of NEXT)) (COND ((SEQ.GREATERP PKTNO XIPNO) (* ; "Here's where it goes.") (replace QLINK of XIP with NEXT) (replace QLINK of CURRENT with XIP) (RETURN))) (SETQ CURRENT NEXT)))) (SELECTC (fetch (SPPXIP DSTYPE) of XIP) (\SPPDSTYPE.END (replace SPPSTATE of CON with \SPS.ENDRECEIVED) (LET ((OUTSTREAM (fetch SPPOUTPUTSTREAM of CON))) (* ; "Can't send any more") (replace ACCESS of OUTSTREAM with NIL) (REPLACE STRMBOUTFN OF OUTSTREAM WITH (FUNCTION \SPP.STREAM.LOST)) (* ;; "Make attempt to output to this stream go thru same error mechanism as other ways of losing stream, rather than getting lisp's FILE NOT OPEN error.")) (\SPP.SEND.ENDREPLY CON) (replace SPPSTATE of CON with \SPS.DALLYING)) (\SPPDSTYPE.ENDREPLY (SELECTC (fetch SPPSTATE of CON) (\SPS.DALLYING (* ; "This is the closing end reply, so can quit now")) (\SPS.ENDSENT (* ; "This is the reply to our END") (\SPP.SEND.ENDREPLY CON T)) (\SPPSENDERROR CON XIP "unexpected ENDREPLY")) (replace SPPSTATE of CON with \SPS.CLOSED) (replace SPPTERMINATEDP of CON with T)) NIL) (COND ((EQ XIPNO ACKNO) (* ;; "Looks like this packet opens the way for some acknowledgements.  Find the end of the run of consecutive packets starting with the one we've just inserted.") (while (AND (SETQ XIP (fetch QLINK of XIP)) (EQ (SETQ PKTNO (fetch (SPPXIP SEQNO) of XIP)) (SEQ.ADD1 XIPNO))) do (SETQ XIPNO PKTNO)) (replace SPPACKNO of CON with (SEQ.ADD1 XIPNO)) (NOTIFY.EVENT (fetch SPPINPUTEVENT of CON))))))
)

(SPPOUTPUTSTREAM

(LAMBDA (SPPINPUTSTREAM) (* ; "Edited 24-Nov-87 12:01 by bvm:") (LET ((CON (GETSPPCON SPPINPUTSTREAM))) (OR (AND CON (fetch SPPOUTPUTSTREAM of CON)) (\SPP.STREAM.LOST SPPINPUTSTREAM))))
)

(\SPP.SENDPKT

(LAMBDA (CON EPKT RETRANSMITP) (* ; "Edited 25-Nov-87 19:31 by bvm:") (* ;; "This function makes sure the variable connection information in the packet is current, and actually sends the packet.  If the packet is to be retransmitted, the connection must be locked when this function is called.  Note that the sequence number is NOT updated;  it was allocated once and for all by \SENDSPP") (PROG ((ACK# (fetch SPPACKNO of CON)) (ALLOC# (fetch SPPACCEPTNO of CON)) (BASE (fetch XIPCONTENTS of EPKT)) SEQNO) (AND RETRANSMITP (HELP "RETRANSMITP on")) (replace (SPPHEAD ACKNO) of BASE with ACK#) (replace (SPPHEAD ALLOCNO) of BASE with ALLOC#) (replace SPPINPUTBLOCKED of CON with (SEQ.GREATERP ACK# ALLOC#)) (* ; "If ACK# > ALLOC# then partner cannot send more data until we eat some of what we have") (COND ((fetch (SPPHEAD SENDACK) of BASE) (* ;; "We start a timer when we send an Ack request, and turn it off when the next packet arrives (in \SPPINPUTWORK.) If the timer expires, we assume that the connection is wedged.  Otherwise, the elapsed time will be used to update our estimate of the round trip delay.  The timer will go off after the user-level timeout, or twice the round trip delay, whichever is longer.") (SETQ SEQNO (fetch (SPPHEAD SEQNO) of BASE)) (COND ((OR (NOT (fetch SPPACKREQUESTED of CON)) (SEQ.GREATERP SEQNO (fetch SPPACKREQUESTED of CON))) (replace SPPACKREQUESTED of CON with SEQNO) (replace SPPACKREQTIME of CON with (SETUPTIMER 0 (fetch SPPACKREQTIME of CON))))) (replace SPPACKREQTIMEOUT of CON with (SETUPTIMER (UNFOLD (fetch SPPROUNDTRIPTIME of CON) 2) (fetch SPPACKREQTIMEOUT of CON))))) (replace SPPACKPENDING of CON with NIL) (* ; "If partner asked for an ack, this will satisfy it") (SENDXIP (fetch SPPMYNSOCKET of CON) EPKT) (replace SPPRETRANSMITTIMER of CON with (SETUPTIMER (COND ((fetch SPPRETRANSMITTING of CON) (fetch SPPROUNDTRIPTIME of CON)) (T (UNFOLD (fetch SPPROUNDTRIPTIME of CON) 2))) (fetch SPPRETRANSMITTIMER of CON)))))
)

(\SPP.RETRANSMIT.NEXT

(LAMBDA (CON) (* ; "Edited 25-Nov-87 19:45 by bvm:") (PROG ((SEQNO (fetch SPPRETRANSMITTING of CON)) XIP) (SETQ XIP (ELT (fetch SPPRETRANSMITQ of CON) (IMOD SEQNO \SPP.RETRANSMITQ.SIZE))) (CHECK (EQ SEQNO (fetch (SPPXIP SEQNO) of XIP))) (replace (SPPXIP SENDACK) of XIP with (if T then T else (* ; "Turn off any undesired acknowledge bit") (EQ SEQNO (fetch SPPOUTPUTALLOCNO of CON)))) (replace SPPRETRANSMITTING of CON with (COND ((EQ (SETQ SEQNO (SEQ.ADD1 SEQNO)) (fetch SPPSEQNO of CON)) (* ; "Finished") NIL) (T SEQNO))) (\SPP.SENDPKT CON XIP)))
)

(\SPPWATCHER

(LAMBDA (SPPCON) (* ; "Edited 25-Nov-87 12:33 by bvm:") (DECLARE (SPECVARS SPPCON)) (RESETSAVE NIL (LIST (FUNCTION \SPP.CLEANUP) SPPCON)) (PROCESSPROP (THIS.PROCESS) (QUOTE INFOHOOK) (FUNCTION \SPP.INFO.HOOK)) (if (NULL (fetch SPPACTIVITYTIMER of SPPCON)) then (replace SPPACTIVITYTIMER of SPPCON with (SETUPTIMER 0))) (WITH.MONITOR (fetch SPPLOCK of SPPCON) (bind (SOCEVENT ← (NSOCKETEVENT (fetch SPPMYNSOCKET of SPPCON))) (ACKINTERVAL ← (IQUOTIENT (TIMES SPP.USER.TIMEOUT 2) 3)) ACTIVITY TIMER until (fetch SPPTERMINATEDP of SPPCON) do (COND ((SETQ ACTIVITY (\SPP.HANDLE.INPUT SPPCON)) (* ; "Got some input, so partner is alive") (replace SPPINACTIVECOUNT of SPPCON with NIL) (SETUPTIMER 0 (fetch SPPACTIVITYTIMER of SPPCON)))) (COND ((AND (NULL ACTIVITY) (NOT (fetch SPPESTABLISHEDP of SPPCON)) (NOT (fetch SPPDESTINATIONKNOWN of SPPCON))) (* ; "Nothing happening, and we're just listening.  Go back to sleep") (MONITOR.AWAIT.EVENT (fetch SPPLOCK of SPPCON) SOCEVENT)) (T (* ; "Do what is appropriate for state of connection") (SETQ TIMER (fetch SPPRETRANSMITTIMER of SPPCON)) (* ; "Default time we might want to do something next") (COND ((fetch SPPRETRANSMITTING of SPPCON) (* ; "In the midst of retransmitting one or more packets that appear to have been missed") (\SPP.RETRANSMIT.NEXT SPPCON)) ((fetch SPPACKPENDING of SPPCON) (* ; "Partner asked for an ack, and we haven't sent anything yet as part of our routine activity, so send simple ack") (\SPP.SENDPKT SPPCON (\SPP.SYSPKT SPPCON (if (\CLOCKGREATERP (fetch SPPACKREQTIME of SPPCON) ACKINTERVAL) then (* ; "if we haven't timed an ACK in a while, take the opportunity now.  This lets us kill two birds with one stone, er, packet--responding to partner's ack, and getting round trip info ourselves.") \SPPHEAD.CC.ACKNOWLEDGE))) (replace SPPACKPENDING of SPPCON with NIL)) ((NULL ACTIVITY) (* ; "No input activity") (COND ((fetch SPPACKREQUESTED of SPPCON) (* ; "We requested an ack, haven't heard anything back") (if (TIMEREXPIRED? (SETQ TIMER (fetch SPPACKREQTIMEOUT of SPPCON))) then (\SPP.NOT.RESPONDING SPPCON))) ((OR (SEQ.GREATERP (fetch SPPSEQNO of SPPCON) (fetch SPPACKEDSEQNO of SPPCON)) (SEQ.GREATERP (fetch SPPSEQNO of SPPCON) (fetch SPPOUTPUTALLOCNO of SPPCON))) (* ; "Not all outstanding packets are acked, or we are out of allocation") (if (TIMEREXPIRED? TIMER) then (* ; "Time to poke again") (\SPP.PROBE SPPCON))) (T (* ; "Connection is quiet.  Periodically poke the other end to make sure it's still alive") (if (\CLOCKGREATERP (fetch SPPACTIVITYTIMER of SPPCON) SPP.USER.TIMEOUT) then (* ; "Haven't heard anything in a while.  Next time thru, SPPACKREQUESTED will be true, so we'll never do this twice in a row.") (\SPP.PROBE SPPCON) else (* ; "Don't need to wake up again until previous clause wants it") (SETUPTIMER (IMAX 0 (- SPP.USER.TIMEOUT (CLOCKDIFFERENCE (fetch SPPACTIVITYTIMER of SPPCON)))) TIMER)))))) (if (fetch SPPTERMINATEDP of SPPCON) then (RETURN)) (MONITOR.AWAIT.EVENT (fetch SPPLOCK of SPPCON) SOCEVENT TIMER T))))))
)

(\SPP.NOT.RESPONDING

(LAMBDA (CON) (* ; "Edited 15-Dec-87 12:28 by bvm:") (* ;; "There hasn't been any response to our probes for a while.") (COND ((AND (>= (replace SPPINACTIVECOUNT of CON with (ADD1 (OR (fetch SPPINACTIVECOUNT of CON) 0))) SPP.MAX.FAILED.PROBES) (OR (NOT (fetch SPPESTABLISHEDP of CON)) (\CLOCKGREATERP (fetch SPPACTIVITYTIMER of CON) SPP.INACTIVITY.TIMEOUT))) (* ;; "If the connection hasn't been established yet, or if the roundtrip time is intolerably long, we drop the connection.") (replace SPPTERMINATEDP of CON with T)) (T (replace SPPROUNDTRIPTIME of CON with (IMIN SPP.USER.TIMEOUT (TIMES (fetch SPPROUNDTRIPTIME of CON) 2))) (* ; "Increase our estimate of the time it takes the other end to respond.") (\SPP.PROBE CON) (COND ((AND (fetch SPPESTABLISHEDP of CON) (EQ (fetch SPPINACTIVECOUNT of CON) (- SPP.MAX.FAILED.PROBES 2))) (* ; "Warn the user after a while that the other end may have crashed, but hang in there.") (if (\CLOCKGREATERP (fetch SPPACTIVITYTIMER of CON) (LRSH SPP.INACTIVITY.TIMEOUT 2)) then (printout PROMPTWINDOW T (PROCESSPROP (THIS.PROCESS) (QUOTE NAME)) " not responding. ") else (* ; "Don't be unduly alarming--it hasn't been that long.  If the round trip time had once been exceedingly low, doubling it a few times doesn't get us very far, so back off") (add (fetch SPPINACTIVECOUNT of CON) -1)))))))
)

(PPSPP

(LAMBDA (CON FILE DETAILS) (* ; "Edited 25-Nov-87 19:56 by bvm:") (PROG (STR N) (SETQ FILE (\GETSTREAM FILE (QUOTE OUTPUT))) (printout FILE "Local: " (fetch SPPSOURCENSADDRESS of CON) ", id = " (fetch SPPSOURCEID of CON) T "Remote: " (fetch SPPDESTNSADDRESS of CON) ", id = " (fetch SPPDESTID of CON) T) (COND ((NOT (fetch SPPESTABLISHEDP of CON)) (printout FILE " [not established]")) (T (printout FILE "DS Type = " (SELECTC (fetch SPPDSTYPE of CON) (\SPPDSTYPE.COURIER "courier") (\SPPDSTYPE.BULKDATA "bulkdata") (fetch SPPDSTYPE of CON))))) (COND ((fetch SPPTERMINATEDP of CON) (printout FILE " [terminated]"))) (COND ((fetch SPPACKREQUESTED of CON) (printout FILE T "Ack requested: " |.F3.1| (FQUOTIENT (CLOCKDIFFERENCE (fetch SPPACKREQTIME of CON)) 1000) " secs ago"))) (printout FILE T "Round trip: " |.F4.1| (FQUOTIENT (fetch SPPROUNDTRIPTIME of CON) 1000) " secs") (printout FILE T "Last input activity: " |.F4.1| (FQUOTIENT (CLOCKDIFFERENCE (fetch SPPACTIVITYTIMER of CON)) 1000) " secs ago" T) (printout FILE T "Input:" T "  Seq# " (fetch SPPACKNO of CON) T "  Allocation: " (\LOLOC (IDIFFERENCE (fetch SPPACCEPTNO of CON) (SUB1 (fetch SPPACKNO of CON)))) T) (PPSPPSTREAM (fetch SPPINPUTSTREAM of CON) FILE) (COND ((NEQ (SETQ N (IPLUS (COND ((fetch SPPINPKT of CON) 1) (T 0)) (\QUEUELENGTH (fetch SPPINPUTQ of CON)))) 0) (printout FILE "  Packets in queue: " N T))) (printout FILE T "Output:" T "  Seq# " (fetch SPPSEQNO of CON)) (COND ((EQ (fetch SPPSEQNO of CON) (fetch SPPACKEDSEQNO of CON)) (printout FILE ", all acked")) (T (printout FILE ", acked# " (fetch SPPACKEDSEQNO of CON)))) (printout FILE T "  Allocation: " (\LOLOC (IDIFFERENCE (fetch SPPOUTPUTALLOCNO of CON) (SUB1 (fetch SPPSEQNO of CON)))) T) (PPSPPSTREAM (fetch SPPOUTPUTSTREAM of CON) FILE) (COND (DETAILS (printout FILE "  Awaiting ack: " %# (for (I ← (fetch SPPACKEDSEQNO of CON)) by (SEQ.ADD1 I) bind (NEXT ← (fetch SPPSEQNO of CON)) while (SEQ.GREATERP NEXT I) do (PRINTSPP (ELT (fetch SPPRETRANSMITQ of CON) (RETRANSMITINDEX I)))) T))) (COND ((SETQ STR (fetch SPPSUBSTREAM of CON)) (printout FILE T "Bulk data stream (" (fetch ACCESS of STR) "):" T) (PPSPPSTREAM STR FILE)))))
)
)

(RPAQQ SPP.INACTIVITY.TIMEOUT
 120000)

(RPAQQ SPP.MAX.FAILED.PROBES
 5)
(DEFINEQ

(\DEFPRINT.BY.NAME

(LAMBDA (OBJECT STREAM NAME TYPENAME) (* ; "Edited  8-May-87 15:53 by bvm:") (* ;; "Print an object using its name, for example, #<FDev ERIS/76,5432>.  NAME is the object's name (or NIL if this one happens to be nameless), TYPENAME is a string giving the generic name you want to appear in front, e.g., %"FDev%"") (.SPACECHECK. STREAM (+ (NCHARS TYPENAME) (PROGN (* ; "Longest address is `< /177,177777>'") 14) (COND (NAME (NCHARS NAME)) (T 0)))) (\OUTCHAR STREAM (fetch (READTABLEP HASHMACROCHAR) of *READTABLE*)) (\OUTCHAR STREAM (CHARCODE <)) (\SOUT (MKSTRING TYPENAME) STREAM) (COND (NAME (\OUTCHAR STREAM (CHARCODE SPACE)) (\SOUT (MKSTRING NAME) STREAM))) (\OUTCHAR STREAM (CHARCODE /)) (\PRINTADDR OBJECT STREAM) (\OUTCHAR STREAM (CHARCODE >)) T)
)
)
(DEFINEQ

(\PAGEDSETFILEPTR

(LAMBDA (STREAM INDX) (* ; "Edited 24-Jun-87 18:18 by bvm:") (\UPDATEOF STREAM) (* ; "Update the EOF in case we have writen thru it") (PROG ((NEWPAGE (fetch (BYTEPTR PAGE) of INDX)) (NEWOFF (fetch (BYTEPTR OFFSET) of INDX))) (UNINTERRUPTABLY (COND ((OR (NEQ NEWPAGE (fetch CPAGE of STREAM)) (AND (EQ NEWPAGE (fetch EPAGE of STREAM)) (> NEWOFF (fetch COFFSET of STREAM)))) (* ;; "Force page release if (1) ptr is moving to a different page, (2) new ptr is past eof.  We permit setting ptr past eof--if the next op is a BIN, an eof error occurs, while if the next op is a write, the end of file gets moved.  In order for this to work, we have the convention that whenever CBUFPTR is non-nil, eof is the greater of the old eof or the current file pointer.") (* ;; "This clause also used to test for backing up on an APPEND-only stream, but that's nonsense--we should probably prohibit it altogether.") (\RELEASECPAGE STREAM) (replace CPAGE of STREAM with NEWPAGE))) (replace COFFSET of STREAM with NEWOFF))))
)

(\PAGED.INCFILEPTR

(LAMBDA (STREAM AMOUNT) (* ; "Edited 24-Jun-87 18:43 by bvm:") (* ;; "Increment file pointer of stream by AMOUNT, which may be negative.  The only reason this function currently exists is to give fast performance to FFILEPOS -- it avoids the boxing that would occur on large file pointers.") (UNINTERRUPTABLY (PROG ((NEWOFF (IPLUS (fetch COFFSET of STREAM) AMOUNT)) NEWPAGE) (* ;; "SETFILEPTR sets CHARPOSITION to zero, but callers of \INCFILEPTR don't care, by fiat") (COND ((IGEQ NEWOFF BYTESPERPAGE) (* ; "New page") (SETQ NEWPAGE (IPLUS (fetch CPAGE of STREAM) (fetch (BYTEPTR PAGE) of NEWOFF))) (SETQ NEWOFF (fetch (BYTEPTR OFFSET) of NEWOFF))) ((ILESSP NEWOFF 0) (* ; "New page going backward") (SETQ NEWPAGE (IDIFFERENCE (fetch CPAGE of STREAM) (fetch (BYTEPTR PAGE) of (SETQ NEWOFF (SUB1 (IDIFFERENCE BYTESPERPAGE NEWOFF)))))) (COND ((ILESSP NEWPAGE 0) (* ; "Probably shouldn't happen;  should it be an error?") (SETQ NEWPAGE 0))) (SETQ NEWOFF (SUB1 (IDIFFERENCE BYTESPERPAGE (fetch (BYTEPTR OFFSET) of NEWOFF))))) ((COND ((ILESSP AMOUNT 0) (* ; "Backing up, may have to set the eof if we have been writing") (\UPDATEOF STREAM) T) (T (* ; "Moving forward, make sure we don't move past the eof") (ILEQ NEWOFF (fetch CBUFSIZE of STREAM)))) (* ; "easy case, no page turn") (replace COFFSET of STREAM with NEWOFF) (* ; "Just bump COFFSET and we're done") (RETURN)) (T (* ; "Moving forward past eof, might as well let this fall thru to general case, since we need to make sure current buffer is released."))) (\UPDATEOF STREAM) (\RELEASECPAGE STREAM) (replace CPAGE of STREAM with NEWPAGE) (replace COFFSET of STREAM with NEWOFF))))
)
)

(RPAQ? *UPPER-CASE-FILE-NAMES*
 T)
(DECLARE%: DONTEVAL@LOAD DOCOPY 
(CHANGENAME (QUOTE \NSMAIL.READ.SERIALIZED.TREE) (QUOTE ERROR!) (QUOTE COURIER.ABORT.BULKDATA))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 COURIER.CALL FILING.CALL)
)
(PUTPROPS NSRANDOM COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (23370 23948 (\FILINGSESSION.DEFPRINT 23380 . 23737) (\FILINGHANDLE.DEFPRINT 23739 . 
23946)) (23949 26343 (\GET.FILING.ATTRIBUTE 23959 . 24705) (\PUT.FILING.ATTRIBUTE 24707 . 25354) (
\GET.SESSION.HANDLE 25356 . 25727) (\PUT.SESSION.HANDLE 25729 . 26341)) (28487 45777 (
\GETFILINGCONNECTION 28497 . 29533) (\NSFILING.GET.NEW.SESSION 29535 . 29959) (\NSFILING.GET.STREAM 
29961 . 30916) (\NSFILING.COURIER.OPEN 30918 . 31138) (\NSFILING.CLOSE.BULKSTREAM 31140 . 31354) (
\NSFILING.RELEASE.BULKSTREAM 31356 . 31760) (FILING.CALL 31762 . 35927) (\NSFILING.LOGIN 35929 . 40918
) (\NSFILING.AFTER.LOGIN 40920 . 41214) (\NSFILING.SET.CONTINUANCE 41216 . 41629) (\NSFILING.LOGOUT 
41631 . 41773) (\NSFILING.DISCARD.SESSION 41775 . 42834) (\VALID.FILING.CONNECTIONP 42836 . 43714) (
\NSFILING.CLOSE.CONNECTIONS 43716 . 45289) (BREAK.NSFILING.CONNECTION 45291 . 45775)) (45855 52598 (
\NSFILING.CONNECT 45865 . 47221) (\NSFILING.MAYBE.CREATE 47223 . 48507) (\NSFILING.REMOVEQUOTES 48509
 . 48825) (\NSFILING.ADDQUOTES 48827 . 50125) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 50127 . 50284) (
\FILING.ATTRIBUTE.TYPE 50286 . 50542) (\LISP.TO.NSFILING.ATTRIBUTE 50544 . 52596)) (52634 78921 (
\NSFILING.GETFILE 52644 . 62585) (\NSFILING.LOOKUP.CACHE 62587 . 63492) (\NSFILING.ADD.TO.CACHE 63494
 . 64751) (\NSFILING.OPEN.HANDLE 64753 . 65973) (\NSFILING.CONFLICTP 65975 . 66846) (
\NSFILING.CHECK.ACCESS 66848 . 67877) (\NSFILING.FILLIN.ATTRIBUTES 67879 . 68740) (
\NSFILING.COMPOSE.PATHNAME 68742 . 69163) (\NSFILING.PARSE.FILENAME 69165 . 71744) (
\NSFILING.ERRORHANDLER 71746 . 74679) (\NSFILING.WHENCLOSED 74681 . 75234) (\NSFILING.CLOSE.HANDLE 
75236 . 75457) (\NSFILING.FULLNAME 75459 . 78919)) (78954 111591 (\NSFILING.OPENFILE 78964 . 80796) (
\NSFILING.HANDLE.ERROR 80798 . 81222) (\NSFILING.CLOSEFILE 81224 . 82690) (\NSFILING.EVENTFN 82692 . 
83957) (\NSFILING.DELETEFILE 83959 . 84775) (\NSFILING.CHILDLESS-P 84777 . 85185) (
\NSFILING.DIRECTORYNAMEP 85187 . 85489) (\NSFILING.HOSTNAMEP 85491 . 87019) (\NSFILING.GETFILENAME 
87021 . 87242) (\NSFILING.GETFILEINFO 87244 . 88862) (\NSFILING.GET.ATTRIBUTES 88864 . 89195) (
\NSFILING.GETFILEINFO.FROM.PLIST 89197 . 90676) (\NSFILING.GDATE 90678 . 90803) (\NSFILING.SETFILEINFO
 90805 . 92229) (\NSFILING.GET/SETINFO 92231 . 93061) (\NSFILING.UPDATE.ATTRIBUTES 93063 . 93644) (
\NSFILING.GETEOFPTR 93646 . 93978) (\NSFILING.GENERATEFILES 93980 . 100307) (\NSFILING.GENERATE.STARS 
100309 . 100670) (\NSFILING.NEXTFILE 100672 . 101557) (\NSFILING.FILEINFOFN 101559 . 101729) (
\NSFILING.RENAMEFILE 101731 . 102198) (\NSFILING.COPYFILE 102200 . 102665) (\NSFILING.COPY/RENAME 
102667 . 111589)) (111630 135907 (\NSRANDOM.CLOSEFILE 111640 . 112787) (\NSRANDOM.RELEASE.HANDLE 
112789 . 113583) (\NSRANDOM.RELEASE.LOCK 113585 . 113842) (\NSRANDOM.RELEASE.IF.ERROR 113844 . 113999)
 (\NSRANDOM.CREATE.STREAM 114001 . 116489) (\NSRANDOM.READPAGES 116491 . 118975) (
\NSRANDOM.READ.SEGMENT 118977 . 122710) (\NSRANDOM.PREPARE.CACHE 122712 . 126191) (
\NSRANDOM.FETCH.CACHE 126193 . 127182) (\NSRANDOM.CHECK.CACHE 127184 . 127730) (\NSRANDOM.WRITEPAGES 
127732 . 130598) (\NSRANDOM.WRITE.SEGMENT 130600 . 131488) (\NSRANDOM.WROTE.HANDLE 131490 . 132630) (
\NSRANDOM.SETEOFPTR 132632 . 133537) (\NSRANDOM.TRUNCATEFILE 133539 . 135209) (
\NSRANDOM.UPDATE.VALIDATION 135211 . 135905)) (135939 143575 (\NSRANDOM.HANDLE.ERROR 135949 . 137414) 
(\NSRANDOM.PROCEEDABLE.ERROR 137416 . 138099) (\NSRANDOM.REESTABLISH 138101 . 138831) (
\NSRANDOM.STREAM.CHANGED 138833 . 139841) (\NSRANDOM.DESTROY.STREAM 139843 . 140358) (
\NSRANDOM.SESSION.WATCHER 140360 . 143037) (\NSRANDOM.ENSURE.WATCHER 143039 . 143573)) (143616 148693 
(GC-FILING-DIRECTORY 143626 . 146802) (\NSGC.COLLECT.DIRECTORIES 146804 . 148691)) (148743 151383 (
\NSFILING.DESERIALIZE 148753 . 149913) (\NSFILING.DESERIALIZE1 149915 . 151381)) (151384 151736 (
\NSFILING.INIT 151394 . 151734)) (151933 170026 (COURIER.SIGNAL.ERROR 151943 . 152639) (COURIER.CALL 
152641 . 154807) (COURIER.EXECUTE.CALL 154809 . 156531) (COURIER.EXECUTE.EXPEDITED.CALL 156533 . 
157604) (\COURIER.RESULTS 157606 . 159776) (\COURIER.HANDLE.BULKDATA 159778 . 161191) (
\COURIER.OUTPUT.ABORTED 161193 . 162063) (\BULK.DATA.STREAM 162065 . 164026) (\BULK.DATA.CLOSE 164028
 . 166248) (COURIER.OPEN 166250 . 167633) (COURIER.ABORT.BULKDATA 167635 . 168091) (COURIER.SKIP 
168093 . 169769) (COURIER.SKIP.SEQUENCE 169771 . 170024)) (170027 176517 (COURIER.READ.STRING 170037
 . 170624) (COURIER.WRITE.STRING 170626 . 171081) (COURIER.WRITE.FAT.STRING 171083 . 171758) (
COURIER.WRITE.SEQUENCE.UNSPECIFIED 171760 . 174027) (COURIER.REP.LENGTH 174029 . 176005) (
COURIER.NSNAME.LENGTH 176007 . 176515)) (176518 191105 (SPP.OPEN 176528 . 178693) (
\SPP.DEFAULT.ERRORHANDLER 178695 . 179128) (\SPP.HANDLE.DATA 179130 . 181752) (SPPOUTPUTSTREAM 181754
 . 181962) (\SPP.SENDPKT 181964 . 183954) (\SPP.RETRANSMIT.NEXT 183956 . 184532) (\SPPWATCHER 184534
 . 187565) (\SPP.NOT.RESPONDING 187567 . 188927) (PPSPP 188929 . 191103)) (191186 191975 (
\DEFPRINT.BY.NAME 191196 . 191973)) (191976 194679 (\PAGEDSETFILEPTR 191986 . 193015) (
\PAGED.INCFILEPTR 193017 . 194677)))))
STOP