(********************************************************************
      *                                                                  *
      *         Copyright (c) 1985 by                                    *
      *            Lewis Makepeace and Stan Zanarotti                    *
      *                                                                  *
      *                                                                  *
      *         All rights reserved.                                     *
      *                                                                  *
      ********************************************************************)
{ core - the meat of discuss

  History:
        23-Nov-84 RDJ Copied from SRZ.
        23-Nov-84 RDJ Added [environment] to force creation of .PEN.
        24-Nov-84 RDJ Setup [inherit] logicals, remove [environment].
        30-Nov-84 RDJ Copied to CS:[DISCUSS].
        30-Nov-84 RDJ Replaced logicals with .pen file names.
         3-Dec-84 RDJ Integrated eval_access.
         4-Dec-84 SRZ Made read_trn_hdr global for coretest
         4-Dec-84 SRZ Tried getting eval_access to work.  Ran into
                      run time errors.
         4-Dec-84 SRZ Added security to remove.
         4-Dec-84 SRZ Fixed eval access bugs.
         4-Dec-84 SRZ Added deleted_trn code.
         4-Dec-84 SRZ Added attempt to find old file
         4-Dec-84 SRZ Fixed transaction numbering for old file
         5-Jan-85 SRZ Added FUTIL file handling.
        22-Jan-85 SRZ Added DUTIL file handling.
        25-Jan-85 SRZ Added locking and formalized cacheing.
        31-Jan-85 SRZ Added calls to enable & disable privs.
}

[inherit (
                'types.pen',
                'mmtgs.pen',
                'umtgs.pen',
                'strings.pen',
                'error.pen',
                'io.pen',
                'lock.pen',
                'system.pen'
)]
module core;

[hidden] const
    nl = 10;
    file_success = 0;
    unique_mtg = 5927;
    unique_trn = 8833;
    blk_size = 508;
    dirs_in_root = 254;
    trns_in_dir = 127;
    MAX_VAX_FILENAMES = 40;
    MAX_DNAMES = 80;
    MAX_SHORT_NAMES = 9; { see module TYPES for definition of short_names }

type

       dnames = packed array [1..MAX_DNAMES] of char;
       vms_filespecs = varying [80] of char;
       vax_filenames = packed array [1..MAX_VAX_FILENAMES] of char;
       blks = array [1..blk_size] of char;
       files = integer;
       blk_nums = [word] 1..32767;
       offsets = [word] 0..blk_size+1;

      {global} trn_recs = record
                             trn_num : trn_nums;
                             author  : unames;
                             date_entered : date_times;
                             subject : subjects;
                             num_lines : words;
                          end;



[hidden]
type
       trn_hdrs = record
                    unique : integer;
                    trn_num : trn_nums;
                    blk_num : blk_nums;
                    offset  : offsets;
                    next    : trn_nums;
                    prev    : trn_nums;
                    nref    : trn_nums;
                    pref    : trn_nums;
                    author  : unames;
                    date_entered : date_times;
                    deleted : boolean;
                    subject : subjects;
                    length  : words;
                    num_lines : words;
                 end;  {record}


      mtg_hdrs = record
                   unique    : integer;
                   chairman  : unames;
                   short_name : short_names;
                   first      : trn_nums;
                   last       : trn_nums;
                   final      : trn_nums;
                   final_blk  : blk_nums;
                   final_offset : offsets;
                 end;

       ftype = array [1..512] of char;
       outarray = varying [80] of char;

 var
      accessfile  : integer;
      meetingfile : files;
      core_public : [global] record
                                username   : unames;
                                attending  : boolean;
                                mtg_name   : mtg_names;
                                short_name : short_names;
                                chairman   : unames;
                                privs      : accesses;
                                highest_seen : trn_nums;
                             end;

      mtg_hdr : mtg_hdrs;

      root_dir : array [1..dirs_in_root] of
                    record
                       blk_num : blk_nums;
                    end;


      sub_dir_blk : blk_nums;
      hdr_modified, sub_dir_modified, root_dir_modified : boolean;
      sub_dir : array [1..trns_in_dir] of
                   record
                      blk_num : blk_nums;
                      offset  : offsets;
                   end;

      emptyblk : blks;











[hidden]
procedure enable_privs; extern;

[hidden]
procedure disable_privs; extern;

[global] procedure fatal (string : outarray);

begin {fatal}
  put_output (string);
  halt;
end;  {fatal}











procedure init_blk (blk_num : blk_nums; var code : codes);

   var rms_code : integer;

begin (*init_blk*)
   dutil$put (meetingfile, %ref emptyblk, blk_num, rms_code);
   code := fstatus (rms_code);
end;  {init_blk}













procedure get_blk (blk_num : blk_nums;var blk : blks);


var    rms_code : integer;

begin {get_blk}
  dutil$get (meetingfile, %ref blk, blk_num, rms_code);
  if rms_code <> 0 then
    fatal ('block cannot be found');
end; {get_blk}













procedure save_blk (blk_num : blk_nums; blk:blks);

var rms_code :integer;
    code : codes;

begin {save_blk}
  dutil$put (meetingfile, %ref blk, blk_num, rms_code);
  if (rms_code <> 0) then begin
    code := fstatus (rms_code);
    error_handler (code, 'Core');
    fatal ('block cannot be located');
  end;
end;  {save_blk}












(* routines to handle cacheing of header, dir, and subdirs. *)

[hidden]
procedure write_cache;

   var blk : blks;

