{ ROSSY2.INC - Remote Operating System Sysop Sub-system, part 2 }

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 process_newin;
{ Process and update newin file (release, delete, hide, and purge) }
  var
    ch, ch_sel: char;
    i, TmpDrv, TmpUsr: integer;
    st: StrTAD;
    ed_descr: StrStd;
    temp_user_rec: user_list;

  procedure purge_newin;
  { Purge NEWIN file of deleted records }
    var
      new_nwin_file: file of nwin_list;
    begin
      writeln(USR, 'Purging NEWIN file.');
      Assign(new_nwin_file, nwin_name + '.$$$');
      Rewrite(new_nwin_file);
      Seek(nwin_file, 0);
      Read(nwin_file, nwin_rec);
      while not EOF(nwin_file) do
        begin
          if nwin_rec.status <> 2
            then Write(new_nwin_file, nwin_rec);
          Read(nwin_file, nwin_rec)
        end;
      Close(nwin_file);
      Close(new_nwin_file);

      Erase(nwin_file);
      Rename(new_nwin_file, nwin_name + ext);

      Reset(nwin_file);
  end;

  begin
    FindSect('NEWIN', TmpDrv, TmpUsr, OK);
    if OK
      then i := pred(FileSize(nwin_file))
      else writeln(USR, 'NEWIN section not found.');
    while OK and (i >= 0) do
      begin
        seek(nwin_file, i);
        read(nwin_file, nwin_rec);
        with nwin_rec do
          begin
            GetRec(DatF, user, temp_user_rec);
            writeln(USR);
            case status of
              0: write(USR, 'Hidden    ');
              1: write(USR, 'Released  ');
              2: write(USR, 'Deleted   ')
            end;
            st := FormTAD(t);
            writeln(USR, pad(name, 15), descr);
            writeln(USR, '   ', pad(st, 30),
              temp_user_rec.fn, ' ', temp_user_rec.ln);
            ch_sel := select('Newin command', 'DeleteEditHidePurgeQuitRelease');
            case ch_sel of
              'D': begin
                     status := 2;
                     SetSect(TmpDrv, TmpUsr);
                     hide_release(name, 'H');
                     SetSect(HomDrv, HomUsr)
                   end;
              'E': begin
                     writeln(USR);
                     ed_descr := descr;
                     GetStr(ed_descr, ch, 50, 'E');
                     writeln(USR);
                     descr := ed_descr
                   end;
              'H': begin
                     status := 0;
                     SetSect(TmpDrv, TmpUsr);
                     hide_release(name, 'H');
                     SetSect(HomDrv, HomUsr)
                   end;
              'P': begin
                     purge_newin;
                     i := FileSize(nwin_file)
                   end;
              'Q': i := 0;
              'R': begin
                     status := 1;
                     SetSect(TmpDrv, TmpUsr);
                     hide_release(name, 'R');
                     SetSect(HomDrv, HomUsr)
                   end;
              '?': begin
                     list('N');
                     writeln(USR)
                   end
            end;
            if (ch_sel <> '?') and (ch_sel <> 'Q')
              then
                begin
                  seek(nwin_file, i);
                  write(nwin_file, nwin_rec)
                end
          end;
        if ch_sel <> '?'
          then i := pred(i)
      end
  end;

overlay procedure print_log;
{ Print the log file }
  const
    action: array[0..9] of FileName = ('ROS up', 'ROS down', 'Login', 'Logout',
      'Receive-Xmdm', 'Send-Xmdm', 'Send-Text', 'Complete', 'Failed', 'New User');
  var
    t: tad_array;
    st: StrTAD;
    user_rec: user_list;
  begin
    GetTAD(t);
    st := FormTAD(t);
    writeln(USR, FF, 'Log file as of: ', st);
    writeln(USR);
    if audit_on
      then
        begin
          writeln(AuditFile, FF, 'Log file as of: ', st);
          writeln(AuditFile)
        end;
    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;
        st := pad(FormTAD(logr_rec.time_stamp), 29);
        writeln(USR, st, pad(action[logr_rec.action], 13),
          pad(user_rec.fn + ' ' + user_rec.ln, 26), logr_rec.text);
        if audit_on
          then writeln(AuditFile, st, pad(action[logr_rec.action], 13),
                 pad(user_rec.fn + ' ' + user_rec.ln, 26), logr_rec.text)
      end;
    if ask('Do you want to reset the log file')
      then
        begin
          Seek(logr_file, 0);
          Read(logr_file, logr_rec);
          Close(logr_file);
          Rewrite(logr_file);
          Write(logr_file, logr_rec);
          writeln(USR, logr_name, ext, ' reset.');
          if audit_on
            then writeln(AuditFile, logr_name, ext, ' reset.')
        end
  end;

overlay procedure print_messages;
{ Print the message file }
  var
    i, j, first_line, last_line: integer;
    t: tad_array;
    st: StrTAD;
  begin
    GetTAD(t);
    st := FormTAD(t);
    writeln(USR, FF, 'Message file as of: ', st);
    if audit_on
      then writeln(AuditFile, FF, 'Message file as of: ', st);
    j := 1;
    seek(summ_file, j);
    while (not brk) and (not EOF(summ_file)) do
      begin
        writeln(USR);
        if audit_on
          then writeln(AuditFile);
        mesg_header_list(j, first_line, last_line);
        seek(mesg_file, first_line);
        for i := 1 to last_line do
          begin
            read(mesg_file, mesg_rec);
            writeln(USR, mesg_rec);
            if audit_on
              then writeln(AuditFile, mesg_rec)
          end;
        j := succ(j)
      end
  end;

