// IfsTelnetDel.bcpl -- IFS server telnet Delete and Rename commands // Copyright Xerox Corporation 1979, 1980, 1981, 1983 // Last modified September 25, 1983 2:00 PM by Taft get "Ifs.decl" get "IfsFiles.decl" get "IfsDirs.decl" get "IfsRs.decl" external [ // outgoing procedures ExecDelete; ExecRename // incoming procedures CollectFilenames; NextFile; DestroyFGD; Subcommands; SetFGDLC WhatChanged; CopyFD; PrintSubFilename InitCmd; Confirm; GetNumber; GetString; EnableCatch; EndCatch; TerminatingChar CreateKeywordTable; InsertKeyword; DestroyKeywordTable TelnetCommandLoop; TelnetSubcommandPrompt; TelnetAborting; TelnetConfirm LookupFD; NextFD; DestroyFD; DeleteFileFromFD LookupIFSFile; IFSRenameFile StringCompare; ExtractSubstring; ConcatenateStrings SysAllocateZero; FreePointer; IFSPrintError; Block; Dismiss Ws; Wss; Puts; Errors; Closes; Resets SysFree; Zero; MoveBlock // incoming statics dsp; keys; CtxRunning ] structure Options: [ autoConfirm word //automatically confirm each deletion keep word //number of versions to keep // -1 => delete one version only (usually lowest) ] manifest lenOptions = size Options/16 //--------------------------------------------------------------------------- let ExecDelete(cs) be //--------------------------------------------------------------------------- // Delete [, ] [ Wss(cs, " (files) ") let fgd = CollectFilenames(cs, lcVLowest+lcMultiple) let options = vec lenOptions Zero(options, lenOptions) options>>Options.keep = -1 if Subcommands(fgd) then [ let kt = CreateKeywordTable(5) InsertKeyword(kt, "Confirm")!0 = 1 InsertKeyword(kt, "Keep")!0 = 2 TelnetCommandLoop(kt, TelnetSubcommandPrompt(), true, options, 0, 0, DeleteSubcommand) DestroyKeywordTable(kt) ] if options>>Options.keep ne -1 then SetFGDLC(fgd, lcVAll+lcMultiple) // change default version to "*" let lastFD, bfd = SysAllocateZero(lenFD), SysAllocateZero(lenFD) let numVer = 0 until TelnetAborting() do [ let fd = NextFile(fgd) if fd eq 0 break test options>>Options.keep le 0 ifso DeleteOneFile(fd, lastFD, options) ifnot [ if StringCompare(lv fd>>FD.dr>>DR.pathName, lv bfd>>FD.dr>>DR.pathName, 1, fd>>FD.lenBodyString, 1, bfd>>FD.lenBodyString) ne 0 then [ CopyFD(bfd, fd); numVer = 0 ] numVer = numVer+1 if numVer gr options>>Options.keep then [ if LookupFD(bfd) eq 0 then DeleteOneFile(bfd, lastFD, options) bfd>>FD.template = fd>>FD.template // so NextFD will work NextFD(bfd) fd>>FD.template = bfd>>FD.template // just in case NextFD deleted it bfd>>FD.template = 0 ] ] Block() ] DestroyFD(lastFD); DestroyFD(bfd) DestroyFGD(fgd) ] //--------------------------------------------------------------------------- and DeleteOneFile(fd, lastFD, options) be //--------------------------------------------------------------------------- // Assumes directory is not locked [ if WhatChanged(fd, lastFD) eq 0 then [ Puts(dsp, $*n); PrintSubFilename(dsp, fd, 1, fd>>FD.lenSubDirString) ] let cs = options>>Options.autoConfirm? dsp, InitCmd(150, 1) if cs eq 0 return Wss(cs, "*n ") PrintSubFilename(cs, fd, fd>>FD.lenSubDirString+1) unless options>>Options.autoConfirm do [ let ok = Confirm(cs) Closes(cs) unless ok return ] let deleteUndeletable = false [ // repeat let ec = DeleteFileFromFD(fd, deleteUndeletable) if ec ne 0 then [ Ws(" -- not deleted:*n "); IFSPrintError(dsp, ec) ] unless ec eq ecFileUndeletable & CtxRunning>>RSCtx.userInfo>>UserInfo.capabilities.wheel return Ws("*n But because you are enabled, you may delete it anyway.") Ws("*n Are you really sure you want to do this?") Dismiss(50) // 0.5 second Resets(keys) unless TelnetConfirm() return deleteUndeletable = true ] repeat ] //--------------------------------------------------------------------------- and DeleteSubcommand(cs, entry, options) be //--------------------------------------------------------------------------- [ switchon entry!0 into [ case 1: Wss(cs, " (all deletes automatically)") options>>Options.autoConfirm = true endcase case 2: Wss(cs, " (# of versions) ") options>>Options.keep = GetNumber(cs) endcase ] ] //--------------------------------------------------------------------------- and ExecRename(cs) be //--------------------------------------------------------------------------- // Rename [ Wss(cs, " (existing file) ") let oldName, oldNameBody, newName = 0, 0, 0 if EnableCatch(cs) then [ FreePointer(lv oldName, lv oldNameBody, lv newName); EndCatch(cs) ] oldName = GetString(cs, 0, Wss, "filename") let fd = LookupIFSFile(oldName, lcVHighest) if fd eq 0 then Errors(cs, 0) oldNameBody = ExtractSubstring(lv fd>>FD.dr>>DR.pathName, fd>>FD.lenSubDirString+1, fd>>FD.lenBodyString-1) DestroyFD(fd) Wss(cs, " (to be) ") newName = GetString(cs, 0, Wss, "filename") if TerminatingChar(cs) eq 33B then // ESC -- append body of old name [ Ws(oldNameBody) newName = ConcatenateStrings(newName, oldNameBody, true) ] let ec = nil unless IFSRenameFile(oldName, newName, lv ec) do [ Ws("*nFailed: "); IFSPrintError(dsp, ec) ] FreePointer(lv oldName, lv oldNameBody, lv newName) ]