// 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 <directory> <subcommands>
// 4-argument form is called to collect subcommands for Create.
// Subcommands are:
// [No] Read|Write|Append|Create|Connect <group>|Owner|World|None
// Reset Default-File-Protection|Create-Protection|Connect-Protection
// [No] Printing-Server [ <hostName> ]
// Additionally, if enabled wheel:
// [No] Group-Membership|Group-Ownership <group>|None
// Reset Group-Membership|Group-Ownership
// Password <password>
// Disk-Limit <number>
// [Not] Files-Only [ <owner> ]
// [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 <Mail> 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)
]