// IfsTelnetProtect.bcpl -- Commands dealing with file protections
// Copyright Xerox Corporation 1979, 1981, 1982

// Last modified May 15, 1982  11:05 AM by Taft

get "IfsFiles.decl"
get "IfsDirs.decl"
get "IfsRS.decl"
get "CmdScan.decl"

external
[
// outgoing procedures
ExecChangeProtection; GetGroup; GetGroupMask

// incoming procedures
CollectFilenames; NextFile; DestroyFGD; WhatChanged; PrintSubFilename
TelnetCommandLoop; TelnetSubcommandPrompt; TelnetAborting
CreateKeywordIntegerMap; CreateKeywordTable; DestroyKeywordTable
InsertKeyword; EnableCatch; DisableCatch; EndCatch; KeywordHelp
GetPhrase; GetKeyword; GetNumber; TerminatingChar; SelectKeyword
ChangeFileAttributes; GetGroupName; ResetStrings; DestroyFD
Gets; Puts; Ws; Wss; Errors; Resets; Endofs; IFSPrintError; SetBit
DefaultArgs; SysAllocateZero; SysFree; FreePointer
Zero; SetBlock; MoveBlock; TruePredicate

// incoming statics
dsp; enableGrapevineGroup
]

structure ACT:  // Attribute Change Template
// Order of entries must match ACMap table constructed in PerformACD
[
fileProt @FileProt
type word
byteSize word
flags word = @ILDFlags
]
manifest lenACT = size ACT/16

structure ACD:  // Attribute Change Descriptor
[
mask @ACT	// mask of bits to change
value @ACT	// corresponding new values of the masked bits
]
manifest lenACD = size ACD/16

structure ACMap↑0,0: [ nWords bit 6; field bit 10 ]

//---------------------------------------------------------------------------
let ExecChangeProtection(cs) be
//---------------------------------------------------------------------------
// Change Protection <file-designators> <subcommands>
// Change Attributes <file-designators> <subcommands>
// Subcommands are:
// [No] Read|Write|Append <group>|Owner|World|None
// [No] Backup
// Type Text|Binary|Unspecified
// Byte-size <byteSize>
// Reset
[
// Collect names of files to be affected
Wss(cs, " (of files) ")
let fgd = CollectFilenames(cs)

let acd = vec lenACD
Zero(acd, lenACD)

// Accept subcommands specifying changes to make
let kt = CreateKeywordIntegerMap("Read", "Write", "Append", "Backup",
 "No", "Reset", "Type", "Byte-size")
ResetStrings()
TelnetCommandLoop(kt, TelnetSubcommandPrompt(), true, acd, 0, 0,
 ChangeProtSubcommand)
DestroyKeywordTable(kt)

// If no changes were specified, stop here.
let mask, value = lv acd>>ACD.mask, lv acd>>ACD.value
for i = 0 to lenACT do if mask!i ne 0 then
   [
   // Actually make the changes to all specified files
   let lastFD = SysAllocateZero(lenFD)

   until TelnetAborting() do
      [
      let fd = NextFile(fgd)
      if fd eq 0 break
      let ec = ChangeFileAttributes(fd, PerformACD, acd)
      if WhatChanged(fd, lastFD) eq 0 then
         [
         Puts(dsp, $*n)
         PrintSubFilename(dsp, fd, 1, fd>>FD.lenSubDirString)
         ]
      Ws("*n  ")
      PrintSubFilename(dsp, fd, fd>>FD.lenSubDirString+1)
      if ec ne 0 then [ Ws(" -- failed:*n   "); IFSPrintError(dsp, ec) ]
      ]

   DestroyFD(lastFD)
   break
   ]

DestroyFGD(fgd)
]

//---------------------------------------------------------------------------
and PerformACD(fd, ld, acd) = valof
//---------------------------------------------------------------------------
// Procedure passed to ChangeFileAttributes to do the actual work.
// Returns true iff any attributes actually changed.
[
// The following table defines the mapping from ACT to ILD.
// It must be maintained in parallel with the ACT structure.
let acMap = table
   [
   lenFileProt lshift 10 + offset ILD.fileProt/16
   1 lshift 10 + offset ILD.type/16
   1 lshift 10 + offset ILD.byteSize/16
   1 lshift 10 + offset ILD.flags/16
   ]
manifest lenACMap = 4

let mask, value = lv acd>>ACD.mask, lv acd>>ACD.value
let changed = false
for i = 0 to lenACMap-1 do
   [
   let field = ld + acMap>>ACMap↑i.field
   for j = 1 to acMap>>ACMap↑i.nWords do
      [
      let old = @field
      @field = (@field & not @mask) + (@value & @mask)
      if @field ne old then changed = true
      field = field+1; mask = mask+1; value = value+1
      ]
   ]
resultis changed
]

