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