begin
   if hdr_modified then begin
      blk := emptyblk;
      sys_move (%ref mtg_hdr, %ref blk[1], size(mtg_hdrs));
      save_blk (1,blk);
      hdr_modified := false;
   end;
   if root_dir_modified then begin
      sys_move (%ref root_dir, %ref blk[1], blk_size);
      save_blk (2,blk);
      root_dir_modified := false;
   end;
   if sub_dir_modified and (sub_dir_blk <> 0) then begin
      sys_move (%ref sub_dir,%ref blk[1], blk_size);
      save_blk(sub_dir_blk,blk);
      sub_dir_modified := false;
   end;
end; {procedure write_cache}


[hidden]
procedure read_cache;

   var blk : blks;

begin
   get_blk (1,blk);
   sys_move(%ref blk[1],%ref mtg_hdr,size(mtg_hdrs));
   hdr_modified := false;
   get_blk (2,blk);
   sys_move(%ref blk[1],%ref root_dir,blk_size);
   root_dir_modified := false;
   if sub_dir_blk <> 0 then begin
      get_blk (sub_dir_blk,blk);
      sys_move(%ref blk[1],%ref sub_dir,blk_size);
   end;
   sub_dir_modified := false;
end; {procedure read_cache}

(* Procedure to assure that the given sub_dir is cached.  It is local *)
[hidden]
procedure cache_sub_dir (dir_num: blk_nums);

   var blk : blks;

begin
   if dir_num <> sub_dir_blk then begin
      if sub_dir_modified then write_cache;
      if dir_num <> 0 then begin
         get_blk (dir_num,blk);
         sys_move(%ref blk[1],%ref sub_dir,blk_size);
      end;
      sub_dir_blk := dir_num;
   end;
end; {procedure cache_sub_dir}

[hidden]
procedure add_dir_entry (trn_num : trn_nums;
                      blk_num : blk_nums; offset : offsets;
                      var code : codes);

var
     blk : blks;
     i : integer;
     new_blk_num : blk_nums;
     sd_blk_num : blk_nums;
     sub_dir_num : blk_nums;
     sub_dir_index : offsets;


begin {add_dir_entry}
  sub_dir_num := (trn_num - 1) div trns_in_dir + 1;
  sub_dir_index := (trn_num - 1) mod trns_in_dir + 1;
  sd_blk_num := (root_dir[sub_dir_num].blk_num);
  if sd_blk_num = 0 then begin
     cache_sub_dir (0);
     {create a new subdir}
     new_blk_num := mtg_hdr.final_blk + 1;
     init_blk (new_blk_num, code);
     if code <> success then return;
     mtg_hdr.final_blk := new_blk_num;
     mtg_hdr.final_offset := blk_size+1;                {end of this block}
     hdr_modified := true;
     for i := 1 to trns_in_dir do begin
        sub_dir[i].blk_num := 0;
        sub_dir[i].offset := 0;
     end;
     sub_dir_blk := new_blk_num;
     root_dir[sub_dir_num].blk_num := new_blk_num;
     root_dir_modified := true;
  end
  else
     cache_sub_dir (sd_blk_num);

  sub_dir[sub_dir_index].blk_num := blk_num;
  sub_dir[sub_dir_index].offset := offset;
  sub_dir_modified := true;
  code := success;
end;  { add_dir_entry}













procedure trn_addr (trn_num : trn_nums; var blk_num : blk_nums;
                           var offset : offsets; var code : codes);

type    t1 = 1..trns_in_dir;
        t2 = 1..dirs_in_root;

var     sub_dir_index : t1;
        blk : blks;
        sub_dir_num : t2;
        sd_blk_num : blk_nums;

begin {trn_addr}
  code := success;

  if trn_num > mtg_hdr.final then begin
    write_cache;
    read_cache;
  end;

  if trn_num > mtg_hdr.final then begin
    blk_num := 0;
    offset := 0;
    code := no_such_trn;                (* past end *)
    return;
  end;

  sub_dir_num := (trn_num - 1) div trns_in_dir + 1;
  sub_dir_index := (trn_num - 1) mod trns_in_dir + 1;
  sd_blk_num := root_dir[sub_dir_num].blk_num;
  if sd_blk_num = 0 then begin
    blk_num := 0;
    offset := 0;
    code := deleted_trn;
    return;
  end
  else cache_sub_dir (sd_blk_num);

  blk_num := sub_dir[sub_dir_index].blk_num;
  offset := sub_dir[sub_dir_index].offset;

  if blk_num = 0 then
     code := deleted_trn;

end;   {trn_addr}













[global] procedure read_trn_hdr (trn_num : trn_nums;
                          var trn_hdr : trn_hdrs;
                          var code : codes);

var
    blk_num : blk_nums;
    offset : offsets;
    blk : blks;


begin {read_trn_hdr}
  if trn_num = 0 then begin
    code := no_such_trn;
    return;
    end;

  trn_addr(trn_num, blk_num, offset, code);
  if code <> success then begin
    return;
    end;

  get_blk (blk_num, blk);
  sys_move (%ref blk[offset], %ref trn_hdr, size(trn_hdrs));
  code := success;
end;  {read_trn_hdr}


























procedure write_trn_hdr (trn_hdr : trn_hdrs);

var  blk : blks;
     temp_hdr : trn_hdrs;

begin {write_trn_hdr}
  get_blk (trn_hdr.blk_num , blk);
  sys_move (%ref blk[trn_hdr.offset],%ref temp_hdr, size(trn_hdrs));
{  if temp_hdr.trn_num <> trn_hdr.trn_num then
    fatal ('writing different transaction ');}
  sys_move (%ref trn_hdr, %ref blk[trn_hdr.offset], size(trn_hdrs));
  save_blk (trn_hdr.blk_num, blk)
