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