option "-nodiag-nocheck"
!!bodily %include "managr:newadmin.inc"
include "inc:util.imp"
include "inc:wildmat.imp"
externalstring (255)fnspec finfo(string (255)s,integer n)
recordformat entry fm (record (entry fm)name next, string (7)id,
string (*)name sur,pre,integer group,flags,created, {from DB}
partition,files,blocks,age {from disk})
recordformat stringlist(record (stringlist)name next,string (*)name s)
conststring adminfile="managr:admin.db"
ownintegerarray admin index('A'-1:'Z'+2)
ownrecord (stringlist)name admingrouplist==nil,adminflaglist==nil
string (*)map heapstring(string (*)name s)
! Allocate enough heap space to hold a copy of S, and copy S into it.
string (*)name h
h == string(heapget(length(s)+1))
h = s; result == h
end
string (*)map nth(record (stringlist)name r,integer n)
! Return the Nth entry in list R, where N=1 gives the first.
! NULL returned for out of range N.
ownstring (1)null=""
cycle
result == null if r==nil or n<=0
result == r_s if n=1
n = n-1; r == r_next
repeat
end
integerfn lookup only(record (stringlist)name list,string (*)name s)
! Search LIST for S, returning index position as result.
! Return 0 if not found.
integer n
string (255)x,y
n = 1; y = s; toupper(y)
cycle
result = 0 if list==nil
x = list_s; toupper(x)
result = n if x=y
n = n+1; list == list_next
repeat
end
record (stringlist)map lookup and add(record (stringlist)name list,
string (*)name s,integername n)
! Search LIST for S, if not found, insert it.
! Return idex position in N.
! Return possibly updated LIST as result.
record (stringlist)name cell==list,pred==nil
string (255)x,y
n = 1; y = s; toupper(y)
while cell##nil cycle
x = cell_s; toupper(x)
result == list if x=y
n = n+1; pred == cell; cell == cell_next
repeat
cell == new(cell); cell_next == nil; cell_s == heapstring(s)
result == cell if pred==nil
pred_next == cell; result == list
end
string (*)map group(integer n)
result == nth(admingrouplist,n)
end
integerfn addgroup(string (*)name s)
record (stringlist)name r,p==nil
integer n=1
r == admingrouplist
while r##nil cycle
result = n if matches(r_s,s)
p == r; r == r_next; n = n+1
repeat
r == new(r); r = 0; r_s == heapstring(s)
if p==nil then admingrouplist == r else p_next == r
result = n
end
string (*)map flag(integer n)
ownstring (1)null=""
integer m = 1
cycle
result == null if n=0
result == nth(adminflaglist,m) if n&1#0
n = n>>1; m = m+1
repeat
end
string (255)fn flags(integer n)
string (255)s=""
cycle
result = s if n=0
s = s."+".flag(n)
n = (n-1)&n
repeat
end
integerfn addflag(string (*)name s)
record (stringlist)name r,p==nil
integer n=1
r == adminflaglist
while r##nil cycle
result = n if matches(r_s,s)
p == r; r == r_next; n = n<<1
repeat
r == new(r); r = 0; r_s == heapstring(s)
if p==nil then adminflaglist == r else p_next == r
result = n
end
integerfn pack date(string (*)name s)
! Result zero if S does not contain a plausible DD/MM/YY.
! Otherwise (16-bit!) result is YY<<9 + MM<<5 + DD.
bytename b == length(s)
integer d=0,m=0,y=0
predicate digit(integer d,integername n)
falseunless '0'<=d<='9'
n = n*10-'0'+d; true
end
result = 0 unless b=8 and digit(b[1],d) and digit(b[2],d)
result = 0 unless b[3]='/' and digit(b[4],m) and digit(b[5],m)
result = 0 unless b[3]='/' and digit(b[7],y) and digit(b[8],y)
result = 0 unless 1<=d<=31 and 1<=m<=12 and y>=80
result = y<<9+m<<5+d
end
string (8)fn unpack date(integer d)
! Re-constitute
string (8)dmy = "00/00/00"
bytename b == length(dmy)
integer m,y
y = rem(d>>9,100); m = d>>5&15; d = d&31
b[1] = d//10+'0'; b[2] = rem(d,10)+'0'
b[4] = m//10+'0'; b[5] = rem(m,10)+'0'
b[7] = y//10+'0'; b[8] = rem(y,10)+'0'
result = dmy
end
routine get age(record (entryfm)name r)
! Fill in the AGE field in the record. This is the age of the first
! (youngest!?) file in the directory, as a "last used" estimate.
! Uses FINFO(1).
string (255)s0,s
bytename b == length(s)
integer n,m
on 3 start
return
finish
r_age = 0
s0 = finfo(r_id,1)
while s0 -> s.(" ").s0 cycle
r_age = packdate(s) andexitif s -> ("/")
repeat
end
routine get sizes(record (entryfm)name r)
! Fill in the FILES and BLOCKS fields in the record.
! Parses the result of FINFO(0).
string (255)s0,s
on 3 start
return
finish
s0 = finfo(r_id,0)
returnunless s0 -> ("(").s0
r_partition = charno(s,1)-'0' if s0 -> s.(".").s0
returnunless s0 -> (": ").s0
r_files = stoi(s) if s0 -> s.(",").s0;
returnunless s0 -> (": ").s0
returnunless s0 -> (": ").s0
r_blocks = stoi(s) if s0 -> s.("/").s0;
end
integerfn readhalf
! Read a 2-byte number MSB first
integer a,b
a = readsymbol; b = readsymbol
result = a<<8+b
end
integerfn readfull
! Read a 4-byte number MSB first
integer a,b
a = readhalf; b = readhalf
result = a<<16+b
end
routine readstring(string (*)name s)
! Read a length-prefixed string
integer i
length(s) = readsymbol
charno(s,i) = readsymbol for i = 1,1,length(s)
end
routine read admin header {assumed opened and selected already}
! We assume the ADMIN database file has been opened and selected.
! Read in the global index array, and also the group and class lists, in
! preparation for reading a single record or the whole rest of the file.
string (255)s
integer k,i
on 9 start
return
finish
adminindex(i) = 0 for i = 'A'-1,1,'Z'+2
adminindex(i) = readfull for i = 'A'-1,1,'Z'+2
admingrouplist == nil
cycle
readstring(s); exitif s=""; i = addgroup(s)
repeat
adminflaglist == nil
cycle
readstring(s); exitif s=""; i = addflag(s)
repeat
end
predicate read admin record(record (entry fm)name r)
! Seek to the right point in the admin file (assumed opened, index
! assumed read in), and read the relevant record if found.
integer l1,created,flags,group
string (255)id,rid,sur,pre
on 9 start
false
finish
id = r_id; falseif id=""; toupper(id)
l1 = charno(id,1)
l1 = 'A'-1 if l1<'A'
l1 = 'Z'+1 if l1>'Z'
falseif adminindex(l1)>=adminindex(l1+1)
setinput(adminindex(l1))
l1 = charno(id,1)
cycle
created = readhalf; flags = readhalf; group = readsymbol
readstring(rid); readstring(sur); readstring(pre)
toupper(rid); exitif rid=id
falseif charno(rid,1)>l1
repeat
r_created = created; r_flags = flags; r_group = group
r_sur == heapstring(sur); r_pre == heapstring(pre); true
end
!!end of body
begin { WHOIS }
record (entry fm)r = 0
r_id = cliparam
toupper(r_id)
returnif r_id=""
openinput(1,adminfile); selectinput(1)
read admin header
unless read admin record(r) start
printline("Entry ".r_id." not in database")
return
finish
printstring(r_id." (")
printstring(group(r_group)); printstring(flags(r_flags))
printline(") ".r_pre." ".r_sur)
printstring("Created "); printstring(unpackdate(r_created))
getsizes(r)
printstring(" in partition "); write(r_partition,0); newline
write(r_blocks,0); printstring(" blocks in ")
write(r_files,0); printstring(" files")
unless r_files<=0 start
getage(r)
printstring(", last written ")
printstring(unpackdate(r_age))
finish
newline
end