// IFSDirAdmin.bcpl -- file system administrative procedures
// Copyright Xerox Corporation 1979, 1980, 1981

// Last modified November 17, 1981  11:24 AM by Taft

get "Ifs.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"
get "IfsRs.decl"

external
[
// Outgoing procedures
ReadDIF; WriteDIF; WheelCall; CreateUser; DestroyUser

// Incoming procedures
IFSOpenFile; CreateIFSFile; OpenIFSStream; StreamsFD
IFSDeleteFile; DeleteFileFromFD; LookupIFSFile
CreateFD; DestroyFD; LookupFD; NextFD; CreateDirectoryEntry
LockDirFD; UnlockDirFD
DIFRecFromDR; Password; InvalidateCachedDIF
CopyString; ExtractSubstring; IFSError; ByteBlt
Closes; ReadBlock; WriteBlock; CallWithArgVec
DefaultArgs; SysAllocateZero; SysFree; MoveBlock; FreePointer

// Incoming statics
system; primaryIFS; CtxRunning
]

//----------------------------------------------------------------------------
let ReadDIF(name, fs, lvErrorCode; numargs na) = valof
//----------------------------------------------------------------------------
// Reads the DIF for directory "name" and returns it in a block
// which the caller must free when done with it.  Returns zero
// if unsuccessful.  The DIFRec portion of the DIF is copied from
// the directory entry rather than from the file itself so as to
// get the up-to-date value for the disk page usage.
// Also copies the real name from the directory entry into "name"
// so as to ensure consistent capitalization.
[
DefaultArgs(lv na, -1, primaryIFS, lv na)
let str = IFSOpenFile("!1", lvErrorCode, 0, 0, 0, fs, name)  // "<name>!1"
if str eq 0 resultis 0
let fd = StreamsFD(str)
if fd>>FD.dr>>DR.type ne drTypeDIF then
   [ Closes(str); @lvErrorCode = ecDirNotFound; resultis 0 ]
ByteBlt(name, 1, lv fd>>FD.dr>>DR.pathName, 2, fd>>FD.lenDirString-2)
let dif = SysAllocateZero(lenDIF)
if ReadBlock(str, dif, lenDIF) ls minLenDIF then IFSError(ecMalformedDIF)
MoveBlock(dif, DIFRecFromDR(fd>>FD.dr), lenDIFRec)
Closes(str)
resultis dif
]

//----------------------------------------------------------------------------
and WriteDIF(name, dif, fs, dontFlush; numargs na) = valof
//----------------------------------------------------------------------------
// Creates or updates a DIF for directory "name".  dif should point
// to a completely filled-in DIF structure.  Returns zero if
// successful and an error code if unsuccessful.
// Flushes name from DIF cache unless dontFlush is true.
[
DefaultArgs(lv na, -2, primaryIFS, false)
unless CtxRunning>>RSCtx.userInfo>>UserInfo.capabilities.wheel do
   resultis ecIllegalDIFAccess

// Disallow illegal characters and ones that could cause confusion
for i = 1 to name>>String.length do
   [
   let c = name>>String.char↑i
   if c le 40B % c ge 177B % c eq $< % c eq $> % c eq $** then
      resultis ecIllegalChar
   ]

// Construct and parse DIF filename
let ec = nil
let fd = CreateFD("!1", lcCreate+lcVHighest, lv ec, fs, name)  // "<name>!1"
if fd eq 0 resultis ec

// See whether the file already exists; create it if not
ec = LookupFD(fd, lockWrite)
if ec ne 0 then
   [  // doesn't exist
   if ec eq ecDirNotFound then
      [ // Construct a new DR big enough to append the DIFRec to
      let length = fd>>FD.dr>>DR.length
      let dr = SysAllocateZero(length+lenDIFRec)
      MoveBlock(dr, fd>>FD.dr, length)
      (dr+length)>>DIFRec.diskPageUsage↑1 =
       2 + (lenDIF-1) rshift fs>>IFS.logPageLength
      dr>>DR.type = drTypeDIF
      dr>>DR.length = length+lenDIFRec
      FreePointer(lv fd>>FD.dr)
      fd>>FD.dr = dr

      // Create the file
      let buffer = SysAllocateZero(fs>>IFS.pageLength)
      buffer>>ILD.readProt.owner = true  // Owner read only
      buffer>>ILD.type = ftBinary
      buffer>>ILD.byteSize = 8
      buffer>>ILD.undeletable = true
      ec = CreateIFSFile(fd, buffer)
      SysFree(buffer)
      ]
   if ec ne 0 then
      [ UnlockDirFD(fd); DestroyFD(fd); resultis ec ]
   fd>>FD.lookupStatus = lsExists
   ]

// Update the data cached in the directory entry.
// Be careful not to clobber the disk page usage.
let difRec = DIFRecFromDR(fd>>FD.dr)
MoveBlock(lv dif>>DIF.diskPageUsage, lv difRec>>DIFRec.diskPageUsage, 2)
MoveBlock(difRec, dif, lenDIFRec)
CreateDirectoryEntry(fd)  // Special call to update entry
UnlockDirFD(fd)

// Open the file and write the data
let str = OpenIFSStream(fd, lv ec, modeWrite)
if str eq 0 then [ DestroyFD(fd); resultis ec ]
WriteBlock(str, dif, lenDIF)
Closes(str)
unless dontFlush do InvalidateCachedDIF(name)
resultis 0
]

