! Various record formats, variables, and routines for the programs
! ADMINHM, ADMINMH, ADMIN, and WHOIS

%include "inc:util.imp"
%include "inc:wildmat.imp"
%externalstring(255)%fnspec finfo(%string(255)d,%integer n)

! The new ADMIN.DB file contains variable-length records (it was the fixed
! size records that made the old ADMIN.DAT so big that it took very long
! to read in or write out).  As before, the records are kept sorted by ID,
! and there is an index at the front pointing to the record of the first
! entry beginning with X.  The index consists of 29 entries, each a longword
! giving the byte offset from the start of the file of the record it points to.
! The first index entry points to the first record (in case this begins with
! a digit rather than a letter).  The second entry points to the first record
! beginning with 'A', the next 25 entries take us to 'Z', the next points to
! the first record beginning with a non-letter (if any), and the last entry
! points off the end of the last record (in fact, to the end of the file).
! The index is followed by the group names, a sequence of length-prefixed
! strings, terminated by a null string.  Then come the class (flag) names,
! stored similarly.  There must be no more than 255 groups, nor 16 classes.
! There follow the actual records, each stored as follows:
! A 2-byte number giving the creation date of the directory, stored as the
! year (mod 100) times 512, plus 32 times the month, plus the day, i.e.
! 7, 4, and 5 bits for year, month, and day.  The MS byte comes first.
! There follows a 2-byte number, MSB first, which represents the set of
! classes in which the directory is a member, each bit represents a class.
! Bit 0 (1) represents the first class which appears in the above list,
! bit 3 (8) the fourth, and so on.  There follows a byte for the group
! number, value 1 representing the first. There follow three length-prefixed
! strings for the ID, surname, and prenames respectively.  There is NO
! padding byte to make the record length even.

%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 findgroup(%string(*)%name s)
%record(stringlist)%name r
%integer n=1
  r == admingrouplist
  %cycle
    %result = 0 %if r==nil
    %result = n %if matches(r_s,s)
    r == r_next; n = n+1
  %repeat
%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 findflag(%string(*)%name s)
%record(stringlist)%name r
%integer n=1
  r == adminflaglist
  %cycle
    %result = 0 %if r==nil
    %result = n %if matches(r_s,s)
    r == r_next; n = n<<1
  %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(15)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
  
  %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 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

%record(entry fm)%map read admin file {assumed already opened and selected}
! Read the header and rest, returning a sorted list of records
! in which the ID, PRE, SUR, GROUP, FLAG, CREATED fields are
! filled in, PARTITION, FILES, BLOCKS, and AGE fields are zapped.
! NB the records are ASSUMED to be in the file in sorted order.
%string(255)s
%record(entryfm)%name list==nil,this,q==nil
  %on 9 %start
    dispose(this)
    %result == list
  %finish
  read admin header
  %cycle
    this == new(this); this = 0
    this_partition = -1
    this_created = readhalf
    this_flags = readhalf
    this_group = readsymbol
    readstring(s); toupper(s); this_id <- s
    readstring(s); this_sur == heapstring(s)
    readstring(s); this_pre == heapstring(s)
    this_next == nil
    %if q==nil %then list == this %else q_next == this; q == this
  %repeat
%end

%routine write admin file(%record(entryfm)%name entries)
! Write out the list ENTRIES, with global group and class lists,
! to the file already assumed opened and selected.
! We assume ENTRIES is sorted by ID.
%integer offset,limit
%record(entryfm)%name this
%record(stringlist)%name fg

  %routine puthalf(%integer k)
    printsymbol(k>>8&255); printsymbol(k&255)
  %end
  
  %routine putlong(%integer k)
    puthalf(k>>16); puthalf(k)
  %end
  
  %routine putstring(%string(255)s)
  %integer i
    printsymbol(length(s)); printsymbol(charno(s,i)) %for i = 1,1,length(s)
  %end
  
  offset = 29*4
  fg == admingrouplist
  %while fg##nil %cycle
    offset = offset+length(fg_s)+1; fg == fg_next
  %repeat
  offset = offset+1
  fg == adminflaglist
  %while fg##nil %cycle
    offset = offset+length(fg_s)+1; fg == fg_next
  %repeat
  offset = offset+1
  putlong(offset); limit = 'A'; this == entries
  %while this##nil %cycle
    %while charno(this_id,1)>=limit %cycle
      putlong(offset)
      limit = 255 %if limit>'Z'
      limit = limit+1
    %repeat
    offset = offset+8+length(this_id)+length(this_sur)+length(this_pre)
    this == this_next
  %repeat
  %cycle
    putlong(offset); %exitif limit>'Z'+1; limit = limit+1
  %repeat
  fg == admingrouplist
  %while fg##nil %cycle
    putstring(fg_s); fg == fg_next
  %repeat
  putstring("")
  fg == adminflaglist
  %while fg##nil %cycle
    putstring(fg_s); fg == fg_next
  %repeat
  putstring("")
  this == entries
  %while this##nil %cycle
    puthalf(this_created); puthalf(this_flags); printsymbol(this_group)
    putstring(this_id); putstring(this_sur); putstring(this_pre)
    this == this_next
  %repeat
%end