{ ROSKOV.INC - Remote Operating System Kernel Overlayed Routines }

overlay procedure list(ch: char);
{ List a portion of the system message file }
  var
    i: integer;
    this: SysmPtr;
  begin
    this := SysmBase;
    while (this <> nil) and (this^.key <> ch) do
      this := this^.next;
    if this^.key = ch
      then
        begin
          writeln(USR);
          seek(sysm_file, succ(this^.loc));
          read(sysm_file, sysm_rec);
          i := 1;
          while (not brk) and (not EOF(sysm_file)) and (sysm_rec[1] <> ':') do
            begin
              writeln(USR, sysm_rec);
              read(sysm_file, sysm_rec);
              i := succ(i);
              if 0 = i mod DispLines
                then pause
            end
        end
  end;

overlay procedure get_name(var fn: firstname; var ln: lastname);
{ Get user name }
  begin
    writeln(USR);
    repeat
      fn := trim(prompt('FIRST name: ', len_fn, 'ES'));
      writeln(USR)
    until (not online) or (fn <> '');
    if fn = 'SYSOP'
      then ln := ''
      else
        repeat
          ln := trim(prompt(' LAST name: ', len_ln, 'ES'));
          writeln(USR)
        until (not online) or (ln <> '')
  end;

overlay procedure get_old_password(st: StrPr; var valid: boolean);
{ Accept and validate old password.  Only 'Max_Tries' will be allowed. }
  var
    tries: integer;
  begin
    tries := 1;
    repeat
      valid := (user_rec.pw = prompt(st + ': ', len_pw, 'S'));
      writeln(USR);
      tries := succ(tries)
    until (not online) or valid or (tries > Max_Tries);
    if not valid
      then writeln(USR, 'Only ', Max_Tries, ' tries allowed.')
  end;

overlay procedure get_new_password;
{ Accept and validate new password. }
  var
    i: integer;
    trial_pw: password;
  begin
    writeln(USR);
    writeln(USR, 'Please select and enter a password of 4-', len_pw, ' characters');
    writeln(USR, 'to ensure that no one else uses your name on the system.');
    writeln(USR);
    repeat
      repeat
        trial_pw := prompt('Password (will NOT display as you type): ', len_pw, 'S');
        writeln(USR);
        i := length(trial_pw);
        if (i < 4) or (i > len_pw)
          then writeln(USR, 'Length must be 4-', len_pw, ' characters.');
      until (not online) or ((4 <= i) and (i <= len_pw));
      user_rec.pw := prompt(' Please enter it again for verification: ', len_pw, 'S');
      writeln(USR);
      if user_rec.pw <> trial_pw
        then writeln(USR, 'No match.  Try again.')
    until (not online) or (user_rec.pw = trial_pw);
    writeln(USR);
    writeln(USR, 'Please remember your password.');
    writeln(USR, 'It will be required for all future calls.')
  end;

overlay procedure get_case;
{ Get case switch from user }
  begin
    user_rec.case_sw := ask('Can your terminal display lower case')
  end;

overlay procedure get_nulls;
{ Get nulls from user }
  begin
    user_rec.nulls := strint(prompt('How many nulls do you need [0-9]? ', 1, 'AES'));
    writeln(USR)
  end;

overlay function mesg_start(pr: StrPr): integer;
{ Get starting message number from user }
  var
    i, lo, hi: integer;
  begin
    if MesgBase = nil
      then
        begin
          lo := 0;
          hi := 0
        end
      else
        begin
          lo := MesgBase^.MesgNo;
          hi := MesgLast^.MesgNo
        end;
    i := strint(prompt(pr + ' [' + intstr(lo, 1) + '-' + intstr(hi, 1) + ']? ', 5, 'E'));
    writeln(USR);
    if (i < lo) or (i > hi)
      then
        begin
          i := succ(user_rec.lasthi);
          writeln(USR, 'Starting after last high message (# ', user_rec.lasthi, ')...')
        end;
    mesg_start := i
  end;

overlay procedure mesg_header_list(loc: integer; var first_line, last_line: integer);
{ Display message header }
  var
    to_fn, fr_fn: firstname;
    to_ln, fr_ln: lastname;
    st: StrTAD;
    temp_user_rec: user_list;
  begin
    seek(summ_file, loc);
    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 if summ_to_num = user_loc
          then
            begin
              to_fn := user_rec.fn;
              to_ln := user_rec.ln
            end
          else
            begin
              GetRec(DatF, summ_to_num, temp_user_rec);
              to_fn := temp_user_rec.fn;
              to_ln := temp_user_rec.ln
            end;
        if summ_from_num = user_loc
          then
            begin
              fr_fn := user_rec.fn;
              fr_ln := user_rec.ln
            end
          else
            begin
              GetRec(DatF, summ_from_num, temp_user_rec);
              fr_fn := temp_user_rec.fn;
              fr_ln := temp_user_rec.ln
            end;
        st := FormTAD(summ_date);
        writeln(USR);
        writeln(USR, 'Message # ', summ_num, ' entered ', st);
        writeln(USR, 'From: ', fr_fn, ' ', fr_ln);
        writeln(USR, '  To: ', to_fn, ' ', to_ln);
        writeln(USR, '  Re: ', summ_subject);
        if audit_on
          then
            begin
              writeln(AuditFile);
              writeln(AuditFile, 'Message # ', summ_num, ' entered ', st);
              writeln(AuditFile, 'From: ', fr_fn, ' ', fr_ln);
              writeln(AuditFile, '  To: ', to_fn, ' ', to_ln);
              writeln(AuditFile, '  Re: ', summ_subject)
            end;
        first_line := summ_st_rec;
        last_line := summ_size
      end
  end;

