-- DirManImpl.mesa
-- Implementation of the directory component of the
-- Cedar Interim File System.
-- Redesigned to use BTrees, May 29, 1982 D. Gifford
-- Coded September 7, 1981 D. Gifford
-- M. D. Schroeder, October 6, 1982 11:46 am


DIRECTORY
Ascii: TYPE USING [NUL, SP],
BTreeDefs: TYPE USING [BTreeHandle, Call, CreateAndInitializeBTree, Delete, Desc,
 EnumerateFrom, Insert, PushBTreeToDisk, ReleaseBTree, TestKeys],
BTreeSupportDefs: TYPE USING [FileHandle],
BTreeSupportExtraDefs: TYPE USING [CloseFile, OpenFile],
CedarSnapshot: TYPE USING [CheckpointProc, Register, RollbackProc],
CIFS: TYPE USING [ConnectionErrors, Error, ErrorCode, maxComment, maxPath],
ConvertUnsafe: TYPE USING [AppendRope],
Directory: TYPE USING [PutProperty],
DirMan,
FT: TYPE USING [Close, create, Delete, Mode, Open, OpenFile, replace, write],
Heap: TYPE USING [MakeNode],
Inline: TYPE USING [LowHalf],
PropertyTypes: TYPE USING [tCreateDate],
Rope: TYPE USING [Cat, Concat, Equal, Fetch, Length, Lower, ROPE, Upper],
Runtime: TYPE USING [BoundsFault],
System: TYPE USING [GetGreenwichMeanTime];


DirManImpl: MONITOR
IMPORTS BTreeDefs, BTreeSupportExtraDefs, CedarSnapshot, CIFS, ConvertUnsafe,
Directory, FT, Heap, Inline, Rope, Runtime, System
EXPORTS DirMan = {

-- DirMan manages the representation of directories
-- Exceptional conditions are reported with CIFS.Error

-- BTree Descriptor
Desc: TYPE = BTreeDefs.Desc;
DescLength: CARDINAL = 80;
-- Roy told me that the BTree package doesn't deal
-- with key + values greater than 80 words

SmallestKey: Desc = DESCRIPTOR[SmallArray];
SmallArray: ARRAY [0..1) OF WORD ← [0];

-- Global structures
global: REF Global ← NIL;

maxOpenDirs: CARDINAL = 100;
MissingDirIndex: TYPE = [0..7];

Global: TYPE = RECORD [
-- standard descriptors for our use
keyDesc: Desc,
valueDesc: Desc,
enumDesc: Desc,
-- directories known not to exist
missingDirRover: MissingDirIndex,
missingDir: ARRAY MissingDirIndex OF Rope.ROPE,
-- the table of open directories
used: INTEGER ← 0,
openTable: SEQUENCE max: [1..maxOpenDirs+1] OF Dir
];

-- Data structures for matching algorihtm
Next: TYPE = ARRAY [0..CIFS.maxPath] OF INTEGER;
PNext: TYPE = REF Next;
gNext: PNext ← NEW[Next];

Dir: TYPE = REF DirObject;

DirObject: PUBLIC TYPE = RECORD [
-- reference count
rc: CARDINAL ← 1,
slot: INTEGER ← 0,
name: Rope.ROPE,
-- if flush is T, then every update will be forced to disk
flush: BOOLEAN ← TRUE,
-- written is T if the directory has been written
written: BOOLEAN ← FALSE,
-- FT file handle
fh: FT.OpenFile,
-- handles for the directory btree
btfh: BTreeSupportDefs.FileHandle,
bt: BTreeDefs.BTreeHandle
];

-- Public procedures

Open: PUBLIC ENTRY PROC [name: Rope.ROPE, erase: BOOLEAN ← FALSE]
RETURNS [d: Dir] = {
-- Open a directory
-- See if the directory is already open
slot, i: INTEGER ← 0;
{ENABLE UNWIND => NULL;
-- if we are going to replace the directory, then don't share it with
-- anyone else
IF erase THEN RETURN[OpenDir[name, TRUE]];
-- if we are not erasing the directory, see if it is already open
FOR i IN [1..global.used] DO
IF global[i]#NIL THEN {
IF Rope.Equal[global[i].name, name, FALSE] THEN {
global[i].rc ← global[i].rc + 1;
RETURN[global[i]];
};
};
ENDLOOP;
-- Not already open. Open Directory
d ← OpenDir[name];
-- if we have enough room, let's remember that we already
-- opened this directory by entering it in our table
FOR i IN [1..maxOpenDirs) DO
IF global[i]=NIL THEN {
slot ← i;
EXIT;
};
ENDLOOP;
IF slot#0 THEN {
global.used ← MAX[slot, global.used];
d.slot ← slot;
global[slot] ← d;
};
-- if there was not enough room, d.slot will be 0
RETURN[d];
}};

