home *** CD-ROM | disk | FTP | other *** search
- /* REXX */
- /*
- OS/2 WARP REXX script to redial a PPP provider when busy.
-
- Written by: Don Russell (c) 1995, 1996
- send email to don_russell@ibm.net
-
- Many changes introduced by Ed Tomlinson in version 2.4
- send email to tomlins@CAM.ORG
-
- Change log: (most recent first)
- 26 December 1996 Version 3.0
- Fix initialization bug with using Call Waiting disable sequence
- Add support for above when using Warp 4.0
- Add support for user exit (ppdxit.cmd)
- 13 July 1996 Version: 2.9
- Improve error checking when examining ini files.
-
- (other history removed, see documentation if interested)
- 8 April 1995: Original
- stop
- A note about distribution.... This script may be distributed freely provided
- I am given credit for it. Please do not alter my name or email address
- nor the manner in which they are displayed.
-
- If you have comments regarding this script, plese let me know by email. I'll
- support it as time, and my ability permit. ;-)
-
- NOTE: I've tested this as well as I can with a single provider. Given the many
- providers and configurations, this may not work properly the first time.
-
- If you have problems with pppdial, please refer to the pppdial.htm file.
-
- Specific things to watch for are the EXACT prompts used when the host
- system is asking for a userid and password. The prompts that pppdial expect
- are "ogin:" (no quotes) and "ssword:" (no quotes) for userid and password
- respectfully.
-
- If your system uses someting different, you will need to use the response file
- option. (Or modify the script slightly. This is not recommended because you will
- have to make the same changes in the next version etc. too.)
-
- -----------------------------------------------------------------*/
- VersionTag = 'PPPDIAL V3.0'
-
- RFile = ''
- UsePhoneNumberFile = 0
- signal on halt
-
- LoginPrompt = 'ogin:'
- PasswordPrompt = 'ssword:'
-
- LoginId = 'userid'
- Password = 'password'
-
- call rxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
- call SysLoadFuncs
-
- parse upper source . . MyDrivePathName
- etcDrivePath = translate( value( 'etc',,'OS2ENVIRONMENT') )
- iniFile = etcDrivePath || '\TCPOS2.INI'
-
- /* before we get too carried away, let's see what we're doing... */
- /* if the ppp_ functions are registered, I assume we're about to */
- /* start a ppp connection... */
- /* If neither the ppp_ functions NOR the slip_ functions are registered */
- /* then I assume we're installing ... */
-
- PPPService = ( RxFuncQuery( 'ppp_com_input' ) = 0 )
- SLIPService = ( RxFuncQuery( 'slip_com_input' ) = 0 )
- if \(PPPService | SLIPService) then do
- call NotFromDialer
- exit 0
- end /* Do */
-
- /* Set some definitions for easier COM strings */
- bs = '08'x
- cr='0d'x
- crlf='0d0a'x
-
- if PPPService then
- parse arg interface , port , . , RFile
- else
- parse arg interface , RFile /* different when slip :-( */
-
- if RFile <> '' then do
- /* The use of slippm.exe is a bit tricky... extra <CR> cause havoc :-( */
- /* Check to see if there are any in the spec and warn the user. */
- if pos(cr, RFile) <> 0 then do
- call lineout , 'Response file is not coded correctly.'
- call lineout , 'Do not press the enter key when typing the response file name'
- call lineout , 'in the login sequence field in slippm.exe'
- exit 8
- end /* Do */
-
- RFile = stream( RFile, 'C', 'QUERY EXISTS' )
- if RFile = '' then do
- if substr(Rfile, 2, 1) <> ':' then do
- call lineout , 'Response file must have drive and path information'
- call lineout , 'or the working directory path of the dialer must be set.'
- exit 8
- end /* Do */
- else do
- call lineout , 'Response file not found.'
- call lineout , 'Processing ended.'
- exit 8
- end
- end /* Do */
- end /* Do */
-
- /*--------------------------------------------------------------------------*/
- /* Initialization and Main Script Code */
- /*--------------------------------------------------------------------------*/
-
- remain_buffer = ''
-
- UsePhoneNumberFile = 0
- UsePhoneNumberList = 0
- Disable = 0
- ActualCarrier = 0 /* to be determined .... */
-
- UpperCase = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
- LowerCase = 'abcdefghijklmnopqrstuvwxyz'
-
- /* initialize variables that MAY be set by a response file... */
- BeepWanted = 1 /* beep when successful connection */
- DialPrefix = ''
- HostTimeout = 60
- init1 = ''
- init2 = ''
- MaxAttempts = 32767
- MinCarrier = 0
- ModemEscapeSequence = '+++'
- ModemRegS7 = -1 /* if still < 0 later, we get it from the modem */
- ModemResetCommand = 'ATH0Z'
- pause = 5 /* seconds between dial attempts */
- PhoneNumber = 'xxx-xxxx' /* may be a blank delimited list, or file name */
- prefix = 'ATDT' /* add any other commands required */
- UseDialer = 1 /* yes, we're using the IBM "Dial Other..." */
- AutoStart = ''
- DisableSequence = ''
-
- if UseDialer then do
- /* Get userid/password etc. from the dialer */
- ConnectTo = strip( SysIni( iniFile, 'CONNECTION', 'CURRENT_CONNECTION' ), 'T', '00'x )
- if (ConnectTo = '') | (ConnectTo = 'ERROR:') then do
- ConnectTo = strip( SysIni( iniFile, 'CONNECTION', 'LAST_CONNECTION' ), 'T', '00'x )
- end /* Do */
- x = Strip( SysIni( iniFile, ConnectTo, 'INIT' ), 'T', '00'x )
- if x <> 'ERROR:' then init1 = x
- x = Strip( SysIni( iniFile, ConnectTo, 'INIT2' ), 'T', '00'x )
- if x <> 'ERROR:' then init2 = x
- x = Strip( SysIni( iniFile, ConnectTo, 'AUTOSTART'), 'T', '00'x );
- if x <> 'ERROR:' then AutoStart = x
- x = Strip( SysIni( iniFile, ConnectTo, 'PREFIX' ), 'T', '00'x )
- if x <> 'ERROR:' then Prefix = x
- x = Strip( SysIni( iniFile, ConnectTo, 'DIAL_PREFIX' ), 'T', '00'x )
- if x <> 'ERROR:' then DialPrefix = x
- x = Strip( SysIni( iniFile, ConnectTo, 'PHONE_NUMBER' ), 'T', '00'x )
- if x <> 'ERROR:' then PhoneNumber = x
- x = Strip( SysIni( iniFile, ConnectTo, 'LOGIN_ID' ), 'T', '00'x )
- if x <> 'ERROR:' then LoginId = x
- x = Strip( SysIni( iniFile, ConnectTo, 'PWD' ), 'T', '00'x )
- if x <> 'ERROR:' then Password = x
- x = Strip( SysIni( iniFile, ConnectTo, 'DISABLE' ), 'T', '00'x )
- if x <> 'ERROR:' then Disable = ( x = 'TRUE' )
- x = Strip( SysIni( iniFile, ConnectTo, 'DISABLE_SEQUENCE' ), 'T', '00'x )
- if x <> 'ERROR:' then DisableSequence = x
- else do /* that ini key was not found... */
- /* The ini file item changed in Warp 4.0 ... */
- x = Strip( SysIni( iniFile, ConnectTo, 'DISABLE_SEQ' ), 'T', '00'x )
- if x <> 'ERROR:' then DisableSequence = x || ','
- end
-
- if (PPPService & SLIPService) then do
- x = Strip( SysIni( iniFile, ConnectTo, 'SERVICE' ), 'T', '00'x )
- if x <> 'ERROR:' then PPPService = ( x = 'PPP' )
- end
- drop x
- end /* Do */
-
- if RFile <> '' then do
- if \ProcessRFileCommands() then do
- say 'Processing ended due to response file error.'
- exit 8
- end /* Do */
-
- if (( RFile.1 <> 'GO') & (RFile.1 <> 'WAIT' )) then do
- call lineout , 'First line of response file must be GO or WAIT.'
- call lineout , 'Processing ended.'
- exit 8
- end /* Do */
-
- end
- else do
- RFile.0 = 0
- end /* Do */
-
- if \datatype( pause, 'W' ) then do
- call lineout , 'invalid time delay specified - 5 sec assumed'
- pause = 5
- end /* Do */
-
- pause = max( 2, pause ) /* A minimum delay of 2 seconds is required to guarantee dial tone */
-
- /* The "phone number" may be a list of numbers, or a file spec of a list of numbers. */
- if words( PhoneNumber ) > 1 then do
- /* Yup, it's a list itself... build a stem of numbers to use */
- /* However, it could be a list of "number/pause" pairs... */
- x = 0
- do i = 1 to words( PhoneNumber )
- x = x + 1
-
- PhoneNo.i = word( PhoneNumber, x )
- if right( PhoneNo.i, 1 ) = ';' then do
- if x >= words( PhoneNumber) then do
- call lineout , 'Do not include semicolon on last number dialed'
- exit 8
- end /* Do */
- PhoneNo.i = PhoneNo.i word( PhoneNumber, x + 1 )
- x = x + 1
- end /* Do */
- end /* do */
- PhoneNo.0 = i - 1
- UsePhoneNumberList = 1
- end /* Do */
- else do
- PhoneNumberFile = stream( PhoneNumber, 'C', 'QUERY EXISTS' )
- if PhoneNumberFile <> '' then do
- /* The phone numbers are in a file. Build a stem variable and close the file */
- UsePhoneNumberFile = 1
- do i = 1 by 1 while lines( PhoneNumberFile )
- PhoneNo.i = linein( PhoneNumberFile )
- end /* do */
- PhoneNumber.0 = i - 1
- call lineout PhoneNumberFile /* close the file */
- end /* Do */
- else do /* it's not a list or a (found) file... */
- PhoneNo.0 = 1
- PhoneNo.1 = PhoneNumber
- end /* else */
- end
-
- /* Flush any stuff left over from previous COM activity */
- call flush_receive
-
- call ResetModem
-
- /* How long will the modem wait for carrier? */
- /* We have to wait a bit longer for a response then... */
-
- /* This value may have been supplied in the response file... */
- if ModemRegS7 < 0 then do
- call lineout , 'Determining modem carrier timeout value...'
- call send 'ATS7?' || cr
- x = GetResult( 2 )
- parse var x ModemRegS7 '0d'x .
- if \datatype( ModemRegS7, 'W') then
- ModemRegS7 = 60
- end /* Do */
-
- FirstTime = 1
- connecting = 0
- count = 0
- do forever until count>=MaxAttempts
-
- connected = 0
- hangup = 0
-
- if \connecting then do
-
- if \FirstTime then do
- call lineout , 'Waiting' pause 'seconds before retry' count
- call lineout , ' 'VersionTag 'by: don_russell@ibm.net'
- call lineout , ' Copyright 1995, 1996 Don Russell'
- call sysSleep pause
- end /* Do */
-
- call flush_receive 'echo'
-
- ActualCarrier = 0
- StartedDialing = 0
- DialCmd = BuildDialCmd( 0 )
-
- parse var DialCmd DialCmd PartialDialPause
- PartialDialing = (PartialDialPause <> '')
- if (\PartialDialing) then
- DialCmd = BuildDialCmd( count )
-
- count = count+1
-
- call charout , 'Dialing...'
- call send DialCmd || cr
-
- StartedDialing = 1
- do i = 1 by 1 while PartialDialPause <> ''
- call GetResult( 2 ) /* Get the OK from the dial command that ended with ; */
- call sysSleep PartialDialPause
- DialCmd = BuildDialCmd( i )
- parse var DialCmd DialCmd PartialDialPause
- call send DialCmd || cr
- end /* Do */
-
- end
-
- FirstTime = 0
-
- do until \abbrev( ResultCode, 'RINGING' ) /* & length(ResultCode)>5 */
- ResultCode = getresult( ModemRegS7 + 10 )
- end /* Do until */
-
- /* debugging
- say c2x(ResultCode)
- say '"'translate(ResultCode, LowerCase, UpperCase)'"'
- */
- select
-
- /* Modem responses that indicate we should redial */
- when abbrev( ResultCode, 'BUSY' ) then connecting = 0
- when abbrev( ResultCode, 'NO CARRIER' ) then connecting = 0
- when abbrev( ResultCode, 'NO ANSWER' ) then connecting = 0
- when abbrev( ResultCode, 'NO DIALTONE' ) then connecting = 0
-
- /* Modem responses that indicate we should hangup and redial */
- /* My modem supports an &N command that allows me to set the */
- /* acceptable connect rate. By setting this at the highest setting */
- /* I cause redialing to occur until I get that speed. */
-
- /* modem responses that indicate we got connected */
-
- when abbrev( ResultCode, 'COMPRESSION' ) then connecting = 1 /* TRON, Supra */
- when abbrev( ResultCode, 'PROTOCOL' ) then connecting = 1 /* Megahertz */
-
- when abbrev( ResultCode, 'CARRIER' ) then do
- if GoodCarrier( ResultCode, MinCarrier ) then
- connecting = 1
- else
- hangup = 1
- end /* Do */
-
- when abbrev( ResultCode, 'CONNECT' ) then do
- if GoodCarrier( ResultCode, MinCarrier ) then
- connected = 1
- else
- hangup = 1
- end /* Do */
-
- /* modem responses that indicate we should give up */
-
- when abbrev( ResultCode, 'ERROR' ) then exit 8
- when abbrev( ResultCode, 'VOICE' ) then exit 8
- when abbrev( ResultCode, 'DIGITAL LINE ERROR' ) then exit 8
- when abbrev( ResultCode, 'RING' ) then exit 12
-
- otherwise do
- /* The modem response was not recognized.... */
- /* Can I query the serial port to check for DCD? */
- /* If DCD is present, then who cares about the response? :-) */
- /* code to be developed */
- /* DCD is NOT present, and the response was not recognized... */
- /* ... so I don't know if the modem is on/off hook here :-( */
- call ResetModem
- end /* otherwise */
- end /* select */
-
- if hangup then do
- call lineout , 'Hanging up due unsatisfactory connection'
- call ResetModem
- connecting = 0
- iterate
- end /* Do */
-
- if \connected then do
- iterate
- end
-
- /* OK.. all we've done so far is get the modems connected. */
- /* If there is a "response file"... process it, otherwise try */
- /* a "reasonable" combination of login and password prompts. */
-
- if RFile <> '' then do
- call lineout , 'Continuing with response file... (' || RFile || ')'
- if \ProcessRFile() then do
- call ResetModem
- iterate
- end
- call lineout , ' '
- call lineout , 'Response file completed.'
- end /* Do */
- else do
- if \ProcessLogin() then do
- call ResetModem
- iterate
- end
- call lineout , ' '
- end /* Do */
-
- leave /* force the end of the loop */
- end /* do */
-
- if count >=MaxAttempts then
- exit 4
-
- if UseDialer then do
- call lineout , VersionTag '- CONNECT' ActualCarrier '-' /* (start slippm V2.0 R1.8h timer) */
- end
-
- if BeepWanted then do
- call beep 262, 250
- call beep 294, 250
- end
-
- rc=0
- /* Call user exit... if present... */
- if stream( 'PPDXIT.CMD', 'C', 'QUERY EXISTS' ) <> '' then do
- rc = ppdxit( ActualCarrier )
- end
-
- exit rc
-
- GoodCarrier:
- /* examine the text following a CONNECT ... or CARRIER ... response code */
- /* Even if no minimum carrier is requested, try to determine the actual */
- /* DCE rate to report later. */
-
- do i = 2 to words( arg(1) )
-
- str = word( arg(1), i )
-
- x = verify( str, '0123456789', 'N' )
- select
- when x = 0 then /* all digits */
- nop
- when x = 1 then /* no digits */
- iterate i
- otherwise /* some digits */
- str = left( str, x-1 )
- end
-
- if str < 1200 then /* just incase some modem reports a strange number */
- iterate i
-
- if ActualCarrier = 0 then /* set to min incase DCE and DTE are present */
- ActualCarrier = str
- else
- ActualCarrier = min(str,ActualCarrier)
-
- end i /* do */
-
- return ( ActualCarrier >= arg(2) )
-
- halt:
- signal off halt
- if RFile <> '' then
- call lineout RFile /* close the response file */
- if UsePhoneNumberFile then
- call lineout PhoneNumberFile /* close the phone number file */
- call lineout , VersionTag 'cancelled.'
- exit 4
-
- BuildDialCmd:
- Parse arg item
- DialCmd = Prefix /* typically ATDT or ATDP */
-
- /* The phone number may be a group... get the next in the list/file */
- x = (item // PhoneNo.0) + 1
-
- /* we only want the disable/prefix sequence if this is the whole number, or the first */
- /* "phrase" of a multi-part number. */
- if (\StartedDialing) then do
- If Disable then
- DialCmd = DialCmd || DisableSequence /* a sequence to disable call waiting */
- if DialPrefix <> '' then
- DialCmd = DialCmd || DialPrefix || ',' /* a '9' or other for PBX */
- end /* Do */
-
- return DialCmd || PhoneNo.x
-
- ProcessLogin:
- success = 1 /* we'll assume it works... */
- call waitfor LoginPrompt, 30
- if result = 1 then do
- call lineout , 'Host is not asking for userid.'
- success = 0
- end /* Do */
- else do
- call send loginId || cr
-
- call waitfor PasswordPrompt, 30
- if result = 1 then do
- call lineout , 'Host is not asking for password.'
- success = 0
- end /* Do */
-
- call send password || cr
- end /* do */
- return success
-
- ProcessRFile:
- RFileProcessed = 1 /* we'll assume success :-) */
- select
- when RFile.1 = 'GO' then ResponseToggle = 1
- when RFile.1 = 'WAIT' then ResponseToggle = 0
- end /* select */
- do i = 2 to RFile.0 while RFileProcessed
- x = RFile.i
- if x = '' then /* ignore blank lines */
- iterate
- if abbrev( x, '[PPPDIAL_' ) then /* ignore parm settings */
- iterate
- if abbrev( x, '[OS/2]' ) then do
- parse var x ']'os2Command
- address CMD os2Command
- iterate
- end /* Do */
- if abbrev( x, '[SLEEP]' ) then do
- parse var x ']'t
- t = strip(t, 'B')
- if t = '' then t = 1
- if \datatype( t, 'W' ) then t = 1
- call syssleep t
- iterate
- end /* Do */
-
- if ResponseToggle then do
- /* we are sending to the host... */
- parse var x x1 '[' x2 ']' x3
-
- select
- when x2 = 'LOGINID' then call send x1 || LoginId || x3 || cr
- when x2 = 'PASSWORD' then do
- call send x1 || Password || x3 || cr
- call lineout , ' '
- end
- when x2 = 'KEYBOARD' then do
- call beep 2000, 125 /* get attention for prompt */
- parse pull TheAnswer
- call send x1 || TheAnswer || x3 || cr
- end /* Do */
- when x2 = 'KEYBOARD_NOECHO' then do
- call beep 2000, 125 /* get attention for prompt */
- TheAnswer = ''
- do until char = cr /* wait for cr */
- char = SysGetKey( 'NOECHO' )
- if char = bs then do
- if TheAnswer = '' then call beep 2000, 125
- else do
- call charout , '082008'x /* bs blank and bs */
- TheAnswer = delstr( TheAnswer, length( TheAnswer) )
- end /* Do */
- end /* Do */
- else do
- if char = cr then
- call charout , crlf
- else do
- TheAnswer = TheAnswer || char
- call charout , '*'
- end /* Do */
- end /* Do */
- end /* Do */
- call send x1 || TheAnswer || x3 || cr
- drop TheAnswer /* don't keep this data around any longer than necessary */
- end /* Do */
- when abbrev( x, '[REPEAT]' ) then do
- parse var x ']' y z k /* get string to send, string to wait for and count */
- if k = '' then k = 1000 /* repeat lots if not told otherwise */
- MatchFound = 0
- do k until MatchFound /* successful match */
- select
- when pos( '^', y ) <> 0 then call send CtrlSequence( y )
- when y = '\r' then call send cr
- otherwise call send y || cr
- end /* select */
- if waitfor( z , 5 ) = 0 then do /* successful match */
- MatchFound = 1
- end /* Do */
- end /* until */
- if \MatchFound then do /* retry count exhausted, no match found */
- RFileProcessed = 0 /* we encountered a problem... */
- end /* Do */
- else do
- /* The string was repeated and we got the expected match... */
- /* I change the toggle so that it will be set to "send" again for */
- /* the next line in the response file. */
- ResponseToggle = \ResponseToggle
- end /* Do */
- end /* when [REPEAT] */
- when pos( '^', x) <> 0 then call send CtrlSequence( x )
- when x = '\r' then call send cr
- otherwise call send x || cr
- end /* select */
- end
- else do
- /* It's our turn to wait for info from the host... */
- /* before we just blindly wait for text, check to see if we're waiting */
- /* for dynamic IP addresses... */
- if pos( '[$IP', x ) > 0 then
- call ProcessDynamicIP pos( '[$IPDEST]', x ), pos( '[$IPADDR]', x )
- else
- if abbrev( x, '[SKIP_TEXT]' ) then do forever
- if PPPService then
- char = ppp_com_input( interface, 1, 100 )
- else
- char = slip_com_input( interface, 1, 100 )
- if (char >= ' ') | (char = lf) | (char = cr) then
- call charout , char
- else
- leave
- end /* Do */
- else
- if waitfor( x, HostTimeout ) = 1 then do
- call lineout , 'Host not responding, waiting for' x
- RFileProcessed = 0 /* terminate processing and dial again :-( */
- end /* Do */
- end /* Do */
- ResponseToggle = \ResponseToggle
- end /* While */
- return RFileProcessed
-
- ProcessDynamicIP:
- /* We have two parms: */
- /* 1st: starting pos of [$IPDEST] */
- /* 2nd: starting pos of [$IPADDR] */
- /* These are just to indicate the order they appear from the host. */
- /* IP addresses must be in "decimal dot" notation */
-
- parse arg dest, addr
- select
- when dest = 0 then ipaddr = GetIPAddr()
- when addr = 0 then ipdest = GetIPAddr()
- when dest < addr then do
- ipdest = GetIPAddr()
- ipaddr = GetIPAddr()
- end /* Do */
- when addr < dest then do
- ipaddr = GetIPAddr()
- ipdest = GetIPAddr()
- end /* Do */
- end /* select */
-
- if \PPPService then do
- /* these don't seem to have any real effect when using PPP */
- 'ifconfig' interface ipaddr ipdest
- 'route add default' ipdest '1'
- end
-
- return
-
- GetIPAddr:
- /* examine data from the host system looking for an IP address */
- /* in "decimal dot" notation. Return the first one we get. */
- call time 'R'
- dot.1 = 0
- dot.2 = 0
- dot.3 = 0
- IPFound = 0
- IPTimeout = 30
- do until IPFound | time('E') > IPTimeOut
- if PPPService then
- remain_buffer = remain_buffer || ppp_com_input( interface, , 100 )
- else
- remain_buffer = remain_buffer || slip_com_input( interface, , 100 )
- if dot.1 = 0 then do
- dot.1 = pos( '.', remain_buffer )
- if dot.1 = 0 then iterate
- end /* Do */
-
- /* "dot.1" is the index in remain_buffer to the first "." in a potential IP address */
- if dot.2 = 0 then do
- dot.2 = pos( '.', remain_buffer, dot.1 + 1 )
- if dot.2 = 0 then iterate
- end /* Do */
-
- if dot.3 = 0 then do
- dot.3 = pos( '.', remain_buffer, dot.2 + 1 )
- if dot.3 = 0 then iterate
- end /* Do */
-
- PotentialIP = substr( remain_buffer, max( 1, dot.1 - 3 ) )
- parse var PotentialIP a '.' b '.' c '.' d .
- /* the "a" part MAY contain a space, we want the second part. */
- if words(a) >1 then a = word( a, 2)
-
- /* the "d" part may not end with digit. i.e. perhaps a ")" */
- x = verify( d, '0123456789', 'N' )
- if x <> 0 then do
- d = substr( d, 1, x - 1 )
- end /* Do */
-
- if \datatype(a, 'W') | \datatype( b, 'W') | \datatype( c, 'W' ) | \datatype(d, 'W' ) then do
- remain_buffer = substr( remain_buffer, dot.1 + 1 )
- dot.1 = 0
- dot.2 = 0
- dot.3 = 0
- iterate
- end /* Do */
-
- DecDot = a || '.' || b || '.' || c || '.' || d
- IPFound = 1
- remain_buffer = substr( remain_buffer, dot.3 + 2 )
- end /* do */
-
- if IPFound then
- call lineout , 'IP addr:' DecDot
- else
- call lineout , 'IP addr: timed out'
-
- return DecDot
-
- ProcessRFileCommands:
- success = 1 /* assume all is OK */
- /* Build a stem variable for the parts required for the log in process. */
- /* olny therelevent parts of the file will be added to the stem. */
- /* Then the file is closed. */
- i = 0
- do while lines( RFile )
- x = linein( RFile )
- if x = '' then /* ignore blank lines */
- iterate
- if \abbrev( x, '[PPPDIAL_' ) then do
- i = i + 1
- RFile.i = x
- iterate
- end
- /* Only [PPPDIAL_...] lines are process here... */
- parse var x '_'kw']'val
- val = strip( val, 'B')
- select
- when kw = 'CARRIER_TIMEOUT' then ModemRegS7 = val
- when kw = 'DELAY' then pause = val
- when kw = 'DIAL_PREFIX' then DialPrefix = val
- when kw = 'DO_NOT_USE_DIALER' then UseDialer = 0
- when kw = 'HOST_TIMEOUT' then HostTimeout = val
- when kw = 'INIT1' then init1 = val
- when kw = 'INIT2' then init2 = val
- when kw = 'MAX_REDIAL' then MaxAttempts = val
- when kw = 'MIN_CARRIER' then MinCarrier = val
- when kw = 'MODEM_ESCAPE' then ModemEscapeSequence = val
- when kw = 'MODEM_RESET' then ModemResetCommand = val
- when kw = 'PHONE' then PhoneNumber = val
- when kw = 'PREFIX' then Prefix = val
- when kw = 'QUIET' then BeepWanted = 0
- when kw = 'REM' then nop /* allow comments... */
- when kw = 'SERVICE' then PPPService = ( val = 'PPP' )
- when kw = 'USE_DIALER' then UseDialer = 1
- otherwise do
- call lineout , kw 'is not a recognized keyword.'
- success = 0
- end /* otherwise */
- end /* select */
- end /* while */
- RFile.0 = i
- call lineout RFile /* close the response file */
- return success
-
- CtrlSequence:
- parse arg string
- /* we do a logical AND X'1F' with the character... */
- /* The "character" should only be in the range of 40 through 5F, */
- /* but who cares... the effect will be the same :-) */
-
- do until x = 0
- x = pos( '^', string )
- if x <> 0 then do
- y = substr( string, x+1, 1) /* isolate the character following ^ */
- string = insert( bitand( y, '1F'x ), string, x+1 )
- /* delete the character pair from the string */
- string = delstr( string, x, 2 )
- end /* Do */
- end
- return string
-
- ResetModem:
- call lineout , 'Initializing modem...'
- if init1 <> '' then do
- call send init1 || cr
- ResultCode = GetResult( 6 )
- end /* Do */
- if init2 <> '' then do
- call send init2 || cr
- ResultCode = GetResult( 6 )
- end /* Do */
-
- if ((init1 = '') & (init2 = '')) then do
- call send ModemResetCommand || cr
- ResultCode = GetResult( 6 )
- end /* Do */
-
- if left(ResultCode , 2) <> 'OK' then do
- call lineout , 'Modem not resetting... Trying again'
- call sysSleep 2
- call send ModemEscapeSequence
- call waitfor crlf, 5
- call flush_receive
- call ResetModem
- end /* Do */
- call flush_receive
- return
-
- /* Routine to send a modem command. */
-
- send:
- parse arg AtCmd
- call flush_receive
- if PPPService then
- call ppp_com_output interface , AtCmd
- else
- call slip_com_output interface , AtCmd
- return
-
- /* Waits for any modem response, and returns the string. */
- /* If timeout is specified, it says how long to wait if data stops showing */
- /* up on the COM port (in seconds). */
- getresult:
- parse arg timeout
- call waitfor crlf, timeout
- if result = 0 then
- call waitfor crlf, timeout
-
- if result = 1 then /* timed out */
- return '*timedout*'
- else
- return waitfor_buffer
-
-
- /*--------------------------------------------------------------------------*/
- /* waitfor ( waitstring , [timeout] ) */
- /* */
- /* Waits for a specific string from the modem. */
- /* Timeout is specified in seconds. */
- /* Ignore case... so login = LOGIN counts as a match... Added for version 3.0 */
-
- waitfor:
- parse upper arg waitstring , timeout
- if timeout = '' then do
- timeout = 90 /* 1.5 minutes if delay not specified */
- end
-
- waitfor_buffer = ''
- found = 0
- expired = 0
-
- call time 'E'
- do until (found | expired)
- if PPPService then
- chars = ppp_com_input( interface, , 10 )
- else
- chars = slip_com_input( interface, , 10 )
- remain_buffer = Translate( remain_buffer || chars )
- index = pos(waitstring, remain_buffer)
- found = ( index > 0 )
- expired = (time('E') > timeout)
- if found then do
- x = index + length(waitstring)
- waitfor_buffer = delstr(remain_buffer, x) /* everything up to what matched */
- remain_buffer = substr(remain_buffer, x) /* keep everything past that */
- end
- /* SLIPPM.EXE V2.0 R1.8h aborts our script when it "sees" certain words in the */
- /* status window. Words like "BUSY", "NO CARRIER", etc. */
- /* To get around this problem I translate all information from the modem */
- /* to lower case, thus thwarting slippm's effort to detect what's going on. :-) */
-
- /* However, I don't know how long this will continue to work, because IBM is */
- /* developing slippm and who knows what they have in mind for the next version? */
-
- call charout , translate(chars, LowerCase, UpperCase)
- end
-
- return \found
-
- /*--------------------------------------------------------------------------*/
- /* flush_receive() */
- /* */
- /* Routine to flush any pending characters to be read from the COM port. */
- /* Reads everything it can until nothing new shows up for 100ms, at which */
- /* point it returns. */
- /* */
- /*--------------------------------------------------------------------------*/
-
- flush_receive:
-
- parse arg echo
-
- /* If echoing the flush - take care of waitfor remaining buffer */
- /* Note - I translate the characters here to lower case to be consistent */
- /* with the "waitfor" routine. (Due to slippm.exe V2.0 R1.8h changes) */
-
- if (echo <> '') & (length(remain_buffer) > 0) then do
- call charout , translate( remain_buffer, LowerCase, UpperCase )
- remain_buffer = ''
- end
-
- /* Read anything left in the modem or COM buffers */
- /* Stop when nothing new appears for 100ms. */
-
- do until line = ''
- if PPPservice then
- line = ppp_com_input( interface,,100 )
- else
- line = slip_com_input( interface,,100 )
- if echo <> '' then
- call charout , translate( line, LowerCase, UpperCase )
- end
-
- return
-
- NotFromDialer:
- parse upper source . . MyDrivePathName
- MyDrive = filespec( 'D', MyDrivePathName )
- MyPath = filespec( 'P', MyDrivePathName )
- MyDrivePath = MyDrive || MyPath
-
- etcDrivePath = translate( value( 'etc',,'OS2ENVIRONMENT') )
- binDrive = filespec( 'D', etcDrivePath )
- binPath = filespec( 'P', etcDrivePath ) || 'BIN\'
- binDrivePath = binDrive || binPath
-
- EraseFile = 0
- if binDrivePath <> MyDrivePath then do
- say 'This script will be moved to' binDrivePath
- say 'Do you wish to continue? (y/n)'
- say '(Saying no will still show help)'
- answer = translate( sysGetKey( 'ECHO' ) )
- if answer = 'Y' then do
- 'COPY' MyDrivePathName binDrivePath
- if rc = 0 then do
- say MyDrivePathName 'will be erased after displaying help'
- EraseFile = 1
- end
- '@PAUSE'
- call sysCls
- end /* Do */
- end /* Do */
-
- call sysCls
- stop = 0
- do i = 3 by 1 until stop
- x = sourceline( i )
- if left( x, 5 ) = 'pause' then do
- '@PAUSE'
- call sysCls
- iterate
- end /* Do */
-
- if left( x, 4 ) <> 'stop' then
- say x
- else
- stop = 1
- end /* do */
- '@PAUSE'
- if EraseFile then
- 'ERASE' MyDrivePathName
- return