// 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
]