%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