home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pibterm / pibt41s3.arc / PIBHOSTD.MOD < prev    next >
Text File  |  1988-02-25  |  44KB  |  1,216 lines
  1. (*----------------------------------------------------------------------*)
  2. (*            Do_Host --- Controls execution of host mode               *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Do_Host;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Do_Host                                              *)
  10. (*                                                                      *)
  11. (*     Purpose:    Controls host mode                                   *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Do_Host;                                                      *)
  16. (*                                                                      *)
  17. (*      Calls:   Async_Send                                             *)
  18. (*               Async_Receive                                          *)
  19. (*               PibTerm_KeyPressed                                     *)
  20. (*               Clear_Window                                           *)
  21. (*                                                                      *)
  22. (*----------------------------------------------------------------------*)
  23.  
  24. VAR
  25.    Done    : BOOLEAN               (* TRUE to exit host mode            *);
  26.    Found   : BOOLEAN               (* TRUE if user name found           *);
  27.    Ch      : CHAR                  (* Character read/written            *);
  28.    S_Ch    : CHAR                  (* Parity_stripped character         *);
  29.    MyPass  : AnyStr                (* Password                          *);
  30.    Try     : INTEGER               (* Number of login attempts          *);
  31.    Back    : BOOLEAN               (* Back from file transfers          *);
  32.    Ierr    : INTEGER               (* I/O error code                    *);
  33.    Keyed_In: BOOLEAN               (* TRUE if character entered at Kbd  *);
  34.  
  35. BEGIN (* Do_Host *)
  36.                                    (* Clear comm line of garbage *)
  37.    Async_Purge_Buffer;
  38.                                    (* Expert mode OFF by default *)
  39.    Expert_On       := FALSE;
  40.                                    (* Assume line feeds not needed *)
  41.    CR_LF_Host      := CHR( CR );
  42.                                    (* Welcome and linefeed check *)
  43.    Done            := FALSE;
  44.                                    (* Current host status *)
  45.    Cur_Host_Status := '';
  46.  
  47.    Host_Send_String_With_CR('PibTerm Version ' + PibTerm_Version);
  48.    Host_Send_String_With_CR(PibTerm_Date);
  49.    Host_Send_String_With_CR('Beginning Remote Communications');
  50.    Host_Send_String_With_CR(' ');
  51.    Host_Send_String_With_CR('Test if line feeds required ...');
  52.  
  53.    REPEAT
  54.  
  55.       Async_Purge_Buffer;
  56.  
  57.       Host_Send_String_With_CR(' ');
  58.       Host_Send_String_And_Echo('Are these lines O V E R P R I N T I N G ?');
  59.  
  60.       Keyed_In := FALSE;
  61.  
  62.       REPEAT
  63.       UNTIL Async_Receive( Ch ) OR PibTerm_KeyPressed OR ( NOT Host_Carrier_Detect );
  64.  
  65.       S_Ch := CHR( ORD( Ch ) AND $7F );
  66.  
  67.                                    (* Look for keyboard input if any *)
  68.       IF PibTerm_KeyPressed THEN
  69.          BEGIN
  70.             Keyed_In := TRUE;
  71.             Read_Kbd( S_Ch );
  72.             IF ( S_Ch = CHR( ESC ) ) THEN
  73.                IF ( NOT PibTerm_KeyPressed ) THEN
  74.                   BEGIN
  75.                      Done        := TRUE;
  76.                      Really_Done := TRUE;
  77.                   END
  78.                ELSE
  79.                   BEGIN
  80.                      Done := TRUE;
  81.                      WHILE PibTerm_KeyPressed DO
  82.                         Read_Kbd( S_Ch );
  83.                   END;
  84.          END;
  85.                                    (* Alter parity if required *)
  86.  
  87.       IF ( ( S_Ch <> Ch ) AND ( NOT Done ) AND ( NOT Keyed_In ) ) THEN
  88.          BEGIN
  89.  
  90.             IF Parity = 'N' THEN
  91.                BEGIN
  92.                   Parity    := 'E';
  93.                   Data_Bits := 7;
  94.                END
  95.             ELSE
  96.                BEGIN
  97.                   Parity    := 'N';
  98.                   Data_Bits := 8;
  99.                END;
  100.  
  101.             Async_Reset_Port( Comm_Port, Baud_Rate, Parity,
  102.                               Data_Bits, Stop_Bits );
  103.  
  104.             Set_Status_Line_Name( Short_Terminal_Name );
  105.             Write_To_Status_Line( Status_Line_Name, 1 );
  106.  
  107.             WRITELN;
  108.             WRITELN('Communication re-adjusted to parity = ',Parity,
  109.                     ' and data bits = ',Data_Bits);
  110.             WRITELN;
  111.  
  112.          END;
  113.                                    (* Echo character *)
  114.       IF ( NOT Done ) THEN
  115.          BEGIN
  116.  
  117.             S_Ch := UpCase( S_Ch );
  118.  
  119.             Host_Send( S_Ch );
  120.  
  121.             IF Printer_On THEN
  122.                Write_Prt( S_Ch );
  123.  
  124.             IF Capture_On THEN
  125.                WRITE( Capture_File , S_Ch );
  126.  
  127.          END;
  128.  
  129.       Done := Done OR ( NOT Host_Carrier_Detect );
  130.  
  131.    UNTIL ( S_Ch IN ['Y','N'] ) OR Done;
  132.  
  133.    IF Done THEN Exit;
  134.  
  135.    IF S_Ch = 'Y' THEN
  136.       CR_LF_Host := CHR( CR ) + CHR( LF )
  137.    ELSE
  138.       CR_LF_Host := CHR( CR );
  139.                                    (* Get user's ID and password *)
  140.    Try := 0;
  141.  
  142.    REPEAT
  143.        INC( Try );
  144.        Get_UserInfo( Found );
  145.    UNTIL( ( Try > Max_Login_Try ) OR Found );
  146.  
  147.                                    (* Check for bad logon or carrier drop *)
  148.  
  149.    Done := Done OR ( NOT Found ) OR ( NOT Host_Carrier_Detect );
  150.  
  151.                                    (* Continue to main menu if OK *)
  152.    IF ( NOT Done ) THEN
  153.       BEGIN
  154.                                    (* Mark this as first entry here  *)
  155.          Host_Section := 'I';
  156.                                    (* Loop over main menu until done *)
  157.          REPEAT
  158.  
  159.             CASE Host_Section OF
  160.                'G':  Gossip_Mode;
  161.                'F':  REPEAT
  162.                         Process_File_Transfer_Commands( Done, Back );
  163.                      UNTIL( Done OR Back );
  164.                'D':  IF ( Privilege = 'S' ) THEN
  165.                         BEGIN
  166.                            IF ( NOT Local_Host ) THEN
  167.                               Jump_To_Dos
  168.                            ELSE
  169.                               BEGIN
  170.                                  DosJump('');
  171.                                  Host_Section := Last_Host_Sect;
  172.                               END;
  173.                         END;
  174.                ELSE
  175.                      Process_Host_Commands( Done );
  176.             END (* CASE *);
  177.  
  178.             Done := Done OR ( NOT Host_Carrier_Detect );
  179.  
  180.          UNTIL ( Done );
  181.  
  182.       END;
  183.                                    (* Update status line *)
  184.    Host_Status( 'Wait for call' );
  185.  
  186.                                    (* Record this logout *)
  187.  
  188.    Write_Log( 'Logged off.', FALSE, FALSE );
  189.  
  190.    Host_Status('Logged off');
  191.  
  192.    Write_Log( 'Waiting for call.', FALSE, FALSE );
  193.  
  194. END   (* Do_Host *);
  195.  
  196. (*----------------------------------------------------------------------*)
  197. (*          Initialize_Host_Mode --- Initializes host mode              *)
  198. (*----------------------------------------------------------------------*)
  199.  
  200. PROCEDURE Initialize_Host_Mode;
  201.  
  202. (*----------------------------------------------------------------------*)
  203. (*                                                                      *)
  204. (*     Procedure:  Initialize_Host_Mode                                 *)
  205. (*                                                                      *)
  206. (*     Purpose:    Initializes host mode.                               *)
  207. (*                                                                      *)
  208. (*     Calling Sequence:                                                *)
  209. (*                                                                      *)
  210. (*        Initialize_Host_Mode;                                         *)
  211. (*                                                                      *)
  212. (*     Remarks:                                                         *)
  213. (*                                                                      *)
  214. (*       This routine reads the user file into memory and scans the     *)
  215. (*       message file as well.  The asynchronous communications port    *)
  216. (*       is also initialized.                                           *)
  217. (*                                                                      *)
  218. (*----------------------------------------------------------------------*)
  219.  
  220. VAR
  221.    Qerr           : BOOLEAN;
  222.    User_File      : Text_File;
  223.    User_Line      : AnyStr;
  224.    I              : INTEGER;
  225.    Done_Flag      : BOOLEAN;
  226.    Xfer_List_File : Text_File   (* File transfer list file    *);
  227.  
  228. (*----------------------------------------------------------------------*)
  229. (*            Get_A_String --- get string up to specified delimeter     *)
  230. (*----------------------------------------------------------------------*)
  231.  
  232. FUNCTION Get_A_String( S : AnyStr; VAR IS: INTEGER; Delim: CHAR ) : AnyStr;
  233.  
  234. (*----------------------------------------------------------------------*)
  235. (*                                                                      *)
  236. (*     Function:   Get_A_String                                         *)
  237. (*                                                                      *)
  238. (*     Purpose:    Gets string up to specified delimeter.               *)
  239. (*                                                                      *)
  240. (*     Calling Sequence:                                                *)
  241. (*                                                                      *)
  242. (*        D_String := Get_A_String( S : AnyStr; VAR IS: INTEGER;        *)
  243. (*                                  Delim: CHAR ) : AnyStr;             *)
  244. (*                                                                      *)
  245. (*           S        --- string to be scanned                          *)
  246. (*           IS       --- first position in S to be scanned             *)
  247. (*           Delim    --- delimeter character to mark end of string     *)
  248. (*                                                                      *)
  249. (*           D_String --- returns substring of S beginning at IS and    *)
  250. (*                        proceeding up to (but not including) Delim,   *)
  251. (*                        or end of string.                             *)
  252. (*                                                                      *)
  253. (*----------------------------------------------------------------------*)
  254.  
  255. VAR
  256.    T: AnyStr;
  257.  
  258. BEGIN (* Get_A_String *)
  259.  
  260.    T := '';
  261.  
  262.    WHILE ( IS <= LENGTH( S ) ) AND ( S[IS] <> Delim ) DO
  263.       BEGIN
  264.          T  := T + S[IS];
  265.          INC( IS );
  266.       END;
  267.  
  268.    Get_A_String := T;
  269.  
  270. END   (* Get_A_String *);
  271.  
  272. (*----------------------------------------------------------------------*)
  273. (*      Get_Kbd_String --- get string from keyboard with ESC check      *)
  274. (*----------------------------------------------------------------------*)
  275.  
  276. FUNCTION Get_Kbd_String(     Prompt  : AnyStr;
  277.                              ForceUp : BOOLEAN;
  278.                          VAR S       : AnyStr  ) : BOOLEAN;
  279.  
  280. BEGIN (* Get_Kbd_String *)
  281.                                    (* Issue prompt *)
  282.    WRITE( Prompt );
  283.                                    (* Read string *)
  284.    S := '';
  285.    Read_Edited_String( S );
  286.    WRITELN;
  287.                                    (* Trim trailing blanks *)
  288.    S := Trim( S );
  289.                                    (* Convert to upper case *)
  290.    IF ForceUp THEN
  291.       S := UpperCase( S );
  292.                                    (* Check for null or ESC *)
  293.  
  294.    Get_Kbd_String := ( S <> '' ) AND ( S <> CHR( ESC ) );
  295.  
  296. END   (* Get_Kbd_String *);
  297.  
  298. (*----------------------------------------------------------------------*)
  299. (*      Create_XferList_File --- Create file listing downloadable files *)
  300. (*----------------------------------------------------------------------*)
  301.  
  302. PROCEDURE Create_XferList_File;
  303.  
  304. VAR
  305.    File_Entry          : SearchRec;
  306.    S_File_Name         : STRING[14];
  307.    S_File_Time         : STRING[8];
  308.    S_File_Date         : STRING[8];
  309.    Done                : BOOLEAN;
  310.    Dir_Spec            : AnyStr;
  311.    Dir_Skip_Entry      : BYTE;
  312.  
  313. BEGIN (* Create_XferList_File *)
  314.  
  315.                                    (* XFer_List_File already assigned. *)
  316.             (*!I-*)
  317.    REWRITE( XFer_List_File );
  318.             (*!I+*)
  319.  
  320.    IF ( INT24Result <> 0 ) THEN
  321.       BEGIN
  322.          Write_Log('Cannot create PIBTERM.XFR.', FALSE, TRUE);
  323.          WRITELN;
  324.          EXIT;
  325.       END
  326.    ELSE
  327.       IF ( LENGTH( Host_Mode_Download ) = 0 ) THEN
  328.          BEGIN
  329.             Write_Log('Creating empty PIBTERM.XFR.', FALSE, TRUE);
  330.             WRITELN;
  331.             WRITELN( Xfer_List_File , 'No files available for downloading.' );
  332.             EXIT;
  333.          END;
  334.  
  335.    Write_Log('Creating PIBTERM.XFR from directory ' + Host_Mode_Download + '.',
  336.              FALSE, TRUE);
  337.                                    (* Construct directory specification *)
  338.  
  339.    Dir_Spec := Host_Mode_Download + '*.*';
  340.  
  341.    WRITELN( Xfer_List_File ,
  342.             '====================== Files available for downloading =======================');
  343.  
  344.                                    (* Attributes of files to be skipped.  *)
  345.  
  346.    Dir_Skip_Entry := Hidden OR Directory OR VolumeID OR SysFile;
  347.  
  348.                                    (* Get the download directory contents *)
  349.  
  350.    FindFirst( Dir_Spec, AnyFile, File_Entry );
  351.  
  352.    Done  := ( DosError <> 0 );
  353.  
  354.    WHILE( NOT Done ) DO
  355.       WITH File_Entry DO
  356.          BEGIN
  357.                                    (* Skip next directory entry if *)
  358.                                    (* hidden or subdirectory.      *)
  359.  
  360.             IF ( ( Attr AND Dir_Skip_Entry ) = 0 ) THEN
  361.                BEGIN
  362.                                    (* Pick up file name *)
  363.  
  364.                   S_File_Name := Name + DUPL( ' ' , 14 - LENGTH( Name ) );
  365.  
  366.                                    (* Pick up creation date and time *)
  367.  
  368.                   Dir_Convert_File_Date_And_Time( Time , S_File_Date , S_File_Time );
  369.  
  370.                                    (* Write entry to xferlist file *)
  371.  
  372.                   WRITELN( Xfer_List_File,
  373.                            S_File_Name,     ' ',
  374.                            Size:8  , ' ',
  375.                            S_File_Date,     ' ',
  376.                            S_File_Time );
  377.  
  378.                END;
  379.  
  380.          FindNext( File_Entry );
  381.  
  382.          Done := Done OR ( DosError <> 0 );
  383.  
  384.    END;
  385.  
  386. END    (* Create_XferList_File *);
  387.  
  388. (*----------------------------------------------------------------------*)
  389.  
  390. BEGIN (* Initialize_Host_Mode *)
  391.                                    (* Set termination flags *)
  392.    Host_Mode      := TRUE;
  393.    Done           := FALSE;
  394.    Really_Done    := FALSE;
  395.    First_Time     := TRUE;
  396.    User_File_Size := 0;
  397.                                    (* Save file paths      *)
  398.  
  399.    Save_Upload       := Upload_Dir_Path;
  400.    Save_Download     := Download_Dir_Path;
  401.    Download_Dir_Path := Host_Mode_Upload;
  402.    Upload_Dir_Path   := Host_Mode_Download;
  403.    Save_Review       := Review_On;
  404.    Review_On         := FALSE;
  405.    Save_Logging      := Logging_On;
  406.    Logging_On        := TRUE;
  407.  
  408.                                    (* Open log file *)
  409.  
  410.    Log_File_Open     := Open_For_Append( Log_File,
  411.                                          Log_File_Name, Ierr );
  412.  
  413.                                    (* Clear screen to start     *)
  414.  
  415.    PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
  416.    Clear_Window;
  417.                                    (* Display status lines      *)
  418.  
  419.    Status_Line_Attr    := 16 * ( ForeGround_Color AND 7 ) +
  420.                           BackGround_Color;
  421.    Do_Status_Line      := TRUE;
  422.    Do_Status_Time      := TRUE;
  423.    Current_Status_Time := -1;
  424.  
  425.    User_Line := ' ESC=quit  F1=chat  F2=logout  F3=DOS  F4=undim  F5=caller  CR=start local';
  426.    User_Line := User_Line + DUPL( ' ' , Max_Screen_Col - LENGTH( User_Line ) );
  427.    WriteSXY( User_Line, 1, PRED( Max_Screen_Line ), Status_Line_Attr );
  428.  
  429.    Short_Terminal_Name := 'Host Mode';
  430.    Set_Status_Line_Name( Short_Terminal_Name );
  431.    Write_To_Status_Line( Status_Line_Name, 1 );
  432.  
  433.    PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line - 2 );
  434.    GoToXY( 1 , 1 );
  435.  
  436.    Write_Log('Host mode started.', FALSE, FALSE );
  437.  
  438.                                    (* Read in the user file *)
  439.  
  440.    ASSIGN( User_File, Home_Dir + 'PIBTERM.USF' );
  441.       (*!I-*)
  442.    RESET ( User_File );
  443.       (*!I+*)
  444.                                    (* User file not present --- prompt *)
  445.                                    (* for single name, password, and   *)
  446.                                    (* privilege level.                 *)
  447.  
  448.    IF ( Int24Result <> 0 ) THEN
  449.       BEGIN
  450.  
  451.          WRITELN(' ');
  452.  
  453.          Write_Log('No user file present, single user mode assumed.',
  454.                    FALSE, TRUE );
  455.  
  456.          User_List := @One_User;
  457.  
  458.          WITH User_List^[1] DO
  459.             BEGIN
  460.                IF ( NOT Get_Kbd_String('Enter first name: ', TRUE, First_Name ) ) THEN
  461.                   BEGIN
  462.                      Really_Done := TRUE;
  463.                      EXIT;
  464.                   END;
  465.                IF ( NOT Get_Kbd_String('Enter last name:  ', TRUE, Last_Name  ) ) THEN
  466.                   BEGIN
  467.                      Really_Done := TRUE;
  468.                      EXIT;
  469.                   END;
  470.                IF ( NOT Get_Kbd_String('Enter password:   ', FALSE, PassWord  ) ) THEN
  471.                   BEGIN
  472.                      Really_Done := TRUE;
  473.                      EXIT;
  474.                   END;
  475.                IF YesNo('Allow superuser privileges (Y/N)? ') THEN
  476.                   Privilege := 'S'
  477.                ELSE
  478.                   Privilege := 'N';
  479.             END;
  480.  
  481.          WRITELN(' ');
  482.  
  483.          NUsers := 1;
  484.  
  485.       END
  486.    ELSE
  487.       BEGIN
  488.                                    (* Scan user file to find # entries      *)
  489.          User_File_Size := 0;
  490.  
  491.          REPEAT
  492.             READLN( User_File , User_Line );
  493.             INC   ( User_File_Size );
  494.          UNTIL ( EOF( User_File ) OR ( User_File_Size > MaxUsers ) );
  495.  
  496.                                    (* Allocate space for user file entries. *)
  497.  
  498.          GETMEM( User_List , User_File_Size * SIZEOF( User_Record ) );
  499.  
  500.                                    (* Make sure we got the space *)
  501.  
  502.          IF ( User_List = NIL ) THEN
  503.             BEGIN
  504.  
  505.                Really_Done := TRUE;
  506.  
  507.                WRITELN(' ');
  508.  
  509.                Write_Log('Not enough memory to store user entries.',
  510.                          FALSE, TRUE );
  511.  
  512.                CLOSE( User_File );
  513.                I := Int24Result;
  514.  
  515.                User_File_Size := 0;
  516.  
  517.                EXIT;
  518.  
  519.             END;
  520.                                    (* Reposition user file for reread *)
  521.          RESET( User_File );
  522.                                    (* Set number of users to 0        *)
  523.          NUsers := 0;
  524.  
  525.          REPEAT
  526.  
  527.             INC( NUsers );
  528.  
  529.             READLN( User_File , User_Line );
  530.  
  531.             WITH User_List^[NUsers] DO
  532.                BEGIN
  533.                   I          := 1;
  534.                   First_Name := Trim( UpperCase( Get_A_String( User_Line, I, ';') ) );
  535.                   INC( I );
  536.                   Last_Name  := Trim( UpperCase( Get_A_String( User_Line, I, ';') ) );
  537.                   INC( I );
  538.                   PassWord   := Trim( Get_A_String( User_Line, I, ';') );
  539.                   INC( I );
  540.                   Privilege  := Trim( UpperCase( Get_A_String( User_Line, I, ';') ) );
  541.                   IF ( Privilege <> 'S' ) THEN
  542.                      Privilege := 'N';
  543.                END;
  544.  
  545.             IF ( User_List^[NUsers].First_Name = '' ) THEN
  546.                DEC( NUsers );
  547.  
  548.          UNTIL ( EOF( User_File ) OR ( NUsers >= MaxUsers ) );
  549.  
  550.          IF ( NUsers = 1 ) THEN
  551.             Write_Log( 'There is 1 user recorded in user file.',
  552.                        FALSE, TRUE)
  553.          ELSE
  554.             Write_Log( 'There are ' + IToS( NUsers ) + ' users recorded in user file.',
  555.                        FALSE, TRUE);
  556.          WRITELN;
  557.  
  558.          IF Debug_Mode THEN
  559.             IF YesNo('Display users (Y/N)? ') THEN
  560.                BEGIN
  561.  
  562.                   WRITELN(' ');
  563.  
  564.                   FOR I := 1 TO NUsers DO
  565.                      WITH User_List^[I] DO
  566.                         BEGIN
  567.                            WRITE( First_Name, ' ', Last_Name, ' ', PassWord );
  568.                            IF Privilege = 'S' THEN
  569.                               WRITE( '*** SuperUser ***' );
  570.                            WRITELN;
  571.                         END;
  572.  
  573.                END
  574.             ELSE
  575.                WRITELN(' ');
  576.  
  577.       END;
  578.                                    (* Close user file              *)
  579.       (*!I-*)
  580.    CLOSE( User_File );
  581.       (*!I+*)
  582.  
  583.    I := INT24Result;
  584.                                    (* Scan message file to see how *)
  585.                                    (* many messages there are      *)
  586.    NMessages := 0;
  587.  
  588.    ASSIGN( Message_File , Home_Dir + 'PIBTERM.MSG' );
  589.       (*!I-*)
  590.    RESET( Message_File );
  591.       (*!I+*)
  592.  
  593.    IF Int24Result <> 0 THEN
  594.       BEGIN
  595.          Write_Log('No messages in message base.', FALSE, TRUE);
  596.          WRITELN;
  597.       END
  598.    ELSE
  599.       REPEAT
  600.  
  601.          READLN( Message_File , Message_Line );
  602.  
  603.          IF COPY( Message_Line, 1, 6 ) = '== End' THEN
  604.             INC( NMessages );
  605.  
  606.       UNTIL ( EOF( Message_File ) );
  607.  
  608.    IF ( NMessages > 0 ) THEN
  609.       IF ( NMessages = 1 ) THEN
  610.          BEGIN
  611.             Write_Log('There is 1 message in message base.',
  612.                       FALSE, TRUE);
  613.             WRITELN;
  614.          END
  615.       ELSE
  616.          BEGIN
  617.             Write_Log('There are ' + IToS( NMessages ) + ' messages in message base.',
  618.                       FALSE, TRUE);
  619.             WRITELN;
  620.          END;
  621.  
  622.       (*!I-*)
  623.    CLOSE( Message_File );
  624.       (*!I+*)
  625.  
  626.    I := INT24Result;
  627.                                    (* Create PIBTERM.XFR if needed *)
  628.  
  629.    ASSIGN( XFer_List_File , Home_Dir + 'PIBTERM.XFR' );
  630.       (*!I-*)
  631.    RESET( XFer_List_File );
  632.       (*!I+*)
  633.  
  634.    IF ( Int24Result <> 0 ) THEN
  635.       Create_XferList_File;
  636.  
  637.       (*!I-*)
  638.    CLOSE( Xfer_List_File );
  639.       (*!I+*)
  640.  
  641.    I := INT24Result;
  642.  
  643. END   (* Initialize_Host_Mode *);
  644.  
  645. (*----------------------------------------------------------------------*)
  646. (*             Terminate_Host_Mode --- Terminate host mode              *)
  647. (*----------------------------------------------------------------------*)
  648.  
  649. PROCEDURE Terminate_Host_Mode;
  650.  
  651. (*----------------------------------------------------------------------*)
  652. (*                                                                      *)
  653. (*     Procedure:  Terminate_Host_Mode                                  *)
  654. (*                                                                      *)
  655. (*     Purpose:    Terminates host mode.                                *)
  656. (*                                                                      *)
  657. (*     Calling Sequence:                                                *)
  658. (*                                                                      *)
  659. (*        Terminate_Host_Mode;                                          *)
  660. (*                                                                      *)
  661. (*     Remarks:                                                         *)
  662. (*                                                                      *)
  663. (*       This routine hangs up the phone.                               *)
  664. (*                                                                      *)
  665. (*----------------------------------------------------------------------*)
  666.  
  667. VAR
  668.    Save_Baud : WORD;
  669.  
  670. BEGIN (* Terminate_Host_Mode *)
  671.                                    (* Wait a second for output to drain *)
  672.  
  673.    Cur_Host_Status := 'End host session';
  674.  
  675.    Async_Drain_Output_Buffer( One_Second ) ;
  676.  
  677.    IF ( NOT Hard_Wired ) THEN
  678.       BEGIN
  679.                                    (* Reset the port *)
  680.          Reset_The_Port;
  681.  
  682.          Save_Baud := New_Baud;
  683.          Baud_Rate := New_Baud;
  684.                                    (* Hang up the phone *)
  685.          HangUpPhone;
  686.                                    (* Reset the modem   *)
  687.  
  688.          Send_Modem_Command( Modem_Host_UnSet );
  689.  
  690.          Async_Drain_Output_Buffer( Five_Seconds );
  691.  
  692.          Baud_Rate := Save_Baud;
  693.  
  694.          Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );
  695.  
  696.          Async_Purge_Buffer;
  697.  
  698.          Set_Status_Line_Name( Short_Terminal_Name );
  699.          Write_To_Status_Line( Status_Line_Name, 1 );
  700.  
  701.       END;
  702.  
  703.    WRITELN;
  704.    WRITELN('Host session ended.');
  705.  
  706.    IF Hard_Wired THEN
  707.       Really_Done := Really_Done OR YesNo('Return to terminal emulation mode (Y/N)? ');
  708.  
  709. END   (* Terminate_Host_Mode *);
  710.  
  711. (*----------------------------------------------------------------------*)
  712. (*        Wait_For_Ring --- Wait for phone to ring and answer it        *)
  713. (*----------------------------------------------------------------------*)
  714.  
  715. PROCEDURE Wait_For_Ring( VAR Done: BOOLEAN );
  716.  
  717. (*----------------------------------------------------------------------*)
  718. (*                                                                      *)
  719. (*     Procedure:  Wait_For_Ring                                        *)
  720. (*                                                                      *)
  721. (*     Purpose:    Answers the phone in host mode.                      *)
  722. (*                                                                      *)
  723. (*     Calling Sequence:                                                *)
  724. (*                                                                      *)
  725. (*        Wait_For_Ring( VAR Done : BOOLEAN );                          *)
  726. (*                                                                      *)
  727. (*           Done -- set TRUE if carrier drops or Sysop requests        *)
  728. (*                   host mode termination.                             *)
  729. (*                                                                      *)
  730. (*     Remarks:                                                         *)
  731. (*                                                                      *)
  732. (*       This routine answers the phone and analyzes the modem response *)
  733. (*       in order to set the proper baud rate for communications.       *)
  734. (*                                                                      *)
  735. (*----------------------------------------------------------------------*)
  736.  
  737. VAR
  738.    Qerr       : BOOLEAN;
  739.    Modem_Ans  : AnyStr;
  740.    Ch         : CHAR;
  741.    I          : INTEGER;
  742.    J          : INTEGER;
  743.    MTimeOut   : BOOLEAN;
  744.    Int_Ch     : INTEGER;
  745.    Blanked    : BOOLEAN;
  746.    Local_Save : Saved_Screen_Ptr;
  747.  
  748. (*----------------------------------------------------------------------*)
  749. (*         Host_Baud_Detect --- Detect caller's baud rate from CRs      *)
  750. (*----------------------------------------------------------------------*)
  751.  
  752. PROCEDURE Host_Baud_Detect;
  753.  
  754. (*----------------------------------------------------------------------*)
  755. (*                                                                      *)
  756. (*     Procedure:  Host_Baud_Detect                                     *)
  757. (*                                                                      *)
  758. (*     Purpose:    Detects caller's baud rate from CR entries           *)
  759. (*                                                                      *)
  760. (*     Calling Sequence:                                                *)
  761. (*                                                                      *)
  762. (*        Host_Baud_Detect;                                             *)
  763. (*                                                                      *)
  764. (*     Calls:                                                           *)
  765. (*                                                                      *)
  766. (*        Async_Receive_With_TimeOut                                    *)
  767. (*                                                                      *)
  768. (*     Remarks:                                                         *)
  769. (*                                                                      *)
  770. (*        The initial baud rate is set to 2400 baud.  Then, as the      *)
  771. (*        enters characters, we look at each and alter the baud rate    *)
  772. (*        until something recognizable emerges.                         *)
  773. (*                                                                      *)
  774. (*----------------------------------------------------------------------*)
  775.  
  776. CONST
  777.    Wait_Ch_Time = 10                (* Seconds to wait for a character *);
  778.  
  779.                                    (* Supported host mode baud rates *)
  780.    N_Of_Host_Baud_Rates = 5;
  781.  
  782.    Host_Baud_Rates : ARRAY[1..N_Of_Host_Baud_Rates] OF WORD
  783.                      = ( 2400, 1200, 9600, 19200, 300 );
  784.  
  785. VAR
  786.    Found_Speed : BOOLEAN;
  787.    IBaud       : INTEGER;
  788.  
  789. (*----------------------------------------------------------------------*)
  790. (*               Try_Baud_Rate --- Try a specified baud rate            *)
  791. (*----------------------------------------------------------------------*)
  792.  
  793. FUNCTION Try_Baud_Rate( Test_Baud_Rate: WORD ) : BOOLEAN;
  794.  
  795. VAR
  796.    Stripped_Ch : INTEGER;
  797.    Timed_Out   : BOOLEAN;
  798.    Ch          : INTEGER;
  799.  
  800. BEGIN (* Try_Baud_Rate *)
  801.                                    (* Assume this baud rate fails *)
  802.    Try_Baud_Rate := FALSE;
  803.                                    (* Set port to given baud rate *)
  804.    Baud_Rate     := Test_Baud_Rate;
  805.  
  806.    Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );
  807.  
  808.    Set_Status_Line_Name( Short_Terminal_Name );
  809.    Write_To_Status_Line( Status_Line_Name, 1 );
  810.  
  811.                                    (* Wait for a character              *)
  812.  
  813.    Async_Receive_With_TimeOut( Wait_Ch_Time , Ch );
  814.    Timed_Out := ( Ch = TimeOut );
  815.    Async_Clear_Errors;
  816.                                    (* Strip parity bit                 *)
  817.    Stripped_Ch := ( Ch AND $7F );
  818.                                    (* See if it's recognizable as CR   *)
  819.                                    (* or space.  If so, then check     *)
  820.                                    (* the parity.                      *)
  821.    IF ( NOT Timed_Out ) THEN
  822.       IF ( Stripped_Ch = CR     )   OR
  823.          ( Stripped_Ch = ORD(' ') ) THEN
  824.          BEGIN
  825.             Try_Baud_Rate := TRUE;
  826.             IF ( Stripped_Ch <> Ch ) THEN
  827.                BEGIN
  828.  
  829.                   IF Parity = 'N' THEN
  830.                      BEGIN
  831.                         Parity    := 'E';
  832.                         Data_Bits := 7;
  833.                      END
  834.                   ELSE
  835.                      BEGIN
  836.                         Parity    := 'N';
  837.                         Data_Bits := 8;
  838.                      END;
  839.  
  840.                   Async_Reset_Port( Comm_Port, Baud_Rate, Parity,
  841.                                     Data_Bits, Stop_Bits );
  842.  
  843.                   Set_Status_Line_Name( Short_Terminal_Name );
  844.                   Write_To_Status_Line( Status_Line_Name, 1 );
  845.  
  846.                END;
  847.          END;
  848.  
  849. END   (* Try_Baud_Rate *);
  850.  
  851. (*----------------------------------------------------------------------*)
  852.  
  853. BEGIN (* Host_Baud_Detect *)
  854.                                    (* Indicates if speed detected       *)
  855.    Found_Speed := FALSE;
  856.                                    (* Wait for modem messages to appear *)
  857.  
  858.    DELAY( 2 * Tenth_Of_A_Second_Delay );
  859.  
  860.                                    (* Purge the receive buffer          *)
  861.    Async_Purge_Buffer;
  862.                                    (* Loop until speed found            *)
  863.  
  864.    WHILE ( NOT Found_Speed ) AND ( Async_Carrier_Detect ) DO
  865.       BEGIN
  866.  
  867.          IBaud := 0;
  868.                                    (* Try each baud rate in turn        *)
  869.          REPEAT
  870.  
  871.             INC( IBaud );
  872.             Parity      := 'N';
  873.             Data_Bits   := 8;
  874.             Found_Speed := Try_Baud_Rate( Host_Baud_Rates[IBaud] );
  875.  
  876.          UNTIL ( Found_Speed ) OR ( IBaud >= N_Of_Host_Baud_Rates );
  877.  
  878.                                    (* If we found the speed, try   *)
  879.                                    (* getting a second character.  *)
  880.                                    (* If it's not recognizable,    *)
  881.                                    (* then it didn't work.         *)
  882.          IF Found_Speed THEN
  883.             Found_Speed := Try_Baud_Rate( Host_Baud_Rates[IBaud] );
  884.  
  885.                                    (* If we didn't get the speed,  *)
  886.                                    (* flush the buffer before next *)
  887.                                    (* try.                         *)
  888.  
  889.          IF ( NOT Found_Speed ) THEN
  890.             BEGIN
  891.                DELAY( 5 );
  892.                Async_Purge_Buffer;
  893.             END;
  894.  
  895.       END  (* WHILE *);
  896.                                    (* Flush the buffer once more *)
  897.    DELAY( Tenth_Of_A_Second_Delay );
  898.  
  899.    Async_Purge_Buffer;
  900.  
  901.    WRITELN('Communications adjusted to ',Baud_Rate,' baud and parity = ',
  902.            Parity );
  903.  
  904. END    (* Host_Baud_Detect *);
  905.  
  906. (*----------------------------------------------------------------------*)
  907. (*     Host_AutoBaud_Detect --- Detect caller's baud rate from modem    *)
  908. (*----------------------------------------------------------------------*)
  909.  
  910. PROCEDURE Host_AutoBaud_Detect;
  911.  
  912. VAR
  913.    New_Baud: WORD;
  914.    I       : INTEGER;
  915.    J       : INTEGER;
  916.  
  917. BEGIN (* Host_AutoBaud_Detect *)
  918.  
  919.    New_Baud := 0;
  920.    J        := POS( Modem_Connect, Modem_Ans ) + LENGTH( Modem_Connect );
  921.  
  922.    FOR I := J TO LENGTH( Modem_Ans ) DO
  923.       IF Modem_Ans[I] IN ['0'..'9'] THEN
  924.          New_Baud := New_Baud * 10 + ORD( Modem_Ans[I] ) - ORD('0');
  925.  
  926.    IF New_Baud = 0 THEN New_Baud := 300;
  927.  
  928.    IF New_Baud > 0 THEN
  929.       BEGIN
  930.  
  931.          Baud_Rate := New_Baud;
  932.  
  933.          Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );
  934.  
  935.          Set_Status_Line_Name( Short_Terminal_Name );
  936.          Write_To_Status_Line( Status_Line_Name, 1 );
  937.  
  938.          WRITELN('Communications adjusted to ',Baud_Rate,' baud.');
  939.  
  940.       END;
  941.  
  942. END   (* Host_AutoBaud_Detect *);
  943.  
  944. (*----------------------------------------------------------------------*)
  945.  
  946. BEGIN (* Wait_For_Ring *)
  947.                                    (* Always 8,n,1 to start in host mode *)
  948.    Parity    := 'N';
  949.    Data_Bits := 8;
  950.    Stop_Bits := 1;
  951.    Baud_Rate := Save_H_Baud_Rate;
  952.  
  953.    Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );
  954.  
  955.    Set_Status_Line_Name( Short_Terminal_Name );
  956.    Write_To_Status_Line( Status_Line_Name, 1 );
  957.  
  958.                                    (* Set the modem *)
  959.    IF ( NOT Hard_Wired ) THEN
  960.       Send_Modem_Command( Modem_Host_Set );
  961.  
  962.    Async_Drain_Output_Buffer( Five_Seconds );
  963.  
  964.    Async_Purge_Buffer;
  965.                                    (* Indicate wait for call *)
  966.  
  967.    Host_Status( 'Wait for call' );
  968.  
  969.                                    (* Nothing from modem yet *)
  970.    Modem_Ans  := '';
  971.                                    (* Assume remote session  *)
  972.    Local_Host := FALSE;
  973.                                    (* Raise terminal ready   *)
  974.    Async_Term_Ready( TRUE );
  975.                                    (* Not done yet           *)
  976.    Done := FALSE;
  977.                                    (* Display intro blurb    *)
  978.  
  979.    WRITELN('Waiting for phone to ring.');
  980.    WRITELN('Hit ESC key to return to terminal mode.');
  981.    WRITELN('F1 starts/stops chat mode.');
  982.    WRITELN('F2 immediately logs out remote user.');
  983.    WRITELN('F3 jumps to DOS.');
  984.    WRITELN('F4 undims screen afters it has been dimmed.');
  985.    WRITELN('F5 gives name of current caller.');
  986.    WRITELN('Hit any other key to start local host session.');
  987.  
  988.                                    (* Remove any pending input     *)
  989.    Async_Purge_Buffer;
  990.                                    (* Track time in between sessions *)
  991.    Blank_Time := TimeOfDay;
  992.    Blanked    := FALSE;
  993.  
  994.    REPEAT                          (* Wait for ring/carrier detect *)
  995.  
  996.       IF PibTerm_KeyPressed THEN
  997.          BEGIN
  998.             Read_Kbd( Ch );
  999.             IF Ch = CHR( ESC ) THEN
  1000.                BEGIN
  1001.                   IF PibTerm_KeyPressed THEN
  1002.                      BEGIN
  1003.                         Read_Kbd( Ch );
  1004.                         CASE ORD( Ch ) OF
  1005.                            F3: DosJump('');
  1006.                            F4: IF Blanked THEN
  1007.                                   BEGIN
  1008.                                      Blank_Time          := TimeOfDay;
  1009.                                      Restore_Screen( Local_Save );
  1010.                                      Current_Status_Time := -1;
  1011.                                      Do_Status_Time      := TRUE;
  1012.                                      Update_Status_Line;
  1013.                                      Blanked             := FALSE;
  1014.                                   END;
  1015.                            ELSE
  1016.                               Local_Host := TRUE;
  1017.                         END (* CASE *)
  1018.                      END  (* PibTerm_KeyPressed *)
  1019.                   ELSE
  1020.                      Done := TRUE;
  1021.                END
  1022.             ELSE
  1023.                Local_Host := TRUE;
  1024.          END
  1025.       ELSE
  1026.          GiveAwayTime( 2 );
  1027.  
  1028.       IF ( NOT Blanked ) THEN
  1029.          IF ( TimeDiff( Blank_Time , TimeOfDay ) > Host_Mode_Blank_Time ) THEN
  1030.             BEGIN
  1031.                WRITELN('Blanking the screen ... ');
  1032.                DELAY( Three_Second_Delay );
  1033.                Save_Screen( Local_Save );
  1034.                PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
  1035.                Clear_Window;
  1036.                Blanked := TRUE;
  1037.                Do_Status_Time := FALSE;
  1038.             END;
  1039.  
  1040.    UNTIL ( Host_Carrier_Detect ) OR Done OR Local_Host;
  1041.  
  1042.    IF Blanked THEN
  1043.       BEGIN
  1044.          Restore_Screen( Local_Save );
  1045.          Current_Status_Time := -1;
  1046.          Do_Status_Time      := TRUE;
  1047.          Update_Status_Line;
  1048.       END;
  1049.  
  1050.    IF Done THEN Really_Done := TRUE;
  1051.  
  1052.                                    (* If local host session,   *)
  1053.                                    (* turn off terminal ready  *)
  1054.                                    (* so phone isn't answered. *)
  1055.    IF Local_Host THEN
  1056.       BEGIN
  1057.          WRITELN('Local host session begins ... ');
  1058.          Async_Term_Ready( FALSE );
  1059.          EXIT;
  1060.       END;
  1061.  
  1062.    IF NOT Done THEN
  1063.       BEGIN                        (* Answer the phone *)
  1064.  
  1065.          WRITELN('Answered phone ... ');
  1066.  
  1067.          Host_Status( 'Answered phone' );
  1068.  
  1069. (*---------------------------------------------------------------*)
  1070. (*                                                               *)
  1071. (*       ----- Let the modem answer the phone -----              *)
  1072. (*                                                               *)
  1073. (*       Send_Modem_Command( Modem_Answer );                     *)
  1074. (*                                                               *)
  1075. (*---------------------------------------------------------------*)
  1076.  
  1077.          DELAY( One_Second_Delay );
  1078.  
  1079.                                    (* Collect modem response for *)
  1080.                                    (* later analysis.            *)
  1081.          MTimeOut := FALSE;
  1082.  
  1083.          REPEAT
  1084.  
  1085.             Async_Receive_With_TimeOut( 1 , Int_Ch );
  1086.  
  1087.             IF Int_Ch <> TimeOut THEN
  1088.                BEGIN
  1089.                   Ch := CHR( Int_Ch );
  1090.                   IF Ch IN ['A'..'Z',' ','0'..'9'] THEN
  1091.                      Modem_Ans := Modem_Ans + Ch;
  1092.                   WRITE( Ch );
  1093.                   IF Printer_On THEN
  1094.                      Write_Prt( Ch );
  1095.                   IF Capture_On THEN
  1096.                      WRITE( Capture_File , Ch );
  1097.                END
  1098.             ELSE
  1099.                MTimeOut := TRUE;
  1100.  
  1101.          UNTIL ( MTimeOut OR Done );
  1102.  
  1103.                                    (* Find speed for caller's modem. *)
  1104.          IF ( NOT Done ) THEN
  1105.             IF ( NOT Hard_Wired ) THEN
  1106.                IF Host_Auto_Baud THEN
  1107.                   Host_AutoBaud_Detect
  1108.                ELSE
  1109.                   Host_Baud_Detect;
  1110.  
  1111.       END  (* NOT Done *);
  1112.  
  1113.    Done := Done OR ( NOT Host_Carrier_Detect );
  1114.  
  1115. END   (* Wait_For_Ring *);
  1116.  
  1117. (*----------------------------------------------------------------------*)
  1118. (*            Emulate_Host_Mode --- main routine for host mode          *)
  1119. (*----------------------------------------------------------------------*)
  1120.  
  1121. BEGIN (* Emulate_Host_Mode *)
  1122.                                    (* Make sure we want to enter host mode *)
  1123.                                    (* if session in progress.              *)
  1124.    IF Async_Carrier_Detect THEN
  1125.       IF Attended_Mode THEN
  1126.          BEGIN
  1127.             WRITELN;
  1128.             IF ( NOT YesNo('Are you sure you want to enter host mode (Y/N)? ') ) THEN
  1129.                BEGIN
  1130.                   Terminal_To_Emulate := Saved_Gossip_Term;
  1131.                   Host_Mode           := FALSE;
  1132.                   EXIT;
  1133.                END;
  1134.          END;
  1135.                                    (* Save current port settings *)
  1136.    Save_H_Parity     := Parity;
  1137.    Save_H_Data_Bits  := Data_Bits;
  1138.    Save_H_Stop_Bits  := Stop_Bits;
  1139.    Save_H_Baud_Rate  := Baud_Rate;
  1140.  
  1141.                                    (* Initialize host mode *)
  1142.    Initialize_Host_Mode;
  1143.  
  1144.    IF ( NOT Really_Done ) THEN
  1145.       REPEAT
  1146.                                    (* Wait for call *)
  1147.          Wait_For_Ring( Done );
  1148.                                    (* Do a host session *)
  1149.          IF NOT Done THEN Do_Host;
  1150.                                    (* End host session *)
  1151.          Terminate_Host_Mode;
  1152.  
  1153.       UNTIL Really_Done;
  1154.  
  1155.    IF ( User_File_Size > 0 ) THEN
  1156.       MyFreeMem( User_List , User_File_Size * SIZEOF( User_Record ) );
  1157.  
  1158.    WRITELN(' ');
  1159.    WRITELN('Host mode communications closed down, ');
  1160.    WRITELN('returning to terminal emulation mode. ');
  1161.  
  1162.    Write_Log('Host mode ended.', FALSE, FALSE );
  1163.  
  1164.             (*!I-*)
  1165.    IF Log_File_Open THEN
  1166.       IF ( NOT Save_Logging ) THEN
  1167.          BEGIN
  1168.             CLOSE( Log_File );
  1169.             Log_File_Open := FALSE;
  1170.          END;
  1171.             (*!I+*)
  1172.  
  1173.    Ierr := Int24Result;
  1174.                                    (* Remove status line display *)
  1175.  
  1176.    PibTerm_Window( 1 , 1 , Max_Screen_Col , Max_Screen_Line );
  1177.  
  1178.    GoToXY( 1 , PRED( Max_Screen_Line ) );
  1179.    ClrEol;
  1180.    GoToXY( 1 , Max_Screen_Line );
  1181.    ClrEol;
  1182.  
  1183.    GoToXY( 1 , PRED( Max_Screen_Line ) );
  1184.    PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
  1185.  
  1186.                                    (* Restore previous file paths    *)
  1187.  
  1188.    Upload_Dir_Path   := Save_Upload;
  1189.    Download_Dir_Path := Save_Download;
  1190.  
  1191.                                    (* Restore previous terminal type *)
  1192.                                    (* or dumb terminal mode if       *)
  1193.                                    (* previous also host mode.       *)
  1194.  
  1195.    IF ( Saved_Gossip_Term = HostMode ) THEN
  1196.       Terminal_To_Emulate := Dumb
  1197.    ELSE
  1198.       Terminal_To_Emulate := Saved_Gossip_Term;
  1199.  
  1200.    Host_Mode           := FALSE;
  1201.    Review_On           := Save_Review;
  1202.    Logging_On          := Save_Logging;
  1203.  
  1204.                                    (* Restore previous port settings *)
  1205.    Parity    := Save_H_Parity;
  1206.    Data_Bits := Save_H_Data_Bits;
  1207.    Stop_Bits := Save_H_Stop_Bits;
  1208.    Baud_Rate := Save_H_Baud_Rate;
  1209.  
  1210.    Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );
  1211.  
  1212.    Set_Status_Line_Name( Short_Terminal_Name );
  1213.    Write_To_Status_Line( Status_Line_Name, 1 );
  1214.  
  1215. END   (* Emulate_Host_Mode *);
  1216.