Close: PUBLIC ENTRY PROC [d: Dir] = {
-- Close a directory
CloseDir[d];
};

Delete: PUBLIC ENTRY PROC [d: Dir, name: Rope.ROPE] = {
-- Delete a name in a directory
-- Delete entry in BTree
BTreeDefs.Delete[d.bt, RopeToDesc[name, global.keyDesc]];
-- write out directory
d.written ← TRUE;
IF d.flush THEN WriteOutDir[d];
};

Destroy: PUBLIC PROC [d: Dir] = {
-- Destroy a directory
IF XDestroy[d] THEN
ERROR CIFS.Error[CIFS.ErrorCode[fileBusy],
Rope.Concat[d.name, " is busy"]];
};

XDestroy: ENTRY PROC [d: Dir]
RETURNS [locked: BOOLEAN] = {
-- Destroy a directory
name: Rope.ROPE ← d.fh.name;
CloseDir[d];
IF d.rc#0 THEN RETURN[TRUE];
FT.Delete[name];
RETURN[FALSE];
};

Enumerate: PUBLIC ENTRY PROC [d: Dir, pattern: Rope.ROPE,
p: DirMan.EProc] = {
-- Enumerate the names in d that match pattern.
-- Pattern can contain "*" (match any sequence of characters)
-- Pattern can contain "#" (match exactly one arbitrary character)
-- The pattern "*" will enumerate the entire directory
{ENABLE UNWIND => NULL;
entry: REF TEXT ← NEW[TEXT[CIFS.maxPath]];
link: REF TEXT ← NEW[TEXT[CIFS.maxPath]];
comment: REF TEXT ← NEW[TEXT[CIFS.maxComment]];
k: CARDINAL;
-- put pattern in string: ropes are slow
pat: STRING ← [CIFS.maxPath];
patLowerCase: STRING ← [CIFS.maxPath];
patLength: INTEGER;
-- note if the pattern ends in "*"
patEndsInStar: BOOLEAN ← FALSE;
-- next encodes the FSA for matching
next: PNext;
ed: Desc ← SmallestKey;
-- in additon to starting the enumeration at a certain point, we
-- will stop it if we know that continuing will be pointless
posFirstWild: INTEGER ← 0;

callProc: BTreeDefs.Call = {
-- This procedure is called for every entry that migth match in the BTree
-- It takes the pattern supplied and matches it against the key in the tree
text: LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER =
DESCRIPTOR[BASE[k], 2*LENGTH[k]];
value: LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER;
textLength: INTEGER ← 2*LENGTH[k];
m: INTEGER ← 0; -- at beginning of key
j : INTEGER ← 0; -- at beginning of pattern
IF text[textLength-1]=Ascii.NUL THEN textLength ← textLength -1;
-- now see if key matches
m ← 0;
WHILE (m < textLength) AND (j < patLength) DO
IF Rope.Upper[text[m]]=pat[j] THEN {
j ← j + 1;
m ← m + 1;
} ELSE {
j ← next[j];
SELECT j FROM
<0 => {j ← -j; m ← m + 1};
=0 => EXIT;
ENDCASE;
};
ENDLOOP;
-- see if pattern ran out before end of line
-- if so, treat as mismatch to handle patterns that end
-- in "*" and "#" properly
IF j < patLength THEN j ← ABS[next[j]];
-- check for match
IF (m >= textLength OR patEndsInStar) AND (j >= patLength) THEN {
  -- match
  value ← DESCRIPTOR[BASE[v], 2*LENGTH[v]];
  -- fill in entry
  FOR m IN [0..textLength) DO entry[m] ← text[m]; ENDLOOP;
  entry.length ← textLength;
  -- now gather link
  m ← 0;
   WHILE m < LENGTH[value] DO
   IF value[m]=Ascii.SP THEN EXIT;
   link[m] ← value[m];
   m ← m + 1;
   ENDLOOP;
   link.length ← m;
   -- now gather comment
   m ← m + 1;
   j ← 0;
   WHILE m < LENGTH[value] DO
   IF value[m]=Ascii.NUL THEN EXIT;
   comment[j] ← value[m];
   m ← m + 1;
   j ← j + 1;
   ENDLOOP;
   comment.length ← j;  
  RETURN[more: NOT p[entry, link, comment], dirty: FALSE];
  };
 
  -- see if we should continue
  FOR m IN [0..MIN[posFirstWild, textLength]) DO
  IF patLowerCase[m] < text[m] THEN RETURN[more: FALSE, dirty: FALSE];
  ENDLOOP;
  -- yes, continue
RETURN[more: TRUE, dirty: FALSE];
};

-- first, convert pattern to upper and lower case
pat.length ← 0;
ConvertUnsafe.AppendRope[to: pat, from: pattern
! Runtime.BoundsFault => CONTINUE];
FOR k IN [0..pat.length) DO
patLowerCase[k] ← Rope.Lower[pat[k]];
pat[k] ← Rope.Upper[pat[k]];
ENDLOOP;
patLowerCase.length ← patLength ← pat.length;
IF pat[pat.length-1]='* THEN patEndsInStar ← TRUE;
-- create next array
next ← CreateNext[pat];
-- find out where the first wild card is
posFirstWild ← pat.length;
FOR k IN [0..pat.length) DO
IF pat[k]='* OR pat[k]='# THEN {
posFirstWild ← k;
EXIT;
};
ENDLOOP;
-- if the first charcter of the pattern is not a wild card, then
-- prepare our starting point in the BTree
-- pattern must be left in upper case for patter matcher
IF posFirstWild > 0 THEN {
pat[patLength] ← Ascii.NUL;
ed ← StringToDesc[pat, posFirstWild, global.enumDesc];
};
BTreeDefs.EnumerateFrom[d.bt, ed, callProc];
}};