end;  {write_trn_hdr}













procedure read_text (dest_file : integer;
                               length : words;
                               blk_num : blk_nums;
                               offset : offsets;
                               var code : codes);

var  blk: blks;
     out_line : varying [255] of char;
     rms_code : integer;


begin {read_text}
  if blk_num < 2 then
    fatal ('invalid parameter to read_text');

  out_line := '';
  get_blk (blk_num, blk);
  while ((length > 0) and (not(sys_interrupt))) do begin
    if offset > blk_size then begin
      offset := 1;
      blk_num := blk_num + 1;
      get_blk ( blk_num , blk)
      end;
    if blk[offset] = chr(nl) then begin
      put_line (dest_file, out_line, rms_code);
      if (rms_code <> 0) then begin
        code := fstatus (rms_code);
        return;
      end;
      out_line := '';
      end
    else begin
      out_line := out_line + blk[offset];
      end;

    offset := offset + 1;
    length := length - 1;
    end;

  code := success;
end;  {read_text}













procedure write_text (source_file : integer;
                               var length : words;
                               var num_lines : words;
                               var code : codes);

var   blk : blks;
      ch : char;
      i,len : integer;
      in_line : packed array [1..255] of char;
      rms_code : integer;


begin {write_text}
  length := 0;
  num_lines := 0;
  code := success;

  get_blk (mtg_hdr.final_blk, blk);
  get_line(source_file, in_line, len, rms_code);
  i := 1;
  while (rms_code = 0) do begin
    if (i > len) then begin
      num_lines := num_lines + 1;
      ch := chr(nl);
    end
    else
      ch := in_line[i];

    length := length + 1;
    if mtg_hdr.final_offset > blk_size then begin
      save_blk (mtg_hdr.final_blk, blk);
      init_blk (mtg_hdr.final_blk + 1, code);
      if code <> success then
         return;

      mtg_hdr.final_blk := mtg_hdr.final_blk + 1;
      mtg_hdr.final_offset := 1;
      hdr_modified := true;
      end;

    blk [mtg_hdr.final_offset] := ch;
    mtg_hdr.final_offset := mtg_hdr.final_offset + 1;
    hdr_modified := true;
    if i > len then begin
       get_line (source_file, in_line, len, rms_code);
       i := 1;
    end
    else
       i := i + 1;
  end;
  if rms_code <> rms_eof then code := fstatus (rms_code);
  save_blk (mtg_hdr.final_blk, blk);
end;   {write_text}











[global] procedure check_mtg_hdr (master_rec : master_recs;
                                  var code : codes);

begin {check_mtg_hdr}

        if (mtg_hdr.unique <> unique_mtg) then
                code := inconsistent
        else if (mtg_hdr.short_name <> master_rec.short_name) then
                code := inconsistent
        else if (mtg_hdr.chairman <> master_rec.chairman) then
                code := inconsistent
        else
                code := success;

end; {check_mtg_hdr}











procedure eval_access (master_rec: master_recs; var privs: accesses);

{ This procedure implements the algorithm that decided the access the
   current user has to the given meeting

   Parameters: master_rec - the master record
               privs - the access privileges that the user has

   Calls: skip_blank - removes all blanks from a string
          submatch - checks for a submatch between 2 strings
          str_to_access - determines what accesses are on a given line in the in
put file  }


var
   done: boolean;
   i: integer;
   instring, testname: string;
   colon_pos, star_pos : integer;
   match : boolean;
   inlen : integer;
   rms_code : integer;
   owner : integer;
   in_line : packed array [1..255] of char;











{eval_access}

   procedure upcase (var str : string);

      var i : integer;
   begin
      for i := 1 to length (str) do begin
         if (str[i]>='a') and (str[i]<='z') then
            str[i] := chr (ord (str[i]) - ord('a') + ord ('A'));
      end;
   end; {upcase}

{eval_access}
   procedure str_to_access (right_str: string; var privs: accesses);

   { This procedure converts from character representation to set

      Parameters: right_str - the string that contains the access rights
                  privs - the set of access rights

      Calls: None  }

   begin
      privs := [];              {assume no access}
      if (index(right_str, 'R')<>0) then
         privs := privs + [rd];
      if (index(right_str, 'W')<>0) then
         privs := privs + [wr];
   end; { str_to_access }











{eval_access}
function submatch(test_str,
                  given_str:varying[len]of char;
                  min_match:integer):boolean;

begin
   if length (test_str) < min_match then
      submatch := false
   else
   if length (test_str) = 0 then
      submatch := true
   else
   if test_str = (substr (given_str, 1, length (test_str))) then
      submatch := true
   else
      submatch := false;
end; {submatch}











{eval_access}
   procedure skip_blank (var str: string);

   { removes all blanks from a string

      Parameters: str - the string to remove blanks from

      Calls: None  }

   { removes all blanks from the string str }

   var
      i: integer;
      temp: string;

   begin
      temp:='';
      for i:=1 to length(str) do
         if str[i]<>' ' then
            temp:=temp + str[i];
      str:=temp
   end; { skip_blank }











