home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / BBS / ROS341.ARC / ROSINI.INC < prev    next >
Text File  |  2000-06-30  |  18KB  |  547 lines
  1. { ROSINI.INC - Remote Operating System initialization/shutdown routines }
  2.  
  3. overlay procedure login;
  4. { Log user into system }
  5.   var
  6.     continue: boolean;
  7.     key: StrName;
  8.  
  9.   procedure get_new_user(var continue: boolean);
  10.   { Get new user information }
  11.     var
  12.       i: integer;
  13.     begin
  14.       continue := FALSE;
  15.       Writeln(USR);
  16.       Writeln(USR, 'Name not found.');
  17.       list('A');
  18.       Writeln(USR);
  19.       continue := ask('Are you a new user');
  20.       if continue
  21.         then with user_rec do
  22.           begin
  23.             get_case;
  24.             get_nulls;
  25.             ad := prompt('Enter your street address', len_ad, 'E');
  26.             cy := prompt('From what CITY are you calling', len_cy, 'E');
  27.             st := prompt(' STATE [2 letter abbreviation]', len_st, 'ES');
  28.             ph := prompt('Enter your phone number (###-###-####)', len_ph, 'E');
  29.             Writeln(USR);
  30.             Writeln(USR, 'You are ', fn, ' ', ln);
  31.             Writeln(USR, 'Your address is:');
  32.             Writeln(USR, ad);
  33.             Writeln(USR, cy, ', ', st);
  34.             Writeln(USR, 'Your phone number is:');
  35.             Writeln(USR, ph);
  36.             Writeln(USR);
  37.             continue := ask('Is that correct');
  38.             if continue
  39.               then
  40.                 begin
  41.                   get_new_password;
  42.                   used := 0;
  43.                   if fn = 'SYSOP'
  44.                     then access := 255
  45.                     else access := def_acc;
  46.                   limit := def_time;
  47.                   help_level := 3;
  48.                   columns := def_chars;
  49.                   lines := def_lines;
  50.                   for i := 0 to 5 do
  51.                     laston[i] := 0;
  52.                   time_today := 0;
  53.                   time_total := 0;
  54.                   lasthi := 0;
  55.                   upload := 0;
  56.                   download := 0;
  57.  
  58.                   key := pad(ln, len_ln) + pad(fn, len_fn);
  59.                   AddRec(DatF, user_loc, user_rec);
  60.                   AddKey(IdxF, user_loc, key);
  61.                   log(9, '');
  62.                   list('I');
  63.                   pause
  64.                 end
  65.           end
  66.     end;
  67.  
  68.   procedure init_user;
  69.   { Initialize user }
  70.     var
  71.       str: StrTAD;
  72.       user_counter: integer;
  73.     begin
  74.       Seek(logr_file, 0);
  75.       Read(logr_file, logr_rec);
  76.       logr_rec.user := succ(logr_rec.user) - 1;
  77.       user_counter := logr_rec.user;
  78.       Seek(logr_file, 0);
  79.       Write(logr_file, logr_rec);
  80.       if local_online
  81.         then log(2, '#' + intstr(user_counter,5) + ',  Local')
  82.         else log(2, '#' + intstr(user_counter,5) + ',' + intstr(rate, 5) + 'Bd');
  83.       Seek(logr_file, 0);
  84.       Read(logr_file, logr_rec);
  85.       logr_rec.user := succ(logr_rec.user);
  86.       Seek(logr_file, 0);
  87.       Write(logr_file, logr_rec);
  88.  
  89.       GetTAD(login_t);
  90.       if (login_t[3] <> user_rec.laston[3]) or
  91.          (login_t[4] <> user_rec.laston[4]) or
  92.          (login_t[5] <> user_rec.laston[5]) then user_rec.time_today := 0;
  93.  
  94.       if user_rec.access < 10               { Hang up on twit }
  95.         then remote_online := FALSE
  96.         else
  97.           begin
  98.             str := FormTAD(login_t);
  99.             Writeln(USR);
  100.             Writeln(USR, 'Login                  : ', user_rec.fn, ' ', user_rec.ln);
  101.             Writeln(USR, 'Date and Time          : ', str);
  102.             Writeln(USR, 'Caller number          : ', logr_rec.user);
  103.             Writeln(USR, 'Access level           : ', user_rec.access);
  104.             Writeln(USR, 'Access time today      : ', user_rec.time_today);
  105.             Writeln(USR, 'Total time avaiable    : ', user_rec.limit - user_rec.time_today + extra_time);
  106.             Writeln(USR, 'Total time on system   : ', user_rec.time_total);
  107.             Writeln(USR, 'Total Uploads          : ', user_rec.upload);
  108.             Writeln(USR, 'Total Downloads        : ', user_rec.download);
  109.             str := FormTAD(user_rec.laston);
  110.             Writeln(USR, 'Last on time system    : ', str);
  111.             Writeln(USR, 'Last high message read : ', user_rec.lasthi)
  112.           end
  113.     end;
  114.  
  115.   begin { login }
  116.     Writeln(USR, version);
  117.     list('W');
  118.     repeat
  119.       get_name(user_rec.fn, user_rec.ln);
  120.       timeout := 300;                       { Now allow five minutes }
  121.       key := pad(user_rec.ln, len_ln) + pad(user_rec.fn, len_fn);
  122.       FindKey(IdxF, user_loc, key);
  123.       if OK
  124.         then
  125.           begin
  126.             GetRec(DatF, user_loc, user_rec);
  127.             get_old_password('  Password', valid_pw);
  128.             if not valid_pw
  129.               then list('P');
  130.             continue := TRUE
  131.           end
  132.         else
  133.           begin
  134.             valid_pw := TRUE;
  135.             get_new_user(continue)
  136.           end
  137.     until (not online) or continue;
  138.     in_use := valid_pw;
  139.     connected := continue;
  140.     if online and in_use
  141.       then init_user
  142.   end;
  143.  
  144. overlay procedure wrapup;
  145. { Disconnect, update and close all files}
  146.   var
  147.     i, j, time_on, time_left: integer;
  148.     t: tad_array;
  149.   begin
  150.     writeln(USR);
  151.     list('Z');
  152.     writeln(USR);
  153.     mdhangup;
  154.     if valid_pw                             { Don't update files if user not initialized }
  155.       then
  156.         begin
  157.           timer(time_on, time_left);
  158.           user_rec.time_today := user_rec.time_today + time_on;
  159.           user_rec.time_total := user_rec.time_total + time_on;
  160.           GetTAD(t);
  161.           user_rec.laston := login_t;
  162.  
  163.           PutRec(DatF, user_loc, user_rec);
  164.  
  165.           log(3, '');
  166.  
  167.           i := login_t[1];
  168.           j := login_t[2];
  169.           while j <> t[2] do
  170.             begin
  171.               stat_rec.busy_per_hour[j] := stat_rec.busy_per_hour[j] + 60 - i;
  172.               i := 0;
  173.               j := succ(j) mod 24
  174.             end;
  175.           stat_rec.busy_per_hour[j] := stat_rec.busy_per_hour[j] + t[1] - i;
  176.  
  177.           seek(stat_file, 0);
  178.           Write(stat_file, stat_rec)
  179.         end;
  180.     CloseFile(DatF);
  181.     CloseIndex(IdxF);
  182.     Close(logr_file);
  183.     Close(stat_file);
  184.     Close(nwin_file);
  185.     Close(summ_file);
  186.     Close(mesg_file)
  187.   end;
  188.  
  189. overlay procedure setup;
  190. { Initialize variables and open files }
  191.   var
  192.     i: integer;
  193.     t: tad_array;
  194.   begin
  195.     fini             := FALSE;
  196.  
  197.     connected        := FALSE;              { Assume no connection }
  198.     local_online     := FALSE;
  199.     local_copy       := TRUE;
  200.     printer_copy     := FALSE;              { Sysop can turn on printer }
  201.     remote_online    := FALSE;
  202.     remote_copy      := FALSE;
  203.  
  204.     mode             := message_mode;       { Start system in message mode }
  205.     st_switch        := TRUE;               { Default file size display - in 'k' }
  206.     new_dir          := FALSE;              { Reset directory flag }
  207.     up_down_display  := TRUE;               { Show up/downloads for files mode }
  208.     extra_time       := 0;                  { None until upload complete }
  209.  
  210.     op_chat          := FALSE;              { Operator chat not initiated }
  211.  
  212.     user_rec.nulls      := 2;               { 2 nulls until recognition }
  213.     user_rec.shift_lock := FALSE;            { Upper case only to start }
  214.     user_rec.noisy      := FALSE;           { Prompt bell initially off }
  215.     user_rec.columns    := def_chars;
  216.     user_rec.lines      := def_lines;
  217.  
  218.     macro            := 'L/R/PAYSG';
  219.     macro_ptr        := 0;
  220.  
  221.     timeout := 60;                          { Allow one minute for input }
  222.  
  223.     InitIndex;                              { Get files ready for use }
  224.  
  225.     OpenFile(DatF, user_data + ext, SizeOf(user_rec));
  226.     if OK
  227.       then OpenIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
  228.     if not OK
  229.       then
  230.         begin
  231.           Write(BEL, 'User files not found.  Creating ', user_data, ext);
  232.           MakeFile(DatF, user_data + ext, SizeOf(user_rec));
  233.           Write(', ', user_indx, ext);
  234.           MakeIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
  235.           Writeln
  236.         end;
  237.  
  238.     {$I-} Reset(logr_file) {$I+};
  239.     if IOresult <> 0
  240.       then
  241.         begin
  242.           Write(BEL, 'Log file not found.  Creating ', logr_name, ext);
  243.           Rewrite(logr_file);
  244.           logr_rec.user := 0;
  245.           Write(logr_file, logr_rec);
  246.           Writeln
  247.         end;
  248.  
  249.     {$I-} Reset(summ_file) {$I+};
  250.     OK := (IOresult = 0);
  251.     if OK
  252.       then
  253.         begin
  254.           {$I-} Reset(mesg_file) {$I+};
  255.           OK := (IOresult = 0)
  256.         end;
  257.     if not OK
  258.       then
  259.         begin
  260.           Write(BEL, 'Message files not found.  Creating ', summ_name, ext);
  261.           Rewrite(summ_file);
  262.           summ_rec.num := 0;
  263.           Write(summ_file, summ_rec);
  264.           Write(', ', mesg_name, ext);
  265.           Rewrite(mesg_file);
  266.           Writeln
  267.         end;
  268.  
  269.     {$I-} Reset(stat_file) {$I+};
  270.     if IOresult = 0
  271.       then read(stat_file, stat_rec)
  272.       else
  273.         begin
  274.           Write(BEL, 'Statistics file not found.  Creating ', stat_name, ext);
  275.           Rewrite(stat_file);
  276.           GetTAD(stat_rec.date);
  277.           for i := 0 to 23 do
  278.             stat_rec.busy_per_hour[i]  := 0;
  279.           for i := 0 to 6 do
  280.             stat_rec.busy_per_day[i]  := 0;
  281.           Writeln
  282.         end;
  283.  
  284.     {$I-} Reset(nwin_file) {$I+};
  285.     if IOresult <> 0
  286.       then
  287.         begin
  288.           Write(BEL, 'Newin file not found.  Creating ', nwin_name, ext);
  289.           Rewrite(nwin_file);
  290.           Writeln
  291.         end;
  292.  
  293.     if cold
  294.       then
  295.         begin
  296.           log(0, '');
  297.           cold := FALSE
  298.         end
  299.   end;
  300.  
  301. overlay procedure wait_for_user;
  302. { Wait for call or console interrupt }
  303.   var
  304.     ch: char;
  305.     count: integer;
  306.   begin
  307.     ClrScr;
  308.     if delay_down
  309.       then
  310.         begin
  311.           putstat('Waiting for delayed shutdown acknowledgement...');
  312.           mdbusy                            { Make modem busy }
  313.         end
  314.       else
  315.         begin
  316.           putstat(version + ' as of ' + ver_date + '.  Copyright (c) 1985 by Steve Fox.');
  317.           mdinit                            { Get modem ready }
  318.         end;
  319.     count := 0;
  320.     repeat
  321.       count := succ(count);
  322.       if count > 8000
  323.         then
  324.           begin
  325.             putstat('');
  326.             GotoXY(succ(Random(79)), succ(Random(23)));
  327.             count := 0
  328.           end;
  329.       if delay_down
  330.         then Write(BEL);
  331.       ch := GetChar;
  332.       if ch = ETX
  333.         then
  334.           begin
  335.             putstat('Busy modem? ');
  336.             read(KBD, ch);
  337.             if UpCase(ch) = 'Y'
  338.               then mdbusy
  339.               else mdhangup;
  340.             putstat('ROS completing...');
  341.             log(1, '');
  342.             CloseFile(DatF);
  343.             CloseIndex(IdxF);
  344.             Close(sysm_file);
  345.             Close(summ_file);
  346.             Close(mesg_file);
  347.             Close(logr_file);
  348.             Close(stat_file);
  349.             Close(nwin_file);
  350.             fini := TRUE
  351.           end
  352.       else if ch = CR
  353.         then
  354.           begin
  355.             putstat('Local use requested');
  356.             mdbusy;
  357.             rate := 1200;                   { Pretend we're running at 1200 bps }
  358.             local_online := TRUE
  359.           end
  360.       else if mdring
  361.         then
  362.           begin
  363.             putstat('Ring detected');
  364.             mdans;
  365.             remote_online := ch_carck;
  366.             remote_copy   := remote_online;
  367.             if remote_online
  368.               then putstat('Connect at ' + intstr(rate, 3) + ' bps')
  369.           end
  370.     until fini or local_online or remote_online;
  371.     delay_down := FALSE
  372.   end;
  373.  
  374. overlay procedure cold_start;
  375. { One-time initialization routine }
  376.   var
  377.     b: byte;
  378.     SDrive: char;
  379.     i, BufferPtr, remaining, SUser, SAccs: integer;
  380.     SysmThis, SysmLast: SysmPtr;
  381.     SectThis, SectLast: SectPtr;
  382.     AreaThis, AreaLast: AreaPtr;
  383.     SName: Str10;
  384.     SDesc: StrPr;
  385.     sect_file: text;
  386.     sysm_text: file;
  387.  
  388.   procedure build_sysm;
  389.   { Build SYSMSG.BB# file }
  390.     begin
  391.       {$I-} Close(sysm_file) {$I+};         { Shouldn't erase an open file }
  392.       i := IOresult;                        { Ignore any errors }
  393.       Rewrite(sysm_file);
  394.       Assign(sysm_text, sysm_name + '.TXT');
  395.       {$I-} Reset(sysm_text) {$I+};
  396.       if IOresult = 0
  397.         then
  398.           begin
  399.             Write('  Creating ', sysm_name, ext);
  400.             BufferPtr := maxint;
  401.             remaining := FileSize(sysm_text);
  402.             b := $7F and getc(sysm_text, BufferPtr, remaining);
  403.             sysm_rec := '';
  404.             while b <> 26 do
  405.               begin
  406.                 if b = 10
  407.                   then
  408.                     begin
  409.                       Write(sysm_file, sysm_rec);
  410.                       sysm_rec := ''
  411.                     end
  412.                   else if b >= 32
  413.                     then sysm_rec := sysm_rec + char(b);
  414.                   b := $7F and getc(sysm_text, BufferPtr, remaining)
  415.               end;
  416.             Close(sysm_text);
  417.             Close(sysm_file);
  418.             Reset(sysm_file)
  419.           end
  420.         else
  421.           begin
  422.             Writeln;
  423.             Write('System message text file not found.  ', sysm_name, ext, ' will be empty.')
  424.           end;
  425.       Writeln
  426.     end;
  427.  
  428.   begin
  429.     cold        := TRUE;
  430.  
  431.     audit_on    := FALSE;                   { No audit file initially }
  432.     delay_down  := FALSE;                   { Don't shut down yet }
  433.     in_library  := FALSE;                   { Start in non-library mode }
  434.  
  435.     SysmBase    := nil;                     { Start with empty system message, }
  436.     SectBase    := nil;                     {   section, }
  437.     AreaBase    := nil;                     {   message area, }
  438.     MesgBase    := nil;                     {   message, }
  439.     DirBase     := nil;                     {   directory, }
  440.     LibBase     := nil;                     {   and library lists }
  441.  
  442.     UsrOutPtr   := addr(putchar);           { Initialize output driver }
  443.  
  444.     HomDrv      := BDOS(getdrive);          { Assume system files are }
  445.     HomUsr      := BDOS(getseluser, $FF);   {   in the startup area }
  446.  
  447.     Assign(sysm_file, sysm_name + ext);
  448.     Assign(summ_file, summ_name + ext);
  449.     Assign(mesg_file, mesg_name + ext);
  450.     Assign(logr_file, logr_name + ext);
  451.     Assign(sect_file, sect_name + ext);
  452.     Assign(stat_file, stat_name + ext);
  453.     Assign(nwin_file, nwin_name + ext);
  454.  
  455.     {$I-} Reset(sysm_file) {$I+};           { Try to open system message file }
  456.     if IOresult <> 0
  457.       then
  458.         begin
  459.           Write('Cannot open ', sysm_name + ext, '.');
  460.           build_sysm
  461.         end;
  462.  
  463.     {$I-} read(sysm_file, sysm_rec) {$I+};  { Try to read file }
  464.     if IOresult <> 0
  465.       then
  466.         begin
  467.           Write('Cannot read ', sysm_name + ext, '.');
  468.           build_sysm;
  469.           seek(sysm_file, 0);
  470.           {$I-} read(sysm_file, sysm_rec) {$I+};
  471.           if IOresult <> 0
  472.             then
  473.               begin
  474.                 Writeln('Still cannot read ', sysm_name + ext, '.');
  475.                 Writeln('Unable to continue.');
  476.                 halt
  477.               end
  478.         end;
  479.  
  480.     i := 0;
  481.     while not EOF(sysm_file) do
  482.       begin
  483.         if sysm_rec[1] = ':'
  484.           then
  485.             begin
  486.               new(SysmThis);
  487.               if SysmBase = nil
  488.                 then SysmBase := SysmThis
  489.                 else SysmLast^.next := SysmThis;
  490.               SysmLast := SysmThis;
  491.               SysmLast^.key := sysm_rec[2];
  492.               SysmLast^.loc := i;
  493.               SysmLast^.next := nil
  494.             end;
  495.         read(sysm_file, sysm_rec);
  496.         i := succ(i)
  497.       end;
  498.  
  499.     RcvDrv := 0;                            { Default to A0: for uploads }
  500.     RcvUsr := 0;
  501.     {$I-} Reset(sect_file) {$I+};           { Build file and message section lists }
  502.     OK := (IOresult = 0);
  503.     if OK
  504.       then
  505.         begin
  506.           while not EOF(sect_file) do
  507.             begin
  508.               readln(sect_file, SDrive, SUser, SAccs, SName, SDesc);
  509.               if SDrive = ' '
  510.                 then
  511.                   begin
  512.                     new(AreaThis);
  513.                     if AreaBase = nil
  514.                       then AreaBase := AreaThis
  515.                       else AreaLast^.next := AreaThis;
  516.                     AreaLast := AreaThis;
  517.                     AreaLast^.Area := SUser;
  518.                     AreaLast^.AreaAccs := SAccs;
  519.                     AreaLast^.AreaName := trim(SName);
  520.                     AreaLast^.AreaDesc := trim(SDesc);
  521.                     AreaLast^.next := nil
  522.                   end
  523.               else if SDrive <> ' '
  524.                 then
  525.                   begin
  526.                     new(SectThis);
  527.                     if SectBase = nil
  528.                       then SectBase := SectThis
  529.                       else SectLast^.next := SectThis;
  530.                     SectLast := SectThis;
  531.                     SectLast^.SectDrive := ord(SDrive) - ord('A');
  532.                     SectLast^.SectUser := SUser;
  533.                     SectLast^.SectAccs := SAccs;
  534.                     SectLast^.SectName := trim(SName);
  535.                     SectLast^.SectDesc := trim(SDesc);
  536.                     SectLast^.next := nil
  537.                   end
  538.             end;
  539.           Close(sect_file);
  540.           FindSect('NEWIN', RcvDrv, RcvUsr, OK);
  541.           if not OK
  542.             then Writeln(BEL, 'NEWIN section not found.');
  543.         end
  544.       else Writeln(BEL, 'Section file not found.');
  545.   end;
  546.  
  547.