{ ROSSYS.INC - Remote Operating System Sysop Sub-system }

overlay procedure toggle_printer;
{ Turn printer on and off }
  begin
    printer_copy := not printer_copy;
    write(USR, 'Printer o');
    if printer_copy
      then writeln(USR, 'n.')
      else writeln(USR, 'ff.')
  end;

overlay procedure print_log;
{ Print the log file }
  const
    action: array[0..7] of FileName = ('ROS up', 'ROS down', 'Login', 'Logout',
      'Send', 'Receive', 'Complete', 'New User');
  var
    t: tad_array;
    user_rec: user_list;
  begin
    GetTAD(t);
    writeln(USR, FF, 'Log file as of: ', FormTAD(t));
    writeln(USR);
    seek(logr_file, 1);
    while (not EOF(logr_file)) and (not brk) do
      begin
        read(logr_file, logr_rec);
        if logr_rec.action > 1
          then GetRec(DatF, logr_rec.user, user_rec)
          else
            begin
              user_rec.fn := '';
              user_rec.ln := ''
            end;
        writeln(USR, pad(FormTAD(logr_rec.time_stamp), 29), pad(action[logr_rec.action], 11),
          pad(user_rec.fn + ' ' + user_rec.ln, 26), logr_rec.text)
      end;
    if ask('Do you want to reset the log file')
      then
        begin
          writeln(USR, 'Resetting ', logr_name, ext);
          Seek(logr_file, 0);
          Read(logr_file, logr_rec);
          Close(logr_file);
          Rewrite(logr_file);
          Write(logr_file, logr_rec)
        end
  end;

overlay procedure print_messages;
{ Print the message file }
  var
    i: integer;
    t: tad_array;
    to_fn, fr_fn: firstname;
    to_ln, fr_ln: lastname;
    temp_user_rec: user_list;
  begin
    GetTAD(t);
    writeln(USR, FF, 'Message file as of: ', FormTAD(t));
    writeln(USR);
    seek(summ_file, 1);
    while (not EOF(summ_file)) and (not brk) do
      begin
        read(summ_file, summ_rec);
        with summ_rec do
          begin
            if summ_to_num = mesg_pub
              then
                begin
                  to_fn := 'ALL';
                  to_ln := ''
                end
            else if summ_to_num = mesg_era
              then
                begin
                  to_fn := 'MESSAGE';
                  to_ln := 'ERASED'
                end
              else
                begin
                  GetRec(DatF, summ_to_num, temp_user_rec);
                  to_fn := temp_user_rec.fn;
                  to_ln := temp_user_rec.ln
               end;
            GetRec(DatF, summ_from_num, temp_user_rec);
            fr_fn := temp_user_rec.fn;
            fr_ln := temp_user_rec.ln;
            writeln(USR, 'Message number ', summ_num, ' entered ', FormTAD(summ_date), '.');
            writeln(USR, 'From: ', fr_fn, ' ', fr_ln);
            writeln(USR, '  To: ', to_fn, ' ', to_ln);
            writeln(USR, '  Re: ', summ_subject);
            seek(mesg_file, summ_st_rec);
            for i := 1 to summ_size do
              begin
                read(mesg_file, mesg_rec);
                writeln(USR, mesg_rec.mesg_text)
              end;
            writeln(USR);
            writeln(USR)
          end
      end
  end;