{eval_access}
begin
   done:=false;
   if (sys_admin or (core_public.username = master_rec.chairman)) then
      privs :=[rd, wr, cm]
   else if master_rec.public_flag then
      privs:=[rd, wr]
   else begin
      testname:=master_rec.vax_filename;
      skip_blank (testname);
      enable_privs;
      futil$open_read(accessfile, testname, '.acl', rms_code);
      disable_privs;
      if (rms_code <> 0) then begin
         privs:=[];     {Cannot access file, no privs.}
         return;
      end;
      futil$owner(accessfile,owner);
      if (owner <> master_rec.uic) then begin
         privs:=[];             { owners must match }
         futil$close(accessfile,rms_code);
         return;
      end;
      get_line(accessfile, in_line, inlen, rms_code);
      while (rms_code = 0) and not done do begin
         instring := substr (in_line, 1, inlen);
         skip_blank(instring);
         upcase(instring);
         if (length (instring) > 1) and (length (instring) <= 40) then begin
            colon_pos := index (instring, ':');
            if (colon_pos > 1) and (colon_pos <= 13) then begin
               testname := substr (instring, 1, colon_pos-1);
               star_pos := index (testname, '*');
               match:=false;
               if (star_pos<>0) then begin      { username* }
                  if star_pos = 1 then begin    { just '*' }
                     match := true
                  end
                  else begin
                     testname := substr (testname, 1, star_pos-1);
                     match := submatch (testname, core_public.username, length (
testname));
                  end;
               end
               else begin
                  testname:=pad(testname,' ',12);
                  match := (testname = core_public.username);
               end;

               if match then begin
                  if colon_pos = length (instring) then begin {: at end of line}
                     privs := [];
                  end
                  else
                     str_to_access(substr(instring,colon_pos+1,length(instring)-
colon_pos),privs);
                  done := true;
               end;
            end; {if : there}
         end; { if }
         get_line (accessfile, in_line, inlen, rms_code);
      end; { while }
      if not done then
         privs:=[];
      futil$close(accessfile, rms_code);
   end;
end; { eval_access }











(*  core$mtg routines:  procedure with locking procedures to isolate
    the rest of discuss from mmtgs.

 *)

[global]
procedure core$get_master_mtg(mtg_name   : mtg_names;
                     Var master_rec : master_recs;
                     Var code       : codes);

   var alt_code : codes;
       prev_mode : lock_modes;
begin
   lock_db (PR_MODE, prev_mode, code);
   if code <> success then return;

   get_master_mtg(mtg_name,master_rec,code);
   lock_db (prev_mode, prev_mode, alt_code);
end;

[global]
procedure core$start_master_mtg;

   var code : codes;
       prev_mode : lock_modes;
begin
   lock_db (PR_MODE, prev_mode, code);
   if code <> success then return;
   start_master_mtg;
   lock_db (prev_mode, prev_mode, code);
end;

[global]
procedure core$next_master_mtg(var master_rec : master_recs;
                              Var code       : codes);

   var alt_code : codes;
       prev_mode : lock_modes;
begin
   lock_db (PR_MODE, prev_mode, code);
   if code <> success then return;
   next_master_mtg(master_rec,code);
   lock_db (prev_mode, prev_mode, alt_code);
end;












[hidden] procedure timestamp (var buf : date_times);

var
        dat, tim : packed array [1..11] of char;
        i : integer;

begin {timestamp}

   date (dat);
   time (tim);
   for i := 1 to 11 do begin
      buf [i] := dat[i];
      buf [12+i] := tim[i];
   end;
   buf [12] := ' ';

end; {timestamp}











[global] procedure record_mtg_change;

var
        blk : blks;
        master_rec : master_recs;
        code : codes;
        prev_mode : lock_modes;

begin {record_mtg_change}
        lock_db (PR_MODE, prev_mode, code);

        get_master_mtg (core_public.mtg_name, master_rec, code);
        if (code <> success) then
                fatal ('attending no meeting');
        date (master_rec.date_modified);
        master_rec.last := mtg_hdr.last;
        update_master_mtg (master_rec, code);
        write_cache;
        lock_db (prev_mode, prev_mode, code);
end; {record_mtg_change}











[global] function trn_num_prev (trn_num : trn_nums) : trn_nums;

{ Gets the previous transaction number }


label 999;
var
  trn_hdr : trn_hdrs;
  code : codes;                { Return code from Read_trn_hdr     }

begin {trn_num_prev}

        trn_num_prev := 0;
        if (core_public.attending) then begin
                read_trn_hdr (trn_num, trn_hdr, code);
                if (code = success) then begin
                        if (trn_hdr.prev <> 0) then begin
                                trn_num := trn_hdr.prev;
                                read_trn_hdr (trn_num, trn_hdr, code);
                                if (code = success) then begin
                                        while (trn_hdr.deleted) do begin
                                                trn_num := trn_hdr.prev;
                                                if (trn_num = 0) then begin
                                                        goto 999;
                                                end;
                                                read_trn_hdr (trn_num, trn_hdr,
                                                             code);
                                                if (code <> success) then begin
                                                        goto 999;
                                                end;
                                        end;
                                        trn_num_prev := trn_num;
                                end;
                        end;
                end;
        end;

999:;
end; {trn_num_prev}











[global] function trn_num_next (trn_num : trn_nums) : trn_nums;

{ gets the next transaction number }


label 999;
var
  trn_hdr : trn_hdrs;
  code : codes;           { Return code from Read_trn_hdr   }