Insert: PUBLIC ENTRY PROCEDURE [d: Dir, name, link, comment: Rope.ROPE] = {
-- Insert a name in a directory
value: Rope.ROPE;
value ← IF link=NIL THEN Rope.Cat[" ", comment] ELSE Rope.Cat[link, " ", comment];
BTreeDefs.Insert[d.bt, RopeToDesc[name, global.keyDesc],
RopeToDesc[value, global.valueDesc]];
d.written ← TRUE;
IF d.flush THEN WriteOutDir[d];
};

SetFlushMode: PUBLIC ENTRY PROCEDURE [d: Dir, flush: BOOLEAN ← TRUE] = {
-- Sets the flush mode
d.flush ← flush;
IF d.flush AND d.written THEN WriteOutDir[d];
};

-- Internal Procedures

OpenDir: INTERNAL PROC [name: Rope.ROPE, erase: BOOLEAN ← FALSE]
RETURNS [d: Dir] = {
-- Open a directory
mode: FT.Mode ← FT.write;
IF erase
THEN {FlushFromMissingDirCache[name];
mode ← mode + FT.create + FT.replace}
ELSE {IF InMissingDirCache[name]
THEN ERROR CIFS.Error[CIFS.ErrorCode[noSuchDirectory],
Rope.Concat["Directory ", Rope.Concat[name, " does not exist"]]]};
d ← NEW[DirObject];
d.fh ← FT.Open[Rope.Concat[name, "/dir.bt!h"], mode
! CIFS.Error => TRUSTED {
SELECT code FROM
CIFS.ErrorCode[noSuchFile] => {
AddToMissingDirCache[name];
ERROR CIFS.Error[CIFS.ErrorCode[noSuchDirectory],
Rope.Concat["Directory ", Rope.Concat[name, " does not exist"]]]};
IN CIFS.ConnectionErrors => {
ERROR CIFS.Error[CIFS.ErrorCode[noSuchDirectory],
Rope.Concat["Directory ", Rope.Concat[name, " assumed not to exist"]]]};
ENDCASE => REJECT }
];
d.name ← name;
d.btfh ← BTreeSupportExtraDefs.OpenFile[d.fh.fc];
d.bt ← BTreeDefs.CreateAndInitializeBTree[
fileH: d.btfh,
initializeFile: erase,
isFirstGreaterOrEqual: IsFirstGE,
areTheyEqual: AreTheyE];
-- make sure file is well formed --
IF erase THEN BTreeDefs.PushBTreeToDisk[d.bt];
};