overlay procedure krunch_messages;
{ Re-pack the message files }
  var
    i: integer;
    nsum_rec  :         summ_list;
    nsum_file : file of summ_list;
    nmsg_rec  :         mesg_list;
    nmsg_file : file of mesg_list;
  begin
    if ask('Krunch (re-pack) the message file')
      then
        begin
          writeln(USR, 'Packing');
          Assign(nsum_file, summ_name + '$$$');
          Assign(nmsg_file, mesg_name + '$$$');
          Rewrite(nsum_file);
          Rewrite(nmsg_file);
          Seek(summ_file, 0);
          Read(summ_file, summ_rec);        { Copy message counter to new file }
          Write(nsum_file, summ_rec);
          while not EOF(summ_file) do
            begin
              Read(summ_file, summ_rec);
              if summ_rec.summ_to_num <> mesg_era
                then
                  begin
                    Seek(mesg_file, summ_rec.summ_st_rec);
                    summ_rec.summ_st_rec := filesize(nmsg_file);
                    Write(nsum_file, summ_rec);
                    for i := 1 to summ_rec.summ_size do
                      begin
                        read(mesg_file, mesg_rec);
                        Write(nmsg_file, mesg_rec)
                      end
                  end
            end;
          close(summ_file);
          close(mesg_file);
          close(nsum_file);
          close(nmsg_file);

          erase(summ_file);
          erase(mesg_file);
          rename(nsum_file, summ_name + ext);
          rename(nmsg_file, mesg_name + ext);

          reset(summ_file);
          reset(mesg_file);
          while MesgBase <> nil do
            begin
              MesgCurr := MesgBase;
              MesgBase := MesgBase^.next;
              dispose(MesgCurr)
            end
        end
  end;

overlay procedure rebuild_index;
{ Rebuild the user index file from the data file }
  var
    i: integer;
    temp: file;
    key: StrName;
    temp_user_rec: user_list;
  begin
    CloseIndex(IdxF);
    Assign(temp, user_indx + ext);
    erase(temp);
    InitIndex;
    MakeIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
    i := 1;
    while i < FileLen(DatF) do
      begin
        GetRec(DatF, i, temp_user_rec);
        if temp_user_rec.used = 0
          then
            begin
              key := pad(temp_user_rec.ln, len_ln) + pad(temp_user_rec.fn, len_fn);
              AddKey(IdxF, i, key);
              if not OK
                then
                  begin
                    writeln(USR, key, ' already in file.');
                    DeleteRec(DatF, i)
                  end
            end;
        i := succ(i)
      end
  end;

overlay procedure edit_user;
{ Display and edit user record }
  var
    i: integer;
    ed_fn: firstname;
    ed_ln: lastname;
    key: StrName;
    temp_user_rec: user_list;

  procedure display_user;
    var
      disp_case: char;
    begin
      ClrScr;
      with temp_user_rec do
        begin
          if case_sw
            then disp_case := 'L'
            else disp_case := 'U';
          writeln(USR, 'Name     : ', fn, ' ', ln);
          writeln(USR, 'Address  : ', ad);
          writeln(USR, 'Password : ', pw);
          writeln(USR, 'Acc level: ', access);
          writeln(USR, 'Nulls    : ', nulls);
          writeln(USR, 'Case     : ', disp_case);
          writeln(USR, 'Last on  : ', FormTAD(laston));
          writeln(USR, 'On today : ', time_today);
          writeln(USR, 'On total : ', time_total);
          writeln(USR, 'Last hi  : ', lasthi);
          writeln(USR, 'Uploads  : ', upload);
          writeln(USR, 'Downloads: ', download)
        end;
      GotoXY(1, 22)
    end;

  procedure accept(x, y: integer; var st: StrStd; len: integer; mode: Str10);
    var
      term: char;
    begin
      GotoXY(x, y);
      getstr(st, term, len, 'E' + mode)
    end;

  procedure change_user;
    var
      st: StrStd;
    begin
      with temp_user_rec do
        begin
          accept(12,  2, st, len_ad, '');
          if st <> ''
            then ad := st;
          accept(12,  3, st, len_pw, 'S');
          if st <> ''
            then pw := st;
          accept(12,  4, st, 3, '');
          if st <> ''
            then
              begin
                access := strint(st);
                temp_access := access       { In case the user is on-line }
              end;
          accept(12,  5, st, 1, '');
          if st <> ''
            then nulls := strint(st);
          accept(12,  8, st, 5, '');
          if st <> ''
            then time_today := strint(st);
          accept(12,  9, st, 5, '');
          if st <> ''
            then time_total := strint(st);
          accept(12, 10, st, 5, '');
          if st <> ''
            then lasthi := strint(st);
          accept(12, 11, st, 5, '');
          if st <> ''
            then upload := strint(st);
          accept(12, 12, st, 5, '');
          if st <> ''
            then download := strint(st)
        end
    end;

  begin { edit_user }
    get_name(ed_fn, ed_ln);
    key := pad(ed_ln, len_ln) + pad(ed_fn, len_fn);
    FindKey(IdxF, i, key);
    if OK
      then
        begin
          GetRec(DatF, i, temp_user_rec);
          display_user;
          while ask('Edit this user') do
            begin
              change_user;
              display_user
            end;
          PutRec(DatF, i, temp_user_rec);
          if i = user_loc
            then user_rec := temp_user_rec;
        end
      else writeln(USR, 'User not found.')
  end;

