home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1997 March / PCO3_97.ISO / filesbbs / os2 / ppdial30.arj / PPPDIAL.CMD < prev    next >
Encoding:
Text File  |  1996-12-26  |  32.3 KB  |  954 lines

  1. /* REXX */
  2. /*
  3.      OS/2 WARP REXX script to redial a PPP provider when busy.
  4.  
  5.       Written by: Don Russell (c) 1995, 1996
  6.       send email to don_russell@ibm.net
  7.  
  8.       Many changes introduced by Ed Tomlinson in version 2.4
  9.       send email to tomlins@CAM.ORG
  10.  
  11. Change log: (most recent first)
  12.       26 December 1996 Version 3.0
  13.              Fix initialization bug with using Call Waiting disable sequence
  14.              Add support for above when using Warp 4.0
  15.              Add support for user exit (ppdxit.cmd)
  16.      13 July 1996 Version: 2.9
  17.              Improve error checking when examining ini files.
  18.  
  19.    (other history removed, see documentation if interested)
  20.    8 April 1995: Original
  21. stop
  22. A note about distribution.... This script may be distributed freely provided
  23. I am given credit for it. Please do not alter my name or email address
  24. nor the manner in which they are displayed.
  25.  
  26. If you have comments regarding this script, plese let me know by email. I'll
  27. support it as time, and my ability permit.   ;-)
  28.  
  29. NOTE: I've tested this as well as I can with a single provider. Given the many
  30. providers and configurations, this may not work properly the first time.
  31.  
  32. If you have problems with pppdial, please refer to the pppdial.htm file.
  33.  
  34. Specific things to watch for are the EXACT prompts used when the host
  35. system is asking for a userid and password. The prompts that pppdial expect
  36. are "ogin:" (no quotes) and "ssword:" (no quotes) for userid and password
  37. respectfully.
  38.  
  39. If your system uses someting different, you will need to use the response file
  40. option. (Or modify the script slightly. This is not recommended because you will
  41. have to make the same changes in the next version etc. too.)
  42.  
  43. -----------------------------------------------------------------*/
  44. VersionTag = 'PPPDIAL V3.0'
  45.  
  46. RFile = ''
  47. UsePhoneNumberFile = 0
  48. signal on halt
  49.  
  50. LoginPrompt = 'ogin:'
  51. PasswordPrompt = 'ssword:'
  52.  
  53. LoginId = 'userid'
  54. Password = 'password'
  55.  
  56. call rxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  57. call SysLoadFuncs
  58.  
  59. parse upper source . . MyDrivePathName
  60. etcDrivePath = translate( value( 'etc',,'OS2ENVIRONMENT') )
  61. iniFile = etcDrivePath || '\TCPOS2.INI'
  62.  
  63. /* before we get too carried away, let's see what we're doing... */
  64. /* if the ppp_ functions are registered, I assume we're about to */
  65. /* start a ppp connection... */
  66. /* If neither the ppp_ functions NOR the slip_ functions are registered */
  67. /* then I assume we're installing ... */
  68.  
  69. PPPService = ( RxFuncQuery( 'ppp_com_input' ) = 0 )
  70. SLIPService = ( RxFuncQuery( 'slip_com_input' ) = 0 )
  71. if \(PPPService | SLIPService) then do
  72.    call NotFromDialer
  73.    exit 0
  74. end  /* Do */
  75.  
  76. /* Set some definitions for easier COM strings */
  77. bs = '08'x
  78. cr='0d'x
  79. crlf='0d0a'x
  80.  
  81. if PPPService then
  82.    parse arg interface , port , . , RFile
  83. else
  84.    parse arg interface , RFile               /* different when slip :-( */
  85.  
  86. if RFile <> '' then do
  87.    /* The use of slippm.exe is a bit tricky... extra <CR> cause havoc :-( */
  88.    /* Check to see if there are any in the spec and warn the user. */
  89.    if pos(cr, RFile) <> 0 then do
  90.       call lineout , 'Response file is not coded correctly.'
  91.       call lineout , 'Do not press the enter key when typing the response file name'
  92.       call lineout , 'in the login sequence field in slippm.exe'
  93.       exit 8
  94.    end  /* Do */
  95.  
  96.    RFile = stream( RFile, 'C', 'QUERY EXISTS' )
  97.    if RFile = '' then do
  98.       if substr(Rfile, 2, 1) <> ':' then do
  99.             call lineout , 'Response file must have drive and path information'
  100.             call lineout , 'or the working directory path of the dialer must be set.'
  101.             exit 8
  102.          end  /* Do */
  103.       else  do
  104.             call lineout , 'Response file not found.'
  105.             call lineout , 'Processing ended.'
  106.             exit 8
  107.          end
  108.    end  /* Do */
  109. end  /* Do */
  110.  
  111. /*--------------------------------------------------------------------------*/
  112. /*                   Initialization and Main Script Code                    */
  113. /*--------------------------------------------------------------------------*/
  114.  
  115. remain_buffer = ''
  116.  
  117. UsePhoneNumberFile = 0
  118. UsePhoneNumberList = 0
  119. Disable = 0
  120. ActualCarrier = 0     /* to be determined .... */
  121.  
  122. UpperCase = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  123. LowerCase = 'abcdefghijklmnopqrstuvwxyz'
  124.  
  125. /* initialize variables that MAY be set by a response file... */
  126. BeepWanted = 1        /* beep when successful connection */
  127. DialPrefix = ''
  128. HostTimeout = 60
  129. init1 = ''
  130. init2 = ''
  131. MaxAttempts = 32767
  132. MinCarrier = 0
  133. ModemEscapeSequence = '+++'
  134. ModemRegS7 = -1   /* if still < 0 later, we get it from the modem */
  135. ModemResetCommand = 'ATH0Z'
  136. pause = 5             /* seconds between dial attempts */
  137. PhoneNumber = 'xxx-xxxx'   /* may be a blank delimited list, or file name */
  138. prefix = 'ATDT'            /* add any other commands required */
  139. UseDialer = 1    /* yes, we're using the IBM "Dial Other..." */
  140. AutoStart = ''
  141. DisableSequence = ''
  142.  
  143. if UseDialer then do
  144.     /* Get userid/password etc. from the dialer */
  145.     ConnectTo = strip( SysIni( iniFile, 'CONNECTION', 'CURRENT_CONNECTION' ), 'T', '00'x )
  146.     if (ConnectTo = '') | (ConnectTo = 'ERROR:') then do
  147.        ConnectTo = strip( SysIni( iniFile, 'CONNECTION', 'LAST_CONNECTION' ), 'T', '00'x )
  148.     end /* Do */
  149.     x = Strip( SysIni( iniFile, ConnectTo, 'INIT' ), 'T', '00'x )
  150.     if x <> 'ERROR:' then init1 = x
  151.     x = Strip( SysIni( iniFile, ConnectTo, 'INIT2' ), 'T', '00'x )
  152.     if x <> 'ERROR:' then init2 = x
  153.     x = Strip( SysIni( iniFile, ConnectTo, 'AUTOSTART'), 'T', '00'x );
  154.     if x <> 'ERROR:' then AutoStart = x
  155.     x = Strip( SysIni( iniFile, ConnectTo, 'PREFIX' ), 'T', '00'x )
  156.     if x <> 'ERROR:' then Prefix = x
  157.     x = Strip( SysIni( iniFile, ConnectTo, 'DIAL_PREFIX' ), 'T', '00'x )
  158.     if x <> 'ERROR:' then DialPrefix = x
  159.     x = Strip( SysIni( iniFile, ConnectTo, 'PHONE_NUMBER' ), 'T', '00'x )
  160.     if x <> 'ERROR:' then PhoneNumber = x
  161.     x = Strip( SysIni( iniFile, ConnectTo, 'LOGIN_ID' ), 'T', '00'x )
  162.     if x <> 'ERROR:' then LoginId = x
  163.     x = Strip( SysIni( iniFile, ConnectTo, 'PWD' ), 'T', '00'x )
  164.     if x <> 'ERROR:' then Password = x
  165.     x = Strip( SysIni( iniFile, ConnectTo, 'DISABLE' ), 'T', '00'x )
  166.     if x <> 'ERROR:' then Disable = ( x = 'TRUE' )
  167.     x = Strip( SysIni( iniFile, ConnectTo, 'DISABLE_SEQUENCE' ), 'T', '00'x )
  168.     if x <> 'ERROR:' then DisableSequence = x
  169.        else do /* that ini key was not found... */
  170.           /* The ini file item changed in Warp 4.0 ... */
  171.           x = Strip( SysIni( iniFile, ConnectTo, 'DISABLE_SEQ' ), 'T', '00'x )
  172.           if x <> 'ERROR:' then DisableSequence = x || ','
  173.         end
  174.  
  175.     if (PPPService & SLIPService) then do
  176.        x = Strip( SysIni( iniFile, ConnectTo, 'SERVICE' ), 'T', '00'x )
  177.        if x <> 'ERROR:' then PPPService = ( x = 'PPP' )
  178.     end
  179.     drop x
  180. end /* Do */
  181.  
  182. if RFile <> '' then do
  183.    if \ProcessRFileCommands() then do
  184.       say 'Processing ended due to response file error.'
  185.       exit 8
  186.    end  /* Do */
  187.  
  188.    if (( RFile.1 <> 'GO') & (RFile.1 <> 'WAIT' )) then do
  189.       call lineout , 'First line of response file must be GO or WAIT.'
  190.       call lineout , 'Processing ended.'
  191.       exit 8
  192.    end /* Do */
  193.  
  194. end
  195. else do
  196.    RFile.0 = 0
  197. end  /* Do */
  198.  
  199. if \datatype( pause, 'W' ) then do
  200.    call lineout , 'invalid time delay specified - 5 sec assumed'
  201.    pause = 5
  202. end  /* Do */
  203.  
  204. pause = max( 2, pause )  /* A minimum delay of 2 seconds is required to guarantee dial tone */
  205.  
  206. /* The "phone number" may be a list of numbers, or a file spec of a list of numbers. */
  207. if words( PhoneNumber ) > 1 then do
  208.    /* Yup, it's a list itself... build a stem of numbers to use */
  209.    /* However, it could be a list of "number/pause" pairs... */
  210.    x = 0
  211.    do i = 1 to words( PhoneNumber )
  212.       x = x + 1
  213.  
  214.       PhoneNo.i = word( PhoneNumber, x )
  215.       if right( PhoneNo.i, 1 ) = ';' then do
  216.          if x >= words( PhoneNumber) then do
  217.              call lineout , 'Do not include semicolon on last number dialed'
  218.              exit 8
  219.          end  /* Do */
  220.          PhoneNo.i = PhoneNo.i word( PhoneNumber, x + 1 )
  221.          x = x + 1
  222.       end /* Do */
  223.    end /* do */
  224.    PhoneNo.0 = i - 1
  225.    UsePhoneNumberList = 1
  226.    end  /* Do */
  227. else do
  228.    PhoneNumberFile = stream( PhoneNumber, 'C', 'QUERY EXISTS' )
  229.    if PhoneNumberFile <> '' then do
  230.       /* The phone numbers are in a file. Build a stem variable and close the file */
  231.       UsePhoneNumberFile = 1
  232.       do i = 1 by 1 while lines( PhoneNumberFile )
  233.          PhoneNo.i = linein( PhoneNumberFile )
  234.       end /* do */
  235.       PhoneNumber.0 = i - 1
  236.       call lineout PhoneNumberFile   /* close the file */
  237.    end  /* Do */
  238.    else do /* it's not a list or a (found) file... */
  239.        PhoneNo.0 = 1
  240.        PhoneNo.1 = PhoneNumber
  241.    end /* else */
  242. end
  243.  
  244. /* Flush any stuff left over from previous COM activity */
  245. call flush_receive
  246.  
  247. call ResetModem
  248.  
  249. /* How long will the modem wait for carrier? */
  250. /* We have to wait a bit longer for a response then... */
  251.  
  252. /* This value may have been supplied in the response file... */
  253. if ModemRegS7 < 0 then do
  254.    call lineout , 'Determining modem carrier timeout value...'
  255.    call send 'ATS7?' || cr
  256.    x = GetResult( 2 )
  257.    parse var x ModemRegS7 '0d'x .
  258.    if \datatype( ModemRegS7, 'W') then
  259.       ModemRegS7 = 60
  260. end /* Do */
  261.  
  262. FirstTime = 1
  263. connecting = 0
  264. count = 0
  265. do forever until count>=MaxAttempts
  266.  
  267.     connected = 0
  268.     hangup = 0
  269.  
  270.     if \connecting then do
  271.  
  272.        if \FirstTime then do
  273.           call lineout , 'Waiting' pause 'seconds before retry' count
  274.           call lineout , '  'VersionTag 'by: don_russell@ibm.net'
  275.           call lineout , '          Copyright 1995, 1996 Don Russell'
  276.           call sysSleep pause
  277.        end  /* Do */
  278.  
  279.        call flush_receive 'echo'
  280.  
  281.        ActualCarrier = 0
  282.        StartedDialing = 0
  283.        DialCmd = BuildDialCmd( 0 )
  284.  
  285.        parse var DialCmd DialCmd PartialDialPause
  286.        PartialDialing = (PartialDialPause <> '')
  287.        if (\PartialDialing) then
  288.           DialCmd = BuildDialCmd( count )
  289.  
  290.        count = count+1
  291.  
  292.        call charout , 'Dialing...'
  293.        call send DialCmd || cr
  294.  
  295.        StartedDialing = 1
  296.        do i = 1 by 1 while PartialDialPause <> ''
  297.           call GetResult( 2 )      /* Get the OK from the dial command that ended with ; */ 
  298.           call sysSleep PartialDialPause
  299.           DialCmd = BuildDialCmd( i )
  300.           parse var DialCmd DialCmd PartialDialPause
  301.           call send DialCmd || cr
  302.        end  /* Do */
  303.  
  304.     end
  305.  
  306.     FirstTime = 0
  307.  
  308.     do until \abbrev( ResultCode, 'RINGING' ) /* & length(ResultCode)>5 */
  309.        ResultCode = getresult( ModemRegS7 + 10 )
  310.     end /* Do until */
  311.  
  312. /* debugging
  313. say c2x(ResultCode)
  314. say '"'translate(ResultCode, LowerCase, UpperCase)'"'
  315. */
  316.     select
  317.  
  318.        /* Modem responses that indicate we should redial */
  319.        when abbrev( ResultCode, 'BUSY' ) then connecting = 0
  320.        when abbrev( ResultCode, 'NO CARRIER' ) then connecting = 0
  321.        when abbrev( ResultCode, 'NO ANSWER' ) then connecting = 0
  322.        when abbrev( ResultCode, 'NO DIALTONE' ) then connecting = 0
  323.  
  324.        /* Modem responses that indicate we should hangup and redial */
  325.        /* My modem supports an &N command that allows me to set the */
  326.        /* acceptable connect rate. By setting this at the highest setting */
  327.        /* I cause redialing to occur until I get that speed. */
  328.  
  329.        /* modem responses that indicate we got connected */
  330.  
  331.        when abbrev( ResultCode, 'COMPRESSION' ) then connecting = 1   /* TRON, Supra  */
  332.        when abbrev( ResultCode, 'PROTOCOL' ) then connecting = 1      /* Megahertz */
  333.  
  334.        when abbrev( ResultCode, 'CARRIER' ) then do
  335.           if GoodCarrier( ResultCode, MinCarrier ) then
  336.              connecting = 1
  337.           else
  338.              hangup = 1
  339.        end  /* Do */
  340.  
  341.        when abbrev( ResultCode, 'CONNECT' ) then do
  342.           if GoodCarrier( ResultCode, MinCarrier ) then
  343.              connected = 1
  344.           else
  345.              hangup = 1
  346.        end  /* Do */
  347.  
  348.        /* modem responses that indicate we should give up */
  349.  
  350.        when abbrev( ResultCode, 'ERROR' ) then exit 8
  351.        when abbrev( ResultCode, 'VOICE' ) then exit 8
  352.        when abbrev( ResultCode, 'DIGITAL LINE ERROR' ) then exit 8
  353.        when abbrev( ResultCode, 'RING' ) then exit 12
  354.  
  355.     otherwise do
  356.        /* The modem response was not recognized.... */
  357.        /* Can I query the serial port to check for DCD? */
  358.        /* If DCD is present, then who cares about the response? :-)  */
  359.             /* code to be developed */
  360.        /* DCD is NOT present, and the response was not recognized... */
  361.        /* ... so I don't know if the modem is on/off hook here :-(  */
  362.        call ResetModem
  363.        end /* otherwise */
  364.     end  /* select */
  365.  
  366.     if hangup then do
  367.        call lineout , 'Hanging up due unsatisfactory connection'
  368.        call ResetModem
  369.        connecting = 0
  370.        iterate
  371.     end  /* Do */
  372.  
  373.     if \connected then do
  374.        iterate
  375.     end
  376.  
  377.     /* OK.. all we've done so far is get the modems connected. */
  378.     /* If there is a "response file"... process it, otherwise try */
  379.     /* a "reasonable" combination of login and password prompts. */
  380.  
  381.     if RFile <> '' then do
  382.        call lineout , 'Continuing with response file... (' || RFile || ')'
  383.        if \ProcessRFile() then do
  384.           call ResetModem
  385.           iterate
  386.        end
  387.        call lineout , ' '
  388.        call lineout , 'Response file completed.'
  389.     end  /* Do */
  390.     else do
  391.        if \ProcessLogin() then do
  392.           call ResetModem
  393.           iterate
  394.        end
  395.        call lineout , ' '
  396.     end  /* Do */
  397.  
  398.     leave           /* force the end of the loop */
  399. end /* do */
  400.  
  401. if count >=MaxAttempts then 
  402.    exit 4
  403.  
  404. if UseDialer then do
  405.    call lineout , VersionTag '- CONNECT' ActualCarrier '-' /* (start slippm V2.0 R1.8h timer) */
  406. end
  407.  
  408. if BeepWanted then do
  409.    call beep 262, 250
  410.    call beep 294, 250
  411. end
  412.  
  413. rc=0
  414. /* Call user exit... if present... */
  415. if stream( 'PPDXIT.CMD', 'C', 'QUERY EXISTS' ) <> '' then do
  416.    rc = ppdxit( ActualCarrier )
  417. end
  418.  
  419. exit rc
  420.  
  421. GoodCarrier:
  422.    /* examine the text following a CONNECT ... or CARRIER ... response code */
  423.    /* Even if no minimum carrier is requested, try to determine the actual */
  424.    /* DCE rate to report later. */
  425.  
  426.    do i = 2 to words( arg(1) )
  427.  
  428.       str = word( arg(1), i )
  429.  
  430.       x = verify( str, '0123456789', 'N' )
  431.       select
  432.          when x = 0 then /* all digits */
  433.             nop
  434.          when x = 1 then /* no digits  */
  435.             iterate i
  436.          otherwise       /* some digits */
  437.             str = left( str, x-1 )
  438.       end
  439.     
  440.       if str < 1200 then    /* just incase some modem reports a strange number */
  441.          iterate i
  442.  
  443.       if ActualCarrier = 0 then   /* set to min incase DCE and DTE are present */
  444.          ActualCarrier = str
  445.       else
  446.          ActualCarrier = min(str,ActualCarrier)
  447.  
  448.    end i /* do */
  449.  
  450.    return ( ActualCarrier >= arg(2) )
  451.  
  452. halt:
  453.    signal off halt
  454.    if RFile <> '' then
  455.       call lineout RFile /* close the response file */
  456.    if UsePhoneNumberFile then
  457.       call lineout PhoneNumberFile  /* close the phone number file */
  458.    call lineout , VersionTag 'cancelled.'
  459. exit 4
  460.  
  461. BuildDialCmd:
  462.    Parse arg item
  463.    DialCmd = Prefix            /* typically ATDT or ATDP */
  464.  
  465.    /* The phone number may be a group... get the next in the list/file */
  466.    x = (item // PhoneNo.0) + 1
  467.  
  468.    /* we only want the disable/prefix sequence if this is the whole number, or the first */
  469.    /* "phrase" of a multi-part number. */
  470.    if (\StartedDialing) then do
  471.       If Disable then
  472.          DialCmd = DialCmd || DisableSequence     /* a sequence to disable call waiting */
  473.       if DialPrefix <> '' then
  474.          DialCmd = DialCmd || DialPrefix || ','         /* a '9' or other for PBX */
  475.    end /* Do */
  476.  
  477.    return DialCmd || PhoneNo.x
  478.  
  479. ProcessLogin:
  480.    success = 1 /* we'll assume it works... */
  481.    call waitfor LoginPrompt, 30
  482.    if result = 1 then do
  483.       call lineout , 'Host is not asking for userid.'
  484.       success = 0
  485.    end  /* Do */
  486.    else do
  487.       call send loginId || cr
  488.  
  489.       call waitfor PasswordPrompt, 30
  490.       if result = 1 then do
  491.          call lineout , 'Host is not asking for password.'
  492.          success = 0
  493.       end  /* Do */
  494.  
  495.       call send password || cr
  496.    end /* do */
  497. return success
  498.  
  499. ProcessRFile:
  500.    RFileProcessed = 1         /* we'll assume success :-)  */
  501.    select
  502.       when RFile.1 = 'GO' then ResponseToggle = 1
  503.       when RFile.1 = 'WAIT' then ResponseToggle = 0
  504.    end  /* select */
  505.    do i = 2 to RFile.0 while RFileProcessed
  506.       x = RFile.i
  507.       if x = '' then     /* ignore blank lines */
  508.          iterate
  509.       if abbrev( x, '[PPPDIAL_' ) then    /* ignore parm settings */
  510.          iterate
  511.       if abbrev( x, '[OS/2]' ) then do
  512.          parse var x ']'os2Command
  513.          address CMD os2Command
  514.          iterate
  515.       end  /* Do */
  516.       if abbrev( x, '[SLEEP]' ) then do
  517.          parse var x ']'t
  518.          t = strip(t, 'B')
  519.          if t = '' then t = 1
  520.          if \datatype( t, 'W' ) then t = 1
  521.          call syssleep t
  522.          iterate
  523.       end  /* Do */
  524.  
  525.       if ResponseToggle then do
  526.           /* we are sending to the host... */
  527.           parse var x x1 '[' x2 ']' x3
  528.  
  529.           select
  530.              when x2 = 'LOGINID' then call send x1 || LoginId || x3 || cr
  531.              when x2 = 'PASSWORD' then do
  532.                  call send x1 || Password || x3 || cr
  533.                  call lineout , ' '
  534.                  end
  535.              when x2 = 'KEYBOARD' then do
  536.                  call beep 2000, 125     /* get attention for prompt */
  537.                  parse pull TheAnswer
  538.                  call send x1 || TheAnswer || x3 || cr
  539.              end  /* Do */
  540.              when x2 = 'KEYBOARD_NOECHO' then do
  541.                  call beep 2000, 125   /* get attention for prompt */
  542.                  TheAnswer = ''
  543.                  do until char = cr  /* wait for cr */
  544.                     char = SysGetKey( 'NOECHO' )
  545.                     if char = bs then do
  546.                        if TheAnswer = '' then call beep 2000, 125
  547.                           else do
  548.                              call charout , '082008'x   /* bs blank and bs */
  549.                              TheAnswer = delstr( TheAnswer, length( TheAnswer)  )
  550.                           end  /* Do */
  551.                    end  /* Do */
  552.                    else do
  553.                       if char = cr then
  554.                          call charout , crlf
  555.                       else do
  556.                          TheAnswer = TheAnswer || char
  557.                          call charout , '*'
  558.                       end /* Do */
  559.                   end /* Do */
  560.                  end /* Do */
  561.                  call send x1 || TheAnswer || x3 || cr
  562.                  drop TheAnswer  /* don't keep this data around any longer than necessary */
  563.              end  /* Do */
  564.              when abbrev( x, '[REPEAT]' ) then do
  565.                 parse var x ']' y z k     /* get string to send, string to wait for and count */
  566.                 if k = '' then k = 1000  /* repeat lots if not told otherwise */
  567.                 MatchFound = 0
  568.                 do k until MatchFound  /* successful match */
  569.                    select
  570.                       when pos( '^', y ) <> 0 then call send CtrlSequence( y )
  571.                       when y = '\r' then call send cr
  572.                    otherwise call send y || cr
  573.                    end  /* select */
  574.                    if waitfor( z , 5 ) = 0 then do /* successful match */
  575.                       MatchFound = 1
  576.                    end  /* Do */
  577.                 end /* until */
  578.                 if \MatchFound then do    /* retry count exhausted, no match found */
  579.                    RFileProcessed = 0     /* we encountered a problem... */
  580.                 end  /* Do */
  581.                 else do
  582.                    /* The string was repeated and we got the expected match... */
  583.                    /* I change the toggle so that it will be set to "send" again for */
  584.                    /* the next line in the response file. */
  585.                    ResponseToggle = \ResponseToggle
  586.                 end  /* Do */
  587.              end  /* when [REPEAT] */
  588.              when pos( '^', x) <> 0 then call send CtrlSequence( x )
  589.              when x = '\r' then call send cr
  590.           otherwise call send x || cr
  591.           end  /* select */
  592.           end
  593.       else do
  594.           /* It's our turn to wait for info from the host... */
  595.           /* before we just blindly wait for text, check to see if we're waiting */
  596.           /* for dynamic IP addresses... */
  597.           if pos( '[$IP', x ) > 0 then
  598.              call ProcessDynamicIP pos( '[$IPDEST]', x ), pos( '[$IPADDR]', x )
  599.           else
  600.           if abbrev( x, '[SKIP_TEXT]' ) then do forever
  601.              if PPPService then
  602.                 char = ppp_com_input( interface, 1, 100 )
  603.             else
  604.                 char = slip_com_input( interface, 1, 100 )
  605.             if (char >= ' ') | (char = lf) | (char = cr) then
  606.                 call charout , char
  607.             else
  608.                 leave
  609.           end  /* Do */
  610.           else
  611.           if waitfor( x, HostTimeout ) = 1 then do
  612.               call lineout , 'Host not responding, waiting for' x
  613.               RFileProcessed = 0   /* terminate processing and dial again :-(  */
  614.           end /* Do */
  615.       end /* Do */
  616.       ResponseToggle = \ResponseToggle
  617.    end /* While */
  618. return RFileProcessed
  619.  
  620. ProcessDynamicIP:
  621. /* We have two parms: */
  622. /* 1st: starting pos of [$IPDEST] */
  623. /* 2nd: starting pos of [$IPADDR] */
  624. /* These are just to indicate the order they appear from the host. */
  625. /* IP addresses must be in "decimal dot" notation */
  626.  
  627. parse arg dest, addr
  628. select
  629.    when dest = 0 then ipaddr = GetIPAddr()
  630.    when addr = 0 then ipdest = GetIPAddr()
  631.    when dest < addr then do
  632.       ipdest = GetIPAddr()
  633.       ipaddr = GetIPAddr()
  634.    end  /* Do */
  635.    when addr < dest then do
  636.       ipaddr = GetIPAddr()
  637.       ipdest = GetIPAddr()
  638.    end  /* Do */
  639. end  /* select */
  640.  
  641. if \PPPService then do
  642.    /* these don't seem to have any real effect when using PPP */
  643.    'ifconfig' interface ipaddr ipdest
  644.    'route add default' ipdest '1'
  645. end
  646.  
  647. return
  648.  
  649. GetIPAddr:
  650. /* examine data from the host system looking for an IP address */
  651. /* in "decimal dot" notation. Return the first one we get. */
  652. call time 'R'
  653. dot.1 = 0
  654. dot.2 = 0
  655. dot.3 = 0
  656. IPFound = 0
  657. IPTimeout = 30
  658. do until IPFound | time('E') > IPTimeOut
  659.    if PPPService then
  660.       remain_buffer = remain_buffer || ppp_com_input( interface, , 100 )
  661.    else
  662.       remain_buffer = remain_buffer || slip_com_input( interface, , 100 )
  663.    if dot.1 = 0 then do
  664.       dot.1 = pos( '.', remain_buffer )
  665.       if dot.1 = 0 then iterate
  666.    end  /* Do */
  667.  
  668.    /* "dot.1" is the index in remain_buffer to the first "." in a potential IP address */
  669.    if dot.2 = 0 then do
  670.       dot.2 = pos( '.', remain_buffer, dot.1 + 1 )
  671.       if dot.2 = 0 then iterate
  672.    end  /* Do */
  673.  
  674.    if dot.3 = 0 then do
  675.       dot.3 = pos( '.', remain_buffer, dot.2 + 1 )
  676.       if dot.3 = 0 then iterate
  677.    end  /* Do */
  678.  
  679.    PotentialIP = substr( remain_buffer, max( 1, dot.1 - 3 ) )
  680.    parse var PotentialIP a '.' b '.' c '.' d .
  681.    /* the "a" part MAY contain a space, we want the second part. */
  682.    if words(a) >1 then a = word( a, 2)
  683.  
  684.    /* the "d" part may not end with  digit. i.e. perhaps a ")" */
  685.    x = verify( d, '0123456789', 'N' )
  686.    if x <> 0 then do
  687.       d = substr( d, 1, x - 1 )
  688.    end  /* Do */
  689.  
  690.    if \datatype(a, 'W') | \datatype( b, 'W') | \datatype( c, 'W' ) | \datatype(d, 'W' ) then do
  691.       remain_buffer = substr( remain_buffer, dot.1 + 1 )
  692.       dot.1 = 0
  693.       dot.2 = 0
  694.       dot.3 = 0
  695.       iterate
  696.    end  /* Do */
  697.  
  698.    DecDot = a || '.' || b || '.' || c || '.' || d
  699.    IPFound = 1
  700.    remain_buffer = substr( remain_buffer, dot.3 + 2 )
  701. end /* do */
  702.  
  703. if IPFound then
  704.    call lineout , 'IP addr:' DecDot
  705. else
  706.    call lineout , 'IP addr: timed out'
  707.  
  708. return DecDot
  709.  
  710. ProcessRFileCommands:
  711.    success = 1   /* assume all is OK */
  712.    /* Build a stem variable for the parts required for the log in process. */
  713.    /* olny therelevent parts of the file will be added to the stem. */
  714.    /* Then the file is closed. */
  715.    i = 0
  716.    do while lines( RFile )
  717.       x = linein( RFile )
  718.       if x = '' then      /* ignore blank lines */
  719.          iterate
  720.       if \abbrev( x, '[PPPDIAL_' ) then do
  721.          i = i + 1
  722.          RFile.i = x
  723.          iterate
  724.       end
  725.       /* Only [PPPDIAL_...] lines are process here... */
  726.       parse var x '_'kw']'val
  727.       val = strip( val, 'B')
  728.       select
  729.          when kw = 'CARRIER_TIMEOUT' then ModemRegS7 = val
  730.          when kw = 'DELAY' then pause = val
  731.          when kw = 'DIAL_PREFIX' then DialPrefix = val
  732.          when kw = 'DO_NOT_USE_DIALER' then UseDialer = 0
  733.          when kw = 'HOST_TIMEOUT'  then HostTimeout = val
  734.          when kw = 'INIT1' then init1 = val
  735.          when kw = 'INIT2' then init2 = val
  736.          when kw = 'MAX_REDIAL' then MaxAttempts = val
  737.          when kw = 'MIN_CARRIER' then MinCarrier = val
  738.          when kw = 'MODEM_ESCAPE' then ModemEscapeSequence = val
  739.          when kw = 'MODEM_RESET' then ModemResetCommand = val
  740.          when kw = 'PHONE' then PhoneNumber = val
  741.          when kw = 'PREFIX' then Prefix = val
  742.          when kw = 'QUIET' then BeepWanted = 0
  743.          when kw = 'REM' then nop   /* allow comments... */
  744.          when kw = 'SERVICE' then PPPService = ( val = 'PPP' )
  745.          when kw = 'USE_DIALER' then UseDialer = 1
  746.       otherwise do
  747.          call lineout , kw 'is not a recognized keyword.'
  748.          success = 0
  749.       end /* otherwise */
  750.       end  /* select */
  751.    end /* while */
  752.    RFile.0 = i
  753.    call lineout RFile /* close the response file */
  754. return success
  755.  
  756. CtrlSequence:
  757.     parse arg string
  758.     /* we do a logical AND X'1F' with the character... */
  759.     /* The "character" should only be in the range of 40 through 5F, */
  760.     /* but who cares... the effect will be the same :-) */
  761.  
  762.     do until x = 0
  763.        x = pos( '^', string )
  764.        if x <> 0 then do
  765.           y = substr( string, x+1, 1)   /* isolate the character following ^ */
  766.           string = insert( bitand( y, '1F'x ), string, x+1 )
  767.           /* delete the character pair from the string */
  768.           string = delstr( string, x, 2 )
  769.       end /* Do */
  770.     end
  771.     return string
  772.  
  773. ResetModem:
  774.     call lineout , 'Initializing modem...'
  775.     if init1 <> '' then do
  776.        call send init1 || cr
  777.        ResultCode = GetResult( 6 )
  778.     end  /* Do */
  779.     if init2 <> '' then do
  780.        call send init2 || cr
  781.        ResultCode = GetResult( 6 )
  782.     end  /* Do */
  783.  
  784.     if ((init1 = '') & (init2 = '')) then do
  785.        call send ModemResetCommand || cr
  786.        ResultCode = GetResult( 6 )
  787.     end  /* Do */
  788.  
  789.     if left(ResultCode , 2) <> 'OK' then do
  790.         call lineout , 'Modem not resetting... Trying again'
  791.         call sysSleep 2
  792.         call send ModemEscapeSequence
  793.         call waitfor crlf, 5
  794.         call flush_receive
  795.         call ResetModem
  796.     end /* Do */
  797.     call flush_receive
  798. return
  799.  
  800. /* Routine to send a modem command. */
  801.  
  802. send:
  803.    parse arg AtCmd
  804.    call flush_receive
  805.    if PPPService then
  806.       call ppp_com_output interface , AtCmd
  807.    else
  808.       call slip_com_output interface , AtCmd
  809.    return
  810.  
  811. /* Waits for any modem response, and returns the string.    */
  812. /* If timeout is specified, it says how long to wait if data stops showing  */
  813. /* up on the COM port (in seconds).                                                         */
  814. getresult:
  815.    parse arg timeout
  816.    call waitfor crlf, timeout
  817.    if result = 0 then
  818.       call waitfor crlf, timeout
  819.  
  820.    if result = 1 then /* timed out */
  821.       return '*timedout*'
  822.    else
  823.       return waitfor_buffer
  824.  
  825.  
  826. /*--------------------------------------------------------------------------*/
  827. /*                    waitfor ( waitstring , [timeout] )                    */
  828. /*                                                                          */
  829. /* Waits for a specific string from the modem. */
  830. /* Timeout is specified in seconds.  */
  831. /* Ignore case... so login = LOGIN counts as a match... Added for version 3.0 */
  832.  
  833. waitfor:
  834.    parse upper arg waitstring , timeout
  835.    if timeout = '' then do
  836.       timeout = 90    /* 1.5 minutes if delay not specified */
  837.    end
  838.  
  839.    waitfor_buffer = ''
  840.    found = 0
  841.    expired = 0
  842.  
  843.    call time 'E'
  844.    do until (found | expired)
  845.       if PPPService then
  846.          chars = ppp_com_input( interface, , 10 )
  847.       else
  848.          chars = slip_com_input( interface, , 10 )
  849.       remain_buffer = Translate( remain_buffer || chars )
  850.       index = pos(waitstring, remain_buffer)
  851.       found = ( index > 0 )
  852.       expired = (time('E') > timeout)
  853.       if found then do
  854.          x = index + length(waitstring)
  855.          waitfor_buffer = delstr(remain_buffer, x)  /* everything up to what matched */
  856.          remain_buffer = substr(remain_buffer, x)  /* keep everything past that */
  857.       end
  858.       /* SLIPPM.EXE V2.0 R1.8h aborts our script when it "sees" certain words in the */
  859.       /* status window. Words like "BUSY", "NO CARRIER", etc. */
  860.       /* To get around this problem I translate all information from the modem */
  861.       /* to lower case, thus thwarting slippm's effort to detect what's going on. :-) */
  862.  
  863.       /* However, I don't know how long this will continue to work, because IBM is */
  864.       /* developing slippm and who knows what they have in mind for the next version? */
  865.  
  866.       call charout , translate(chars, LowerCase, UpperCase)
  867.    end
  868.  
  869.  return \found
  870.  
  871. /*--------------------------------------------------------------------------*/
  872. /*                             flush_receive()                             */
  873. /*                                                                          */
  874. /* Routine to flush any pending characters to be read from the COM port.    */
  875. /* Reads everything it can until nothing new shows up for 100ms, at which   */
  876. /* point it returns.                                                        */
  877. /*                                                                          */
  878. /*--------------------------------------------------------------------------*/
  879.  
  880. flush_receive:
  881.  
  882.    parse arg echo
  883.  
  884.    /* If echoing the flush - take care of waitfor remaining buffer */
  885.    /* Note - I translate the characters here to lower case to be consistent */
  886.    /* with the "waitfor" routine. (Due to slippm.exe V2.0 R1.8h changes) */
  887.  
  888.    if (echo <> '') & (length(remain_buffer) > 0) then do
  889.       call charout , translate( remain_buffer, LowerCase, UpperCase )
  890.       remain_buffer = ''
  891.    end
  892.  
  893.    /* Read anything left in the modem or COM buffers */
  894.    /* Stop when nothing new appears for 100ms.      */
  895.  
  896.    do until line = ''
  897.       if PPPservice then
  898.          line = ppp_com_input( interface,,100 )
  899.       else
  900.          line = slip_com_input( interface,,100 )
  901.       if echo <> '' then
  902.          call charout , translate( line, LowerCase, UpperCase )
  903.    end
  904.  
  905.    return
  906.  
  907. NotFromDialer:
  908.     parse upper source . . MyDrivePathName
  909.     MyDrive = filespec( 'D', MyDrivePathName )
  910.     MyPath = filespec( 'P', MyDrivePathName )
  911.     MyDrivePath = MyDrive || MyPath
  912.  
  913.     etcDrivePath = translate( value( 'etc',,'OS2ENVIRONMENT') )
  914.     binDrive = filespec( 'D', etcDrivePath )
  915.     binPath = filespec( 'P', etcDrivePath ) || 'BIN\'
  916.     binDrivePath = binDrive || binPath
  917.  
  918.     EraseFile = 0
  919.     if binDrivePath <> MyDrivePath then do
  920.         say 'This script will be moved to' binDrivePath
  921.         say 'Do you wish to continue? (y/n)'
  922.         say '(Saying no will still show help)'
  923.         answer = translate( sysGetKey( 'ECHO' ) )
  924.         if answer = 'Y' then do
  925.             'COPY' MyDrivePathName binDrivePath
  926.             if rc = 0 then do
  927.                say MyDrivePathName 'will be erased after displaying help'
  928.                EraseFile = 1
  929.             end
  930.            '@PAUSE'
  931.            call sysCls
  932.         end /* Do */
  933.     end  /* Do */
  934.  
  935.     call sysCls
  936.     stop = 0
  937.     do i = 3 by 1 until stop
  938.        x = sourceline( i )
  939.        if left( x, 5 ) = 'pause' then do
  940.           '@PAUSE'
  941.           call sysCls
  942.           iterate
  943.        end  /* Do */
  944.  
  945.        if left( x, 4 ) <> 'stop'  then
  946.           say x
  947.        else
  948.           stop = 1
  949.     end /* do */
  950.     '@PAUSE'
  951.     if EraseFile then
  952.         'ERASE' MyDrivePathName
  953. return
  954.