// IFSDirDelRen.bcpl -- Delete, rename, and change attributes
// Copyright Xerox Corporation 1979, 1980, 1981, 1982, 1983
// Last modified September 25, 1983 1:38 PM by Taft
get "Ifs.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"
external
[
// Outgoing procedures
IFSDeleteFile; DeleteFileFromFD; IFSDeleteOldVersions
IFSRenameFile; RenameFileFromFD; ChangeFileAttributes
// Incoming procedures -- IFSDirs
LookupIFSFile; CreateDirectoryEntry; CreateFD; DestroyFD; NextFD
LookupFD; LockTransferLeaderPage; TransferLeaderPage
GetDIFRec; UpdateDIFRec; DIFRecFromDR
GetDiskFromFD; GetBufferForFD
UpdatePageUsage; UserOwns; CheckAccess; CheckAllocation
LockFile; UnlockFile; LockDirFD; UnlockDirFD; ModifyDirFD; NamesMatch
// Incoming procedures -- B-Tree
DeleteKey
// Incoming procedures -- rest of IFS
FreePointer; CopyString; ExtractSubstring; IFSError; ByteBlt
// Incoming procedures -- operating system
DefaultArgs; MoveBlock; Zero; SysFree; Noop
CallersFrame; ReturnFrom; DeleteDiskPages
// Incoming statics
primaryIFS
]
//---------------------------------------------------------------------------
let IFSDeleteFile(name, lvErrorCode, lc, fs, dirName, ignoreUndeletable;
numargs na) = valof
//---------------------------------------------------------------------------
// Deletes a file. Arguments same as for IFSOpenFile except that
// lc defaults to lcVLowest. A DIF may be deleted by this means,
// but one should be careful first to delete all other files
// belonging to the same directory. Returns true iff successful.
// Returns an error code in @lvErrorCode if unsuccessful.
// Note: caller should not lock the directory, and the directory
// is unlocked upon return.
[
DefaultArgs(lv na, -1, lv na, lcVLowest, 0, 0, false)
let fd = LookupIFSFile(name, lc, lvErrorCode, fs, dirName)
if fd ne 0 then
[ @lvErrorCode = DeleteFileFromFD(fd, ignoreUndeletable); DestroyFD(fd) ]
resultis @lvErrorCode eq 0
]
//---------------------------------------------------------------------------
and IFSDeleteOldVersions(name, lvErrorCode, fs, dirName, ignoreUndeletable;
numargs na) = valof
//---------------------------------------------------------------------------
// Deletes all but the highest-numbered version of all files designated
// by name, which may include "*"s (but must not have an explicit version).
// Returns true normally and false if no file by that name exists or
// any of the delete operations fails; an error code for the last such
// failure is stored in @lvErrorCode.
[
DefaultArgs(lv na, -1, lv na, 0, 0, false)
let fd = LookupIFSFile(name, lcVHighest+lcMultiple, lvErrorCode, fs, dirName)
if fd eq 0 resultis false
[ // repeat
// fd ranges over the highest-numbered versions of all filenames
name = ExtractSubstring(lv fd>>FD.dr>>DR.pathName, 1,
fd>>FD.lenBodyString-1) // current name, without version number
let lfd = LookupIFSFile(name, lcVAll+lcMultiple, lvErrorCode, fs, dirName)
SysFree(name)
if lfd ne 0 then
[ // lfd ranges over all versions of the name designated by fd
while lfd>>FD.version uls fd>>FD.version do
[
@lvErrorCode = DeleteFileFromFD(lfd, ignoreUndeletable)
unless NextFD(lfd) break
]
DestroyFD(lfd)
]
] repeatwhile NextFD(fd)
DestroyFD(fd)
resultis @lvErrorCode eq 0
]
//---------------------------------------------------------------------------
and DeleteFileFromFD(fd, ignoreUndeletable, fileLocked; numargs na) = valof
//---------------------------------------------------------------------------
// Deletes a file given its fd. Returns zero if successful and
// an error code if unsuccessful.
// Note: caller should not lock the directory, and the directory
// is unlocked upon return.
// If ignoreUndeletable then ignore the undeletable attribute of the file.
// if fileLocked then the caller asserts that the file is already
// write-locked by the current context; in this case, the file is unlocked
// as it is deleted, but remains locked if the delete fails. (This option
// also bypasses the normal check for write access.)
[
DefaultArgs(lv na, -1, false, false)
let buffer = GetBufferForFD(fd)
// Check access and write-lock the file
let ec = valof
[
let ec = LockTransferLeaderPage(fd, buffer)
if ec ne 0 resultis ec
unless fileLocked do
unless CheckAccess(lv buffer>>ILD.writeProt, UserOwns(fd)) do
resultis ecAccessDenied
unless ignoreUndeletable do
if buffer>>ILD.undeletable resultis ecFileUndeletable
let ec = LookupFD(fd, lockWrite, true) // requireExists
if ec eq 0 then
unless fileLocked % LockFile(fd, modeWrite) do ec = ecFileBusy
if ec ne 0 then UnlockDirFD(fd)
resultis ec
]
// Directory is write-locked if that was successful, unlocked otherwise.
let hintLastPage = buffer>>ILD.hintLastPageFa.pageNumber
SysFree(buffer)
if ec ne 0 resultis ec
// Delete the directory entry
ModifyDirFD(fd)
DeleteDirectoryEntry(fd)
// Now that the file is no longer accessible, we don't
// need to keep anything locked. We must unlock the directory
// since actually deleting the file can take arbitrarily long.
// We must unlock the file before freeing its pages because someone else
// might immediately re-use the former leader page for a new file and
// cause a collision in the OFT.
UnlockDirFD(fd)
UnlockFile(fd)
// Update page count in DIF entry
unless fd>>FD.dr>>DR.type eq drTypeDIF do
UpdateDIFRec(fd, UpdatePageUsage, -(hintLastPage+1))
// Delete the file
buffer = GetBufferForFD(fd)
DeleteDiskPages(GetDiskFromFD(fd), buffer, fd>>FD.dr>>DR.fp.page,
lv fd>>FD.dr>>DR.fp, 0, 0, hintLastPage)
SysFree(buffer)
resultis 0
]
//---------------------------------------------------------------------------
and IFSRenameFile(oldName, newName, lvErrorCode,
lc, fs, oldDirName, newDirName; numargs na) = valof
//---------------------------------------------------------------------------
// Renames the file oldName to be newName. Returns true iff
// successful. Returns an error code in @lvErrorCode if
// unsuccessful. The lc parameter applies to oldName only.
// Note: caller should not lock the directory, and the directory
// is unlocked upon return.
[
DefaultArgs(lv na, -2, lv na, lcVHighest, primaryIFS, 0, 0)
let fd = LookupIFSFile(oldName, lc, lvErrorCode, fs, oldDirName)
if fd ne 0 then
[
@lvErrorCode = RenameFileFromFD(fd, newName, newDirName)
DestroyFD(fd)
]
resultis @lvErrorCode eq 0
]
//---------------------------------------------------------------------------
and RenameFileFromFD(ofd, newName, newDirName, leaderProc, arg; numargs na) = valof
//---------------------------------------------------------------------------
// Renames the file designated by ofd to be newName.
// Returns zero if successful and an error code if unsuccessful.
// ofd is untouched and still refers to the file under its old name.
// If leaderProc is supplied, calls leaderProc(ild, arg), where ild is
// a pointer to a buffer containing the leader page of the file being renamed.
// Note: caller should not lock the directory, and the directory
// is unlocked upon return.
[
DefaultArgs(lv na, -2, 0, Noop, nil)
manifest dirLocked = 100000B // state flags added to error codes
manifest fileLocked = 40000B
let buffer = GetBufferForFD(ofd)
let nfd, difFD = 0, 0
let ec = valof
[
// Look up the old file and lock it. We must have write access,
// and the file must not be busy.
let ec = LockTransferLeaderPage(ofd, buffer)
if ec ne 0 resultis ec
unless CheckAccess(lv buffer>>ILD.writeProt, UserOwns(ofd)) do
resultis ecAccessDenied
let fs = ofd>>FD.fs
if ofd>>FD.dr>>DR.type eq drTypeDIF resultis ecIllegalDIFAccess
ec = LookupFD(ofd, lockRead, true) // requireExists
if ec ne 0 resultis dirLocked+ec
unless LockFile(ofd, modeWrite) resultis dirLocked+ecFileBusy
UnlockDirFD(ofd)
// Now consider the new filename.
nfd = LookupIFSFile(newName, lcCreate+lcVNext, lv ec, fs, newDirName)
if ec ne 0 resultis fileLocked+ec
if nfd>>FD.dr>>DR.type eq drTypeDIF resultis fileLocked+ecIllegalDIFAccess
let match = NamesMatch(ofd, nfd>>FD.dr)
// RenameFileFromFD (cont'd)
// We must have create access to the new directory, and it must
// not be over allocation.
difFD = GetDIFRec(nfd)
if difFD eq 0 resultis fileLocked+ecDirNotFound
let difRec = DIFRecFromDR(difFD>>FD.dr)
if match eq 0 then
[ // renaming into a different directory
unless CheckAccess(lv difRec>>DIFRec.createProt, UserOwns(nfd)) do
resultis fileLocked+ecAccessDenied
unless CheckAllocation(difRec) do
resultis fileLocked+ecAllocExceeded
]
// Lookup the new file -- it must not already exist
ec = LookupFD(nfd, lockWrite)
if ec ne 0 resultis dirLocked+fileLocked+ec
if nfd>>FD.lookupStatus eq lsExists then
[
unless match eq 3 do resultis dirLocked+fileLocked+ecFileAlreadyExists
// Rename to self is ok, to change capitalization. Unfortunately,
// LookupFD has replaced the supplied name with the one from the
// existing directory entry, so we have to restore the desired
// capitalization by re-parsing the supplied name and copying the result.
let tempFD = CreateFD(newName, lcCreate+lcVNext, 0, fs, newDirName)
ByteBlt(lv nfd>>FD.dr>>DR.pathName, 1, lv tempFD>>FD.dr>>DR.pathName, 1,
nfd>>FD.lenBodyString)
DestroyFD(tempFD)
]
// Ensure consistent capitalization of directory name
ByteBlt(lv nfd>>FD.dr>>DR.pathName, 1, lv difFD>>FD.dr>>DR.pathName, 1,
nfd>>FD.lenDirString)
// Put the new name in the leader page and update it.
// Zero backup date so file will be re-dumped under new name.
CopyString(lv buffer>>ILD.pathName, lv nfd>>FD.dr>>DR.pathName)
Zero(lv buffer>>ILD.backedUp, 2)
leaderProc(buffer, arg) // give client a chance to change the leader page
TransferLeaderPage(ofd, buffer, true)
let pages = buffer>>ILD.hintLastPageFa.pageNumber+1
FreePointer(lv buffer)
// Delete the old directory entry and insert the new one
MoveBlock(lv nfd>>FD.dr>>DR.fp, lv ofd>>FD.dr>>DR.fp, lFP) // copy fp
DeleteDirectoryEntry(ofd)
CreateDirectoryEntry(nfd)
UnlockDirFD(nfd)
// If changed directory name, update page utilizations
if match eq 0 then
[
UpdateDIFRec(ofd, UpdatePageUsage, -pages)
UpdateDIFRec(nfd, UpdatePageUsage, pages)
]
resultis fileLocked
]
// All done, clean up and return
if (ec&dirLocked) ne 0 then UnlockDirFD(ofd)
if (ec&fileLocked) ne 0 then UnlockFile(ofd)
if nfd ne 0 then DestroyFD(nfd)
if difFD ne 0 then DestroyFD(difFD)
FreePointer(lv buffer)
resultis ec & not (dirLocked+fileLocked)
]
//---------------------------------------------------------------------------
and ChangeFileAttributes(fd, Proc, arg) = valof
//---------------------------------------------------------------------------
// Facilitates changing attributes of the file designated by fd.
// First, checks access to file: caller must have owner access to
// the directory or write access to the file.
// Then reads file leader page and calls Proc(fd, ld, arg), where ld
// is a pointer to a buffer containing the leader page.
// If Proc returns true, the leader page is rewritten.
// Returns zero if successful and an error code if unsuccessful.
// Note: caller should not lock the directory, and the directory is
// unlocked upon return. The directory is read-locked when Proc is called.
[
let buf = GetBufferForFD(fd)
let res = valof
[
let ec = LockTransferLeaderPage(fd, buf)
if ec ne 0 resultis ec
if fd>>FD.dr>>DR.type eq drTypeDIF resultis ecIllegalDIFAccess
unless UserOwns(fd) % CheckAccess(lv buf>>ILD.writeProt, false) do
resultis ecAccessDenied
ec = LookupFD(fd, lockRead, true) // requireExists
if ec eq 0 then
if Proc(fd, buf, arg) then
[
Zero(lv buf>>ILD.backedUp, 2) // force new backup
TransferLeaderPage(fd, buf, true)
]
UnlockDirFD(fd)
resultis ec
]
SysFree(buf)
resultis res
]
//---------------------------------------------------------------------------
and DeleteDirectoryEntry(fd) be
//---------------------------------------------------------------------------
[
unless DeleteKey(fd>>FD.fs>>IFS.dirBTree, fd, 0, fd>>FD.pathStk, true) do
IFSError(ecCantDeleteDirEntry)
fd>>FD.lookupStatus = lsNonexistent
]