! Filestore Admin Program
! J. Butler 10/85. Original by RWT.
! Default permission -> FNA 31/10/86 JHB

%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:1000)
%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")
       %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