CP/M/CPM_CDROM.iso/mbug/mbug184.arc/ROS34.LBR/ROSINI.IZC/ROSINI.INC

Text File | 1979-12-31 | 17KB | 529 lines

{ ROSINI.INC - Remote Operating System initialization/shutdown routines }

overlay procedure login;
{ Log user into system }
  var
    continue: boolean;
    key: StrName;

  procedure get_new_user(var continue: boolean);
  { Get new user information }
    var
      i: integer;
    begin
      continue := FALSE;
      Writeln(USR);
      Writeln(USR, 'Name not found.');
      list('A');
      Writeln(USR);
      continue := ask('Are you a new user');
      if continue
        then with user_rec do
          begin
            get_case;
            get_nulls;
            cy := prompt('From what CITY are you calling', len_ad, 'E');
            st := prompt(' STATE [2 letter abbreviation]', len_st, 'ES');
            Writeln(USR);
            Writeln(USR, 'You are ', fn, ' ', ln, ' from ', cy, ', ', st, '.');
            Writeln(USR);
            continue := ask('Is that correct');
            if continue
              then
                begin
                  get_new_password;
                  used := 0;
                  ad := '';
                  ph := '';
                  if fn = 'SYSOP'
                    then access := 255
                    else access := def_acc;
                  limit := def_time;
                  help_level := 3;
                  columns := def_chars;
                  lines := def_lines;
                  for i := 0 to 5 do
                    laston[i] := 0;
                  time_today := 0;
                  time_total := 0;
                  lasthi := 0;
                  upload := 0;
                  download := 0;

                  key := pad(ln, len_ln) + pad(fn, len_fn);
                  AddRec(DatF, user_loc, user_rec);
                  AddKey(IdxF, user_loc, key);
                  log(9, '');
                  list('I');
                  pause
                end
          end
    end;

  procedure init_user;
  { Initialize user }
    var
      str: StrTAD;
    begin
      if local_online
        then log(2, 'Local')
        else log(2, intstr(rate, 3) + ' bps');
      Seek(logr_file, 0);
      Read(logr_file, logr_rec);
      logr_rec.user := succ(logr_rec.user);
      Seek(logr_file, 0);
      Write(logr_file, logr_rec);

      GetTAD(login_t);
      if (login_t[3] <> user_rec.laston[3]) or
         (login_t[4] <> user_rec.laston[4]) or
         (login_t[5] <> user_rec.laston[5]) then user_rec.time_today := 0;

      if user_rec.access < 10               { Hang up on twit }
        then remote_online := FALSE
        else
          begin
            str := FormTAD(login_t);
            Writeln(USR);
            Writeln(USR, 'Login             : ', str);
            Writeln(USR);
            Writeln(USR, 'Caller number     : ', logr_rec.user);
            Writeln(USR, 'Access time today : ', user_rec.time_today);
            Writeln(USR, 'Access time total : ', user_rec.time_total);
            str := FormTAD(user_rec.laston);
            Writeln(USR, 'Last on system    : ', str);
            Writeln(USR, 'Last high message : ', user_rec.lasthi)
          end
    end;

  begin { login }
    Writeln(USR, version);
    list('W');
    repeat
      get_name(user_rec.fn, user_rec.ln);
      timeout := 300;                       { Now allow five minutes }
      key := pad(user_rec.ln, len_ln) + pad(user_rec.fn, len_fn);
      FindKey(IdxF, user_loc, key);
      if OK
        then
          begin
            GetRec(DatF, user_loc, user_rec);
            get_old_password('  Password', valid_pw);
            if not valid_pw
              then list('P');
            continue := TRUE
          end
        else
          begin
            valid_pw := TRUE;
            get_new_user(continue)
          end
    until (not online) or continue;
    in_use := valid_pw;
    connected := continue;
    if online and in_use
      then init_user
  end;