begin {trn_num_next}

        trn_num_next := 0;
        if (core_public.attending) then begin
                read_trn_hdr (trn_num, trn_hdr, code);
                if (code = success) then begin
                        if (trn_hdr.next <> 0) then begin
                                trn_num := trn_hdr.next;
                                read_trn_hdr (trn_num, trn_hdr, code);
                                if (code = success) then begin
                                        while (trn_hdr.deleted) do begin
                                                trn_num := trn_hdr.next;
                                                if (trn_num = 0) then begin
                                                        goto 999;
                                                end;
                                                read_trn_hdr (trn_num, trn_hdr,
                                                             code);
                                                if (code <> success) then begin
                                                        goto 999;
                                                end;
                                        end;
                                        trn_num_next := trn_num;
                                end;
                        end;
                end;
        end;

999:;
end; {trn_num_next}











[global] function trn_num_pref (trn_num : trn_nums) : trn_nums;

{ Gets the previous transaction number in the current chain }


label 999;
var
  trn_hdr : trn_hdrs;
  code : codes;                { Return code from Read_trn_hdr     }

begin {trn_num_pref}

        trn_num_pref := 0;
        if (core_public.attending) then begin
                read_trn_hdr (trn_num, trn_hdr, code);
                if (code = success) then begin
                        if (trn_hdr.pref <> 0) then begin
                                trn_num := trn_hdr.pref;
                                read_trn_hdr (trn_num, trn_hdr, code);
                                if (code = success) then begin
                                        while (trn_hdr.deleted) do begin
                                                trn_num := trn_hdr.pref;
                                                if (trn_num = 0) then begin
                                                        goto 999;
                                                end;
                                                read_trn_hdr (trn_num, trn_hdr,
                                                             code);
                                                if (code <> success) then begin
                                                        goto 999;
                                                end;
                                        end;
                                        trn_num_pref := trn_num;
                                end;
                        end;
                end;
        end;

999:;
end; {trn_num_pref}











[global] function trn_num_nref (trn_num : trn_nums) : trn_nums;

{ Gets the next transaction number in the current chain }


label 999;
var
  trn_hdr : trn_hdrs;
  code : codes;           { Return code from Read_trn_hdr   }

begin {trn_num_nref}

        trn_num_nref := 0;
        if (core_public.attending) then begin
                read_trn_hdr (trn_num, trn_hdr, code);
                if (code = success) then begin
                        if (trn_hdr.nref <> 0) then begin
                                trn_num := trn_hdr.nref;
                                read_trn_hdr (trn_num, trn_hdr, code);
                                if (code = success) then begin
                                        while (trn_hdr.deleted) do begin
                                                trn_num := trn_hdr.nref;
                                                if (trn_num = 0) then begin
                                                        goto 999;
                                                end;
                                                read_trn_hdr (trn_num, trn_hdr,
                                                             code);
                                                if (code <> success) then begin
                                                        goto 999;
                                                end;
                                        end;
                                        trn_num_nref := trn_num;
                                end;
                        end;
                end;
        end;

999:;
end; {trn_num_nref}











[global] function trn_num_last : trn_nums;

{ Gets the last transaction number in  the current meeting }

begin {trn_num_last}

        if (not core_public.attending) then
                trn_num_last := 0
        else
                trn_num_last := mtg_hdr.last;

end; {trn_num_last}











[global] function trn_num_first : trn_nums;

{ Gets the first transaction number in the current meeting }

begin {trn_num_first}

        if (not core_public.attending) then
                trn_num_first := 0
        else
                trn_num_first := mtg_hdr.first;

end; {trn_num_first}











[global] procedure add_trn (source_file : integer;
                            subject : subjects;
                            rpy_trn_num : trn_nums;
                            var fnl_trn_num : trn_nums;
                            var code : codes);

var lref_trn_hdr, prev_trn_hdr, new_trn_hdr : trn_hdrs;
    nref, lref : trn_nums;
    prev_last : trn_nums;
    i : integer;
    prev_mode : lock_modes;
    alt_code : codes;

