%option "-nons"{-nocheck-nodiag}
%include "inc:fs.imp"
%include "managr:admin.inc"

%begin; ! Revamped ADMIN program - RWT February 1990

%record(entry fm)%name database==nil,dirlist==nil
%integer today=0,needtoupdate=0,sortingorder=0,sizesknown=0

%routine note change
! Set a flag to indicate that database writeback is required.
! Open file at this point already to act as interlock to avoid
! problem of multiple administrators.
  %on 3 %start
    selectoutput(0); printline(event_message)
    printline("Cannot update database")
    %stop
  %finish
  %returnunless needtoupdate=0
  openoutput(2,adminfile)
  selectoutput(0)
  needtoupdate = 1
%end

%routine update database
  %if needtoupdate=0 %start
    printline("No changes made to database")
  %else
    selectoutput(2)
    write admin file(database)
    closeoutput
    selectoutput(0)
    needtoupdate = 0
  %finish
%end

%record(entryfm)%map locate record(%string(*)%name id,%record(entryfm)%name l)
! Find first/next record in database which matches ID.
! Call with L==NIL for first, with L==(previous result) for next.
! I.e. with L==NIL start search at DATABASE, otherwise start at L_NEXT.
  %if l==nil %then l == database %else l == l_next
  %cycle
    %result == l %if l==nil %or matches(l_id,id)
    l == l_next
  %repeat
%end

%routine addhex(%integer n,%string(*)%name s)
! (for FCOMM) append 'HD'hex number to end of S
  addhex(n>>4,s) %if n>>4#0
  s = s.tostring(n&15+'0')
%end

%routine accredit(%string(*)%name owner,%integer partition,quota)
! Create directory OWNER in the specified partition with given quota.
%string(255)s
%integer x
  %on 3 %start
    printline(event_message); %return
  %finish
  s = tostring(partition+'0').owner
  s = s.","; addhex(quota,s); x = fcomm('['<<8,s)
%end

%routine permit(%string(*)%name file,perms)
%string(255)s
%integer x
  %on 3 %start
    printline(event_message); %return
  %finish
  s = file.",".perms; x = fcomm('E'<<8,s)
%end

%routine delete(%string(*)%name file)
%ownstring(3)frv="frv"
%integer x,attempt=1
  %on 3 %start
    %unless attempt=1 %start
      printline(event_message); %return
    %finish
    attempt = 2; permit(file,frv)
  %finish
  x = fcomm('D'<<8,file)
%end

%routine rename(%string(*)%name old,new)
%string(255)s
%integer x
  %on 3 %start
    printline(event_message); %return
  %finish
  s = old.",".new
  x = fcomm('B'<<8,s)
%end

%predicate directory exists(%string(*)%name d)
! If we have already read in the directory list, we simply scan that,
! otherwise we ask the filestore specifically.
%record(entry fm)%name r
%string(255)s
  %on 3 %start
    %false
  %finish
  r == dirlist
  s = finfo(d,0) %andtrueif r==nil
  %cycle
    %falseif r==nil
    %trueif r_id=d
    r == r_next
  %repeat
%end

%routine read directory list
! Read the owner register, creating a sorted list of records with
! the ID and PARTITION fields filled in, the other fields are zapped.
%string(7)%array dir(1:64)  {64 directories per semipartition}
%string(255)s
%record(entry fm)%name pred,this,item
%integer p,i,n=0

  %routine shoogle(%string(*)%name s)