//---------------------------------------------------------------------------
and ChangeProtSubcommand(cs, entry, acd) be
//---------------------------------------------------------------------------
[
let noPrefix = false
let whichProt = nil
switchon entry!0 into
   [
   case 1:  // Read
      whichProt = offset FileProt.readProt/16
      endcase
   case 2:  // Write
      whichProt = offset FileProt.writeProt/16
      endcase
   case 3:  // Append
      whichProt = offset FileProt.appendProt/16
      endcase
   case 4:  // Backup
      acd>>ACD.value.noBackup = noPrefix
      acd>>ACD.mask.noBackup = true
      return
   case 5:  // No
      noPrefix = true
      docase SelectKeyword(cs, "Read", "Write", "Append", "Backup")
   case 6:  // Reset
      Wss(cs, " (all existing access)")
      SetBlock(lv acd>>ACD.mask.fileProt, -1, lenFileProt)
      return
   case 7:  // Type
      acd>>ACD.value.type = SelectKeyword(cs, "Unspecified",
       "Text", "Binary")-1
      acd>>ACD.mask.type = -1
      return
   case 8:  // Byte-size
      Puts(cs, $*s)
      acd>>ACD.value.byteSize = GetNumber(cs)
      acd>>ACD.mask.byteSize = -1
      return
   ]

// Here only for [No] Read|Write|Append
let mask = lv acd>>ACD.mask.fileProt + whichProt
let value = lv acd>>ACD.value.fileProt + whichProt
let protection = vec lenProtection; Zero(protection, lenProtection)
Wss(cs, " (access to groups) ")
if GetGroupMask(cs, protection, not noPrefix) then
   [ SetBlock(mask, -1, lenProtection); Zero(value, lenProtection) ]
for i = 0 to lenProtection-1 do
   [
   mask!i = mask!i % protection!i
   value!i = noPrefix? value!i & not protection!i, value!i % protection!i
   ]
]

//---------------------------------------------------------------------------
and GetGroupMask(cs, protection, permitNone) = valof
//---------------------------------------------------------------------------
// Gets a list of groups and sets corresponding bits in protection.
// If permitNone is true, an item of "None" is permitted.
// Returns true iff "None" was input.
[
let gotNone = false
let gotProt = false

   [ // repeat
   if cs>>CS.iPhOut eq cs>>CS.maxPhrases-1 then
      [
      Wss(cs, "[list is full]")
      unless GetPhrase(cs, TruePredicate, TruePredicate) eq 0 &
       TerminatingChar(cs) eq $*n do Errors(cs, 0)
      break
      ]

   let group = GetGroup(cs, true, permitNone, gotProt)
   switchon group into
      [
      case -1:  // "None"
         gotNone = true
         endcase

      case -2:  // empty phrase
         if TerminatingChar(cs) eq $*n then break
         Errors(cs, 0)

      default:
         SetBit(protection, group, true)
         endcase
      ]

   gotProt = true
   Puts(cs, $*s)
   ] repeatuntil TerminatingChar(cs) eq $*n

resultis gotNone
]

//----------------------------------------------------------------------------
and GetGroup(cs, permitOwnerWorld, permitNone, permitEmpty;
    numargs na) = valof
//----------------------------------------------------------------------------
// Returns a group number for a typed-in group name or number.
// If permitOwnerWorld is true, "Owner" and "World" are permitted and
// produce the appropriate group numbers.  If permitNone is true,
// "None" is also permitted and produces a result of -1.  If permitEmpty,
// an empty phrase is permitted and produces a result of -2.
[
DefaultArgs(lv na, -1, false, false, false)
let kt = nil
if EnableCatch(cs) then
   [ DestroyKeywordTable(kt); EndCatch(cs) ]
kt = CreateKeywordTable(size Protection+2)

for group = 0 to (permitOwnerWorld? size Protection-1, nGroups-1) do
   [
   let name = GetGroupName(group)
   if name ne 0 then
      [ InsertKeyword(kt, name)!0 = group; SysFree(name) ]
   ]

if permitNone then InsertKeyword(kt, "None")!0 = -1
if permitEmpty then InsertKeyword(kt, "")!0 = -2

// Input phrase and then examine it to decide whether to parse it as
// keyword or number.  Note: empty string must be treated as keyword,
// since it is valid in some contexts.
let allDigits = false
unless GetPhrase(cs, 0, 0, 0, KeywordHelp, kt) eq 0 do
   [
   allDigits = true
   until Endofs(cs) do
      if (Gets(cs)-$0) ugr 9 then [ allDigits = false; break ]
   ]
Resets(cs)
let group = nil
test allDigits
   ifso [ group = GetNumber(cs); if group uge nGroups then Errors(cs, 0) ]
   ifnot group = GetKeyword(cs, kt)!0

DestroyKeywordTable(kt)
DisableCatch(cs)
resultis group
]