// IfsTelnetChangeDir1.bcpl -- Change Directory-Parameters command // Copyright Xerox Corporation 1979, 1980, 1981 // Last modified November 25, 1981 2:55 PM by Taft get "Ifs.decl" get "IfsFiles.decl" get "IfsDirs.decl" get "IfsRS.decl" get "CmdScan.decl" external [ // outgoing procedures ExecChangeDirectory // incoming procedures ChangeDirSubcommand GetString EnableCatch; EndCatch; TerminatingChar; DefaultPhrase; Confirm CreateKeywordTable; DestroyKeywordTable; InsertKeyword; DefaultTemplate TelnetCommandLoop; TelnetSubcommandPrompt; TelnetAborting ReadDIF; WriteDIF; WheelCall; Password LookupIFSFile; GetBufferForFD; LockTransferLeaderPage DeleteFileFromFD; DestroyFD; OpenIFSStream; CloseIFSStream SysFree; FreePointer; Zero; SetBlock; MoveBlock Ws; Wss; Puts; Errors; IFSPrintError // incoming statics dsp; CtxRunning ] manifest ecMailboxNotEmpty = 301 //--------------------------------------------------------------------------- let ExecChangeDirectory(cs, name, dif, new; numargs na) be //--------------------------------------------------------------------------- // Change Directory-Parameters // 4-argument form is called to collect subcommands for Create. // Subcommands are: // [No] Read|Write|Append|Create|Connect |Owner|World|None // Reset Default-File-Protection|Create-Protection|Connect-Protection // [No] Printing-Server [ ] // Additionally, if enabled wheel: // [No] Group-Membership|Group-Ownership |None // Reset Group-Membership|Group-Ownership // Password // Disk-Limit // [Not] Files-Only [ ] // [Not] Wheel|Mail [ let calledFromCreate = na eq 4 unless calledFromCreate do [ Wss(cs, " (of directory) ") name = 0; dif = 0 if EnableCatch(cs) then [ FreePointer(lv name, lv dif); EndCatch(cs) ] DefaultPhrase(cs, CtxRunning>>RSCtx.userInfo>>UserInfo.connName) name = GetString(cs, 0, Wss, "directory name") // ReadDIF will fail if the user doesn't own the DIF because // DIFs are read-protected against all but the owner. Therefore, // no additional access check is required. dif = ReadDIF(name) if dif eq 0 then Errors(cs, 0) new = false ] // Collect subcommands for changing directory parameters let kt = CreateKeywordTable(15) InsertKeyword(kt, "Read")!0 = 1 InsertKeyword(kt, "Write")!0 = 2 InsertKeyword(kt, "Append")!0 = 3 InsertKeyword(kt, "Create")!0 = 4 InsertKeyword(kt, "Connect")!0 = 5 InsertKeyword(kt, "No")!0 = 6 InsertKeyword(kt, "Reset")!0 = 7 InsertKeyword(kt, "Printing-Server")!0 = 8 if CtxRunning>>RSCtx.userInfo>>UserInfo.capabilities.wheel then [ InsertKeyword(kt, "Not")!0 = 9 InsertKeyword(kt, "Group")!0 = 10 InsertKeyword(kt, "Password")!0 = 11 InsertKeyword(kt, "Disk-Limit")!0 = 12 InsertKeyword(kt, "Files-Only")!0 = 13 InsertKeyword(kt, "Wheel")!0 = 14 InsertKeyword(kt, "Mail")!0 = 15 ] TelnetCommandLoop(kt, TelnetSubcommandPrompt(), true, lv name, 0, 0, ChangeDirSubcommand) DestroyKeywordTable(kt) // ExecChangeDirectory (cont'd) if Confirm(cs) then [ // Update the DIF let ec = WheelCall(WriteDIF, name, dif) if ec eq 0 & CtxRunning>>RSCtx.userInfo>>UserInfo.capabilities.wheel then [ // Create or destroy mailbox in conformance with mail capability let fd = LookupIFSFile(name, lcVHighest+lcCreate, lv ec, 0, "Mail>Box"); if ec eq ecDirNotFound then [ // Ignore this error if not trying to create a mailbox if dif>>DIF.capabilities.mail then Ws("*nCan't create mailbox: no directory.") ec = 0 ] if fd ne 0 then [ switchon (fd>>FD.lookupStatus eq lsExists) lshift 1 + dif>>DIF.capabilities.mail into [ case true*2+0: [ let buf = GetBufferForFD(fd) LockTransferLeaderPage(fd, buf) let empty = buf>>ILD.hintLastPageFa.pageNumber le 1 & buf>>ILD.hintLastPageFa.charPos eq 0 SysFree(buf) ec = empty? DeleteFileFromFD(fd), ecMailboxNotEmpty endcase; ] case false*2+1: [ let str = OpenIFSStream(fd, lv ec, modeWrite); if str ne 0 then CloseIFSStream(str); endcase; ] ] DestroyFD(fd); ] ] if ec ne 0 then [ Puts(dsp, $*n); IFSPrintError(dsp, ec) ] ] unless calledFromCreate do FreePointer(lv name, lv dif) ]