InMissingDirCache: INTERNAL PROC [n: Rope.ROPE] RETURNS [BOOLEAN] = {
FOR i:MissingDirIndex IN MissingDirIndex DO
IF Rope.Equal[global.missingDir[i], n, FALSE] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE]
};

AddToMissingDirCache: INTERNAL PROC [n: Rope.ROPE] = {
global.missingDir[global.missingDirRover] ← n;
global.missingDirRover ← IF global.missingDirRover = LAST[MissingDirIndex]
THEN 0 ELSE global.missingDirRover + 1;
};

FlushFromMissingDirCache: INTERNAL PROC [n: Rope.ROPE] = {
FOR i:MissingDirIndex IN MissingDirIndex DO
IF Rope.Equal[global.missingDir[i], n, FALSE]
THEN global.missingDir[i] ← NIL;
ENDLOOP;
};

InitializeMissingDirCache: ENTRY PROC = {
FOR i:MissingDirIndex IN MissingDirIndex DO
global.missingDir[i] ← NIL;
ENDLOOP;
global.missingDirRover ← 0;
};



CloseDir: PROC [d: Dir] = {
-- Close a directory
IF (d=NIL) OR (d.fh=NIL) THEN RETURN;
IF (d.rc ← d.rc - 1)#0 THEN RETURN;
-- ref count is zero. close the directory
-- first, set the create date
IF d.written THEN WriteOutDir[d];
-- shut down BTree
BTreeSupportExtraDefs.CloseFile[BTreeDefs.ReleaseBTree[d.bt]];
-- now tell CIFS that we are no longer using the directory
FT.Close[d.fh];
d.fh ← NIL;
-- now take us out of the open directory table
IF d.slot#0 THEN global[d.slot] ← NIL;
};

-- CreateNext and Enumerate implement pattern matching
-- using a O(m + n) time algorithm. To understand the algorithm,
-- read Sections 1 and 2 of
-- "Fast Pattern Matching in Strings"
-- by Knuth, Morris, and Pratt
-- SIAM J. Computing, Vol. 6, No. 2, June 1977, pp. 323-350

-- We have redefined the contents of the next array to handle more
-- complex paterns. If next[j] = k, then the meaning of k is:
-- k=0 This means that text[j] must match pattern[j]
-- k>0 This means that if a match fails at position j of the pattern,
-- to skip to position k of the pattern without shifting the text.
-- k<0 This means that if a match fails at position j of the pattern,
-- to skip to position -k of the pattern, and shift the text
-- left one place.

CreateNext: INTERNAL PROC [pattern: LONG STRING]
RETURNS [next: PNext] = {
-- returns the next array for pattern matching
-- as a performance optz, use preallocated next array
t: INTEGER;
j: CARDINAL;
next ← gNext;
-- compute next for entire pattern
j ← 0;
WHILE j < pattern.length DO
SELECT pattern[j] FROM
  '* => {
  next[j] ← j + 1;
  j ← j + 1;
  t ← -j; next[j] ← t;
  WHILE (j < pattern.length) AND
  (pattern[j]#'#) AND (pattern[j]#'*) DO
  WHILE (t > 0) AND (pattern[j]#pattern[t]) DO
  t ← next[t];
  ENDLOOP;
  t ← IF t>0 THEN t+1 ELSE -t;
  j ← j + 1;
  -- t == f[j]
  IF pattern[j]=pattern[t] THEN
  next[j] ← next[t]
  ELSE next[j] ← t;
  ENDLOOP;
  };
'# => {
  next[j] ← -(j + 1);
  j ← j + 1;
  };
  ENDCASE => {
  next[j] ← 0;
  j ← j + 1;
  };
 ENDLOOP;
};

