PFSImpl.mesa
Copyright Ó 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Carl Hauser, July 26, 1989 10:25:31 am PDT
Chauser, March 20, 1992 2:06 pm PST
Christian Jacobi, July 24, 1992 2:51 pm PDT
Willie-s, September 1, 1992 1:24 pm PDT
Michael Plass, January 29, 1992 10:27 am PST
Doug Wyatt, April 7, 1992 1:39 pm PDT
DIRECTORY
Basics,
FinalizeOps,
IO USING [Close, STREAM],
List,
PFS,
PFSBackdoor,
PFSExtras,
PFSPrivate,
PFSCanonicalNames,
PFSCFSNames,
PFSClass,
PFSPrefixMap,
PFSNames,
PreDebug,
Process,
ProcessProps,
Rope USING [Cat, EqualSubstrs, IsEmpty, Fetch, Find, Length, ROPE],
UnixTypes USING [FD];
PFSImpl: CEDAR MONITOR
IMPORTS FinalizeOps, IO, List, PFS, PFSBackdoor, PFSCanonicalNames, PFSCFSNames, PFSClass, PFSNames, PFSPrefixMap, PFSPrivate, PreDebug, Process, ProcessProps, Rope
EXPORTS PFS, PFSExtras, PFSBackdoor
~ BEGIN OPEN PFS;
Copied Types and Constants
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
PATH: TYPE ~ PFSNames.PATH;
Exported to PFS
OpenFileObject: PUBLIC TYPE = PFSClass.OpenFileObject;
Error: PUBLIC ERROR [error: PFS.ErrorDesc] ~ CODE;
AtomFromErrorGroup: PUBLIC PROC[eg: ErrorGroup] RETURNS[ATOM] ~ {
SELECT eg FROM
ok => RETURN[$ok];
bug => RETURN[$bug];
environment => RETURN[$environment];
client => RETURN[$client];
user => RETURN[$user];
ENDCASE => RETURN[$NIL];
};
ErrorGroupFromAtom: PUBLIC PROC[at: ATOM] RETURNS[ErrorGroup] ~ {
SELECT at FROM
$ok => RETURN[ok];
$bug => RETURN[bug];
$environment => RETURN[environment];
$client => RETURN[client];
$user => RETURN[user];
ENDCASE => RETURN[ErrorGroup.LAST];
};
File Names
This is a quick hack implementation. Let's do it right someday.
RopeFromPath: PUBLIC PROC [path: PATH, format: NameFormat ¬ slashes] RETURNS [rope: ROPE] ~ {
IF path=NIL THEN RETURN[NIL];
rope ¬ IF format = slashes THEN PFSCanonicalNames.UnparseName[path] ELSE PFSCFSNames.UnparseName[path];
};
PathFromRope: PUBLIC PROC [rope: ROPE] RETURNS [path: PATH] ~ {
IF rope.IsEmpty[] THEN RETURN[NIL]
ELSE {
c0: CHAR ¬ rope.Fetch[0];
SELECT c0 FROM
'[ => RETURN[PFSCFSNames.ParseName[rope]];
'/ => RETURN[PFSCanonicalNames.ParseName[rope]];
ENDCASE => IF rope.Find["/"] > 0 THEN RETURN[PFSCanonicalNames.ParseName[rope]] ELSE RETURN[PFSCFSNames.ParseName[rope]];
};
};
Working Directory
wDirKey: ATOM ~ $WorkingDirectory; -- val: [wDir: ROPE]
DoInWDir: PUBLIC PROC [ wDir: PATH, inner: PROC ] ~ {
wDirRope: ROPE ~ RopeFromPath[wDir];
propList: List.AList ~ List.PutAssoc[key: wDirKey, val: wDirRope, aList: NIL];
ProcessProps.AddPropList[propList: propList, inner: inner];
};
GetWDir: PUBLIC PROC RETURNS [ wDir: PATH ] ~ {
wDirRope: ROPE ~ GetWorkingDirectoryRope[];
wDir ¬ PathFromRope[wDirRope];
};
AbsoluteName: PUBLIC PROC [short: PATH, wDir: PATH ¬ NIL] RETURNS [absolute: PATH] ~ {
SELECT TRUE FROM
PFSNames.IsAbsolute[short] => absolute ¬ short;
wDir#NIL => absolute ¬ wDir.Cat[short];
ENDCASE => absolute ¬ PFSNames.Cat[GetWDir[], short];
absolute ¬ ResolveRelativeComponents[absolute];
};
backing: PATH ← NIL;
BackingName: PROC [short: PATH] RETURNS [absolute: PATH] ~ {
SELECT TRUE FROM
backing=NIL => RETURN[NIL];
PFSNames.IsAbsolute[short] => RETURN[NIL];
ENDCASE => absolute ← PFSNames.Cat[backing, short];
absolute ← ResolveRelativeComponents[absolute];
};
SetBacking: PROC [ backingRope: ROPE ] ~ {
backing ← PathFromRope[backingRope];
};
ResolveRelativeComponents: PROC [path: PATH] RETURNS [PATH] ~ {
anyRelative: BOOL ¬ FALSE;
FOR i: CARD IN [0..PFSNames.ComponentCount[path]) DO
comp: PFSNames.Component ~ path.Fetch[i];
IF Rope.EqualSubstrs[comp.name.base, comp.name.start, comp.name.len, "."] OR Rope.EqualSubstrs[comp.name.base, comp.name.start, comp.name.len, ".."] THEN {
anyRelative ¬ TRUE; EXIT;
};
ENDLOOP;
IF anyRelative THEN {
comps: LIST OF PFSNames.Component ¬ NIL;
FOR i: CARD IN [0..PFSNames.ComponentCount[path]) DO
comp: PFSNames.Component ~ path.Fetch[i];
SELECT TRUE FROM
Rope.EqualSubstrs[comp.name.base, comp.name.start, comp.name.len, "."] => NULL;
Rope.EqualSubstrs[comp.name.base, comp.name.start, comp.name.len, ".."] => {
comps ¬ IF comps=NIL THEN NIL ELSE comps.rest;
};
ENDCASE => comps ¬ CONS[comp, comps];
ENDLOOP;
RETURN[ PFSNames.ConstructName[components~comps, absolute~path.IsAbsolute[], directory~path.IsADirectory[], reverse~TRUE] ];
}
ELSE RETURN[ path ];
};
GetWorkingDirectoryRope: PROC RETURNS [ wDirRope: ROPE ] ~ {
gets the $WorkingDirectory property from the process property list;
if empty, uses the default working directory
propList: List.AList ~ ProcessProps.GetPropList[];
WITH List.Assoc[key: wDirKey, aList: propList] SELECT FROM
rope: ROPE => { wDirRope ¬ rope };
ENDCASE;
IF ( wDirRope.IsEmpty[] ) THEN wDirRope ¬ PFSPrivate.GetDefaultWDirRope[];
};
File Information
FileInfo: PUBLIC PROC [
name: PATH,
wantedUniqueID: UniqueID ¬ nullUniqueID
] RETURNS [
fullFName, attachedTo: PATH,
uniqueID: UniqueID,
bytes: INT,
mutability: Mutability,
fileType: FileType
] ~
{
fs: PFSClass.FSHandle;
nameOnFS: PATH;
replacedPrefix: PATH;
suppliedPrefixLen: INT;
success: BOOL ¬ TRUE;
version: PFSNames.Version;
absoluteName: PATH ~ AbsoluteName[name];
[fs, nameOnFS, replacedPrefix, suppliedPrefixLen] ¬ ServerAndHints[absoluteName];
[version, attachedTo, bytes, uniqueID, mutability, fileType] ¬ fs.procs.fileInfo[fs, nameOnFS, wantedUniqueID ];
fullFName ¬ PFSNames.SetVersionNumber[absoluteName, version];
NoteEvent[$fileInfo, fullFName];
};
Enumeration
EnumerateForInfo: PUBLIC PROC [pattern: PATH, proc: InfoProc, lbound: PATH, hbound: PATH] ~
{
fs: PFSClass.FSHandle;
patternOnFS: PATH;
replacedPrefix: PATH;
suppliedPrefixLen: INT;
NameTranslator: InfoProc ~ {
IF lbound # NIL AND PFSNames.Compare[fullFName, lbound]=less THEN RETURN [TRUE];
IF hbound # NIL AND PFSNames.Compare[fullFName, hbound]=greater THEN RETURN [FALSE];
RETURN [
proc[
BackTranslate[fullFName, replacedPrefix, suppliedPrefixLen],
attachedTo, uniqueID, bytes, mutability, fileType]
];
};
IF lbound # NIL THEN lbound ¬ DoServer[AbsoluteName[lbound]].nameOnFS;
IF hbound # NIL THEN hbound ¬ DoServer[AbsoluteName[hbound]].nameOnFS;
[fs, patternOnFS, replacedPrefix, suppliedPrefixLen] ¬ ServerAndHints[AbsoluteName[pattern]];
fs.procs.enumerateForInfo[fs, patternOnFS, NameTranslator, lbound, hbound];
};
EnumerateForNames: PUBLIC PROC [pattern: PATH, proc: NameProc, lbound: PATH, hbound: PATH] ~
{
fs: PFSClass.FSHandle;
patternOnFS: PATH;
replacedPrefix: PATH;
suppliedPrefixLen: INT;
NameTranslator: NameProc ~ {
IF lbound # NIL AND PFSNames.Compare[name, lbound]=less THEN RETURN [TRUE];
IF hbound # NIL AND PFSNames.Compare[name, hbound]=greater THEN RETURN [FALSE];
RETURN [
proc[BackTranslate[name, replacedPrefix, suppliedPrefixLen]]
];
};
IF lbound # NIL THEN lbound ¬ DoServer[AbsoluteName[lbound]].nameOnFS;
IF hbound # NIL THEN hbound ¬ DoServer[AbsoluteName[hbound]].nameOnFS;
[fs, patternOnFS, replacedPrefix, suppliedPrefixLen] ¬ ServerAndHints[AbsoluteName[pattern]];
fs.procs.enumerateForNames[fs, patternOnFS, NameTranslator, lbound, hbound];
};
BackTranslate: PROC [name, newPrefix: PATH, replacePrefixLen: CARD] RETURNS [PATH] ~ {
RETURN [
PFSNames.Cat[newPrefix, PFSNames.SubName[name, replacePrefixLen]]
];
};
FileLookup: PUBLIC PROC [name: PATH, tryExtensions: LIST OF ROPE] RETURNS [fullPath: PATH ¬ NIL ] ~
{
fs: PFSClass.FSHandle;
nameOnFS: PATH;
replacedPrefix: PATH;
suppliedPrefixLen: INT;
[fs, nameOnFS, replacedPrefix, suppliedPrefixLen] ¬ ServerAndHints[AbsoluteName[name]];
fullPath ¬ fs.procs.lookupName[fs, nameOnFS ! PFS.Error => CONTINUE ];
IF fullPath = NIL THEN {
FOR extList: LIST OF ROPE ¬ tryExtensions, extList.rest WHILE extList# NIL DO
ext: ROPE ¬ extList.first;
IF( fullPath ¬ fs.procs.lookupName[fs, AddExt[nameOnFS, ext]
! PFS.Error => CONTINUE]) # NIL
THEN EXIT;
ENDLOOP;
};
IF fullPath # NIL THEN
fullPath ¬ BackTranslate[fullPath, replacedPrefix, suppliedPrefixLen];
};
FileSearch: PUBLIC PROC [name: PATH, searchRules: LIST OF -- Directory -- PATH] RETURNS [fullPath: PATH] ~
{
IF name.IsAbsolute[] THEN RETURN[FileLookup[name, NIL]];
FOR dirList: LIST OF PATH ¬ searchRules, dirList.rest WHILE dirList # NIL DO
dir: PATH ¬ dirList.first;
IF (fullPath ¬ FileLookup[PFSNames.Cat[dir, name], NIL]) # NIL THEN RETURN;
ENDLOOP;
RETURN[NIL];
};
Opening Files
Open: PUBLIC PROC [name: PATH,
access: AccessOptions ¬ read,
wantedUniqueID: UniqueID ¬ nullUniqueID,
checkFileType: BOOL ¬ FALSE, fileType: FileType ¬ tUnspecified,
createOptions: CreateOptions ¬ defaultCreateOptions
] RETURNS [OpenFile] ~
{
fs: PFSClass.FSHandle;
nameOnFS: PATH;
openFile: OpenFile;
absoluteName: PATH ¬ AbsoluteName[name];
backingName: PATH ← BackingName[name];
[fs, nameOnFS] ¬ DoServer[absoluteName];
openFile ¬ fs.procs.open[fs, nameOnFS, wantedUniqueID, access, checkFileType, fileType, createOptions -- ! PFS.Error => IF access=read AND backingName#NIL THEN CONTINUE -- ];
IF openFile#NIL THEN {
openFile.fullFName ¬ PFSNames.SetVersionNumber[absoluteName, openFile.fullFName.ShortName[].version];
openFile.access ¬ access;
IF access # create THEN NoteEvent[$readOpen, openFile.fullFName];
[] ¬ FinalizeOps.EnableFinalization[openFile, fq];
RETURN [openFile];
};
[fs, nameOnFS] ← DoServer[backingName];
openFile ← fs.procs.open[fs, nameOnFS, wantedUniqueID, access, checkFileType, fileType, createOptions];
openFile.fullFName ← PFSNames.SetVersionNumber[backingName, openFile.fullFName.ShortName[].version];
[] ← FinalizeOps.EnableFinalization[openFile, fq];
RETURN [openFile];
};
Store and Retrieve
Retrieve: PUBLIC PROCEDURE [name: PATH,
wantedUniqueID: UniqueID ¬ nullUniqueID,
proc: RetrieveConfirmProc,
checkFileType: BOOL ¬ FALSE, fileType: FileType ¬ tUnspecified
] ~
{
fs: PFSClass.FSHandle;
nameOnFS: PATH;
absolute: PATH ~ AbsoluteName[name];
[fs, nameOnFS] ¬ DoServer[absolute];
NoteEvent[$startRetrieving, absolute];
fs.procs.retrieve[fs, nameOnFS, wantedUniqueID, proc, checkFileType, fileType];
NoteEvent[$endRetrieving, absolute];
};
Store: PUBLIC PROCEDURE [name: PATH,
wantedUniqueID: UniqueID,
str: IO.STREAM,
proc: StoreConfirmProc,
createOptions: CreateOptions ¬ defaultCreateOptions
] ~
{
fs: PFSClass.FSHandle;
nameOnFS: PATH;
absolute: PATH ~ AbsoluteName[name];
[fs, nameOnFS] ¬ DoServer[absolute];
NoteEvent[$startStoring, absolute];
fs.procs.store[fs, nameOnFS, wantedUniqueID, str, proc, createOptions];
NoteEvent[$endStoring, absolute];
};
Operations On Open Files
GetClass: PUBLIC PROC [file: OpenFile] RETURNS [ATOM] ~
{
RETURN[$PFS];
};
GetName: PUBLIC PROC [file: OpenFile] RETURNS [fullFName, attachedTo: PATH] ~
{
RETURN[file.fullFName, file.attachedTo];
};
GetInfo: PUBLIC PROC [file: OpenFile] RETURNS [
fullFName, attachedTo: PATH,
uniqueID: UniqueID,
bytes: INT,
mutability: Mutability,
fileType: FileType
] ~
{
RETURN file.fs.procs.getInfo[file.fs, file];
};
SetAttributes: PUBLIC PROC [file: OpenFile, attributes: CreateOptions] ~
{
file.fs.procs.setAttributes[file.fs, file, attributes];
};
SetByteCountAndUniqueID: PUBLIC PROC [
file: OpenFile,
bytes: INT ¬ -1,
uniqueID: UniqueID ¬ nullUniqueID
] ~
{
file.fs.procs.setByteCountAndUniqueID[file.fs, file, bytes, uniqueID];
};
Read: PUBLIC UNSAFE PROC [file: OpenFile, filePosition, nBytes: CARD, to: POINTER TO Basics.RawBytes, toStart: CARD ¬ 0] RETURNS [bytesRead: INT] ~
UNCHECKED {
RETURN [ file.fs.procs.read[file.fs, file, filePosition, nBytes, to, toStart] ];
};
Write: PUBLIC PROC [file: OpenFile, filePosition, nBytes: CARD, from: POINTER TO Basics.RawBytes, fromStart: CARD ¬ 0] RETURNS [bytesWritten: INT] ~ {
TRUSTED {RETURN [ file.fs.procs.write[file.fs, file, filePosition, nBytes, from, fromStart] ]};
};
Close: PUBLIC PROC [file: OpenFile] ~
{
NewClose[file, FALSE];
};
NewClose: PUBLIC PROC [file: OpenFile, abort: BOOL ← FALSE] ~
exported to PFSExtras; eventually PFS.Close should have this signature
{
file.state ¬ closed;
file.fs.procs.close[file.fs, file, abort];
IF file.access # read THEN NoteEvent[$writeClose, file.fullFName];
};
General File Manipulations
Attach: PUBLIC PROC [attachment, attachedFile: PATH,
keep: CARDINAL ¬ 0, -- no keep processing
wantedUniqueID: UniqueID ¬ nullUniqueID,
remoteCheck: BOOL ¬ TRUE
]
RETURNS [toFName: PATH] ~
{
fs: PFSClass.FSHandle;
attachmentOnFS: PATH;
absoluteTo: PATH ~ AbsoluteName[attachment];
[fs, attachmentOnFS] ¬ DoServer[absoluteTo];
IF fs.procs.attach=NIL THEN ProduceError[notImplemented, "Attachments not implemented in this view", fs];
NoteEvent[$startCopying, absoluteTo];
toFName ¬ fs.procs.attach[fs, attachmentOnFS, attachedFile, keep, wantedUniqueID, remoteCheck];
NoteEvent[$endCopying, absoluteTo];
};
Delete: PUBLIC PROC [name: PATH,
wantedUniqueID: UniqueID ¬ nullUniqueID,
confirmProc: NameConfirmProc
] ~
{
fs: PFSClass.FSHandle;
nameOnFS: PATH;
replacedPrefix: PATH;
suppliedPrefixLen: INT;
NameTranslator: NameConfirmProc ~ {
RETURN [
confirmProc[BackTranslate[fullName, replacedPrefix, suppliedPrefixLen], uniqueID]
];
};
absolute: PATH ~ AbsoluteName[name];
[fs, nameOnFS, replacedPrefix, suppliedPrefixLen] ¬ ServerAndHints[absolute];
NoteEvent[$startDeleting, absolute];
fs.procs.delete[fs, nameOnFS, wantedUniqueID, IF confirmProc#NIL THEN NameTranslator ELSE NIL];
NoteEvent[$endDeleting, absolute];
};
Rename: PUBLIC PROC [from, to: PATH,
wantedUniqueID: UniqueID ¬ nullUniqueID,
createOptions: CreateOptions ¬ defaultCreateOptions,
confirmProc: NameConfirmProc
] ~
{
fromFS, toFS: PFSClass.FSHandle;
fromNameOnFS, toNameOnFS: PATH;
replacedPrefix: PATH;
suppliedPrefixLen: INT;
NameTranslator: NameConfirmProc ~ {
RETURN [
confirmProc[BackTranslate[fullName, replacedPrefix, suppliedPrefixLen], uniqueID]
];
};
done: BOOL ¬ FALSE;
absoluteTo: PATH ~ AbsoluteName[to];
[fromFS, fromNameOnFS] ¬ DoServer[AbsoluteName[from]];
[toFS, toNameOnFS, replacedPrefix, suppliedPrefixLen] ¬ ServerAndHints[absoluteTo];
NoteEvent[$startRenaming, absoluteTo];
IF fromFS=toFS THEN {
done ¬ fromFS.procs.rename[fromFS, fromNameOnFS, wantedUniqueID, toNameOnFS, createOptions, IF confirmProc#NIL THEN NameTranslator ELSE NIL];
};
IF NOT done THEN {
ProduceError[notImplemented, "File rename requiring copying is not yet implemented"]
};
NoteEvent[$endRenaming, absoluteTo];
};
Copy: PUBLIC PROC [from, to: PATH,
wantedUniqueID: UniqueID ¬ nullUniqueID,
createOptions: CreateOptions ¬ defaultCreateOptions,
confirmProc: NameConfirmProc
] ~
{
fromFS, toFS: PFSClass.FSHandle;
fromNameOnFS, toNameOnFS: PATH;
replacedPrefix: PATH;
suppliedPrefixLen: INT;
CopyNameTranslator: NameConfirmProc ~ {
RETURN [
IF confirmProc#NIL THEN confirmProc[BackTranslate[fullName, replacedPrefix, suppliedPrefixLen], uniqueID] ELSE TRUE
];
};
StoreNameTranslator: StoreConfirmProc ~ {
RETURN [
IF confirmProc#NIL THEN confirmProc[BackTranslate[fullName, replacedPrefix, suppliedPrefixLen], wantedUniqueID] ELSE TRUE
];
};
done: BOOL ¬ FALSE;
toStream, fromStream: IO.STREAM;
absoluteTo: PATH ~ AbsoluteName[to];
[fromFS, fromNameOnFS] ¬ DoServer[AbsoluteName[from]];
[toFS, toNameOnFS, replacedPrefix, suppliedPrefixLen] ¬ ServerAndHints[absoluteTo];
NoteEvent[$startCopying, absoluteTo];
IF fromFS=toFS THEN {
done ¬ fromFS.procs.copy[fromFS, fromNameOnFS, wantedUniqueID, toNameOnFS, createOptions, IF confirmProc#NIL THEN CopyNameTranslator ELSE NIL];
};
IF NOT done THEN {
ENABLE UNWIND => {
IF toStream # NIL THEN IO.Close[toStream ! PFS.Error => CONTINUE];
IF fromStream # NIL THEN IO.Close[fromStream ! PFS.Error => CONTINUE];
};
fromStream ¬ PFS.StreamOpen[fileName~from, accessOptions~read, wantedUniqueID~wantedUniqueID, streamOptions~[includeFormatting: TRUE, closeFSOpenFileOnClose: TRUE]];
IF wantedUniqueID=nullUniqueID THEN wantedUniqueID ¬ GetInfo[OpenFileFromStream[fromStream]].uniqueID;
toFS.procs.store[toFS, toNameOnFS, wantedUniqueID, fromStream, StoreNameTranslator, createOptions];
IO.Close[fromStream];
};
NoteEvent[$endCopying, absoluteTo];
};
SetClientProperty: PUBLIC PROC [file: OpenFile, propertyName: ROPE, propertyValue: ROPE] ~
{
file.fs.procs.setClientProperty[file.fs, file, propertyName, propertyValue];
};
GetClientProperty: PUBLIC PROC [file: OpenFile, propertyName: ROPE] RETURNS [propertyValue: ROPE] ~
{
RETURN[file.fs.procs.getClientProperty[file.fs, file, propertyName]];
};
EnumerateClientProperties: PUBLIC PROC [file: OpenFile, proc: PropProc] ~
{
file.fs.procs.enumerateClientProperties[file.fs, file, proc];
};
Exported to PFSExtras
PFSNameToUnixName: PUBLIC PROC [ file: PATH ] RETURNS [ ROPE ] ~ {
fs: PFSClass.FSHandle;
patternOnFS: PATH;
proc: PFSClass.PFSNameToUnixNameProc;
[fs, patternOnFS] ¬ ServerAndHints[AbsoluteName[file]];
IF (proc ¬ fs.procs.pfsNameToUnixName) # NIL
THEN RETURN[proc[fs, patternOnFS]]
ELSE {
try for an attachment
ENABLE PFS.Error => GOTO GiveUp;
attachedFile: PATH ~ fs.procs.fileInfo[fs, patternOnFS, nullUniqueID].attachedTo;
IF attachedFile#NIL THEN RETURN[PFSNameToUnixName[attachedFile]];
EXITS
GiveUp => NULL;
};
RETURN[NIL]
};
CaseSensitive: PUBLIC PROC [ file: PATH ] RETURNS [ BOOL ] ~ {
fs: PFSClass.FSHandle;
patternOnFS: PATH;
proc: PFSClass.CaseSensitiveProc;
[fs, patternOnFS] ¬ ServerAndHints[AbsoluteName[file]];
IF (proc ¬ fs.procs.caseSensitive) # NIL
THEN RETURN[proc[fs, patternOnFS]]
ELSE {
message: ROPE ~ Rope.Cat["Class for ", RopeFromPath[file], " doesn't implement case-sensitivity determination."];
ProduceError[notImplemented, message];
RETURN[FALSE]; -- not reached
};
};
Exported to PFSBackdoor
codeAtoms: ARRAY PFSBackdoor.ErrorCode OF ATOM ¬ ALL[$unknown];
codeGroups: ARRAY PFSBackdoor.ErrorCode OF PFS.ErrorGroup ¬ ALL[bug];
ProduceError: PUBLIC PROC [code: PFSBackdoor.ErrorCode, explanation: Rope.ROPE, info: REF ¬ NIL] ~ {
codeAtom: ATOM ~ codeAtoms[code];
codeGroup: ErrorGroup ~ codeGroups[code];
ERROR Error[[codeGroup, codeAtom, explanation, info]];
};
ExplainPFSError: PreDebug.Explainer = {
msg ¬ "PFS Error";
IF args=NIL THEN RETURN;
PreDebug.Raise[signalOrError, args ! PFS.Error => {
info: ROPE ¬ NIL;
IF ~Rope.IsEmpty[error.explanation] THEN msg ¬ Rope.Cat[msg, ": ", error.explanation];
WITH error.info SELECT FROM
r: ROPE => info ¬ r;
p: PATH => info ¬ RopeFromPath[p ! Error => CONTINUE];
ENDCASE => {};
IF ~Rope.IsEmpty[info] THEN msg ¬ Rope.Cat[msg, ": ", info];
CONTINUE
}];
};
Events
lastEvent: REF PFSBackdoor.Event ¬ NIL;
newEvent: CONDITION;
NoteEvent: ENTRY PROC [op: PFSBackdoor.Op, fName: PFSNames.PATH] ~ {
IF lastEvent = NIL THEN RETURN; -- never activated
lastEvent.chain ¬ NEW[PFSBackdoor.Event ¬ [op, fName, NIL]];
lastEvent ¬ lastEvent.chain;
BROADCAST newEvent;
};
NextEvent: PUBLIC ENTRY PROC [prev: REF READONLY PFSBackdoor.Event] RETURNS [REF READONLY PFSBackdoor.Event] ~ {
ENABLE UNWIND => NULL; -- may abort during wait
IF prev = NIL THEN {
IF lastEvent = NIL THEN lastEvent ¬ NEW[PFSBackdoor.Event];
prev ¬ lastEvent;
};
UNTIL prev.chain # NIL DO
WAIT newEvent;
ENDLOOP;
RETURN [prev.chain];
};
Error Codes
AtomFromErrorCode: PUBLIC PROC [code: PFSBackdoor.ErrorCode] RETURNS [ATOM] ~
{ RETURN[codeAtoms[code]] };
ErrorCodeFromAtom: PUBLIC PROC [atom: ATOM] RETURNS [PFSBackdoor.ErrorCode] ~ {
RETURN[ SELECT atom FROM
$ok => ok,
$inconsistent => inconsistent,
$resourceLimitExceeded => resourceLimitExceeded,
$ioError => ioError,
$volumeFull => volumeFull,
$noMoreVersions => noMoreVersions,
$serverInaccessible => serverInaccessible,
$connectionRejected => connectionRejected,
$connectionTimedOut => connectionTimedOut,
$badCredentials => badCredentials,
$accessDenied => accessDenied,
$quotaExceeded => quotaExceeded,
$invalidPropertyStorage => invalidPropertyStorage,
$outOfPropertySpace => outOfPropertySpace,
$positionNotInFile => positionNotInFile,
$invalidOpenFile => invalidOpenFile,
$notImplemented => notImplemented,
$fileTypeMismatch => fileTypeMismatch,
$unknownClass => unknownClass,
$unknownFile => unknownFile,
$unknownUniqueID => unknownUniqueID,
$illegalName => illegalName,
$patternNotAllowed => patternNotAllowed,
$versionSpecified => versionSpecified,
$cantUpdateTiogaFile => cantUpdateTiogaFile,
$invalidNameSyntax => invalidNameSyntax,
ENDCASE => LOOPHOLE[BYTE.LAST/2]
];
};
FD from file/stream
FDFromOpenFile: PROC [file: OpenFile] RETURNS [UnixTypes.FD] ~ {
This does not lock the OpenFile's data - the client had better beware of concurrent access, anyway!
WITH file.data SELECT FROM
ux: REF PFSBackdoor.UXData => {
ux.fdIndex ¬ PFSBackdoor.unreliableIndex;
RETURN[ux.fd];
};
vux: REF PFSBackdoor.VUXData => {
vux.fdIndex ¬ PFSBackdoor.unreliableIndex;
RETURN[vux.fd];
};
ENDCASE;
PFSBackdoor.ProduceError[notImplemented, "FDFromOpenFile not implemented for this file"];
RETURN[error];
};
FDFromOpenStream: PUBLIC PROC [self: IO.STREAM] RETURNS [UnixTypes.FD] ~ {
RETURN[FDFromOpenFile[PFS.OpenFileFromStream[self]]];
};
Private Procedures
DoServer: PROC [name: PATH] RETURNS [fs: PFSClass.FSHandle, nameOnFS: PATH] ~ {
translation: PFSPrefixMap.PrefixTableEntry ¬ PFSPrefixMap.TranslateAndGetHints[name];
IF NOT translation.translation.IsAbsolute[] THEN {
ProduceError[invalidNameSyntax, Rope.Cat["The prefix map produced a relative translation for ", RopeFromPath[name], " and an absolute translation is required."], translation.translation]
};
fs ¬ PFSClass.GetFS[translation.fsName !
PFSClass.Error => ProduceError[unknownFile, Rope.Cat["The file server for ", RopeFromPath[name], " is unknown or unavailable."], NIL]];
nameOnFS ¬ translation.nameOnFS;
};
ServerAndHints: PROC [name: PATH] RETURNS [fs: PFSClass.FSHandle, nameOnFS: PATH, replacedPrefix: PATH, suppliedPrefixLen: INT] ~ {
translation: PFSPrefixMap.PrefixTableEntry ¬ PFSPrefixMap.TranslateAndGetHints[name];
IF NOT translation.translation.IsAbsolute[] THEN {
ProduceError[invalidNameSyntax, Rope.Cat["The prefix map produced a relative translation for ", RopeFromPath[name], " and an absolute translation is required."], translation.translation]
};
fs ¬ PFSClass.GetFS[translation.fsName !
PFSClass.Error => ProduceError[unknownFile, Rope.Cat["The file server for ", RopeFromPath[name], " is unknown or unavailable."], NIL]];
nameOnFS ¬ translation.nameOnFS;
replacedPrefix ¬ translation.replacedPrefix;
suppliedPrefixLen ¬ translation.suppliedPrefixLen;
};
AddExt: PROC [name: PATH, ext: ROPE] RETURNS [newName: PATH] ~ {
newBase: ROPE ~ Rope.Cat[PFSNames.ComponentRope[name.ShortName[]], ".", ext];
newName ¬ PFSNames.ReplaceShortName[
name,
[name~[newBase, 0, newBase.Length[]], version~[none, 0]]
];
};
fq: FinalizeOps.CallQueue ~ FinalizeOps.CreateCallQueue[Finalizer];
openFilesFinalized: CARD ¬ 0;
OpenFilesFinalized: PROC [] RETURNS [CARD] ~ {
RETURN[openFilesFinalized];
};
closedFilesFinalized: CARD ¬ 0;
ClosedFilesFinalized: PROC [] RETURNS [CARD] ~ {
RETURN[closedFilesFinalized];
};
Finalizer: FinalizeOps.FinalizeProc ~ {
openFile: REF OpenFileObject ¬ NARROW[object];
IF openFile # NIL THEN {
IF openFile.state # closed THEN {
NewClose[file~openFile, abort~TRUE ! PFS.Error => CONTINUE];
openFilesFinalized ¬ openFilesFinalized + 1;
}
ELSE closedFilesFinalized ¬ closedFilesFinalized + 1;
};
};
InitErrorArrays: PROC ~ {
codeGroups array is initalized to bug
codeGroups[ok] ¬ ok;
codeGroups[inconsistent] ¬ bug;
FOR i: PFSBackdoor.ErrorCode IN [resourceLimitExceeded..invalidPropertyStorage] DO
codeGroups[i] ¬ environment;
ENDLOOP;
FOR i: PFSBackdoor.ErrorCode IN [outOfPropertySpace..fileTypeMismatch] DO
codeGroups[i] ¬ client;
ENDLOOP;
FOR i: PFSBackdoor.ErrorCode IN [unknownClass..invalidNameSyntax] DO
codeGroups[i] ¬ user;
ENDLOOP;
codeAtoms array is initialized to $unknown
codeAtoms[ok] ¬ $ok;
codeAtoms[inconsistent] ¬ $inconsistent;
codeAtoms[resourceLimitExceeded] ¬ $resourceLimitExceeded;
codeAtoms[ioError] ¬ $ioError;
codeAtoms[volumeFull] ¬ $volumeFull;
codeAtoms[noMoreVersions] ¬ $noMoreVersions;
codeAtoms[serverInaccessible] ¬ $serverInaccessible;
codeAtoms[connectionRejected] ¬ $connectionRejected;
codeAtoms[connectionTimedOut] ¬ $connectionTimedOut;
codeAtoms[badCredentials] ¬ $badCredentials;
codeAtoms[accessDenied] ¬ $accessDenied;
codeAtoms[quotaExceeded] ¬ $quotaExceeded;
codeAtoms[invalidPropertyStorage] ¬ $invalidPropertyStorage;
codeAtoms[outOfPropertySpace] ¬ $outOfPropertySpace;
codeAtoms[positionNotInFile] ¬ $positionNotInFile;
codeAtoms[invalidOpenFile] ¬ $invalidOpenFile;
codeAtoms[notImplemented] ¬ $notImplemented;
codeAtoms[fileTypeMismatch] ¬ $fileTypeMismatch;
codeAtoms[unknownClass] ¬ $unknownClass;
codeAtoms[unknownFile] ¬ $unknownFile;
codeAtoms[unknownUniqueID] ¬ $unknownUniqueID;
codeAtoms[illegalName] ¬ $illegalName;
codeAtoms[patternNotAllowed] ¬ $patternNotAllowed;
codeAtoms[versionSpecified] ¬ $versionSpecified;
codeAtoms[cantUpdateTiogaFile] ¬ $cantUpdateTiogaFile;
codeAtoms[invalidNameSyntax] ¬ $invalidNameSyntax;
};
InitErrorArrays[];
TRUSTED {
Process.EnableAborts[@newEvent];
};
PreDebug.RegisterErrorExplainer[PFS.Error, ExplainPFSError];
END.