overlay procedure mesg_delete(num: integer);
{ Delete message indicated by 'num' or the current message if 'num' is 0. }
  var
    this: MesgPtr;
  begin
    if num <> 0
      then
        begin
          mesg_find(num);
          seek(summ_file, MesgCurr^.SummLoc);
          read(summ_file, summ_rec)
        end;
    summ_rec.summ_to_num := mesg_era;
    seek(summ_file, pred(FilePos(summ_file)));
    write(summ_file, summ_rec);
    this := MesgCurr;
    if MesgCurr = MesgBase
      then
        begin
          MesgCurr := MesgBase^.next;
          MesgBase := MesgBase^.next;
          dispose(this)
        end
    else if MesgCurr <> nil
      then
        begin
          MesgCurr := MesgBase;             { Find previous record }
          while MesgCurr^.next <> this do
            MesgCurr := MesgCurr^.next;
          MesgCurr^.next := this^.next;     { Make it point to next record }
          if MesgLast = this
            then MesgLast := MesgCurr;
          MesgCurr := MesgCurr^.next;
          dispose(this)
        end;
    writeln(USR, 'Message #', summ_rec.summ_num, ' erased.')
  end;

overlay 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;

overlay procedure ReadDir(var entries, space_used: integer; var first: FilePtr);
{ Create an alphabetized list of files in the selected file area }
  var
    i, j, off: integer;
    this: FilePtr;
    searchblk: FileBlock;                 { Buffer to define search params }
    answerblk: array[0..3] of FileBlock;  { Buffer to receive file names }
  begin
    new_dir := TRUE;
    space_used := 0;
    while first <> nil do                 { Clean out any old directory list }
      begin
        this := first;
        first := first^.Next;             { Go to next on chain }
        dispose(this)                     { Reclaim space }
      end;
    DirEntries := 0;
    with searchblk do
      begin
        drive := 0;
        for i := 1 to 11 do
          fname[i] := ord('?');
        extent := ord('?');
        s1     := ord('?');
        s2     := ord('?');
        reccount := 0;
        for i := 16 to 31 do
          map[i] := 0
      end;
    SetSect(SetDrv, SetUsr);
    BDOS(setdma, addr(answerblk));
    off := BDOS(findfirst, addr(searchblk));
    while off <> 255 do
      begin
        with answerblk[off] do
{ Non-system or sysop and not creating system directory? }
          if (($80 and ord(fname[10])) = 0) or
             ((user_rec.access = 255) and (mode = files_mode))
            then InsertFile(fname, 0, reccount + (extent + (s2 shl 5)) shl 7,
                            entries, space_used, first);
        off := BDOS(findnext, addr(searchblk))
      end;
    BDOS(setdma, fcb);                    { Restore DMA buffer }
    if user_rec.access >= 200
      then free_space := diskfree;
    SetSect(HomDrv, HomUsr)
  end;

overlay procedure LibReadDir(var entries, space_used: integer; var first: FilePtr);
{ Read library directory }
  var
    i, off: integer;
    LibBlock: array[0..3] of EntryBlock;
  begin
    SetSect(SetDrv, SetUsr);
    Assign(libr_file, LibReq);
    {$I-} Reset(libr_file) {$I+};
    if IOresult = 0
      then
        begin
          blockread(libr_file, LibBlock, 1);
          in_library := TRUE;
          for i := 1 to 11 do
            if LibBlock[0].fname[i] <> $20
              then in_library := FALSE;
          in_library := in_library and (LibBlock[0].status = 0);
          if in_library
            then
              begin
                new_dir := TRUE;
                space_used := 0;
                LibEntries := 0;
                for i := 1 to pred(LibBlock[0].fsize shl 2) do
                  begin
                    off := i mod 4;
                    if off = 0
                      then blockread(libr_file, LibBlock, 1);
                    with LibBlock[off] do
                      if status < $FE
                        then InsertFile(fname, index, fsize, entries, space_used, first)
                  end
              end
        end;
    SetSect(HomDrv, HomUsr)
  end;