! Filestore Admin Program
! J. Butler 10/85. Original by RWT.
! Default permission -> FNA 31/10/86 JHB
constinteger maxusers = 2048
include "managr:addefs.inc"
include "Inc:fs.imp"
include "Inc:util.imp"
include "inc:fsutil.imp"
!%externalroutinespec move(%integer len, %bytename from, to)
routine move(integer bytes, bytename from, to)
!Move BYTES bytes from FROM to TO. Pinched from IE.
!If addr(FROM) < addr(TO) do the move from the top down to allow overlap
return if Bytes = 0 or From == To
if Addr (To) < Addr (From) start
*Subq.l #1, d0
f loop:
*move.b (a0)+, (a1)+
*dbra d0, f loop
else
*add.l d0, a0
*add.l d0, a1
*subq.l #1, d0
b loop:
*move.b -(a0), -(a1)
*dbra d0, b loop
finish
end
begin
integer lastcpu ;!CPUTIME of last FS resource-consuming command.
constinteger decent interval = 2000 ;!Milliseconds
integer this fs acc
constinteger bdmax = 150
recordformat link fm(record (admin fm) name data, c
integer status, record (link fm) name flink, rlink)
record (link fm) array ad(0:maxusers)
record (admin fm) array bd(1:bdmax)
record (admin fm) xx ;!Dummy for giving size.
record (link fm) name head, tail
string (31)s,t,datfile
owninteger i, j, sym=' ', adstart, adlen, adwriteback = 0, bddirs = 0
integer default partition = '1', default quota = 1984
string (31) default protection = "FNA"
integername addirs
const integer max perms = 5
const string (3) array perms (0:max perms) = "FFA", "FRA", "FNA",
"FFV", "FRV", "FNV"
! Auxiliary routines
routine waitcheck
while cputime < lastcpu + decent interval cycle ; repeat
lastcpu = cputime
end
routine printfield(string (*) name s, integer width)
!Printstring s to fit in a field of WIDTH. Padding or truncating as necessary.
integer l
if width < length(s) then l = width else l = length(s)
printstring(substring(s, 1, l)); spaces(width - l)
end
predicate same(string (*) name s1, s2)
!Compare two strings independantly of case
integer i
false if length(s1) # length(s2)
for i = 1, 1, length(s1) cycle
false if charno(s1, i) & 16_5F # charno(s2, i) & 16_5F
repeat
true
end
routine warn (string (255) str)
select output (0)
print string (str)
newline
end
routine flagwrite
on 3,9 start
warn("Database locked by another ADMIN: " . event_message)
return
finish
open output(1, "managr:$admin.dat") if adwriteback = 0
selectoutput(0)
adwriteback = 1
end
routine print help
printstring( -
"C(reate) <owner> F(ind) <owner> D(efault) <part> <quota> <prot>")
printstring ("
Q(uota) <owner> <inc> M(odify) <owner> R(egister) <part> <file>")
printstring ("
P(ass) <owner> <pass> S(how) <name> L(ist) <file>")
printstring ("
N(ewname) <owner> <new> T(idy) H(elp)")
printstring ("
K(ill) <owner> E(xit)")
newline
newline
end
routine reject
!Warn user of error and discard rest of line including newline char.
printsymbol(sym) and readsymbol(sym) until sym=nl
printstring(" not understood"); newline
end
routine skip
!Skip up to next non-space, returning 1st character in SYM
!Don't do anything if next char is a newline
returnif sym=nl
cycle
sym = nextsymbol; exitunless sym=' '
readsymbol(sym)
repeat
end
routine reads
!Read up to next white space, placing data in S.
!Return null if next char is a newline
s = ""
returnif sym=nl
cycle
readsymbol(sym); exitif sym<=' '; s = s.tostring(sym)
repeat
end
routine append(integer x)
integer y
y = x&15+'0'
x = x>>4; append(x) unless x=0
t = t.tostring(y)
end
predicate verify(string (15)s)
!Return true if the rest of the line (if present) matches S.
integer i
i = 0
cycle
readsymbol(sym)
if sym<=' ' start
skip; true
finish
sym = sym!32
i = i+1
if i>length(s) or sym#charno(s,i) start
reject; false
finish
repeat
end
integerfn status(string (31)s)
! Test whether owner S exists.
! Result <0 if not
! Result 0 if it has no files
! Result >0 otherwise
bytearray b(1:512)
on 3,9 start
result = -1
finish
s = s.",1"
result = fcommr('F'<<8,s,b(1),512)
end
! Database manipulation routines
record (link fm) map find id(string (7) id, integername previous)
!Looks for id. If it finds it it returns a pointer to it, NIL if not.
!Previous points to the previous record.
record (link fm) name d
string (7) tryid
previous = addr(head); d == head_flink
to lower(id)
while d ## nil cycle
tryid = d_data_id
to lower(tryid)
exit if tryid >= id
previous = addr(d); d == d_flink
repeat
if d == nil or tryid # id then result == nil else result == d
end
routine show id(record (link fm) name d)
integer g
string (7) s
printfield(d_data_id, 10)
if charno(d_data_prenames, 1) # '!' start
printfield(d_data_surname, 18)
printfield(d_data_prenames, 26)
else
printfield(d_data_supervisor, 18)
printfield(d_data_description, 26)
finish
s = ""
if d_data_fs & alpha acc # 0 then s = s."A" else s = s." "
if d_data_fs & bravo acc # 0 then s = s."B" else s = s." "
if d_data_fs & charlie acc # 0 then s = s."C" else s = s." "
if d_data_fs & vax acc # 0 then s = s."V"
printfield(s, 5)
g = d_data_group&255
if d_data_group & 1<<ex bit # 0 then printstring(pref names(ex bit)."-")
if 1 <= g < dummy last grp then printstring(grp names(g))
space
if d_data_group & 1<<laser bit # 0 then printsymbol('L')
if d_data_group & 1<<fem bit # 0 then printsymbol('F')
if d_data_group & 1<<trusted bit # 0 then printsymbol('T')
newline
end
routine kill id(record (link fm) name d)
integer i
if d_rlink == nil start ;!Delete from head
warn("Can't delete head!"); stop
elseif d_flink == nil ;!Delete from tail
d_rlink_flink == nil; tail == d_rlink
else
d_rlink_flink == d_flink
d_flink_rlink == d_rlink
finish
addirs = addirs - 1; !Bend pointer
flagwrite
end
routine insert id(record (link fm) name d, p)
if p == nil start ;!Add to head
warn("can't add to head!"); stop
elseif p_flink == nil ;!Add to tail
d_flink == nil; d_rlink == tail
tail_flink == d; tail == d
else
d_flink == p_flink; d_rlink == p
p_flink_rlink == d; p_flink == d
finish
addirs = addirs + 1
end
record (link fm) map new id(integer prev)
record (link fm) name p, d
result == nil if bddirs = bdmax
p == record(prev)
bddirs = bddirs + 1; bd(bddirs) = 0
d == ad(addirs+1) ;!Use next cell. INSERT ID updates addirs.
d_data == bd(bddirs)
d_status = -2
d_data = 0
!t!printstring("Cell Initted"); newline
insert id(d, p)
result == d
end
integerfn wildness(string (*)name s)
integer k,i,w=0
for i=1,1,length(s) cycle
k = charno(s,i); w = w+1 if k='*' or k='%'
repeat
result = w
end
routine print defaults
printstring("Using partition "); printsymbol(default partition)
printstring(", a quota of "); write(default quota,0)
printstring(" blocks, and protection ".default protection); newline
end
! Command routines
routine default
string (255) str
return unless verify("efault")
unless sym=nl start
read(sym)
default partition = sym+'0' if sym&¬7=0
skip
read(default quota) unless sym=nl
skip
if sym#nl start
read line (str)
if length(str) = 3 start
to upper(str)
for I = 0, 1, max perms cycle
default protection = str and exit if str=perms(I)
warn ("Invalid permission") if i=max perms
repeat
else
warn ("Invalid permission")
finish
finish
finish
print defaults
end
routine register
integer part,lopart,hipart,i
bytearray b(1:512)
return unless verify("egister")
unless sym=nl start
read(sym)
if sym<0 then lopart=0 and hipart=MAX PARTITION elsestart
part = default partition - '0'
part = sym if 0<=sym<=MAX PARTITION
lopart=part; hipart=part
finish
skip
reads; skip while sym#nl
s = ":t" if s=""
openoutput(1,s)
selectoutput(1)
for part=lopart,1,hipart cycle
printstring("Users of partition ".tostring(part+'0').snl)
s = tostring(part<<1+'0')
printsymbol(b(i)) for i = 1,1,fcommr('¬'<<8,s,b(1),512)
s = tostring(part<<1+'1')
printsymbol(b(i)) for i = 1,1,fcommr('¬'<<8,s,b(1),512)
repeat
closeoutput
selectoutput(0)
finish
end
routine show cmd
record (link fm) name d
string (*) name name
integer laser
return unless verify("how")
reads; skip while sym#nl
if s ->s.("/").t then openoutput(2,t) and selectoutput(2) else c
selectoutput(0)
if s -> s.("-l").t then laser = 1 else laser = 0
d == head_flink
while d ## nil cycle
if charno(d_data_description, 1) = '!' then name == d_data_description c
else name == d_data_surname
show id(d) if matches(name, s) and (laser = 0 or c
(laser = 1 and d_data_group & 1<<laser bit # 0))
d == d_flink
repeat
selectoutput(0)
end
routine tidy cmd
string (7) array dirs(0:499)
integer dirtot
routine grab dirs
!Grab the list of users ACTUALLY on this FS.
integer part
routine do part(integer part)
string (255) s, t
integer i, l
bytearray buff(0:511)
s = tostring(part+'0')
l = fcommr('¬'<<8,s,buff(0),512)
for i = 0, 8, 504 cycle
move(8, buff(i), charno(t, 1))
length(t) = 8
length(t) = length(t)-1 while t # "" and charno(t, length(t)) <= ' '
unless t = "---" start
dirs(dirtot) = t
dirtot = dirtot+1
finish
repeat
end
dirtot = 0
for part = 0, 1, MAX PARTITION cycle
do part(part<<1); do part(part<<1+1)
repeat
end
predicate dir exists(string (7) dir)
integer i
for i = 0, 1, dirtot-1 cycle
true if same(dirs(i), dir)
repeat
false
end
record (link fm) name d
integer recs, i, j
return unless verify("idy")
recs = 0
grab dirs
write(dirtot, 3); printstring(" directories found"); newline
!Scan through database. Anything which exists on FS but not in database
!will be inserted.
for i = 0, 1, dirtot-1 cycle
d == find id(dirs(i), j)
if d == nil start
printstring(dirs(i)." Missing from database ")
d == new id(j)
unless d == nil start
d_data_id = dirs(i); d_data_surname = "--"; d_data_prenames = "--"
d_data_fs = d_data_fs ! this fs acc
d_data_created = date
recs = recs + 1
warn("& inserted")
else
warn(" - no room to insert it")
finish
finish
repeat
write(recs, 3); printstring(" records inserted"); newline
flagwrite if recs # 0
d == head_flink; recs = 0
! Scan through and delete anything on database which doesn't appear to exist.
! Update any user IDs which don't have the accredit bit set for this FS.
while d ## nil cycle
!Dont forget to add new (disc) users to ???(dirtot)
if dir exists(d_data_id) start
flagwrite if d_data_fs & this fs acc = 0
d_data_fs = d_data_fs ! this fs acc
else
flagwrite if d_data_fs & this fs acc # 0
d_data_fs = d_data_fs & (¬this fs acc)
finish
if d_data_fs & (bravo acc ! charlie acc ! portable acc ! this fs acc) = 0 start
!Delete records not accredited on any filestore
warn("Database user ".d_data_id." not on any filestore & deleted")
kill id(d)
recs = recs + 1
finish
d == d_flink
repeat
write(recs, 3); printstring(" records deleted"); newline
end
routine xper cmd
!Repository for odd fudges
string (63) u, v
record (link fm) name d, p, n
string (7) lastid
integer i
return unless verify("per")
d == head_flink; lastid = " "
warn("*")
while d ## nil cycle
if d_data_id < lastid start
warn("!")
kill id(d) ;!Zap it
n == find id(d_data_id, i) ;!i points to record before where it ought to be
warn("n non-null") unless n == nil
p == record(i)
insert id(d, p)
warn(d_data_id." out of order - reinserted after ")
printstring(p_data_id) unless p == nil
d == head_flink; lastid = ""
else
lastid = d_data_id; d == d_flink
finish
repeat
flagwrite
end
routine list cmd
integer j,i
bytearray b(1:512)
return unless verify("ist")
reads; skip while sym#nl; s = ":t" if s=""
openoutput(1,s)
selectoutput(1)
for j = 0,1,2*MAX PARTITION+1 cycle
if rem(j,2)=0 start
newlines (2)
printstring("Users of partition ".tostring(j//2+'0'))
newlines (2)
finish
s = tostring(j+'0')
printsymbol(b(i)) for i = 1,1,fcommr('¬'<<8,s,b(1),512)
repeat
closeoutput
selectoutput(0)
end
integerfn find group(string (31) grp)
!Interprets a group specification of the form (<prefix>-)*[<group>]
!The prefixes if present build up a bitmap and the group if present is
!put in the bottom 8 bits.
integer i, g
string (31) prefix
g = 0
while grp -> prefix.("-").grp cycle
for i = dummy last prefix,1,15 cycle
g = g ! 1<<i if same(pref names(i), prefix)
repeat
repeat
for i = 0, 1, dummy last grp-1 cycle
result = g ! i if same(grp names(i), grp)
repeat
result = g
end
routine create
integer i, j, exist, ustat
string (255) surname, prenames
record (link fm) name d, p, e
string (255) fn trim(string (*) name s, integer len)
integer i
length(s) = length(s) - 1 while s # "" and charno(s, length(s)) = ' '
length(s) = len if length(s) > len
result = s
end
return unless verify("reate")
reads; skip while sym#nl
unless s -> s.("/").t start
warn ("No ownername specified") and return if s=""
ustat = status(s)
if ustat < 0 start
t = s
t = tostring(default partition).s unless charno(s,1)&¬7='0'
t = t.","; append(default quota)
waitcheck
i = fcomm('['<<8,t)
warn (s." created")
t = s.":,".default protection
i = fcomm('E'<<8,t)
else
warn (s." already exists on disc")
finish
finish
d == find id(s, j)
if d == nil start
d == new id(j)
warn("No room to add ".s) and return if d == nil
d_data_id = s
to upper(d_data_id)
else
warn("** Warning: ".s." already exists on database")
finish
prompt("Owner Surname:"); readline(s)
surname = s and prenames = "" unless s -> surname.(",").prenames
if prenames = "" start
prompt("Prenames/Desc:"); readline(prenames)
finish
!If id has a '_' in it, use the "parent" id as a default surname
if surname = "" start
if d_data_id -> s.("_") start
e == find id(s, j)
unless e==nil start
d_data_surname = e_data_surname
d_data_prenames = e_data_prenames
d_data_group = e_data_group
d_data_group = e_data_group
d_data_mailaddr = e_data_mailaddr
-> user known
finish
finish
finish
if prenames#"" start
if charno(prenames, 1) = '!' start
d_data_description = trim(prenames, 51)
d_data_supervisor = trim(surname, 15)
else
d_data_surname = trim(surname, 15)
d_data_prenames = trim(prenames, 35)
finish
finish
prompt("Group:")
readline(s)
d_data_group = find group(s)
if d_data_group = 0 start
printstring("Group ".s." not recognised"); newline
finish
prompt("Mail address:"); readline(s)
d_data_mail addr = trim(s, 31)
User known:
d_data_fs = d_data_fs ! this fs acc
d_data_created = date
flagwrite
end
routine find cmd
integer i
string (63) t
record (link fm) name d
return unless verify("ind")
reads; skip while sym#nl
if s ->s.("/").t then openoutput(2,t) and selectoutput(2) else c
selectoutput(0)
warn ("No ownername specified") and return if s=""
if wildness(s) = 0 start
i = status(s)
if i<0 start
warn (s." does not exist on the disc")
elseif i=0
warn (s." exists on the disc but has no files")
else
warn (s." exists on the disc and has files")
finish
d == find id(s, i)
if d == nil start
warn("Cannot find ".s." in database")
else
show id(d)
finish
else
d == head_flink
while d ## nil cycle
show id(d) if matches(d_data_id, s)
d == d_flink
repeat
finish
selectoutput(0)
end
routine kill cmd
record (link fm) name d
integer i
bytearray b(1:512)
string (63) t
return unless verify("ill")
reads; skip while sym#nl
warn ("No ownername specified") and return if s=""
!/d indicates database only. Can't delete on disc and not on database
unless s -> s.("/").t start
i = status(s)
if i >= 0 start
if i = 0 start
t = s.":"
waitcheck
i = fcomm('D'<<8,t)
warn (s." killed on disc")
finishelse warn (s." still has files") and return
finishelse warn (s." does not exist on disc")
finish
d == find id(s, i)
if d == nil then warn(s." does not exist in database") else start
if d_data_fs&this fs acc =0 start
warn (s." was not registered on the filestore")
else
d_data_fs= d_data_fs & (¬this fs acc)
if d_data_fs & (bravo acc ! charlie acc ! portable acc) = 0 start
kill id (d)
warn (s." killed in database")
finish
finish
finish
end
routine quota cmd
integer i
return unless verify("uota")
reads; skip
warn ("No ownername specified") and return if s=""
if sym=nl then i = default quota elsestart
read(i); skip while sym#nl
finish
t = s.","; append(i)
waitcheck
i = fcomm('^'<<8,t)
warn (s."'s quota adjusted")
end
routine mod cmd
integer i, cmd
string (63) t
record (link fm) name p
return unless verify("od")
reads; skip while sym # nl
warn("No ownername specified") and return if s=""
p == find id(s, i)
warn("Owner not in database") and return if p == nil
printstring("(E)xit,(F)emale,(G)roup,(L)aser,(P)renames,(S)urname,(T)rusted,(V)ax:")
newline
cycle
show id(p)
prompt("Mod>")
readsymbol(sym)
exit if sym = 'e'
skipsymbol while nextsymbol <= ' '
if sym = 'g' start
prompt("Group:")
cycle
readline(s)
i = find group(s)
exit unless i = 0
printstring("Group ".s." not recognised"); newline
repeat
p_data_group = i
flagwrite
elseif sym = 'f'
p_data_group = p_data_group !! (1<<fem bit)
flag write
elseif sym = 'l'
p_data_group = p_data_group !! (1<<laser bit)
flagwrite
elseif sym = 'o'
readline(p_data_supervisor)
flagwrite
elseif sym = 'p'
readline(p_data_prenames)
flagwrite
elseif sym = 's'
readline(p_data_surname)
flagwrite
elseif sym = 't'
p_data_group = p_data_group !!(1<<trusted bit)
flagwrite
elseif sym = 'v'
p_data_fs = p_data_fs !! vax acc
flag write
else
reject
finish
repeat
prompt("Admin>")
end
routine rename cmd
record (link fm) name p, d
string (255) o
integer i
return unless verify("ewname")
reads; skip
if s -> s.("/").o then i = 1 else i = 0
warn ("No ownername specifed") and return if s=""
warn ("Invalid length of ownername") and return if length(s)>6
o = s
reads; skip while sym#nl
warn ("No new ownername specified") and return if s=""
warn ("Invalid length of new ownername") and return if length(s)>6
o = o.":" if charno(o,length(o))#':'
s = s.":" if charno(s,length(s))#':'
t = o.",".s
if i = 0 start ;!Wanted it altered on disc
i = fcomm('B'<<8,t)
warn (o." renamed to ".s." on disc")
finish
length(o) = length(o) - 1 ;!Ditch the colon
length(s) = length(s) - 1
d == find id(o, i)
if d == nil start
warn("Can't find ".o." in database")
else
!Entry has to be reinserted in correct alphabetical order
p == find id(s, i)
if p == nil start
p == record(i)
kill id(d)
d_data_id = s
to upper(d_data_id)
insert id(d, p)
flagwrite
finishelse warn(s. "exists in database already")
finish
end
routine pass cmd
string (255) new1,new2
integer i
return unless verify("ass")
reads; skip
warn ("No ownername specifed") and return if s=""
warn ("Invalid length of ownername") and return if length(s)>6
set terminal mode (no echo)
prompt("New password:"); readline(new1)
prompt("Confirm:"); readline(new2)
set terminal mode (0)
warn("Pass was not confirmed") and return if new1#new2
length(new1) = length(new1)-1 while new1#"" c
and charno(new1, length(new1)) = ' '
new1 = substring (new1, 2, length(new1)) while new1#"" c
and charno(new1, 1) = ' '
t = new1.",".s
waitcheck
i = fcomm('P'<<8,t)
warn (s."'s password changed")
end
routine help cmd
return unless verify("elp")
skip while sym#nl
print help
end
routine exit cmd(integer user)
integer i, j
string (63) s, t
record (link fm) name d
on 3,9 start
select output (0)
Printstring ("Trouble writing the database, please check it")
Newline
stop
finish
if user # 0 start ;!User typed EXIT
return unless verify("xit")
skip while sym#nl
finish
if adwriteback # 0 start
!Set up sequential file index
warn("Creating Index...")
for i = 1,1,26 cycle ; integer(adstart+i*4) = 0; repeat
d == tail
for i = addirs,-1,1 cycle
if 'A' <= charno(d_data_id, 1) <= 'Z' then c
integer(adstart+(charno(d_data_id,1)-'A'+1)*4) = i
d == d_rlink
repeat
j=0
for i = 1,1,26 cycle
if integer(adstart+i*4) = 0 then integer(adstart+i*4) = j
j = integer(adstart+i*4)
repeat
warn("Writing database...")
select output (1)
s = "" unless adminfile -> s.(":")
if exists(adminfile) start
delete(adminold) if exists(adminold)
rename(adminfile, adminold)
finish
d == head
while d ## nil cycle
for j = 0, 1, sizeof(xx)-1 cycle
printsymbol(byteinteger(addr(d_data)+j))
repeat
d == d_flink
repeat
close output; selectoutput(0)
warn("Database written.")
t = adminfile unless adminfile -> (s.":").t
rename("managr:$admin.dat",t)
permit(adminfile, "fra")
finish
stop if user # 0
end
! Main Program
on 3,4,9 start
if event_event=9 start
exit cmd(0)
newline and stop if sym=0
finish
selectoutput(0); printstring(event_message); newline; ->loop
finish
! Establish command stream
lastcpu = cputime
if rdte = 16_14 start
this fs acc = alpha acc
else if rdte = 16_15
this fs acc = bravo acc
else if rdte = 16_1B
this fs acc = charlie acc
else if rdte = 16_3F
this fs acc = portable acc
else if rdte = 16_72
this fs acc = vax acc
else
this fs acc = 0
warn ("Unknown FS address, no account being set")
finish
s = cliparam
length(s) = length(s) - 1 while s # "" and charno(s, length(s)) = ' '
if s = "" start
print help; print defaults
S = ":"
finish
openinput(1,s)
selectinput(1)
warn("Reading database...")
if exists(adminfile) start
datfile = adminfile
else
datfile = adminold
warn("Using OLD database ".datfile)
finish
connect file(datfile, 0, adstart, adlen)
addirs == integer(adstart)
write(addirs, 1); printstring(" entries"); newline
ad(0)_data == record(adstart)
ad(0)_flink == ad(1)
ad(0)_rlink == nil
ad(0)_status = -2
for i = 1, 1, addirs-1 cycle
ad(i)_data == record(adstart+i*sizeof(xx))
ad(i)_flink == ad(i+1)
ad(i)_rlink == ad(i-1)
ad(i)_status = -2
repeat
ad(addirs)_data == record(adstart+addirs*sizeof(xx))
ad(addirs)_flink == nil
ad(addirs)_rlink == ad(addirs-1)
ad(addirs)_status = -2
head == ad(0); tail == ad(addirs)
loop:
selectinput (1)
cycle
prompt("Admin>")
sym = 0
skip symbol while next symbol<=' '
readsymbol(sym)
sym = sym!32
if sym='c' start
create
elseif sym='d'
default
elseif sym='e'
exit cmd(1)
elseif sym='f'
find cmd
elseif sym='h'
help cmd
elseif sym='k'
kill cmd
elseif sym='l'
list cmd
elseif sym='m'
mod cmd
elseif sym='n'
rename cmd
elseif sym='p'
pass cmd
elseif sym='q'
quota cmd
elseif sym='r'
register
elseif sym='s'
show cmd
elseif sym='t'
tidy cmd
elseif sym='x'
xper cmd
else
reject
finish
repeat
endofprogram