begin
   if not core_public.attending then begin
      code := no_current_mtg;
      return;
   end;

   if not (wr in core_public.privs) then begin
      code := no_access;
      return;
   end;

   lock_mtg (mtg_hdr.short_name, PW_MODE, prev_mode, code);
   if code <> success then return;

   read_cache;

   lref := rpy_trn_num;
   if (lref <> 0) then begin            { replying to a transaction }
        read_trn_hdr (lref, lref_trn_hdr, code);
        if (code <> success) then begin
                code := no_such_trn;
                lock_mtg (mtg_hdr.short_name,prev_mode,prev_mode,alt_code);
                return;
        end;
        while (lref_trn_hdr.nref <> 0) do begin { find last in chain of replies
}
                lref := lref_trn_hdr.nref;
                read_trn_hdr (lref, lref_trn_hdr, code);
                if (code <> success) then begin
                     lock_mtg (mtg_hdr.short_name,prev_mode,prev_mode,alt_code);
                     return;
                end;
        end;
   end;

   fnl_trn_num := mtg_hdr.final + 1;

   if (mtg_hdr.final_offset + size(trn_hdrs) > blk_size) then begin
      init_blk (mtg_hdr.final_blk+1,code);      { allocate a new one }
      if code <> success then begin
         lock_mtg (mtg_hdr.short_name, prev_mode, prev_mode, alt_code);
         return;
      end;

      mtg_hdr.final_blk := mtg_hdr.final_blk + 1;
      mtg_hdr.final_offset := 1;
      hdr_modified := true;
   end;

   {fill in transaction header}
   new_trn_hdr.unique := unique_trn;
   new_trn_hdr.trn_num := fnl_trn_num;
   new_trn_hdr.blk_num := mtg_hdr.final_blk;
   new_trn_hdr.offset := mtg_hdr.final_offset;
   new_trn_hdr.next := 0;
   new_trn_hdr.prev := mtg_hdr.final;
   new_trn_hdr.nref := 0;
   new_trn_hdr.pref := lref;
   new_trn_hdr.author := core_public.username;
   timestamp (new_trn_hdr.date_entered);
   new_trn_hdr.deleted := false;
   new_trn_hdr.subject := subject;
   new_trn_hdr.length := 0;
   new_trn_hdr.num_lines := 0;

   write_trn_hdr (new_trn_hdr);
   mtg_hdr.final_offset := mtg_hdr.final_offset + size(trn_hdrs);
   hdr_modified := true;

   write_text (source_file, new_trn_hdr.length, new_trn_hdr.num_lines, code);
   if code <> success then begin
      lock_mtg (mtg_hdr.short_name, prev_mode, prev_mode, alt_code);
      return;
   end;

   write_trn_hdr (new_trn_hdr);         { update length and num_lines }

   add_dir_entry (fnl_trn_num, new_trn_hdr.blk_num, new_trn_hdr.offset, code);
   if code <> success then begin
      lock_mtg (mtg_hdr.short_name, prev_mode, prev_mode, alt_code);
      return;
   end;

   { From now on, we should not get any 'soft errors'.  Let things get
   { inconsistent...
   }

   if (lref <> 0) then begin
        lref_trn_hdr.nref := fnl_trn_num;
        write_trn_hdr (lref_trn_hdr);
   end;

   if (mtg_hdr.final <> 0) then begin
      read_trn_hdr (mtg_hdr.final, prev_trn_hdr, code); { read prev trn }
      prev_trn_hdr.next := fnl_trn_num;
      write_trn_hdr (prev_trn_hdr);
   end;

   { update mtg_hdr }
   mtg_hdr.final := fnl_trn_num;
   prev_last := mtg_hdr.last;           (* keep it around for highest seen check
 *)
   mtg_hdr.last := fnl_trn_num;
   hdr_modified := true;
   if (mtg_hdr.first = 0) then
      mtg_hdr.first := fnl_trn_num;

{srz: change highest_seen definition:
    if he's kept up-to-date, mark this one as 'seen' }
    if core_public.highest_seen >= prev_last then
       core_public.highest_seen := fnl_trn_num;

   record_mtg_change;

   lock_mtg (mtg_hdr.short_name, prev_mode, prev_mode, code);

end; {add_trn}











[hidden] function may_access_trn (trn_hdr: trn_hdrs): boolean;

begin {may_access_trn}

        if ((cm in core_public.privs) or
            ( (wr in core_public.privs) and
              (trn_hdr.author = core_public.username) )) then
                may_access_trn := true
        else
                may_access_trn := false;

end; {may_access_trn}











[global] procedure delete_trn (trn_num : trn_nums;
                               var code : codes);

var
        trn_hdr : trn_hdrs;
        prev, next : trn_nums;
        prev_mode : lock_modes;
        alt_code : codes;

begin {delete_trn}

        if (not core_public.attending) then
                code := no_current_mtg
        else begin
                lock_mtg (mtg_hdr.short_name, PW_MODE, prev_mode, code);
                if code <> success then return;

                read_cache;
                read_trn_hdr (trn_num, trn_hdr, code);
                if (code = success) then
                        if (trn_hdr.deleted) then
                                code := deleted_trn
                        else if (may_access_trn (trn_hdr)) then begin
                                prev := trn_num_prev (trn_num);
                                next := trn_num_next (trn_num);
                                trn_hdr.deleted := true;
                                write_trn_hdr (trn_hdr);
                                if (trn_num = mtg_hdr.first) then begin
                                        mtg_hdr.first := next;
                                        hdr_modified := true;
                                end;
                                if (trn_num = mtg_hdr.last) then begin
                                        mtg_hdr.last := prev;
                                        hdr_modified := true;
                                end;
                                record_mtg_change;
                                code := success;
                        end
                        else
                                code := no_access;
                lock_mtg (mtg_hdr.short_name, prev_mode, prev_mode, alt_code);
        end;

end; {delete_trn}











[global] procedure retrieve_trn (trn_num : trn_nums;
                                 var code : codes);
var
        trn_hdr : trn_hdrs;
        prev_mode : lock_modes;
        alt_code : codes;

begin {retrieve_trn}

        if (not core_public.attending) then
                code := no_current_mtg
        else begin
                lock_mtg (mtg_hdr.short_name, PW_MODE, prev_mode, code);
                if code <> success then return;

                read_cache;
                read_trn_hdr (trn_num, trn_hdr, code);
                if (code = success) then
                        if (not trn_hdr.deleted) then
                                code := not_deleted
                        else if (may_access_trn (trn_hdr)) then begin
                                trn_hdr.deleted := false;
                                write_trn_hdr (trn_hdr);
                                if ((mtg_hdr.first > trn_num) or
                                    (mtg_hdr.first = 0)) then begin
                                        mtg_hdr.first := trn_num;
                                        hdr_modified := true;
                                end;
                                if (mtg_hdr.last < trn_num) then begin
                                        mtg_hdr.last := trn_num;
                                        hdr_modified := true;
                                end;
                                record_mtg_change;
                                code := success;
                        end
                        else code := no_access;
                lock_mtg (mtg_hdr.short_name, prev_mode, prev_mode, alt_code);
        end;

end; {retrieve_trn}











[global] procedure attend (mtg_name : mtg_names;
                           var code : codes);

   var blk : blks;
       master_rec : master_recs;
       user_rec : user_recs;
       rms_code : integer;
       alt_code : codes;
       prev_mode : lock_modes;
       owner : integer;

begin {attend}

   if (core_public.attending) then begin
      code := already_attending;
      return;
   end;

   core$get_master_mtg (mtg_name, master_rec, code);
   if (code <> success) then
        return;


   lock_mtg (master_rec.short_name, CR_MODE, prev_mode, code);
   if code <> success then return;

   (* make sure this meeting hasn't disappeared (since we had no lock on it) *)
   core$get_master_mtg (mtg_name, master_rec, code);
   if code <> success then begin
      lock_mtg (master_rec.short_name, prev_mode, prev_mode, alt_code);
      return;
   end;

   eval_access (master_rec, core_public.privs);
   if (not (rd in core_public.privs)) and (not (wr in core_public.privs)) then b
egin
        lock_mtg (master_rec.short_name, prev_mode, prev_mode, alt_code);
        code := no_access;
        if master_rec.invisible then code := no_such_mtg; {don't give anything a
way}
        return;
   end;

   enable_privs;
   dutil$open_old(meetingfile, rtrim(master_rec.vax_filename),
                  '.mtg',size(blks),rms_code);
   disable_privs;
   if (rms_code <> 0) then begin
      code := fstatus(rms_code);
      lock_mtg (master_rec.short_name, prev_mode, prev_mode, alt_code);
      return;
   end;

   futil$owner (meetingfile, owner);
   if (owner <> master_rec.uic) then begin
      code := no_access;
      lock_mtg (master_rec.short_name, prev_mode, prev_mode, alt_code);
      futil$close (meetingfile, rms_code);
      return;
   end;

   sub_dir_blk := 3;
   read_cache;
   check_mtg_hdr (master_rec, code);
   if (code <> success) then begin
        dutil$close(meetingfile,rms_code);
        lock_mtg (master_rec.short_name, prev_mode, prev_mode, alt_code);
        return;
   end;


   get_user_mtg (master_rec.mtg_name, user_rec, code);
   if (code <> success) then begin
        { create meeting record }
        user_rec.mtg_name := master_rec.mtg_name;
        user_rec.highest_seen := 0;
        timestamp (user_rec.last_time_attend);
        user_rec.last_access := core_public.privs;
        add_user_mtg (user_rec, code);
        if (code <> success) then
                return;
   end;
   core_public.attending := true;
   core_public.mtg_name := master_rec.mtg_name;
   core_public.short_name := master_rec.short_name;
   core_public.chairman := master_rec.chairman;
   core_public.highest_seen := user_rec.highest_seen;

   code := success;
end; {attend}











[global] procedure resign (mtg_name : mtg_names;
                  var code : codes);
var
        master_rec : master_recs;

begin {resign}

        delete_user_mtg (mtg_name, code);
        if (code <> success) then begin         { must be short name }
                get_master_mtg (mtg_name, master_rec, code);
                if (code <> success) then       { not in master meetings }
                        code := no_such_mtg
                else
                        delete_user_mtg (master_rec.mtg_name, code);
                        { code as set from delete_user_mtg }
        end;

end; {resign}






















[global] procedure create (mtg_name : mtg_names;
                           short_name : short_names;
                           public : boolean;
                           hidden : boolean;
                           var code : codes);

var dirname : dnames;
    master_rec : master_recs;
    blk : blks;
    i,j : integer;
    mtg_filename : varying [80] of char;
    m_name,s_name : string;
    rms_code : integer;
    file_created : boolean;
    alt_code : codes;
    prev_mode : lock_modes;
    uic : integer;

begin {create}
   if core_public.attending then begin
      code := already_attending;
      return;
   end;
   code := inv_name;
   m_name := rtrim (mtg_name);
   if length (m_name) = 0 then return;

   for j := 1 to length (m_name) do begin
      if not (m_name[j] in ['A'..'Z','a'..'z', '_','0'..'9']) then return;
   end;

   s_name := rtrim (short_name);
   if length (s_name) = 0 then return;

   for j := 1 to length (s_name) do begin
      if not (s_name[j] in ['A'..'Z','a'..'z', '0'..'9']) then return;
   end;

   if equals (m_name, s_name) then begin
      code := names_same;
      return;
   end;

   sys_directory (dirname);
   sys_uic (uic);
   master_rec.mtg_name := mtg_name;
   master_rec.chairman := core_public.username;
   master_rec.last := 0;
   str_to_pkd (rtrim(dirname)+short_name,master_rec.vax_filename);
   master_rec.short_name := short_name;
   date (master_rec.date_created);
   master_rec.date_modified := master_rec.date_created;
   master_rec.public_flag := public;
   master_rec.uic := uic;
   master_rec.invisible := hidden;
   master_rec.unused := 0;

   mtg_hdr.unique := unique_mtg;
   mtg_hdr.chairman := master_rec.chairman;
   mtg_hdr.short_name := master_rec.short_name;
   mtg_hdr.first := 0;
   mtg_hdr.last := 0;
   mtg_hdr.final := 0;
   mtg_hdr.final_blk := 3;
   mtg_hdr.final_offset := blk_size+1;

   mtg_filename := rtrim(dirname)+rtrim(short_name)+'.mtg';

   file_created := false;
   dutil$open_old(meetingfile,mtg_filename,'',size(blks),rms_code);
   if rms_code <> 0 then begin
      dutil$open_new_mtg(meetingfile,mtg_filename,'',size(blks),rms_code);
      if (rms_code <> 0) then begin
         code := fstatus (rms_code);
         return;
      end;

      file_created := true;
      Init_blk (1, code);
      Init_blk (2, code);
      Init_blk (3, code);
      if code <> success then return;

      root_dir[1].blk_num := 3;
      for i := 2 to dirs_in_root do
         root_dir[i].blk_num := 0;

      for i := 1 to trns_in_dir do begin
         sub_dir[i].blk_num := 0;
         sub_dir[i].offset := 0;
      end;

      hdr_modified := true;
      root_dir_modified := true;
      sub_dir_modified := true;
      sub_dir_blk := 3;
      write_cache;
   end
   else begin
       {old file found.  Check for consistency with what is should be.}
        sub_dir_blk := 0;
        read_cache;

        check_mtg_hdr(master_rec, code);
        if code <> success then begin
           dutil$close (meetingfile, rms_code);
           return;
        end;
        master_rec.last := mtg_hdr.last;
   end;

   dutil$close (meetingfile, rms_code);

   lock_db (PW_MODE, prev_mode, code);
   if code <> success then return;
   add_master_mtg (master_rec, code);

   lock_db (prev_mode, prev_mode, alt_code);

   (* if we go thru all this trouble, and cannot even add it, then
      get rid of the old file. *)
   if file_created and (code <> success) then begin
      futil$delete (mtg_filename, '', rms_code);
   end;

end; {create}











[global] procedure copy_trn (trn_num : trn_nums;
                             dest_file : integer;
                             var code: codes);
var
        trn_hdr : trn_hdrs;

begin {copy_trn}
        if (not core_public.attending) then
                code := no_current_mtg
        else
        if not (rd in core_public.privs) then
           code := no_access
        else begin
                read_trn_hdr (trn_num, trn_hdr, code);
                if (code = success) then begin
                        read_text (dest_file, trn_hdr.length, trn_hdr.blk_num,
                                   trn_hdr.offset + size(trn_hdrs), code);
                        if (code = success) and
                           (trn_num > core_public.highest_seen) then
                           core_public.highest_seen := trn_num;
                end;
        end;

end; {copy_trn}











[global] procedure remove (mtg_name : mtg_names;
                           var code : codes);

   var mtg_rec : master_recs;
       prev_mode : lock_modes;
       prev_db_mode : lock_modes;
       alt_code : codes;

begin {remove}
        core$get_master_mtg (mtg_name, mtg_rec, code);
        if (code = SUCCESS) then begin
           if (core_public.username = mtg_rec.chairman) or Sys_admin then begin
              lock_mtg (mtg_rec.short_name,EX_MODE, prev_mode, code);
              if code <> success then return;
              lock_db (PW_MODE, prev_db_mode, code);
              if code <> success then begin
                 lock_mtg (mtg_rec.short_name, prev_mode, prev_mode, alt_code);
                 return;
              end;
              delete_master_mtg (mtg_name, code);
              lock_db (prev_db_mode, prev_db_mode, alt_code);
              lock_mtg (mtg_rec.short_name, prev_mode, prev_mode, alt_code);
           end
           else begin
              code := no_access;
           end;
        end;

end; {remove}











[global] procedure leave (var code : codes);

var blk : blks;
    user_rec : user_recs;
    rms_code : integer;
    prev_mode : lock_modes;

begin {leave}

   if not core_public.attending then begin
      code := no_current_mtg;
      return;
   end;

   core_public.attending := false;

   dutil$close (meetingfile, rms_code);
   if (rms_code <> 0) then begin
      code := fstatus(rms_code);
      return;
   end;

   { fix up user_meeting_record }
   get_user_mtg (core_public.mtg_name, user_rec, code);
   if (code <> success) then begin
        code := inconsistent;
        return;
   end;

   user_rec.last_access := core_public.privs;
   user_rec.highest_seen := core_public.highest_seen;
   timestamp (user_rec.last_time_attend);
   update_user_mtg (user_rec, code);
   lock_mtg (mtg_hdr.short_name, DL_MODE, prev_mode, code);

end; {leave}











[global] procedure get_trn_rec (trn_num : trn_nums;
                                var trn_rec : trn_recs;
                                var code : codes);
var
        trn_hdr : trn_hdrs;

begin {get_trn_rec}
     if not core_public.attending then
        code := no_current_mtg
     else
     if not (rd in core_public.privs) then
        code := no_access
     else begin

        read_trn_hdr (trn_num, trn_hdr, code);
        if (code = success) then begin
                { copy trn_hdr to trn_rec }
                trn_rec.trn_num := trn_hdr.trn_num;
                trn_rec.author := trn_hdr.author;
                trn_rec.date_entered := trn_hdr.date_entered;
                trn_rec.subject := trn_hdr.subject;
                trn_rec.num_lines := trn_hdr.num_lines;
                if trn_hdr.deleted then code := deleted_trn;
        end;
     end;

end; {get_trn_rec}






















[global] procedure core_init (var code : codes);

   var i : integer;
       prev_mode : lock_modes;
       alt_code : codes;

begin {core_init}

   sys_username (core_public.username);

   core_public.attending := false;
   for i:=1 to blk_size do
      emptyblk [i] := chr(0);

   lock_db (PR_MODE, prev_mode, code);
   if code <> success then return;

   init_master_mtg (code);
   if (code = success) then
        init_user_mtg (code);

   lock_db (NL_MODE, prev_mode, alt_code);
end; {core_init}

[global] procedure core_term (var code : codes);

   var prev_mode : lock_modes;

begin {core_term}
    lock_db (DL_MODE, prev_mode, code);
end; {core_term}

end {module core}.