//----------------------------------------------------------------------------
and WheelCall(proc, args, nil, nil, nil, nil, nil, nil, nil, nil, nil;
    numargs na) = valof
//----------------------------------------------------------------------------
// Temporarily enables the currently-running process as a wheel, and then
// calls proc with the remaining arguments as its arguments (up to 10).
// Returns the result returned by proc.
[
let ui = CtxRunning>>RSCtx.userInfo
let capabilities = ui>>UserInfo.capabilities
ui>>UserInfo.capabilities.wheel = true
let result = CallWithArgVec(proc, lv args, na-1)
ui>>UserInfo.capabilities = capabilities
resultis result
]

//----------------------------------------------------------------------------
and CreateUser(name, password, diskLimit, owner, capabilities, worldRead,
    fs; numargs na) = valof
//----------------------------------------------------------------------------
// Creates a new user directory with the parameters supplied and
// the remaining parameters set to default values.   Returns zero
// if successful and an error code if unsuccessful.  Owner is a string
// specifying ownership of a files-only directory; 0 means not files-only.
// *** Note: this procedure is useful primarily during file system creation.
// It provides means for setting only a subset of all possible directory
// parameters.
[
DefaultArgs(lv na, -2, 1000, 0, 0, false, primaryIFS)

// Construct DIF structure
let dif = SysAllocateZero(lenDIF)
Password(password, lv dif>>DIF.password, true)
dif>>DIF.diskPageLimit↑1 = diskLimit
if owner ne 0 then
   [
   dif>>DIF.filesOnly = true
   CopyString(lv dif>>DIF.owner, owner)
   ]
dif>>DIF.capabilities = capabilities

// Default protections are such that owner has all access,
// and all other users have read access iff worldRead is true
dif>>DIF.createProt.owner = true
dif>>DIF.connectProt.owner = true
dif>>DIF.readProt.owner = true
dif>>DIF.readProt.world = worldRead
dif>>DIF.writeProt.owner = true
dif>>DIF.appendProt.owner = true

// Create the DIF
let ec = WriteDIF(name, dif, fs)
SysFree(dif)
resultis ec
]

//----------------------------------------------------------------------------
and DestroyUser(name, fs; numargs na) = valof
//----------------------------------------------------------------------------
// Destroy a user directory.  Returns zero if successful and
// an error code if unsuccessful.
[
DefaultArgs(lv na, -1, primaryIFS)

// First, get an fd designating all files in the directory
let ec = 0
let fd = LookupIFSFile("**", lcMultiple+lcVAll, lv ec, fs, name) // "<name>*"
if fd eq 0 resultis ec

// Loop to delete all files besides the DIF itself
   [ // repeat
   if fd>>FD.dr>>DR.type ne drTypeDIF then
      [
      ec = DeleteFileFromFD(fd)
      if ec ne 0 then [ DestroyFD(fd); resultis ec ]
      ]
   ] repeatwhile NextFD(fd)

DestroyFD(fd)

// If there's a mail file, delete it
fd = LookupIFSFile(name, lcVHighest, lv ec, fs, "Mail>Box");
test fd
   ifnot unless ec eq ecDirNotFound % ec eq ecFileNotFound resultis ec;
   ifso [ ec = DeleteFileFromFD(fd); DestroyFD(fd); if ec ne 0 resultis ec ];

// Now delete the DIF
fd = LookupIFSFile("!1", lcVHighest, lv ec, fs, name) // "<name>!1"
if fd ne 0 then
   [
   ec = DeleteFileFromFD(fd, true)  // ignoreUndeletable
   DestroyFD(fd)
   InvalidateCachedDIF(name)
   ]
resultis ec
]