! Initially S contains a control-terminated name, similar to a C string,
! but terminated by space or newline instead of null.  We convert this
! to a normal Imp string, i.e. length-prefixed.
! Search until terminator is found, then shuffle all characters along
! one to make space for the length byte.
! By choosing '0' instead of space as control threshold, we eliminate the
! dummy names "---" and "*bad*", returning null strings for these.
  %bytename l,k
  %integer len=0
    l == length(s); k == l
    k == k[1] %and len = len+1 %while k>='0'
    %while k##l %cycle
      k = k[-1]; k == k[-1]
    %repeat
    k = len
  %end
  
  %on 3 %start  {in case fewer than 16 semipartitions}
    write(n,0); printline(" directories")
    %return
  %finish
  
  %returnunless dirlist==nil
  printstring("Reading register - ")
  %for p = 0,1,15 %cycle
    s = tostring(p+'0')
    i = fcommr('\'<<8,s,length(dir(1)),512)
    %for i = 1,1,64 %cycle
      shoogle(dir(i))
      %unless dir(i)="" %start
        item == new(item); item = 0
        item_id = dir(i); toupper(item_id)
        item_partition = p>>1
        pred == nil; this == dirlist
        %cycle
          %if this==nil %or this_id>item_id %start
            item_next == this
            %if pred==nil %then dirlist == item %else pred_next == item
            %exit
          %finish
          pred == this; this == this_next
        %repeat
        n = n+1
      %finish
    %repeat
  %repeat
  %signal 3 {to report}
%end

%routine read database
%record(entry fm)%name e
%integer n=0
  printstring("Reading database - ")
  openinput(2,adminfile); selectinput(2)
  database == read admin file
  closeinput; selectinput(1)
  e == database
  e == e_next %and n = n+1 %while e##nil
  write(n,0); printline(" entries")
  e == database
  %unless e==nil %start
    %while e_next##nil %cycle
      %if e_next_id<=e_id %start
        printline("Warning: Database is not sorted")
        %exit
      %finish
      e == e_next
    %repeat
  %finish
%end

%routine merge { dirlist into database }
%record(entryfm)%name l,r,pred==nil,this
  read directory list
  l == database; r == dirlist
  %cycle
    %if l==nil %start  {end of database}
      %exitif r==nil   {end of both lists reached}
pd:   this == new(this); this = r; r == r_next
      printstring("No database entry for directory "); printline(this_id)
    %elseif r==nil     {end of directory list}
fd:   this == l; l == l_next
      printstring("No directory for database entry "); printline(this_id)
    %elseif r_id=l_id
      l_partition = r_partition
      l_age = r_age; l_blocks = r_blocks; l_files = r_files
      this == l; l == l_next; r == r_next
    %elseif r_id<l_id
      ->pd
    %else
      ->fd
    %finish
    this_next == nil
    %if pred==nil %then database == this %else pred_next == this
    pred == this
  %repeat
%end

%routine get full info
%record(entryfm)%name r
%integer n=0
  %returnunless sizesknown=0; sizesknown=1
  printline("Reading file statistics")
  read directory list
  r == dirlist
  %while r##nil %cycle
    n = n+1; write(n,0); printsymbol(13)
    getsizes(r); getage(r)
    r == r_next
  %repeat
  newline
  merge
%end

%integer partitionno=-1,groupno=-1, flagword=0, quotasize=1990
%string(255)line,rest,id,pre,sur,permissionsparm = "FNA"

%routine amend
%record(entry fm)%name r
  %if line -> id.(" ").rest %and rest -> pre.(" ").sur -
  %and id#"" %and pre#"" %and sur#"" %start
    toupper(id)
    pre = pre." ".rest %while sur -> rest.(" ").sur
    printline("No wildcards please") %andreturnif wildness(id)#0
    r == locate record(id,nil)
    printline(id." not in database") %andreturnif r==nil
    r_sur == heapstring(sur); r_pre == heapstring(pre)
    note change
    %return
  %finish
  printline("The AMEND command changes the pre- and surnames in the database")
  printline("associated with a particular ID.")
  printline("Parameters:  ID  PRENAMES  SURNAME")
  printline("For non-person directories, the prenames should explain what")
  printline("the directory is, and the notional surname should be the ID")
  printline("(not name) of the person responsible for the directory.")
%end

%routine by
%integer k
  %unless line="" %start
    k = charno(line,1)!32; k = 0 %unless 'a'<=k<='z'
    %if 1<<(k-'a')&2_00000000001000000000000000#0 %then merge
    %if 1<<(k-'a')&2_00000000000000000000000011#0 %then get full info
!                              P N    I G    BA
    %if 1<<(k-'a')&2_00000000001010000101000011#0 -
    %then sorting order = k %andreturn
  %finish
  printline("The BY command determines the order in which entries are printed")
  printline("by the LIST and SHOW commands.  Output is always sorted by ID,")
  printline("but may first be sorted either by NAME, GROUP, PARTITION, AGE,")
  printline("or BLOCKS.  The parameter is the first letter of one of these.")
%end

%routine create
%record(entry fm)%name r,t,p
  today = packdate(date) %if today=0
  %if line -> id.(" ").rest %and rest -> pre.(" ").sur -
  %and id#"" %and pre#"" %and sur#"" %start
    toupper(id)
    pre = pre." ".rest %while sur -> rest.(" ").sur
    id = "*" %and printline("Please select a GROUP") %if groupno<0
    id = "*" %and printline("Please select a PARTITION") %if partitionno<0
!   id = "*" %and printline("Please select a set of FLAGS") %if flagword=0
    printline("No wildcards please") %andreturnif wildness(id)#0
    %if directory exists(id) %start
      printline("Directory already exists")
    %else
      accredit(id,partitionno&7,quotasize)
      id = id.":"; permit(id,permissionsparm)
      length(id)  = length(id)-1
    %finish
    %if locate record(id,nil)==nil %start
      r == new(r); r = 0
      r_id = id; r_group = groupno; r_flags = flagword
      r_partition = partitionno; r_created = today
      r_sur == heapstring(sur); r_pre == heapstring(pre)
      p == nil; t == database
      %cycle
        %if t==nil %or t_id>r_id %start
          r_next == t
          %if p==nil %then database == r %else p_next == r
          %exit
        %finish
        p == t; t == t_next
      %repeat
      note change
    %else
      printline("Entry already exists in database")
    %finish
    %return
  %finish
  printline("The CREATE command adds a new directory to the disk and makes a")
  printline("new entry in the database.  Before using the CREATE command you")
  printline("must have used the GROUP, FLAGS, and PARTITION commands to supply")
  printline("database information, and to specify where on disk the directory")
  printline("is to be put.  You may also have used the QUOTA and PERMISSIONS")
  printline("commands to alter the default values (1990 blocks and FNA).")
  printline("Parameters:  ID  PRENAMES  SURNAME")
  printline("In the case of non-person directories, the prenames should explain")
  printline("what the directory is, and the notional surname should be the ID")
  printline("(not name) of the person responsible for the directory.")
%end

%routine deletedir
%record(entry fm)%name r,t,p
  %unless line="" %start
    id = line; toupper(id)
    printline("No wildcards please") %andreturnif wildness(id)#0
    r == locate record(id,nil)
    %if directoryexists(id) %start
      id = id.":"; delete(id)
    %else
      printline("Directory does not exist")
    %finish
    printline("No entry in database") %andreturnif r==nil
    p == nil; t == database
    %while t##r %cycle
      p == t; t == t_next
    %repeat
    %if p==nil %then database == t_next %else p_next == t_next
    note change
    %return
  %finish
  printline("The DELETE command removes a directory from disk and an entry")
  printline("from the database.")
  printline("Parameter:  ID")
%end

%routine file
  %on 3 %start
    selectoutput(0)
    printline(event_message)
    %return
  %finish
  %unless line="" %start
    selectoutput(1); closeoutput
    openoutput(1,line); selectoutput(0)
    %return
  %finish
  printline("The FILE command may be used to direct output from the LIST")
  printline("and SHOW commands to a file instead of the terminal.")
  printline("Parameter:  FILENAME")
%end

%routine find
%record(entry fm)%name r
  %unless line="" %start
    id = line; toupper(id)
    r == locate record(id,nil)
    %cycle
      %if r==nil %start
        printline("No entry in database")
        r == new(r); r = 0; r_id = id
      %else
        printstring(r_id)
        space; printstring(group(r_group)); printstring(flags(r_flags))
        printstring(" created "); printstring(unpackdate(r_created))
        space; printstring(r_pre); space; printline(r_sur)
      %finish
      %if directory exists(r_id) %start
        %if sizesknown=0 %start
          getsizes(r); getage(r) %unless r_files=0
        %finish
        write(r_blocks,0); printstring(" blocks in ")
        write(r_files,0); printstring(" files")
        %unless r_partition<0 %start
          printstring(" in partition "); write(r_partition,0) 
        %finish
        %unless r_age=0 %start
          printstring(", last written "); printstring(unpackdate(r_age))
        %finish
        newline
      %else
        printline("Directory does not exist")
      %finish
      r == locate record(id,r)
      newline
    %repeatuntil r==nil
    %return
  %finish
  printline("The FIND command is used to locate a specific disk directory")
  printline("and/or database entry.  Details are printed on the terminal.")
  printline("Parameter:  ID")
%end

%routine chooseflags
%string(255)f
%integer n,m
  %unless line="" %start
    flagword = 0; m = 0; rest = line.","
    %while rest -> f.(",").rest %cycle
      %continueif f=""
      n = findflag(f)
      %if n=0 %and wildness(f)=0 %start
        n = addflag(f)
        printline(f." is a new category")
        printline("Too many flag categories") %andreturnif n&16_ffff=0
      %else
        printline("Flag ".f." not known") %andreturnif n=0
      %finish
      m = m!n
    %repeat
    flagword = m
    %if flagword=0 %start
      printline("Any combination")
    %elseif wildness(line)#0
      line = flags(m)
      %returnunless line -> ("+").line
      line = line.", ".rest %while line -> line.("+").rest
      printline("Flags: ".line)
    %finish
    %return
  %finish
  printline("The FLAGS command defines the set of flags to be used for")
  printline("subsequent CREATE commands, or restricts searches by the")
  printline("LIST and SHOW commands.  It may be wild.")
  printline("Parameter(s):  FLAG-VALUES separated by commas")
%end

%routine choosegroup
%integer n
  %unless line="" %start
    groupno = -1
    n = findgroup(line)
    %if n=0 %and wildness(line)=0 %start
      n = addgroup(line)
      printline(line." is a new group")
      printline("Too many groups") %andreturnif n>255
    %else
      printline("Group ".line." not known") %andreturnif n=0
      printline("Group ".group(n)) %if wildness(line)#0
    %finish
    groupno = n
    %return
  %finish
  printline("The GROUP command defines the group to be used in subsequent")
  printline("CREATE commands, or restricts searches by the LIST, SHOW,")
  printline("and REFLAG commands.  It may be wild.")
  printline("Parameter:  GROUPNAME")
%end

%record(entry fm)%map next(%record(entry fm)%name r)
%ownrecord(entry fm)%name min,max,prev
%integer dif

  %routine compare(%string(255)s,t)
    toupper(s); toupper(t); dif = 0
    dif = 1 %if s>t
    dif = -1 %if s<t
  %end
  
  %if r==nil %start
    r == database; min == r; max == r
    %while r##nil %cycle
      %if sortingorder='p' %start
        min == r %if r_partition<min_partition
        max == r %if r_partition>=max_partition
      %elseif sortingorder='n'
        compare(r_sur,min_sur)
        compare(r_pre,min_pre) %if dif=0
        min == r %if dif<0
        compare(r_sur,max_sur)
        compare(r_pre,max_pre) %if dif=0
        max == r %if dif>=0
      %elseif sortingorder='b'
        min == r %if r_blocks<min_blocks
        max == r %if r_blocks>=max_blocks
      %elseif sortingorder='a'
        min == r %if r_age<min_age
        max == r %if r_age>=max_age
      %elseif sortingorder='g'
        min == r %if group(r_group)<group(min_group)
        max == r %if group(r_group)>=group(max_group)
      %else
        max == r
      %finish
      r == r_next
    %repeat
    %result == min
  %finish
  %result == nil %if r==max
  prev == r
  min == r_next
  min == database %if min==nil
  %result == nil %if min==nil
  %cycle
    r == r_next
    r == database %if r==nil
    %result == min %if r==prev %or r==nil
    %if sortingorder='p' %start
      %if r_partition=prev_partition %start
        %result==r %if r_id>prev_id
      %else
        min == r %if r_partition<min_partition
      %finish
    %elseif sortingorder='n'
      compare(r_sur,prev_sur)
      compare(r_pre,prev_pre) %if dif=0
      %if dif=0 %start
        %result==r %if r_id>prev_id
      %else
        compare(r_sur,min_sur)
        compare(r_pre,min_pre) %if dif=0
        min == r %if dif<0
      %finish
    %elseif sortingorder='b'
      %if r_blocks=prev_blocks %start
        %result == r %if r_id>prev_id
      %else
        min == r %if r_blocks<min_blocks
      %finish
    %elseif sortingorder='a'
      %if r_age=prev_age %start
        %result == r %if r_id>prev_id
      %else
        min == r %if r_age<min_age
      %finish
    %elseif sortingorder='g'
      %if r_group=prev_group %start
        %result == r %if r_id>prev_id
      %else
        min == r %if group(r_group)<group(min_group)
      %finish
    %else
      %result == r
    %finish
  %repeat
%end

%routine list or show(%integer ls)
%record(entry fm)%name r
  merge %if dirlist==nil
  get full info %unless ls=0
  id = line; pre = ""; sur = ""
  %if line -> id.(" ").rest %start
    %if rest -> pre.(" ").sur %start
      pre = pre." ".rest %while sur -> rest.(" ").sur
    %finishelse sur = rest
  %finish
  toupper(id)
  id = "*" %if id=""
  pre = "*" %if pre=""
  sur = "*" %if sur=""
  r == nil
  %cycle
    r == next(r); %exitif r==nil
    %continueunless matches(r_id,id)
    %continueunless r_sur==nil %or matches(r_sur,sur)
    %continueunless r_pre==nil %or matches(r_pre,pre)
    %continueunless groupno<0 %or r_group=groupno
    %continueunless flagword=0 %or r_flags&flagword#0
    %continueunless partitionno<0 %or r_partition=partitionno
    printstring(r_id); write(r_partition,9-length(r_id)); space
    %unless ls=0 %start
      %if sizesknown=0 %start
        getsizes(r); getage(r)
      %finish
      write(r_blocks,5); write(r_files,3); space
      printstring(unpackdate(r_age)); space
    %finish
    printstring(unpackdate(r_created)); space
    printstring(r_pre); space; printstring(r_sur); space
    spaces(30-length(r_pre)-length(r_sur))
    printstring(group(r_group)); printstring(flags(r_flags))
    newline
  %repeat
%end

%routine list
  listorshow(0) %andreturnunless line=""
  printline("The LIST command lists database entries.  Only those entries")
  printline("which match the parameters selected by earlier GROUP and FLAGS")
  printline("commands are printed.  The ID, PRENAMES, and SURNAME parameters")
  printline("must all match.  An absent NAME is taken to be wild.")
  printline("Parameters:  ID  PRENAMES  SURNAME  (any or all may be wild)")
%end

%routine partition
  %on 4 %start
    printline(line." is not a number")
    %return
  %finish
  %unless line="" %start 
    partitionno = -1
    partitionno = stoi(line) %unless wildness(line)#0
    %return
  %finish
  printline("The PARTITION command determines which disk partition subsequent")
  printline("directories will be put into by the CREATE command, or restricts")
  printline("searches by the LIST and SHOW commands.  It may be wild.")
  printline("Parameter:  PARTITION-NUMBER")
%end

%routine permissions
  toupper(line)
  permissionsparm = line %andreturnunless line=""
  printline("The PERMISSIONS command sets up file permissions to be applied")
  printline("to new directories added by the CREATE command (default: FNA).")
  printline("Parameter:  PERMISSIONS")
%end

%routine promote
%string(255)from,to
%record(entry fm)%name r
%integer count=0,old,new
  %if line -> id.(" ").rest %and rest -> from.(" ").to -
  %and id#"" %and from#"" %and to#"" %start
    %if wildness(to)#0 %start
      printline("No wildcards for groups please")
      %return
    %finish
    old = -1; old = findgroup(from) %if wildness(from)=0
    printline("Unknown group ".from) %andreturnif old=0
    new = addgroup(to)
    printline("What's the point?") %andreturnif old=new
    r == nil
    %cycle
      r == locate record(id,r); %exitif r==nil
      %continueunless old<0 %or r_group=old
      r_group = new; count = count+1
    %repeat
    note change %unless count=0
    write(count,0); printline(" entries changed")
    %return
  %finish
  printline("The PROMOTE command is used to change the GROUP attribute of")
  printline("one or more users.")
  printline("Parameters:  ID  OLDGROUP  NEWGROUP")
  printline("Example:  PROMOTE * CS3 CS4")
%end

%routine quota
  %on 4 %start
    printline(line." is not a number"); %return
  %finish
  quotasize = stoi(line) %andreturnunless line=""
  printline("The QUOTA command sets up initial quota allocations for new")
  printline("directories added with the CREATE command (default 1990).")
  printstring("Parameter:  Number-of-blocks")
%end

%routine reflag
%string(255)f
%integer count=0,clear=0,set=0,this
%record(entry fm)%name r
  %if line -> id.(" ").rest %and id#"" %and rest#"" %start
    rest = rest.","
    %while rest -> f.(",").rest %cycle
      %continueif f=""
      %if charno(f,1)='-' %start
        f -> ("-").f; %continueif f=""
        this = findflag(f)
        printline("Unknown flag category ".f) %andreturnif this=0
        clear = clear!this
      %else
        this = findflag(f)
        printline("Unknown flag category ".f) %andreturnif this=0
        set = set!this
      %finish
    %repeat
    clear = \clear
    r == nil
    %cycle
      r == locate record(id,r); %exitif r==nil
      %continueunless groupno<0 %or r_group=groupno
      this = r_flags&clear!set
      count = count+1 %unless r_flags=this
      r_flags = this
    %repeat
    note change %unless count=0
    write(count,0); printline(" entries changed")
    %return
  %finish
  printline("The REFLAG command is used to set or clear various flag bits")
  printline("associated with existing entries in the database (such as")
  printline("whether Laser printer access is allowed).  The GROUP parameter")
  printline("must match, as well as the ID.  Flag names preceded by a minus")
  printline("sign indicate that the flag is to be cleared.")
  printline("Parameters:  ID  List of flag names separated by commas")
%end

%routine renamedir
%string(255)oid,nid
%record(entry fm)%name r,t,p
  %on 3 %start
    printline(event_message); %return
  %finish
  %if line -> oid.(" ").nid %and oid#"" %and nid#"" %start
    toupper(nid)
    printline("No wildcards please") %andreturn -
      %if wildness(oid)#0 %or wildness(nid)#0
    %if directory exists(oid) %start
      %if directory exists(nid) %start
        printline("New directory already exists")
      %else
        oid = oid.":"; nid = nid.":"; rename(oid,nid)
      %finish
    %else
      printline("Old directory does not exist")
    %finish
    r == locate record(nid,nil)
    printline("New entry already exists in database") %andreturnif r##nil
    r == locate record(oid,nil)
    printline("Old entry not in database") %andreturnif r==nil
    p == nil; t == database
    %while t##r %cycle
      p == t; t == t_next
    %repeat
    %if p==nil %then database == t_next %else p_next == t_next
    r_id = nid
    p == nil; t == database
    %cycle
      %if t==nil %or t_id>r_id %start
        r_next == t
        %if p==nil %then database == r %else p_next == r
        %exit
      %finish
      p == t; t == t_next
    %repeat
    note change
    %return
  %finish
  printline("The RENAME command renames a directory on disk and changes the")
  printline("ID field of an existing database entry.  No wildcards allowed.")
  printline("Parameters:  OLDID  NEWID")
%end

%routine show
  list or show(1) %andreturnunless line=""
  printline("The SHOW command behaves exactly like the LIST command, except")
  printline("that additional information about disk usage is included.")
  printline("Parameters:  ID  PRENAMES  SURNAME")
%end

%routine wipe
%string(255)f
%integer n=0
  %on 9 %start
    selectinput(2); closeinput; selectinput(1)
    write(n,0); printline(" files deleted")
    %return
  %finish
  %unless line="" %start
    id = line; toupper(id)
    printline("No wildcards please") %andreturnif wildness(id)#0
    %if directory exists(id) %start
      id = id.":"
      openinput(2,id); selectinput(2)
      %cycle
        readline(f); f = id.f; delete(f); n = n+1
      %repeat
    %finish
    printline("Directory does not exist")
    %return
  %finish
  printline("The WIPE command is used to delete all files in a directory")
  printline("about to be deleted.  This is not done automatically by the")
  printline("DELETE command, as a precaution against accidentally deleting")
  printline("the wrong directory.  The filestores cooperate in this by")
  printline("refusing to delete non-empty directories.")
  printline("Parameter:  ID")
%end

%predicate ok(%string(*)%name x,y)
! True if X is the leading part of Y
%integer lx = length(x)
  %falseif lx>length(y)
  %trueif x=substring(y,1,lx)
  %false
%end

%integerfn find element(%string(*)%name s,
                        %string(*)%arrayname a(1:%integer max))
%integer i
  %for i = 1,1,max %cycle
    %if ok(s,a(i)) %start
      %result = i %if i=max %ornot ok(s,a(i+1))
      printstring("Ambiguous: ")
      %cycle
        printstring(a(i)); i = i+1
        %exitif i>max %ornot ok(s,a(i))
        printstring(", ")
      %repeat
      newline
      %result = 0
    %finish
  %repeat
  %result = 0
%end

%string(255)input=cliparam,verb
%constinteger commands=18
%integer i
%switch action(0:commands)
%conststring(11)%array command(1:commands)=-
 "AMEND","BY","CREATE","DELETE","EXIT","FILE","FIND","FLAGS","GROUP","LIST",
 "PARTITION","PERMISSIONS","PROMOTE","QUOTA","REFLAG","RENAME","SHOW","WIPE"

%on 9 %start
  %stopif input=""
  closeinput
  input = ""
%finish

read database %if database==nil

input = ":" %if input=""
openinput(1,input); selectinput(1); prompt("Admin:")
input = "" %if input=":"
%cycle
  readline(line)
  %if line="" %start
    %continueunless input=""
    printline("Information about individual commands is available by typing")
    printline("the command without parameters.  The following commands exist:")
    printline(command(i)) %for i = 1,1,commands
    printline("They may be abbreviated to the first few letters.")
    %continue
  %finish
  verb = line %and line = "" %unless line -> verb.(" ").line
  toupper(verb)
  ->action(find element(verb,command))
action(0):  printstring("Command "); printstring(verb)
            printline(" not recognised")
            %signal 9 %unless input=""
            %continue
action(1):  amend;       %continue
action(2):  by;          %continue
action(3):  create;      %continue
action(4):  deletedir;   %continue
action(5):  %exit
action(6):  file;        %continue
action(7):  find;        %continue
action(8):  chooseflags; %continue
action(9):  choosegroup; %continue
action(10): list;        %continue
action(11): partition;   %continue
action(12): permissions; %continue
action(13): promote;     %continue
action(14): quota;       %continue
action(15): reflag;      %continue
action(16): renamedir;   %continue
action(17): show;        %continue
action(18): wipe
%repeat
update database

%end
