option "-nons"{-nocheck-nodiag}
include "inc:fs.imp"
include "managr:admin.inc"
begin ; ! Revamped ADMIN program - RWT February 1990
record (entry fm)name database==nil,dirlist==nil
integer today=0,needtoupdate=0,sortingorder=0,sizesknown=0
routine note change
! Set a flag to indicate that database writeback is required.
! Open file at this point already to act as interlock to avoid
! problem of multiple administrators.
on 3 start
selectoutput(0); printline(event_message)
printline("Cannot update database")
stop
finish
returnunless needtoupdate=0
openoutput(2,adminfile)
selectoutput(0)
needtoupdate = 1
end
routine update database
if needtoupdate=0 start
printline("No changes made to database")
else
selectoutput(2)
write admin file(database)
closeoutput
selectoutput(0)
needtoupdate = 0
finish
end
record (entryfm)map locate record(string (*)name id,record (entryfm)name l)
! Find first/next record in database which matches ID.
! Call with L==NIL for first, with L==(previous result) for next.
! I.e. with L==NIL start search at DATABASE, otherwise start at L_NEXT.
if l==nil then l == database else l == l_next
cycle
result == l if l==nil or matches(l_id,id)
l == l_next
repeat
end
routine addhex(integer n,string (*)name s)
! (for FCOMM) append 'HD'hex number to end of S
addhex(n>>4,s) if n>>4#0
s = s.tostring(n&15+'0')
end
routine accredit(string (*)name owner,integer partition,quota)
! Create directory OWNER in the specified partition with given quota.
string (255)s
integer x
on 3 start
printline(event_message); return
finish
s = tostring(partition+'0').owner
s = s.","; addhex(quota,s); x = fcomm('['<<8,s)
end
routine permit(string (*)name file,perms)
string (255)s
integer x
on 3 start
printline(event_message); return
finish
s = file.",".perms; x = fcomm('E'<<8,s)
end
routine delete(string (*)name file)
ownstring (3)frv="frv"
integer x,attempt=1
on 3 start
unless attempt=1 start
printline(event_message); return
finish
attempt = 2; permit(file,frv)
finish
x = fcomm('D'<<8,file)
end
routine rename(string (*)name old,new)
string (255)s
integer x
on 3 start
printline(event_message); return
finish
s = old.",".new
x = fcomm('B'<<8,s)
end
predicate directory exists(string (*)name d)
! If we have already read in the directory list, we simply scan that,
! otherwise we ask the filestore specifically.
record (entry fm)name r
string (255)s
on 3 start
false
finish
r == dirlist
s = finfo(d,0) andtrueif r==nil
cycle
falseif r==nil
trueif r_id=d
r == r_next
repeat
end
routine read directory list
! Read the owner register, creating a sorted list of records with
! the ID and PARTITION fields filled in, the other fields are zapped.
string (7)array dir(1:64) {64 directories per semipartition}
string (255)s
record (entry fm)name pred,this,item
integer p,i,n=0
routine shoogle(string (*)name s)
! Initially S contains a control-terminated name, similar to a C string,
! but terminated by space or newline instead of null. We convert this
! to a normal Imp string, i.e. length-prefixed.
! Search until terminator is found, then shuffle all characters along
! one to make space for the length byte.
! By choosing '0' instead of space as control threshold, we eliminate the
! dummy names "---" and "*bad*", returning null strings for these.
bytename l,k
integer len=0
l == length(s); k == l
k == k[1] and len = len+1 while k>='0'
while k##l cycle
k = k[-1]; k == k[-1]
repeat
k = len
end
on 3 start {in case fewer than 16 semipartitions}
write(n,0); printline(" directories")
return
finish
returnunless dirlist==nil
printstring("Reading register - ")
for p = 0,1,15 cycle
s = tostring(p+'0')
i = fcommr('¬'<<8,s,length(dir(1)),512)
for i = 1,1,64 cycle
shoogle(dir(i))
unless dir(i)="" start
item == new(item); item = 0
item_id = dir(i); toupper(item_id)
item_partition = p>>1
pred == nil; this == dirlist
cycle
if this==nil or this_id>item_id start
item_next == this
if pred==nil then dirlist == item else pred_next == item
exit
finish
pred == this; this == this_next
repeat
n = n+1
finish
repeat
repeat
signal 3 {to report}
end
routine read database
record (entry fm)name e
integer n=0
printstring("Reading database - ")
openinput(2,adminfile); selectinput(2)
database == read admin file
closeinput; selectinput(1)
e == database
e == e_next and n = n+1 while e##nil
write(n,0); printline(" entries")
e == database
unless e==nil start
while e_next##nil cycle
if e_next_id<=e_id start
printline("Warning: Database is not sorted")
exit
finish
e == e_next
repeat
finish
end
routine merge { dirlist into database }
record (entryfm)name l,r,pred==nil,this
read directory list
l == database; r == dirlist
cycle
if l==nil start {end of database}
exitif r==nil {end of both lists reached}
pd: this == new(this); this = r; r == r_next
printstring("No database entry for directory "); printline(this_id)
elseif r==nil {end of directory list}
fd: this == l; l == l_next
printstring("No directory for database entry "); printline(this_id)
elseif r_id=l_id
l_partition = r_partition
l_age = r_age; l_blocks = r_blocks; l_files = r_files
this == l; l == l_next; r == r_next
elseif r_id<l_id
->pd
else
->fd
finish
this_next == nil
if pred==nil then database == this else pred_next == this
pred == this
repeat
end
routine get full info
record (entryfm)name r
integer n=0
returnunless sizesknown=0; sizesknown=1
printline("Reading file statistics")
read directory list
r == dirlist
while r##nil cycle
n = n+1; write(n,0); printsymbol(13)
getsizes(r); getage(r)
r == r_next
repeat
newline
merge
end
integer partitionno=-1,groupno=-1, flagword=0, quotasize=1990
string (255)line,rest,id,pre,sur,permissionsparm = "FNA"
routine amend
record (entry fm)name r
if line -> id.(" ").rest and rest -> pre.(" ").sur -
and id#"" and pre#"" and sur#"" start
toupper(id)
pre = pre." ".rest while sur -> rest.(" ").sur
printline("No wildcards please") andreturnif wildness(id)#0
r == locate record(id,nil)
printline(id." not in database") andreturnif r==nil
r_sur == heapstring(sur); r_pre == heapstring(pre)
note change
return
finish
printline("The AMEND command changes the pre- and surnames in the database")
printline("associated with a particular ID.")
printline("Parameters: ID PRENAMES SURNAME")
printline("For non-person directories, the prenames should explain what")
printline("the directory is, and the notional surname should be the ID")
printline("(not name) of the person responsible for the directory.")
end
routine by
integer k
unless line="" start
k = charno(line,1)!32; k = 0 unless 'a'<=k<='z'
if 1<<(k-'a')&2_00000000001000000000000000#0 then merge
if 1<<(k-'a')&2_00000000000000000000000011#0 then get full info
! P N I G BA
if 1<<(k-'a')&2_00000000001010000101000011#0 -
then sorting order = k andreturn
finish
printline("The BY command determines the order in which entries are printed")
printline("by the LIST and SHOW commands. Output is always sorted by ID,")
printline("but may first be sorted either by NAME, GROUP, PARTITION, AGE,")
printline("or BLOCKS. The parameter is the first letter of one of these.")
end
routine create
record (entry fm)name r,t,p
today = packdate(date) if today=0
if line -> id.(" ").rest and rest -> pre.(" ").sur -
and id#"" and pre#"" and sur#"" start
toupper(id)
pre = pre." ".rest while sur -> rest.(" ").sur
id = "*" and printline("Please select a GROUP") if groupno<0
id = "*" and printline("Please select a PARTITION") if partitionno<0
! id = "*" %and printline("Please select a set of FLAGS") %if flagword=0
printline("No wildcards please") andreturnif wildness(id)#0
if directory exists(id) start
printline("Directory already exists")
else
accredit(id,partitionno&7,quotasize)
id = id.":"; permit(id,permissionsparm)
length(id) = length(id)-1
finish
if locate record(id,nil)==nil start
r == new(r); r = 0
r_id = id; r_group = groupno; r_flags = flagword
r_partition = partitionno; r_created = today
r_sur == heapstring(sur); r_pre == heapstring(pre)
p == nil; t == database
cycle
if t==nil or t_id>r_id start
r_next == t
if p==nil then database == r else p_next == r
exit
finish
p == t; t == t_next
repeat
note change
else
printline("Entry already exists in database")
finish
return
finish
printline("The CREATE command adds a new directory to the disk and makes a")
printline("new entry in the database. Before using the CREATE command you")
printline("must have used the GROUP, FLAGS, and PARTITION commands to supply")
printline("database information, and to specify where on disk the directory")
printline("is to be put. You may also have used the QUOTA and PERMISSIONS")
printline("commands to alter the default values (1990 blocks and FNA).")
printline("Parameters: ID PRENAMES SURNAME")
printline("In the case of non-person directories, the prenames should explain")
printline("what the directory is, and the notional surname should be the ID")
printline("(not name) of the person responsible for the directory.")
end
routine deletedir
record (entry fm)name r,t,p
unless line="" start
id = line; toupper(id)
printline("No wildcards please") andreturnif wildness(id)#0
r == locate record(id,nil)
if directoryexists(id) start
id = id.":"; delete(id)
else
printline("Directory does not exist")
finish
printline("No entry in database") andreturnif r==nil
p == nil; t == database
while t##r cycle
p == t; t == t_next
repeat
if p==nil then database == t_next else p_next == t_next
note change
return
finish
printline("The DELETE command removes a directory from disk and an entry")
printline("from the database.")
printline("Parameter: ID")
end
routine file
on 3 start
selectoutput(0)
printline(event_message)
return
finish
unless line="" start
selectoutput(1); closeoutput
openoutput(1,line); selectoutput(0)
return
finish
printline("The FILE command may be used to direct output from the LIST")
printline("and SHOW commands to a file instead of the terminal.")
printline("Parameter: FILENAME")
end
routine find
record (entry fm)name r
unless line="" start
id = line; toupper(id)
r == locate record(id,nil)
cycle
if r==nil start
printline("No entry in database")
r == new(r); r = 0; r_id = id
else
printstring(r_id)
space; printstring(group(r_group)); printstring(flags(r_flags))
printstring(" created "); printstring(unpackdate(r_created))
space; printstring(r_pre); space; printline(r_sur)
finish
if directory exists(r_id) start
if sizesknown=0 start
getsizes(r); getage(r) unless r_files=0
finish
write(r_blocks,0); printstring(" blocks in ")
write(r_files,0); printstring(" files")
unless r_partition<0 start
printstring(" in partition "); write(r_partition,0)
finish
unless r_age=0 start
printstring(", last written "); printstring(unpackdate(r_age))
finish
newline
else
printline("Directory does not exist")
finish
r == locate record(id,r)
newline
repeatuntil r==nil
return
finish
printline("The FIND command is used to locate a specific disk directory")
printline("and/or database entry. Details are printed on the terminal.")
printline("Parameter: ID")
end
routine chooseflags
string (255)f
integer n,m
unless line="" start
flagword = 0; m = 0; rest = line.","
while rest -> f.(",").rest cycle
continueif f=""
n = findflag(f)
if n=0 and wildness(f)=0 start
n = addflag(f)
printline(f." is a new category")
printline("Too many flag categories") andreturnif n&16_ffff=0
else
printline("Flag ".f." not known") andreturnif n=0
finish
m = m!n
repeat
flagword = m
if flagword=0 start
printline("Any combination")
elseif wildness(line)#0
line = flags(m)
returnunless line -> ("+").line
line = line.", ".rest while line -> line.("+").rest
printline("Flags: ".line)
finish
return
finish
printline("The FLAGS command defines the set of flags to be used for")
printline("subsequent CREATE commands, or restricts searches by the")
printline("LIST and SHOW commands. It may be wild.")
printline("Parameter(s): FLAG-VALUES separated by commas")
end
routine choosegroup
integer n
unless line="" start
groupno = -1
n = findgroup(line)
if n=0 and wildness(line)=0 start
n = addgroup(line)
printline(line." is a new group")
printline("Too many groups") andreturnif n>255
else
printline("Group ".line." not known") andreturnif n=0
printline("Group ".group(n)) if wildness(line)#0
finish
groupno = n
return
finish
printline("The GROUP command defines the group to be used in subsequent")
printline("CREATE commands, or restricts searches by the LIST, SHOW,")
printline("and REFLAG commands. It may be wild.")
printline("Parameter: GROUPNAME")
end
record (entry fm)map next(record (entry fm)name r)
ownrecord (entry fm)name min,max,prev
integer dif
routine compare(string (255)s,t)
toupper(s); toupper(t); dif = 0
dif = 1 if s>t
dif = -1 if s<t
end
if r==nil start
r == database; min == r; max == r
while r##nil cycle
if sortingorder='p' start
min == r if r_partition<min_partition
max == r if r_partition>=max_partition
elseif sortingorder='n'
compare(r_sur,min_sur)
compare(r_pre,min_pre) if dif=0
min == r if dif<0
compare(r_sur,max_sur)
compare(r_pre,max_pre) if dif=0
max == r if dif>=0
elseif sortingorder='b'
min == r if r_blocks<min_blocks
max == r if r_blocks>=max_blocks
elseif sortingorder='a'
min == r if r_age<min_age
max == r if r_age>=max_age
elseif sortingorder='g'
min == r if group(r_group)<group(min_group)
max == r if group(r_group)>=group(max_group)
else
max == r
finish
r == r_next
repeat
result == min
finish
result == nil if r==max
prev == r
min == r_next
min == database if min==nil
result == nil if min==nil
cycle
r == r_next
r == database if r==nil
result == min if r==prev or r==nil
if sortingorder='p' start
if r_partition=prev_partition start
result ==r if r_id>prev_id
else
min == r if r_partition<min_partition
finish
elseif sortingorder='n'
compare(r_sur,prev_sur)
compare(r_pre,prev_pre) if dif=0
if dif=0 start
result ==r if r_id>prev_id
else
compare(r_sur,min_sur)
compare(r_pre,min_pre) if dif=0
min == r if dif<0
finish
elseif sortingorder='b'
if r_blocks=prev_blocks start
result == r if r_id>prev_id
else
min == r if r_blocks<min_blocks
finish
elseif sortingorder='a'
if r_age=prev_age start
result == r if r_id>prev_id
else
min == r if r_age<min_age
finish
elseif sortingorder='g'
if r_group=prev_group start
result == r if r_id>prev_id
else
min == r if group(r_group)<group(min_group)
finish
else
result == r
finish
repeat
end
routine list or show(integer ls)
record (entry fm)name r
merge if dirlist==nil
get full info unless ls=0
id = line; pre = ""; sur = ""
if line -> id.(" ").rest start
if rest -> pre.(" ").sur start
pre = pre." ".rest while sur -> rest.(" ").sur
finishelse sur = rest
finish
toupper(id)
id = "*" if id=""
pre = "*" if pre=""
sur = "*" if sur=""
r == nil
cycle
r == next(r); exitif r==nil
continueunless matches(r_id,id)
continueunless r_sur==nil or matches(r_sur,sur)
continueunless r_pre==nil or matches(r_pre,pre)
continueunless groupno<0 or r_group=groupno
continueunless flagword=0 or r_flags&flagword#0
continueunless partitionno<0 or r_partition=partitionno
printstring(r_id); write(r_partition,9-length(r_id)); space
unless ls=0 start
if sizesknown=0 start
getsizes(r); getage(r)
finish
write(r_blocks,5); write(r_files,3); space
printstring(unpackdate(r_age)); space
finish
printstring(unpackdate(r_created)); space
printstring(r_pre); space; printstring(r_sur); space
spaces(30-length(r_pre)-length(r_sur))
printstring(group(r_group)); printstring(flags(r_flags))
newline
repeat
end
routine list
listorshow(0) andreturnunless line=""
printline("The LIST command lists database entries. Only those entries")
printline("which match the parameters selected by earlier GROUP and FLAGS")
printline("commands are printed. The ID, PRENAMES, and SURNAME parameters")
printline("must all match. An absent NAME is taken to be wild.")
printline("Parameters: ID PRENAMES SURNAME (any or all may be wild)")
end
routine partition
on 4 start
printline(line." is not a number")
return
finish
unless line="" start
partitionno = -1
partitionno = stoi(line) unless wildness(line)#0
return
finish
printline("The PARTITION command determines which disk partition subsequent")
printline("directories will be put into by the CREATE command, or restricts")
printline("searches by the LIST and SHOW commands. It may be wild.")
printline("Parameter: PARTITION-NUMBER")
end
routine permissions
toupper(line)
permissionsparm = line andreturnunless line=""
printline("The PERMISSIONS command sets up file permissions to be applied")
printline("to new directories added by the CREATE command (default: FNA).")
printline("Parameter: PERMISSIONS")
end
routine promote
string (255)from,to
record (entry fm)name r
integer count=0,old,new
if line -> id.(" ").rest and rest -> from.(" ").to -
and id#"" and from#"" and to#"" start
if wildness(to)#0 start
printline("No wildcards for groups please")
return
finish
old = -1; old = findgroup(from) if wildness(from)=0
printline("Unknown group ".from) andreturnif old=0
new = addgroup(to)
printline("What's the point?") andreturnif old=new
r == nil
cycle
r == locate record(id,r); exitif r==nil
continueunless old<0 or r_group=old
r_group = new; count = count+1
repeat
note change unless count=0
write(count,0); printline(" entries changed")
return
finish
printline("The PROMOTE command is used to change the GROUP attribute of")
printline("one or more users.")
printline("Parameters: ID OLDGROUP NEWGROUP")
printline("Example: PROMOTE * CS3 CS4")
end
routine quota
on 4 start
printline(line." is not a number"); return
finish
quotasize = stoi(line) andreturnunless line=""
printline("The QUOTA command sets up initial quota allocations for new")
printline("directories added with the CREATE command (default 1990).")
printstring("Parameter: Number-of-blocks")
end
routine reflag
string (255)f
integer count=0,clear=0,set=0,this
record (entry fm)name r
if line -> id.(" ").rest and id#"" and rest#"" start
rest = rest.","
while rest -> f.(",").rest cycle
continueif f=""
if charno(f,1)='-' start
f -> ("-").f; continueif f=""
this = findflag(f)
printline("Unknown flag category ".f) andreturnif this=0
clear = clear!this
else
this = findflag(f)
printline("Unknown flag category ".f) andreturnif this=0
set = set!this
finish
repeat
clear = ¬clear
r == nil
cycle
r == locate record(id,r); exitif r==nil
continueunless groupno<0 or r_group=groupno
this = r_flags&clear!set
count = count+1 unless r_flags=this
r_flags = this
repeat
note change unless count=0
write(count,0); printline(" entries changed")
return
finish
printline("The REFLAG command is used to set or clear various flag bits")
printline("associated with existing entries in the database (such as")
printline("whether Laser printer access is allowed). The GROUP parameter")
printline("must match, as well as the ID. Flag names preceded by a minus")
printline("sign indicate that the flag is to be cleared.")
printline("Parameters: ID List of flag names separated by commas")
end
routine renamedir
string (255)oid,nid
record (entry fm)name r,t,p
on 3 start
printline(event_message); return
finish
if line -> oid.(" ").nid and oid#"" and nid#"" start
toupper(nid)
printline("No wildcards please") andreturn -
if wildness(oid)#0 or wildness(nid)#0
if directory exists(oid) start
if directory exists(nid) start
printline("New directory already exists")
else
oid = oid.":"; nid = nid.":"; rename(oid,nid)
finish
else
printline("Old directory does not exist")
finish
r == locate record(nid,nil)
printline("New entry already exists in database") andreturnif r##nil
r == locate record(oid,nil)
printline("Old entry not in database") andreturnif r==nil
p == nil; t == database
while t##r cycle
p == t; t == t_next
repeat
if p==nil then database == t_next else p_next == t_next
r_id = nid
p == nil; t == database
cycle
if t==nil or t_id>r_id start
r_next == t
if p==nil then database == r else p_next == r
exit
finish
p == t; t == t_next
repeat
note change
return
finish
printline("The RENAME command renames a directory on disk and changes the")
printline("ID field of an existing database entry. No wildcards allowed.")
printline("Parameters: OLDID NEWID")
end
routine show
list or show(1) andreturnunless line=""
printline("The SHOW command behaves exactly like the LIST command, except")
printline("that additional information about disk usage is included.")
printline("Parameters: ID PRENAMES SURNAME")
end
routine wipe
string (255)f
integer n=0
on 9 start
selectinput(2); closeinput; selectinput(1)
write(n,0); printline(" files deleted")
return
finish
unless line="" start
id = line; toupper(id)
printline("No wildcards please") andreturnif wildness(id)#0
if directory exists(id) start
id = id.":"
openinput(2,id); selectinput(2)
cycle
readline(f); f = id.f; delete(f); n = n+1
repeat
finish
printline("Directory does not exist")
return
finish
printline("The WIPE command is used to delete all files in a directory")
printline("about to be deleted. This is not done automatically by the")
printline("DELETE command, as a precaution against accidentally deleting")
printline("the wrong directory. The filestores cooperate in this by")
printline("refusing to delete non-empty directories.")
printline("Parameter: ID")
end
predicate ok(string (*)name x,y)
! True if X is the leading part of Y
integer lx = length(x)
falseif lx>length(y)
trueif x=substring(y,1,lx)
false
end
integerfn find element(string (*)name s,
string (*)arrayname a(1:integer max))
integer i
for i = 1,1,max cycle
if ok(s,a(i)) start
result = i if i=max ornot ok(s,a(i+1))
printstring("Ambiguous: ")
cycle
printstring(a(i)); i = i+1
exitif i>max ornot ok(s,a(i))
printstring(", ")
repeat
newline
result = 0
finish
repeat
result = 0
end
string (255)input=cliparam,verb
constinteger commands=18
integer i
switch action(0:commands)
conststring (11)array command(1:commands)=-
"AMEND","BY","CREATE","DELETE","EXIT","FILE","FIND","FLAGS","GROUP","LIST",
"PARTITION","PERMISSIONS","PROMOTE","QUOTA","REFLAG","RENAME","SHOW","WIPE"
on 9 start
stopif input=""
closeinput
input = ""
finish
read database if database==nil
input = ":" if input=""
openinput(1,input); selectinput(1); prompt("Admin:")
input = "" if input=":"
cycle
readline(line)
if line="" start
continueunless input=""
printline("Information about individual commands is available by typing")
printline("the command without parameters. The following commands exist:")
printline(command(i)) for i = 1,1,commands
printline("They may be abbreviated to the first few letters.")
continue
finish
verb = line and line = "" unless line -> verb.(" ").line
toupper(verb)
->action(find element(verb,command))
action(0): printstring("Command "); printstring(verb)
printline(" not recognised")
signal 9 unless input=""
continue
action(1): amend; continue
action(2): by; continue
action(3): create; continue
action(4): deletedir; continue
action(5): exit
action(6): file; continue
action(7): find; continue
action(8): chooseflags; continue
action(9): choosegroup; continue
action(10): list; continue
action(11): partition; continue
action(12): permissions; continue
action(13): promote; continue
action(14): quota; continue
action(15): reflag; continue
action(16): renamedir; continue
action(17): show; continue
action(18): wipe
repeat
update database
end