RopeToDesc: PROC [rope: Rope.ROPE, desc: Desc]
RETURNS [rdesc: Desc] = {
-- copies a rope into a Desc
-- fills with a zero byte if necessary
d: LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER ←
DESCRIPTOR[BASE[desc], 2*LENGTH[desc]];
length: INTEGER ← MIN[Inline.LowHalf[rope.Length[]], 2*LENGTH[desc]];
i: INTEGER;
FOR i IN [0..length) DO d[i] ← rope.Fetch[i]; ENDLOOP;
d[length] ← Ascii.NUL;
RETURN[DESCRIPTOR[BASE[desc], (length+1)/2]];
};

StringToDesc: PROC [s: STRING, length: CARDINAL, desc: Desc]
RETURNS [rdesc: Desc] = {
-- copies a string into a Desc
-- fills with a zero byte if necessary
d: LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER ←
DESCRIPTOR[BASE[desc], 2*LENGTH[desc]];
i: CARDINAL;
FOR i IN [0..length] DO d[i] ← s[i]; ENDLOOP;
RETURN[DESCRIPTOR[BASE[desc], (length+1)/2]];
};


WriteOutDir: PROC [d: Dir] = {
-- Writes out a directory
time: LONG CARDINAL ← System.GetGreenwichMeanTime[];
-- update create date
Directory.PutProperty[file: d.fh.fc, property: PropertyTypes.tCreateDate,
propertyValue: DESCRIPTOR[@time, SIZE[LONG CARDINAL]]];
-- now push BTree to disk
BTreeDefs.PushBTreeToDisk[d.bt];
-- reset d.written
d.written ← FALSE;
};

IsFirstGE: BTreeDefs.TestKeys -- [a, b: BTreeDefs.Desc] RETURNS[BOOLEAN] -- =
BEGIN
aC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
FOR i:CARDINAL IN [0..2*MIN[LENGTH[a],LENGTH[b]]) DO
IF Rope.Lower[aC[i]] < Rope.Lower[bC[i]] THEN RETURN[FALSE];
IF Rope.Lower[aC[i]] > Rope.Lower[bC[i]] THEN RETURN[TRUE];
ENDLOOP;
RETURN[LENGTH[a] >= LENGTH[b]];
END; -- of IsFirstGE --

AreTheyE: BTreeDefs.TestKeys -- [a, b: BTreeDefs.Desc] RETURNS[BOOLEAN] -- =
BEGIN
aC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
IF LENGTH[a] = LENGTH[b] THEN
FOR i:CARDINAL IN [0..2*LENGTH[a]) DO
IF Rope.Lower[aC[i]] # Rope.Lower[bC[i]] THEN EXIT;
REPEAT FINISHED => RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END; -- of AreTheyE --

-- Checkpoint stuff --

CheckPointP: CedarSnapshot.CheckpointProc = {};
RollbackP: CedarSnapshot.RollbackProc = {InitializeMissingDirCache[]};


-- Intialization

Init: PROC = {

AllocDesc: PROC RETURNS [d: Desc] = {
p: LONG POINTER ← Heap.MakeNode[n: DescLength];
RETURN[DESCRIPTOR[p, DescLength]];
};

global ← NEW[Global[maxOpenDirs]];
global.keyDesc ← AllocDesc[];
global.valueDesc ← AllocDesc[];
global.enumDesc ← AllocDesc[];
InitializeMissingDirCache[];
CedarSnapshot.Register[CheckPointP, RollbackP];
};

Init[];

}..