%include "GDMR_H:FSysAcc.Inc"
%include "GDMR_H:Tree.Inc"
%include "GDMR_H:IO_F.Inc"

%include "GDMR_H:Dump.Inc"

%externalroutinespec fsys initialise

%systemroutinespec phex(%integer i)

%routine zprintstring(%string(255) s)
   %integer i, ch
      %for i = 1, 1, length(s) %cycle
         ch = charno(s, i)
         %if ' ' <= ch <= '~' %start
            print symbol(ch)
         %else
            print symbol('<')
            write(ch, 0)
            print symbol('>')
         %finish
      %repeat
%end

! User record manipulation routines...
! User record fields appear in the database in the following order:
!     Pointers to authorisation record, login directory, description
!     Password (first, because it's fixed in size (4 bytes))
!     Username
!     Authorisation record
!     Login directory
!     Textual description

%recordformat database fm(%byte authorisation offset, login offset,
                          %byte description offset, spare,
                          %integer encrypted password,
                          %shortarray x(1 : 250))

%recordformat user fm(%integer size, %record(database fm) U)

%routine process one(%record(database fm)%name d, %integer size)
   %record(fsys access fm)%name a
   %string(*)%name u, l, t
   %integer i
      {} dump(size, byteinteger(addr(d)))
      u == string(addr(d_x(1)))
      a == record(addr(d_x(d_authorisation offset)))
      l == string(addr(d_x(d_login offset)))
      t == string(addr(d_x(d_description offset)))
      printstring("User: ");  printstring(u)
      printstring(", ID: ");  write(a_user ID, 0)
      printstring(", supervisor: ");  write(a_supervisor ID, 0);  newline
      printstring("Description: ");  printstring(t)
      printstring(", login directory: ");  printstring(l);  newline
      printstring("Privileges: ");  phex(a_privileges)
      printstring(", groups: ")
      write(a_group(i), 0) %and space %for i = 1, 1, a_groups
      newline
%end

%begin
   %integer ID, token = 0, flags, status, size
   %record(key list fm)%name keys, k
   %record(database fm) d
      %on 3, 9 %start
         printstring(event_message);  newline
         status = B tree close(token, 1) %if token # 0
         %stop
      %finish
      L translate path(nil, "Drive_1:System:Authority:Local_Database", ID)
      printstring("Database ID is ");  phex(ID);  newline
      fsys initialise
      status = B tree open by ID(nil, ID, 0, token, flags)
      %if status # 0 %start
         printstring("Open status: ");  write(status, 0)
         newline
         %stop
      %finish
      printstring("Tree opened as ");  phex(token);  newline
      keys == B tree key list(token, status)
      %if status # 0 %start
         printstring("Key list status: ");  write(status, 0)
         newline
         %stop
      %finish
      k == keys
      %while k ## nil %cycle
         phex(k_value);  spaces(2)
         zprintstring(k_key);  newline
         %if charno(k_key, 1) # 0 %start
            status = B tree data value(token, k_value, size, d)
            !! dump(size, byteinteger(addr(d)))
            process one(d, size)
         %finish
         k == k_next
      %repeat
      status = B tree close(token, 1)
%end %of %program