overlay procedure delete_user;
{ Delete user from file }
  var
    i, user_loc: integer;
    del_fn: firstname;
    del_ln: lastname;
    key: StrName;
  begin
    writeln(USR);
    get_name(del_fn, del_ln);
    if ask('Delete')
      then
        begin
          key := pad(del_ln, len_ln) + pad(del_fn, len_fn);
          DeleteKey(IdxF, user_loc, key);
          if OK
            then
              begin
                DeleteRec(DatF, user_loc);
                writeln(USR, key, ' deleted.');
                writeln(USR, 'Checking message summary file.');
                for i := 1 to pred(FileSize(summ_file)) do
                  begin                     { Delete messages pertaining to user }
                    seek(summ_file, i);
                    read(summ_file, summ_rec);
                    if ((summ_rec.summ_to_num = user_loc) or (summ_rec.summ_from_num = user_loc))
                      then mesg_delete(0)
                  end
              end
            else writeln(USR, 'User not found.');
        end
  end;

overlay procedure purge_user;
{ Delete users that have not used the system in a specified time }
  var
    i, user_loc, del_count: integer;
    date, unv_age, val_age: real;
    t: tad_array;
    key: StrName;
    temp_user_rec: user_list;

  function greg_to_jul(day, mon, yr: integer): real;
  { Convert from Gregorian date to Julian }
    var
      i: integer;
    begin
      i := (mon - 14) div 12;
      greg_to_jul := day - 32075 + 367 * (mon - 2 - 12 * i) div 12 -
                     3 * (yr + 6800 + i) div 400 + 365.25 * (yr + 6700 + i)
    end;

  begin { purge_user }
    GetTAD(t);
    writeln(USR, FF, 'User deletions as of: ', FormTAD(t));
    writeln(USR);
    date := greg_to_jul(t[3], t[4], t[5]);
    unv_age := date - unv_days;
    val_age := date - val_days;
    del_count := 0;
    user_loc := 1;
    while (not brk) and (user_loc < FileLen(DatF)) do
      with temp_user_rec do
        begin
          GetRec(DatF, user_loc, temp_user_rec);
          date := greg_to_jul(laston[3], laston[4], laston[5]);
          if ((used = 0) and
              (((date < unv_age) and (access < 20)) or
               ((date < val_age) and (access >= 20))))
            then
              begin
                key := pad(ln, len_ln) + pad(fn, len_fn);
                DeleteKey(IdxF, user_loc, key);
                if OK
                  then
                    begin
                      DeleteRec(DatF, user_loc);
                      writeln(USR, key, ' ', access, ' ', FormTAD(laston));
                      del_count := succ(del_count);
                      for i := 1 to pred(FileSize(summ_file)) do
                        begin               { Delete messages pertaining to user }
                          seek(summ_file, i);
                          read(summ_file, summ_rec);
                          if ((summ_rec.summ_to_num = user_loc) or (summ_rec.summ_from_num = user_loc))
                            then mesg_delete(0)
                        end
                    end
                  else writeln(USR, 'Key not found.')
              end;
          user_loc := succ(user_loc)
        end;
    writeln(USR, del_count, ' users deleted.');
  end;