overlay procedure krunch_messages;
{ Re-pack the message files }
  var
    i: integer;
    nsum_file : file of summ_list;
    nmsg_file : file of mesg_list;
  begin
    if ask('Krunch (re-pack) the message file')
      then
        begin
          writeln(USR, 'Krunching');
          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 macro_setup;
{ Create and edit sysop macro }
  begin
    case select('Macro', 'DisplayEnterResetStart') of
      'D': writeln(USR, macro);
      'E': macro := prompt('Enter macro: ', 45, 'ES');
      'R': macro_ptr := 0;
      'S': macro_ptr := 1
    end
  end;

overlay procedure sys_dir;
{ Create system directory file }
  var
    TmpDrv, TmpUsr, KepDrv, KepUsr: integer;
    this: SectPtr;
    t: tad_array;
    st: StrTAD;
    dir_file: text;

  procedure center(st: StrStd);
  { Center string on print line }
    begin
      writeln(dir_file, ' ':(35 - length(st) div 2), st);
      writeln(dir_file)
    end;

  procedure write_dir;
  { Write directory to file }
    var
      i, j, k, entries, rows, size: integer;
      this: FilePtr;
      nodes: array[1..columns] of FilePtr;
      st: Str10;
    begin
      writeln(dir_file);
      entries := DirEntries;
      if entries <> 0
        then
          begin
            this := DirBase;
            writeln(dir_file, '   File area: ', SectReq, '   Files: ', entries,
              '   Space used: ', DirSpace, 'k');
            rows := entries div columns;
            if 0 <> entries mod columns
              then rows := succ(rows);
            nodes[1] := this;
            for i := 2 to columns do
              begin
                for j := 1 to rows do
                  this := this^.next;
                nodes[i] := this
              end;
            i := 1;
            while (not brk) and (i <= rows) do
              begin
                for j := 1 to columns do
                  begin
                    this := nodes[j];
                    if (i + rows * pred(j)) <= entries
                      then
                        begin
                          size := this^.fsize shr 3;
                          if (this^.fsize mod 8) <> 0
                            then size := succ(size);
                          st := intstr(size, 4) + 'k ';
                          write(dir_file, this^.fname, st);
                          if j < columns
                            then write(dir_file, fence, ' ')
                            else writeln(dir_file)
                        end
                      else writeln(dir_file);
                    nodes[j] := nodes[j]^.next   { Go to next on list }
                  end;
                i := succ(i)
              end
          end;
      if j <> columns
        then writeln(dir_file)
    end;

  begin { sys_dir }
    KepDrv := SetDrv;
    KepUsr := SetUsr;
    FindSect('LOGIN', TmpDrv, TmpUsr, OK);
    if not OK
      then
        begin
          TmpDrv := HomDrv;
          TmpUsr := HomUsr
        end;
    SetSect(TmpDrv, TmpUsr);
    Assign(dir_file, 'SYSTEM.DIR');
    {$I-} Rewrite(dir_file) {$I+};
    OK := (IOresult = 0);
    if OK
      then
        begin
          center('Complete System Directory Listing');
          center('as of');
          GetTAD(t);
          st := FormTAD(t);
          center(st);
          this := SectBase;
          while this <> nil do
            begin
              if this^.SectAccs <= 20
                then
                  begin
                    SectReq := this^.SectName;
                    SetDrv  := this^.SectDrive;
                    SetUsr  := this^.SectUser;
                    SetSect(HomDrv, HomUsr);
                    ReadDir(DirEntries, DirSpace, DirBase);
                    SetSect(TmpDrv, TmpUsr);
                    write_dir
                  end;
              this := this^.next
            end;
          Close(dir_file);
          SetSect(Homdrv, HomUsr);
          SetDrv := KepDrv;
          SetUsr := KepUsr;
          ReadDir(DirEntries, DirSpace, DirBase)
        end
  end;

overlay procedure toggle_audit;
{ Turn the audit trail on and off }
  var
    i, ext: integer;
    t: tad_array;
    AuditName: FileName;
  begin
    if audit_on
      then
        begin
          Close(AuditFile);
          writeln(USR, 'Audit file closed.');
          audit_on := FALSE
        end
      else
        begin
          GetTAD(t);
          ext := 0;
          repeat
            AuditName := intstr(t[4], 2) + '-' + intstr(t[3], 2) + '-' +
              intstr(t[5], 2) + '.' + intstr(ext, 3);
            for i:= 1 to length(AuditName) do
              if AuditName[i] = ' '
                then AuditName[i]:= '0';
            Assign(AuditFile, AuditName);
            {$I-} Reset(AuditFile) {$I+};   { Make sure it's a new file }
            ext := succ(ext)
          until IOresult <> 0;
          Rewrite(AuditFile);
          writeln(USR, 'Audit file, ', AuditName, ', ready.');
          audit_on := TRUE
        end
  end;