overlay procedure wrapup;
{ Disconnect, update and close all files}
  var
    i, j, time_on, time_left: integer;
    t: tad_array;
  begin
    Write(USR, 'Adios, call again...');
    mdhangup;
    if valid_pw                             { Don't update files if user not initialized }
      then
        begin
          timer(time_on, time_left);
          user_rec.time_today := user_rec.time_today + time_on;
          user_rec.time_total := user_rec.time_total + time_on;
          GetTAD(t);
          user_rec.laston := t;

          PutRec(DatF, user_loc, user_rec);

          log(3, '');

          i := login_t[1];
          j := login_t[2];
          while j <> t[2] do
            begin
              stat_rec.busy_per_hour[j] := stat_rec.busy_per_hour[j] + 60 - i;
              i := 0;
              j := succ(j) mod 24
            end;
          stat_rec.busy_per_hour[j] := stat_rec.busy_per_hour[j] + t[1] - i;

          seek(stat_file, 0);
          Write(stat_file, stat_rec)
        end;
    CloseFile(DatF);
    CloseIndex(IdxF);
    Close(logr_file);
    Close(stat_file);
    Close(nwin_file);
    Close(summ_file);
    Close(mesg_file)
  end;

overlay procedure setup;
{ Initialize variables and open files }
  var
    i: integer;
    t: tad_array;
  begin
    fini             := FALSE;

    connected        := FALSE;              { Assume no connection }
    local_online     := FALSE;
    local_copy       := TRUE;
    printer_copy     := FALSE;              { Sysop can turn on printer }
    remote_online    := FALSE;
    remote_copy      := FALSE;

    mode             := message_mode;       { Start system in message mode }
    st_switch        := TRUE;               { Default file size display - in 'k' }
    new_dir          := FALSE;              { Reset directory flag }
    up_down_display  := TRUE;               { Show up/downloads for files mode }
    extra_time       := 0;                  { None until upload complete }

    op_chat          := FALSE;              { Operator chat not initiated }

    user_rec.nulls      := 2;               { 2 nulls until recognition }
    user_rec.shift_lock := TRUE;            { Upper case only to start }
    user_rec.noisy      := FALSE;           { Prompt bell initially off }
    user_rec.columns    := def_chars;
    user_rec.lines      := def_lines;

    macro            := 'L/R/PAYSG';
    macro_ptr        := 0;

    timeout := 60;                          { Allow one minute for input }

    InitIndex;                              { Get files ready for use }

    OpenFile(DatF, user_data + ext, SizeOf(user_rec));
    if OK
      then OpenIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
    if not OK
      then
        begin
          Write(BEL, 'User files not found.  Creating ', user_data, ext);
          MakeFile(DatF, user_data + ext, SizeOf(user_rec));
          Write(', ', user_indx, ext);
          MakeIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
          Writeln
        end;

    {$I-} Reset(logr_file) {$I+};
    if IOresult <> 0
      then
        begin
          Write(BEL, 'Log file not found.  Creating ', logr_name, ext);
          Rewrite(logr_file);
          logr_rec.user := 0;
          Write(logr_file, logr_rec);
          Writeln
        end;

    {$I-} Reset(summ_file) {$I+};
    OK := (IOresult = 0);
    if OK
      then
        begin
          {$I-} Reset(mesg_file) {$I+};
          OK := (IOresult = 0)
        end;
    if not OK
      then
        begin
          Write(BEL, 'Message files not found.  Creating ', summ_name, ext);
          Rewrite(summ_file);
          summ_rec.num := 0;
          Write(summ_file, summ_rec);
          Write(', ', mesg_name, ext);
          Rewrite(mesg_file);
          Writeln
        end;

    {$I-} Reset(stat_file) {$I+};
    if IOresult = 0
      then read(stat_file, stat_rec)
      else
        begin
          Write(BEL, 'Statistics file not found.  Creating ', stat_name, ext);
          Rewrite(stat_file);
          GetTAD(stat_rec.date);
          for i := 0 to 23 do
            stat_rec.busy_per_hour[i]  := 0;
          for i := 0 to 6 do
            stat_rec.busy_per_day[i]  := 0;
          Writeln
        end;

    {$I-} Reset(nwin_file) {$I+};
    if IOresult <> 0
      then
        begin
          Write(BEL, 'Newin file not found.  Creating ', nwin_name, ext);
          Rewrite(nwin_file);
          Writeln
        end;

    if cold
      then
        begin
          log(0, '');
          cold := FALSE
        end
  end;

overlay procedure wait_for_user;
{ Wait for call or console interrupt }
  var
    ch: char;
    count: integer;
  begin
    ClrScr;
    if delay_down
      then
        begin
          putstat('Waiting for delayed shutdown acknowledgement...');
          mdbusy                            { Make modem busy }
        end
      else
        begin
          putstat(version + ' as of ' + ver_date + '.  Copyright (c) 1985 by Steve Fox.');
          mdinit                            { Get modem ready }
        end;
    count := 0;
    repeat
      count := succ(count);
      if count > 8000
        then
          begin
            putstat('');
            GotoXY(succ(Random(79)), succ(Random(23)));
            count := 0
          end;
      if delay_down
        then Write(BEL);
      ch := GetChar;
      if ch = ETX
        then
          begin
            putstat('Busy modem? ');
            read(KBD, ch);
            if UpCase(ch) = 'Y'
              then mdbusy
              else mdhangup;
            putstat('ROS completing...');
            log(1, '');
            CloseFile(DatF);
            CloseIndex(IdxF);
            Close(sysm_file);
            Close(summ_file);
            Close(mesg_file);
            Close(logr_file);
            Close(stat_file);
            Close(nwin_file);
            fini := TRUE
          end
      else if ch = CR
        then
          begin
            putstat('Local use requested');
            mdbusy;
            rate := 1200;                   { Pretend we're running at 1200 bps }
            local_online := TRUE
          end
      else if mdring
        then
          begin
            putstat('Ring detected');
            mdans;
            remote_online := ch_carck;
            remote_copy   := remote_online;
            if remote_online
              then putstat('Connect at ' + intstr(rate, 3) + ' bps')
          end
    until fini or local_online or remote_online;
    delay_down := FALSE
  end;

overlay procedure cold_start;
{ One-time initialization routine }
  var
    b: byte;
    SDrive: char;
    i, BufferPtr, remaining, SUser, SAccs: integer;
    SysmThis, SysmLast: SysmPtr;
    SectThis, SectLast: SectPtr;
    AreaThis, AreaLast: AreaPtr;
    SName: Str10;
    SDesc: StrPr;
    sect_file: text;
    sysm_text: file;

  procedure build_sysm;
  { Build SYSMSG.BB# file }
    begin
      {$I-} Close(sysm_file) {$I+};         { Shouldn't erase an open file }
      i := IOresult;                        { Ignore any errors }
      Rewrite(sysm_file);
      Assign(sysm_text, sysm_name + '.TXT');
      {$I-} Reset(sysm_text) {$I+};
      if IOresult = 0
        then
          begin
            Write('  Creating ', sysm_name, ext);
            BufferPtr := maxint;
            remaining := FileSize(sysm_text);
            b := $7F and getc(sysm_text, BufferPtr, remaining);
            sysm_rec := '';
            while b <> 26 do
              begin
                if b = 10
                  then
                    begin
                      Write(sysm_file, sysm_rec);
                      sysm_rec := ''
                    end
                  else if b >= 32
                    then sysm_rec := sysm_rec + char(b);
                  b := $7F and getc(sysm_text, BufferPtr, remaining)
              end;
            Close(sysm_text);
            Close(sysm_file);
            Reset(sysm_file)
          end
        else
          begin
            Writeln;
            Write('System message text file not found.  ', sysm_name, ext, ' will be empty.')
          end;
      Writeln
    end;

  begin
    cold        := TRUE;

    audit_on    := FALSE;                   { No audit file initially }
    delay_down  := FALSE;                   { Don't shut down yet }
    in_library  := FALSE;                   { Start in non-library mode }

    SysmBase    := nil;                     { Start with empty system message, }
    SectBase    := nil;                     {   section, }
    AreaBase    := nil;                     {   message area, }
    MesgBase    := nil;                     {   message, }
    DirBase     := nil;                     {   directory, }
    LibBase     := nil;                     {   and library lists }

    UsrOutPtr   := addr(putchar);           { Initialize output driver }

    HomDrv      := BDOS(getdrive);          { Assume system files are }
    HomUsr      := BDOS(getseluser, $FF);   {   in the startup area }

    Assign(sysm_file, sysm_name + ext);
    Assign(summ_file, summ_name + ext);
    Assign(mesg_file, mesg_name + ext);
    Assign(logr_file, logr_name + ext);
    Assign(sect_file, sect_name + ext);
    Assign(stat_file, stat_name + ext);
    Assign(nwin_file, nwin_name + ext);

    {$I-} Reset(sysm_file) {$I+};           { Try to open system message file }
    if IOresult <> 0
      then
        begin
          Write('Cannot open ', sysm_name + ext, '.');
          build_sysm
        end;

    {$I-} read(sysm_file, sysm_rec) {$I+};  { Try to read file }
    if IOresult <> 0
      then
        begin
          Write('Cannot read ', sysm_name + ext, '.');
          build_sysm;
          seek(sysm_file, 0);
          {$I-} read(sysm_file, sysm_rec) {$I+};
          if IOresult <> 0
            then
              begin
                Writeln('Still cannot read ', sysm_name + ext, '.');
                Writeln('Unable to continue.');
                halt
              end
        end;

    i := 0;
    while not EOF(sysm_file) do
      begin
        if sysm_rec[1] = ':'
          then
            begin
              new(SysmThis);
              if SysmBase = nil
                then SysmBase := SysmThis
                else SysmLast^.next := SysmThis;
              SysmLast := SysmThis;
              SysmLast^.key := sysm_rec[2];
              SysmLast^.loc := i;
              SysmLast^.next := nil
            end;
        read(sysm_file, sysm_rec);
        i := succ(i)
      end;

    RcvDrv := 0;                            { Default to A0: for uploads }
    RcvUsr := 0;
    {$I-} Reset(sect_file) {$I+};           { Build file and message section lists }
    OK := (IOresult = 0);
    if OK
      then
        begin
          while not EOF(sect_file) do
            begin
              readln(sect_file, SDrive, SUser, SAccs, SName, SDesc);
              if SDrive = ' '
                then
                  begin
                    new(AreaThis);
                    if AreaBase = nil
                      then AreaBase := AreaThis
                      else AreaLast^.next := AreaThis;
                    AreaLast := AreaThis;
                    AreaLast^.Area := SUser;
                    AreaLast^.AreaAccs := SAccs;
                    AreaLast^.AreaName := trim(SName);
                    AreaLast^.AreaDesc := trim(SDesc);
                    AreaLast^.next := nil
                  end
              else if SDrive <> ' '
                then
                  begin
                    new(SectThis);
                    if SectBase = nil
                      then SectBase := SectThis
                      else SectLast^.next := SectThis;
                    SectLast := SectThis;
                    SectLast^.SectDrive := ord(SDrive) - ord('A');
                    SectLast^.SectUser := SUser;
                    SectLast^.SectAccs := SAccs;
                    SectLast^.SectName := trim(SName);
                    SectLast^.SectDesc := trim(SDesc);
                    SectLast^.next := nil
                  end
            end;
          Close(sect_file);
          FindSect('NEWIN', RcvDrv, RcvUsr, OK);
          if not OK
            then Writeln(BEL, 'NEWIN section not found.');
        end
      else Writeln(BEL, 'Section file not found.');
  end;