{ ROSSYU.INC - Remote Operating System Sysop Sub-system, User file routines }

overlay procedure validate_user;
{ Change user access time and level to 'validated' status }
  var
    i: integer;
    ed_fn: firstname;
    ed_ln: lastname;
    key: StrName;
    temp_user_rec: user_list;
  begin
    i := summ_rec.summ_from_num;
    GetRec(DatF, i, temp_user_rec);
    if ask('Validate ' + temp_user_rec.fn + ' ' + temp_user_rec.ln)
      then OK := TRUE
      else
        begin
          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
                if i = user_loc
                  then temp_user_rec := user_rec
                  else GetRec(DatF, i, temp_user_rec)
              end
            else writeln(USR, 'User not found.')
        end;
    if OK
      then
        begin
          temp_user_rec.access := val_acc;
          temp_user_rec.limit  := val_time;
          if i = user_loc
            then user_rec := temp_user_rec
            else PutRec(DatF, i, temp_user_rec);
          writeln(USR, temp_user_rec.fn, ' ', temp_user_rec.ln, ' validated.')
        end
  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;
    st: StrTAD;
    key: StrName;
    temp_user_rec: user_list;
  begin
    GetTAD(t);
    st := FormTAD(t);
    writeln(USR, FF, 'User deletions as of: ', st);
    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);
                      st := FormTAD(laston);
                      writeln(USR, key, ' ', access, ' ', st);
                      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;

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;
      st: StrTAD;
    begin
      ClrScr;
      with temp_user_rec do
        begin
          if case_sw
            then disp_case := 'L'
            else disp_case := 'U';
          st := FormTAD(laston);
          writeln(USR, 'Name     : ', fn, ' ', ln);
          writeln(USR, 'Address  : ', ad);
          writeln(USR, 'Password : ', pw);
          writeln(USR, 'Acc level: ', access);
          writeln(USR, 'Limit    : ', limit);
          writeln(USR, 'Nulls    : ', nulls);
          writeln(USR, 'Case     : ', disp_case);
          writeln(USR, 'Last on  : ', st);
          writeln(USR, 'On today : ', time_today);
          writeln(USR, 'On total : ', time_total);
          writeln(USR, 'Last high: ', 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);
      st := '';
      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 access := strint(st);
          accept(12,  5, st, 3, '');
          if st <> ''
            then limit := strint(st);
          accept(12,  6, st, 1, '');
          if st <> ''
            then nulls := strint(st);
          accept(12,  9, st, 5, '');
          if st <> ''
            then time_today := strint(st);
          accept(12, 10, st, 5, '');
          if st <> ''
            then time_total := strint(st);
          accept(12, 11, st, 5, '');
          if st <> ''
            then lasthi := strint(st);
          accept(12, 12, st, 5, '');
          if st <> ''
            then upload := strint(st);
          accept(12, 13, 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);
    SearchKey(IdxF, i, key);
    if OK
      then
        begin
          if i = user_loc
            then temp_user_rec := user_rec
            else GetRec(DatF, i, temp_user_rec);
          display_user;
          while ask('Edit this user') do
            begin
              change_user;
              display_user
            end;
          if i = user_loc
            then user_rec := temp_user_rec
            else PutRec(DatF, i, temp_user_rec)
        end
      else writeln(USR, 'User not found.')
  end;

overlay procedure rebuild_index;
{ Rebuild the user index file from the data file.  In addition, this routine
  can recover the data file from certain types of damage. }
  var
    i, previous_rec, count_used, count_unused: integer;
    key: StrName;
    temp_user_rec: user_list;
    temp: file;
  begin
    writeln(USR, 'Rebuilding user index file.');
    writeln(USR, 'User data file in record order:');
    CloseIndex(IdxF);
    Assign(temp, user_indx + ext);
    Erase(temp);
    InitIndex;
    MakeIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
    previous_rec := -1;
    count_used := 0;
    count_unused := 0;
    with temp_user_rec do
      begin
        for i := 1 to pred(FileLen(DatF)) do
          begin
            GetRec(DatF, i, temp_user_rec);
            if used = 0
              then
                begin
                  key := pad(ln, len_ln) + pad(fn, len_fn);
                  AddKey(IdxF, i, key);
                  if OK
                    then
                      begin
                        count_used := succ(count_used);
                        writeln(USR, i:4, '  ', used:4, '  ', fn, ' ', ln)
                      end
                    else
                      begin
                        used := previous_rec;    { Can't use DeleteRec since }
                        previous_rec := i;       {   we're playing with pointers }
                        PutRec(DatF, i, temp_user_rec);
                        count_unused := succ(count_unused);
                        writeln(USR, i:4, '  ', used:4, '  Duplicate record deleted')
                      end;
                end
              else
                begin
                  used := previous_rec;
                  previous_rec := i;
                  PutRec(DatF, i, temp_user_rec);
                  count_unused := succ(count_unused);
                  writeln(USR, i:4, '  ', used:4, '  Free record')
                end
          end
      end;
    GetRec(DatF, 0, temp_user_rec);
    DatF.FirstFree := previous_rec;
    DatF.NumberFree := count_unused;
    PutRec(DatF, 0, temp_user_rec);

{ Normally ROS only closes files between sessions to improve operational
  speed, but since essential data files have just been modified, they will
  be closed and reopened to ensure file integrity. }

    CloseFile(DatF);
    CloseIndex(IdxF);
    OpenFile(DatF, user_data + ext, SizeOf(user_rec));
    OpenIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
    writeln(USR);
    writeln(USR, FileLen(DatF), ' records, ', UsedRecs(DatF), ' users in file.')
  end;