OS/2 Shareware BBS: 35 Internet/35-Internet.zip/yrndl153.zip/YARNDIAL.CMD

OS/2 REXX Batch file | 1997-03-13 | 92KB | 2,744 lines

/* YARNDIAL.CMD v 1.53 by Jerry Levy  13 Mar 97
Comments appreciated: send to [e-mail]
(Jerry Levy, Marblehead, MA USA) */

version = '1.53'

local_error_trapping = 1

choose = ''
arg choose

/*
===========History============
See YD.DOC for details.

YARNDIAL v. 1.53     13 Mar 97
  Some fixes

YARNDIAL v. 1.52     04 Mar 97 (GA Release)
  Numerous small changes/customization/corrections so runs
  equally well under Object ReXX as well as Classic ReXX

YARNDIAL v. 1.50     25 Jan 97
   Final beta.
   Added: support for multiple ISP's

YARNDIAL v. 1.42 (several betas)     to 25 Jan 97
   Bug-catching in YARNDIAL.CMD.
   Support for use of VSOUP (VSOUP1.2.5) as alternative to SOUPER.
   Eliminated TIMER.CMD (see README.1ST, YD.DOC).
   Changes in YDINSTL, mostly related to VSoup support.
   Souper and VSoup _xtra_options changed

==========COPYRIGHT NOTICE AND DISCLAIMER=============
YDINSTL.CMD is Copyright 1996-7 by Jerry Levy (all rights reserved)
YARNDIAL.CMD is Copyright 1995-7 by Jerry Levy (all rights reserved)

These are provided as-is and without charge, with no warranty expressed
or implied as to merchantability or fitness for any particular purpose.  All
responsibility for any and all incidental and consequential damages is
disclaimed.  These programs and associated text files are freeware.  They
may be distributed without restriction providing: (1) this notice and
disclaimer remain intact, (2) all programs and files are included and
unchanged, and (3) they are distributed either in the original .zip archive
or the archive after being unzipped into a folder or onto a disk or other
medium.  Use of either or both of these programs constitutes acceptance
of these terms by all users.

================INSTALLATION======================
You could read YD.DOC.
Or you could read README.1ST (shorter, recommended).

If YARN and SOUPER are installed and run OK...

...and if you are using the IAK Dialer to connect to IBM/IGN/Advantis,
or the Dial-Other-Internet_Providers utility (SLIPPM.EXE)...

then just run YDINSTL.CMD.
==================================================

*/

cr = d2c(13)        /* enter key, as well as carriage return */
crlf = d2c(13) || d2c(10)   /* carriage return + linefeed */
escape = d2c(27)   /* escape character */
ctrl_Q = d2c(17)
ctrl_R = d2c(18)
bs = d2c(8)   /* Backspace */
tab = d2c(9)   /* tab */
X1 = d2c(0)   /* Extended key */
X2 = d2c(224)   /* Extended key */

/* We back up the soup.zip created from incoming mail, but not the
one created for incoming news.  You can change that by editing these
two assignments.  1 we back up, 0 we don't. */
make_mail_soupzip_backup = 1
make_news_soupzip_backup = 0

do_not_kill = 0
rebuilt = 0
remote = 0

call Welcome      /* Say Hello */

if local_error_trapping then signal on failure
if local_error_trapping then signal on halt
if local_error_trapping then signal on syntax
if local_error_trapping then signal on error
if local_error_trapping then signal on notready
if local_error_trapping then signal on novalue

trace 'N'

timeout = 0      /* Flag is reset to 1 if dialer times out */

Abandon = 0     /* Initialize */
replies_zip = 1        /* if we try to export mail and there is none, this is reset to 0 */
do_catchup_on_news = 0        /* initialize the flag to do no news catchup */

queue_ydext = rxqueue('GET') /* current active queue */

/* create named dataqueue */
queue_ydint = 'Q_YD_INT'        /* for use inside YARNDIAL */
call rxqueue 'DELETE', queue_ydint        /* If a queue_ydint queue existed, kill it */
call rxqueue 'CREATE', queue_ydint        /* Create our internal queue */
call rxqueue 'SET', queue_ydint        /* Set our internal queue active */
call rxqueue 'SET', queue_ydext        /* Set external queue active */

/* MAIN PROGRAM */

/* Load Rexx Util functions if not already loaded */
if RxFuncQuery('SysLoadFuncs') \= 0 then
   do
      call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
      call SysLoadFuncs
   end

/* Initialize these filenames */
go_exe = 'GO.EXE'
ydinstl_cmd = 'YDINSTL.CMD'
ydparms_dat = 'YD_PARMS.DAT'
killjoy_exe = 'KILLJOY.EXE'
alt_dialer_exe = 'SLIPPM.EXE'
logfile = 'C:\DESKTOP\LOG.TXT'

'@echo off'        /* No echoing of any os/2 commands */

/* Read parameters in from the ydparms.dat datafile */
call parms_from_ydparms_dat

/* CHOOSE is the command-line argument, if any */
call analyze_choose

/* We look for some obvious inconsistencies or omissions in YDPARMS_DAT */
call fatal_error_check

call directory_maintenance

/* are we connected? to whom? is it the right connection? */
call get_current_connection

/*
================
Call up the main_menu.  What do we want to do? We can get mail, news, send, etc.
Returns a variable CHOICE = 1, 2, 3, 4, 5, 6, or 7.  Or Escape or CTRL-Q to quit.
1 = get mail only
2 = get news only
3 = get both mail and news
4 = export replies, posts, etc. (only export, no retrieval)
5 = get mail and news, export replies, posts, etc.
6 = Fix an interrupted import
7 = set catchup on news, read-only for mail, limit size of news articles
     and then we are re-prompted whether to get, send, etc.
================
*/
if \remote then call main_menu

if \remote then call analyze_choice        /* From main_menu() response */

/*
====================
A home\replies folder (empty) may be left behind as trash
after execution of mail/news retrieval from some Yarn/Souper
installations. We get rid of it if your setup of Yarn/Souper
leaves one behind.
====================
*/
replies_dir = home || '\replies'
call SysRmDir replies_dir

/* Do whatever we selected we wanted to do from the main_menu() */

/*
============
Process MAIN_MENU selection = 6.
6 = Fix the interrupted import
============
*/
if choice = pos(choice, 'xxxxx6x') then
   do
      call fix_import_message
      k = 1
      call fix_import
      if number_of_ISPs > 1 then
        do k = 2 to number_of_ISPs
           if isp_active.k = 0 then iterate
           if popsrvr.k = '' then iterate
           call fix_import
        end
      signal goodbye        /* Exit the program when done */
   end

/*
============
Process MAIN_MENU selection = 7.
7 = set some souper switches so we can
  do read-only for mail, limit news-article size, do catchup on news

First: tell us what we're going to do.
============
*/
if choice = pos(choice, 'xxxxxx7') then
   do
      call SysCls
      say ''
      say 'You selected to modify souper options.'
      say ''
      say 'We will first dial in.'
      say ''
      say 'After a connection is successfully established you will'
      say 'be asked to select your one-time-only Souper/VSoup options.'
      say ''
      say 'When you are finished with that, another menu will pop'
      say 'up asking if you want to do news catchup, to get news or mail,'
      say 'or to send posts.'
      say ''
      say 'To quit now, press Escape'
      say 'Any other key starts the dialup connection or uses one already up'
      if SysGetKey('NOECHO') = Escape then signal goodbye
      else NOP
    end

/*
============
These are for all selections.  Dial up if not already connected.
============
*/
call dialup_server
call time 'R'        /* start clock recording time on line */
t = 0

/*
============
Now, for MAIN_MENU selection = 7 again
============
*/

      if choice = pos(choice, 'xxxxxx7') then
        do
           call souper_options
           if \remote then choice = menu2()        /* calls menu2() */
        end
/*
=================
For remaining MAIN_MENU selections of 1, 2, 3, 4, 5.
1 = get mail only
2 = get news only
3 = get both mail and news
4 = export replies, posts, etc. (only export, no retrieval)
5 = get mail and news, export replies, posts, etc.
=================
*/
      k = 1
      if choice = pos(choice, '1x3x5xx') then call import_mail
      if number_of_ISPs > 1 then
        do k = 2 to number_of_ISPs
           if isp_active.k = 0 then iterate
           if popsrvr.k = '' then iterate
           if choice = pos(choice, '1x3x5xx') then call import_mail
        end

      k = 1
      if choice = pos(choice, 'x23x5xx') then call import_news
      if number_of_ISPs > 1 then
        do k = 2 to number_of_ISPs
           if isp_active.k = 0 then iterate
           if default_news.k = '' then iterate
           if choice = pos(choice, 'x23x5xx') then call import_news
        end

      if choice = pos(choice, 'xxx45xx') then call exporter /* only export once */

call kill_dialers_slip_ppp_slattach        /* Kill these and slattach, too */

if \remote then call restore_zip        /* If sending went south on you, you can restore to send again */
if \remote then call toss_old_news

signal Depart        /* Exit and report times */
/*
=======================
goodbye()
quit()
depart()

Exit routines.  Most exits are jumps to
goodbye()
=======================
*/

goodbye:
call kill_dialers_slip_ppp_slattach        /* Now fall into DEPART() */

Depart:
if timeout then signal Quit
say ''
if \rebuilt then call connect_stats        /* tell us elapsed time, unless we were fixing import */
x = EndLocal()

/* Now fall into QUIT() */

Quit:
say ''
if \remote then say 'Done. Press any key to exit...'
if \remote then answer = SysGetKey('NOECHO')
if remote then say 'Remote operation over at' time() date()
EXIT

RETURN

/*
======================================================
End of main program
======================================================
*/

/*
=====================
welcome()

Say Hello.
=====================
*/
welcome:
say ''
say 'YRNDIAL.CMD v' || version
say '(c) 1995-7 by Jerry Levy (all rights reserved)'
say '[e-mail]        Marblehead, MA USA'
say ''
say 'Dials in, gets or posts news, mail and replies.'
say 'Normally this program closes the connection upon exiting.' crlf
time1 = time()
date1 = date('S')
/* format date as yyyy/mm/dd */
date1 = left(date1,4) || '/' || substr(date1,5,2) || '/' || right(date1,2)
RETURN

/*
=======================================
fatal_error_check()

We check for some obvious flaws in the data
returned from YDPARMS_DAT
=======================================
*/

fatal_error_check:
service = translate(service)        /* Upper case */

if pos(connection_type, '134567') = 0 & connection_type < 8 then
        /* 2 is reserved for future use */
   do
      call beep 1000, 200
      say ''
      say 'Fatal error in' ydparms_dat '; the connection_type'
      say 'can only be 1, or 3-7'
      say ''
      Abandon = 1
   end

if connection_type = pos(connection_type, '13457') & dialup_string = '' then
   do
      call beep 1000, 200
      say ''
      say 'Fatal error in' ydparms_dat
      say 'Dialup_string is blank.  Cannot be blank if connection_type is 1, 3-5, or 7.'
      say ''
      Abandon = 1
   end

if service = '' then
   do
      call beep 1000, 200
      say ''
      say 'Possible error in' ydparms_dat 'SERVICE field is blank.'
      say 'Usually would contain something like: PPP, SLIP, SL, etc.'
   end

if override_dnk_during_remote \= 0 & override_dnk_during_remote \= 1 then
   do
      call beep 1000, 200
      say ''
      say 'Fatal error in' ydparms_dat
      say 'OVERRIDE_DNK_DURING_REMOTE can only be 0 or 1'
      if pos(interface_removal, 'Oo') \=0 then
        say 'You have the letter' pos(interface_removal, 'Oo') 'there now.'
      say ''
      say 'A setting of 1 is advised if you are running from a timer program'
      say 'and if you could rack up huge phone and connection bills if your'
      say 'connection stayed up.'
      override_dnk_during_remote = 1
      do_not_kill_connection = 0
      do_not_kill = 0

      Abandon = 1
   end

if vsoup \= 0 & vsoup \= 1 then
   do
      call beep 1000, 200
      say ''
      say 'Fatal error in' ydparms_dat
      say 'VSOUP in' ydparms_dat 'is neither 0 nor 1.'
      say 'VSOUP can only be 0 or 1'
      if pos(interface_removal, 'Oo') \=0 then
        say 'You have the letter' pos(interface_removal, 'Oo') 'there now.'
      say ''
      say 'A setting of 1 means you are running VSOUP.EXE.'
      say 'A setting of 0 means you are running SOUPER.EXE.'
      say 'You must edit VSOUP in the' ydparms_dat
      say 'file to  to equal 0 or 1, depending on which of these'
      say 'programs you are using.'
      Abandon = 1
   end

if pos(getmail_autho.1, '123') = 0 & getmail_autho.1 < 4 & vsoup = 1,
   & pos(getnews_autho.1, '123') = 0 & getnews_autho.1 < 4,
   & pos(send_autho.1, '123') = 0 & send_autho.1 < 4 then
   do
      call beep 1000, 200
      say ''
      say 'Fatal error in' ydparms_dat
      say 'getmail_autho.1, getnews_autho.1, and send_autho.1 can only be 1, 2, or 3'
      if pos(getmail_autho.1, 'Oo') \=0,
        | pos(getnews_autho.1, 'Oo') \=0,
        | pos(send_autho.1, 'Oo') \=0 then
        say 'You may have a wrong value or the letter O or o there now.'
      say ''
      Abandon = 1
   end

/* Check if domain nameserver addresses are both blank.  If only
on is, copy the other over to it.  Error only if both are missing. */
if DNS = '' then DNS = DNS2
if DNS2 = '' then DNS2 = DNS
if DNS = '' & DNS2 = '' then
   do
      call beep 1000, 200
      say ''
      say 'Possible error: nothing in DNS or DNS2 fields in' ydparms_dat ||','
      say 'DNS and DNS2 are the domain nameserver addresses (main and'
      say 'alternate) in Decimal Dot notation.  At least one of these fields'
      say 'must be populated.  It would look like: 150.203.23.247'
      say ''
   end

if VSOUP = 0 & stream(souper_exe, 'c', 'query exists') = '' then
   do
      Abandon = 1
      say ''
      say 'You are trying to run YARNDIAL with SOUPER and we cannot'
      say 'find' souper_exe || '. You must either copy SOUPER to the'
      say 'directory indicated or edit the name and/or path of the'
      say 'SOUPER_EXE entry in' ydparms_dat 'to correctly'
      say 'indicate where the SOUPER program is located.'
   end

if VSOUP = 1 & stream(vsoup_exe, 'c', 'query exists') = '' then
   do
      Abandon = 1
      say ''
      say 'You are trying to run YARNDIAL with VSOUP and we cannot'
      say 'find' vsoup_exe || '. You must either copy VSOUP to the'
      say 'directory indicated or edit the name and/or path of the'
      say 'VSOUP_EXE entry in' ydparms_dat 'to correctly'
      say 'indicate where the VSOUP program is located.'
   end

if Abandon = 1 then
   do
      say 'Aborting...'
      signal goodbye
   end
RETURN

/*
=================
get_current_connection()

(1)  Check whether slippm.exe, slip.exe, ppp.exe, in-joy.exe,
IAK Dialer, ilink2.exe are running.  Are what is running the right
processes for our connection_type and service (SLIP or PPP)?
Of these processes:
        SLIP.EXE
        PPP.EXE
        SLIPPM.EXE
        IN-JOY.EXE
        ILINK2.EXE
        the IAK Dialer
        whatever alt_dialer_exe is

Close down any that are not consistent with
our connection_type.

Then determine: which ones are (left) running?


(2)  Check for sl and ppp and other router interfaces
====================
*/
get_current_connection:
say 'Check for an existing connection, and whether it is correct for us:'
say '   Active dialers? Active SLIP?  Active PPP?'

if connection_type = 1 then        /* IBM/IGN/Advantis IAK Dialer only */
   do
      service = 'SLIP'        /* must be SLIP for the IAK Dialer */
      call close_down 'ppp'        /* ...because none of these should be running */
      call close_down 'slippm'
      call close_down 'in-joy'
      call close_down 'ilink2'
      if alt_dialer \= 'DIALER' then
        call close_down alt_dialer
   end

/* for connection_type 6 (pot luck) we check (almost) nothing */
if connection_type = 6 then
   do
      if service = 'PPP' then call close_down 'slip'
      if service = 'SLIP' then call close_down 'ppp'
   end

if pos(connection_type, '45') \= 0,
   & alt_dialer = 'SLIPPM' then
   do
      call close_down 'in-joy'
      call close_down 'dialer'
      call close_down 'ilink2'
   end

if pos(connection_type, '45') \= 0,
   & alt_dialer = 'IN-JOY' then
   do
      call close_down 'slip'        /* IN-JOY doesn't use this...*/
      call close_down 'ppp'        /* ...or these...*/
      call close_down 'slippm'
      call close_down 'ilink2'
      call close_down 'dialer'        /*...IAK Dialer */
   end

if pos(connection_type, '45') \= 0,
   & alt_dialer = 'ILINK2' then
   do
      call close_down 'in-joy'
      call close_down 'dialer'
      call close_down 'slippm'
   end

if pos(connection_type, '45') \= 0,
   & alt_dialer \= 'SLIPPM',
   & alt_dialer \= 'ILINK2',
   & alt_dialer \= 'DIALER',
   & alt_dialer \= 'IN-JOY' then
   do
      call close_down 'slippm'
      call close_down 'ilink2'
      call close_down 'dialer'
      call close_down 'in-joy'
   end

if connection_type = 3 then        /* PPP.EXE or SLIP.EXE dialup string only */
   do
      if service = 'SLIP' then
        call close_down 'ppp'
      if service = 'PPP' then
        call close_down 'slip'
      call close_down 'slippm'
      call close_down 'in-joy'
      call close_down 'ilink2'
      if alt_dialer \= 'PPP' & alt_dialer \= 'SLIP' then
        call close_down alt_dialer
   end


/*
===============
See what stuff related to dialers or dialup strings may
be running

and

Poll the routers: e.g., is an sl or a ppp interface up?
Note, however, that what is returned may not be
currently active, and what is returned could represent
the last occurrence not a present connection.
Calls wait_for_interface(), which uses
NETSTAT.EXE -r to poll.
===============
*/

/*
==================
Below are flags.  They are set to 1 if a process is running
or if an interface is up.  Initialize all to zero
==================
*/

slip_is_running = 0
ppp_is_running = 0
IAKdialer_is_running = 0
slippm_is_running = 0
ilink2_is_running = 0
alt_dialer_is_running = 0
slipexe_or_pppexe_running = 0

some_interf_up = 0
ifprefix_interf_up = 0

/* are any of these running? */
call is_slip_running        /* If so returns slip_is_running=1 */
call is_ppp_running        /* If so returns ppp_is_running=1 */
call is_slippm_running        /* If so returns slippm_is_running=1 */
call is_ilink2_running        /* If so returns slippm_is_running=1 */
call is_IAKdialer_running        /* If so returns IAKdialer_is_running=1 */
call is_alt_dialer_running /* etcetera */
if slip_is_running | ppp_is_running then slipexe_or_pppexe_running = 1

say '   Checking router interfaces...'
/* Check for pppx or slx or lanx router interfaces
we may not use this information, but this step is
done here in anticipation of future uses */

call are_there_interfaces_up


/*
==================
Get path to TCPOS2.INI file.

We get information about the current_connection from
TCPOS2.INI, unless our dialer is IN-JOY which doesn't
talk to TCPOS2.INI.
==================
*/
tcpip_etc_path = value('etc', , 'OS2ENVIRONMENT')
tcpos2_ini = tcpip_etc_path || '\' || 'tcpos2.ini'

/*
==========
TCPOS2.INI inquiries
==========
*/
current_connection_key = SysIni(tcpos2_ini, 'CONNECTION', 'CURRENT_CONNECTION')

/* strip final null char */
current_connection_key = strip(current_connection_key, 'T', X1)
userID_connected = SysIni(tcpos2_ini, 'CONNECTION', current_connection_key)
userID_connected = strip(userID_connected, 'T', X1)
parse var userID_connected user_ID ',' system_app

/*
====================
Next we will decide if we need to dial or whether we
can use what may already be established as a connection.

When dial = 1 we need to dial.  We will determine
below whether, if we are already on line, we are online
to the provider for this user installation or not.  If
we cannot ID the provider as ours we simply close down
SLIP, PPP, SLIPPM, and the IAK DIALER and redial.  First
we set the dial flag (set dial = 1), then we determine
if we should really dial.  If we are connected to our
provider we zero the dial flag.
====================
*/

dial = 1        /* initialize it */

/*
====================
We get parameters from the CONNECTION app of TCPOS2.INI
We can make a pretty good (not perfect) assessment in
this simple way whether we are connected to the right provider.
====================
*/
if alt_dialer_is_running & some_interf_up & connection_type \= 7 then
      select
        when connection_type = 1,
        & IAKdialer_is_running,
        & translate(user_id) = translate(login_ID.1),
        & translate(system_app) = 'ADVANTIS' then
           do
              say 'Two beeps means' user_id 'is already connected to IBM/IGN/Advantis.  Proceed.'
              call connected_signal
           end

        when connection_type = 4,
        & (slippm_is_running | ilink2_is_running),
        & translate(user_ID) = translate(login_ID.1) then
           do
              say 'Two beeps means we are already logged in as'
              say user_id '(Pop_ID:' pop_ID.1 || ').  Proceed.'
              call connected_signal
           end

        when pos(connection_type, '45') \= 0 & alt_dialer = 'IN-JOY',
        & pos(translate(interf_prefix), make_if_list()) \= 0 then
           do
              say 'Two beeps means we are connected via' alt_dialer
              say 'to' domain_name || '.  Proceed...'
              call connected_signal
           end

        when connection_type = 3,   /* slip.exe or ppp.exe dialer string */
        & translate(user_ID) = translate(login_ID.1) then
           do
              say 'Two beeps means we are already logged in as'
              say user_id '(Pop_ID:' pop_ID.1 || ').  Proceed.'
              call connected_signal
           end

        when connection_type = 6 then
        dial = 0        /* Pot Luck */

        otherwise
           say 'Connected, but to a provider or for a connection different than'
           say 'the one for which this YARN user installation was configured.'
           say 'We are closing down whatever was up (if one was up).'
           say 'We will redial after you select an action from the next menu.'
           say ''
           dial = 1        /* we will dial when we hit dialup_server() */
           connection_type = 7    /* we act like we are connection_type 7 */

           x = do_not_kill /* save it */
           do_not_kill = 0  /* temporarily to 0*/
           call kill_all        /* ...so we can kill everything */
           do_not_kill = x  /* and reset it to what it was */
     end   /* of select */

if connection_type = 7 | \some_interf_up then
   dial = 1

RETURN


/*
===============
connected_signal()
Double-beep if connected (no double-beep if in remote mode)
===============
*/
connected_signal:
say ''
if \remote then call beep 1000, 200
if \remote then call beep 32767, 25  /* Too high pitched, inaudible, an improvised pause. */
if \remote then call beep 1000, 200
dial = 0        /* unset the flag: we do not need to dial up server */
RETURN


/*
=====================
directory_maintenance()

Some grunt work to get drives, directories we need.
=====================
*/

directory_maintenance:
home_drive = filespec('drive', home)
/* Make dirs for temp storage of incoming mail and news.  We make them
compatible with the directory structure recommended by R. Griech
for his VSoup, whether we use VSoup or not */

call SysMkDir home || '\yarn'        /* of course this already exists */
call SysMkDir home || '\yarn\in'
call SysMkDir home || '\yarn\in\mail'
call SysMkDir home || '\yarn\in\news'
mail_incoming_dir.1 = home || '\yarn\in\mail'
news_incoming_dir.1 = home || '\yarn\in\news'
if number_of_ISPs > 1 then
   do i = 2 to number_of_ISPs
      call SysMkDir home || '\yarn\in\mail' || i
      call SysMkDir home || '\yarn\in\news' || i
      mail_incoming_dir.i = home || '\yarn\in\mail' || i
      news_incoming_dir.i = home || '\yarn\in\news' || i
   end

/* Create an outgoing dir compatible with the directory structure recommended
for VSoup, whether we use it or not */
call SysMkDir home || '\yarn\out'

/* Extract drive and dir for the reply packet .zip file */
parse var reply_packet rpname '.' ext
yarn_outgoing_drive = filespec('drive', reply_packet)
yarn_outgoing_dir = yarn_outgoing_drive || strip(filespec('path', reply_packet), 'T', '\')

RETURN

/*
================
 routines use GO.EXE to let us determine whether
        SLIP.EXE
        PPP.EXE
        SLIPPM.EXE
        IN-JOY.EXE
        ILINK2.EXE
        DIALER.EXE
        alt_dialer_exe (whatever it is)
are running processes
================
*/

is_slip_running:
signal off error
slip_is_running = 0
go_exe '-cp SLIP>NUL'        /* returns 1 if slip is running, 0 if not */
If RC=1 then
   do
      slip_is_running = 1
   end
if local_error_trapping then signal on error
RETURN

is_ppp_running:
signal off error
ppp_is_running = 0
go_exe '-cp PPP>NUL'        /* returns 1 if ppp is running, 0 if not */
If RC=1 then
   do
      ppp_is_running = 1
   end
if local_error_trapping then signal on error
RETURN

is_slippm_running:
signal off error
slippm_is_running = 0
go_exe '-cp SLIPPM>NUL'        /* returns 1 if slippm is running, 0 if not */
If RC=1 then
   do
      slippm_is_running = 1
   end
if local_error_trapping then signal on error
RETURN

is_ilink2_running:
signal off error
ilink2_is_running = 0
go_exe '-cp ILINK2>NUL'        /* returns 1 if ilink2 is running, 0 if not */
If RC=1 then
   do
      ilink2_is_running = 1
   end
if local_error_trapping then signal on error
RETURN

is_IAKdialer_running:
signal off error
IAKdialer_is_running = 0
go_exe '-cp DIALER>NUL'        /* returns 1 if IAK Dialer is running, 0 if not */
If RC=1 then
   do
      IAKdialer_is_running = 1
   end
if local_error_trapping then signal on error
RETURN

is_alt_dialer_running:
signal off error
alt_dialer_is_running = 0
go_exe '-cp' alt_dialer '>NUL'        /* returns 1 if running, 0 if not */
If RC=1 then
   do
      alt_dialer_is_running = 1
   end
if local_error_trapping then signal on error
RETURN

/*
=============================================
main_menu()

This is the main YARNDIAL selection menu.  If we select 7 (souper options)
we first dial in to the system and only after we're connected do we get to
select the options.  Then we get another menu asking if we want to get or send stuff.
=============================================
*/
main_menu:
   say ''
   say 'MAIN SELECTION MENU'
   say '1  Only import Mail'
   say '2  Only import News Articles'
   say '3  Only import, but both Mail AND News'
   say '4  Only export (send Mail, Posts, Replies, and Follow-ups)'
   say '5  Everything: Get Mail and News AND send Posts, Replies, Follow-ups'
   say '6  Complete an interrupted importation of mail/news or rebuild a'
   say '        corrupted YARN history file (always shuts down dialer)'
   say '7  Souper options:  one-time-only changes in how Souper/VSoup run:'
   say '      Catchup on News'
   say '      Maximum News Packet Size'
   say '      Do not retrieve newsgroup articles longer than set number of lines'
   say '      Read-only for Mail: Don''t empty POP3 mailbox'
   say 'Press:'
   say '    1 2 3 4 5 6 7   Executes functions as shown; goes off-line when done.'
   if do_not_kill_connection then        /* ...then we have a choice */
      do
        say ' or' dnk.1 dnk.2 dnk.3 dnk.4 dnk.5 dnk.6 dnk.7,
        '  Same functions; connection remains up.'
      end

   say 'To exit now and close connection: Escape key'
   if do_not_kill_connection then
      say 'To exit, but leave any existing connection up: CTRL-Q'
   say 'Enter Selection:'
RETURN

/*
===================
analyze_choice()
If we are not logging to a file and choice is 1-7, we pass it on;
if !@#$%^& we intercept, set do_not_kill=1, and translate to 1-7;
if it is an exit command (Escape, ctrl_Q) we quit; and anything else,
it is an incorrect response and we re-prompt.
===================
*/
analyze_choice:
do until pos(choice, '1234567' || Escape) \= 0
   choice = SysGetKey('NOECHO')

/*
==================
We can select dnk.1 thru 7 whereby we elect to do the same things
as for choices 1 thru 7 except we do not close down dialer
and other connection stuff at the end.  If any of the dnk. characters
are the 1,2,3,4,5,6, or 7, the dialer is shut down.

dnk.1 thru 7 default to the shift-key characters
[on a US keyboard !@#$%^&] for keypresses 12345677]

For menu choice 6, the dialer is always shut down so
dnk.6, whatever is entered, is blanked out.
==================
*/

   select
      when choice = Escape then
        do
        say 'Quitting Yarndial...'
        signal goodbye
        end
      when choice = ctrl_Q & \do_not_kill_connection then
        do
        choice = ''        /* Blank.  Something that is not a correct one */
        say 'Selection must be 1-7 or Escape key.  Try again...'
        end
       when choice = ctrl_Q & do_not_kill_connection then
        do
        say 'Quitting Yarndial...'
        do_not_kill = 1
        signal goodbye
        end
      when pos(choice, '1234567') = 0 & \do_not_kill_connection then
        do
        say ''
        say 'Selection must be 1-7 or Escape key.  Try again...'
        say ''
        end
      when pos(choice, '1234567') = 0,
        & do_not_kill_connection,
        & pos(choice, dnk_string) = 0 then
        do
        say ''
        say 'Not an allowable selection, try again...'
        say ''
        end
      when pos(choice, '1234567') = 0,
        & pos(choice, dnk_string) \=0  then
        do
           do_not_kill = 1
           if choice = dnk.1 then choice = 1
           if choice = dnk.2 then choice = 2
           if choice = dnk.3 then choice = 3
           if choice = dnk.4 then choice = 4
           if choice = dnk.5 then choice = 5
           if choice = dnk.6 then choice = 6
           if choice = dnk.7 then choice = 7
        end
      otherwise NOP
   end        /* of Select */
   dnk_alert = ''
   if do_not_kill = 1 then dnk_alert = '  (connection will stay up when finished)'
   say ''
   say ' Menu Selection: ' choice dnk_alert
   say ''
end        /* of Do Until Pos(choice, '1234567' || Escape) */
RETURN

/*
===================
analyze_choose()
CHOOSE is the command-line argument (or arguments).
CHOOSE can be the value of choice we would make
after being prompted from main_menu()
===================
*/
analyze_choose:
remote = 0
   select
      when strip(choose, 'B') = '' then NOP        /* blank? Then just normal operation */
      when pos(choose, '12345') = 0 & \do_not_kill_connection then
        do
           selection = '"Menu" selection(' choose '=' c2x(choose) || 'hex) invalid.  Terminating YarnDial.'
           say selection
        end
      when pos(choose,  '12345' || dnk.1 || dnk.2 || dnk.3 || dnk.4 || dnk.5) = 0,
        & do_not_kill_connection then
        do
           selection = '"Menu" selection(' choose '=' c2x(choose) || 'hex) invalid.  Terminating YarnDial.'
           say selection
        end
      when pos(choose, '12345') \= 0,
        & length(choose) = 1 & \do_not_kill_connection then
        do
           choice = choose
           remote = 1
        end
      when pos(choose, '12345') \= 0,
        & length(choose) = 1 & do_not_kill_connection then
        do
           choice = choose
           remote = 1
        end
      when pos(choose, dnk.1 || dnk.2 || dnk.3 || dnk.4 || dnk.5) \= 0,
        & length(choose) = 1 & do_not_kill_connection then
        do
           do_not_kill = 1
           choice = choose
           if choice = dnk.1 then choice = 1
           if choice = dnk.2 then choice = 2
           if choice = dnk.3 then choice = 3
           if choice = dnk.4 then choice = 4
           if choice = dnk.5 then choice = 5
           remote = 1
        end
      otherwise NOP
   end        /* of Select */

   dnk_alert = ''
   if override_dnk_during_remote & remote then do_not_kill = 0        /*override to kill conn. */
   if do_not_kill = 1 then dnk_alert = '  (connection will stay up when finished)'
RETURN

/*
====================
This is the menu that comes up after we have made
one-time-only changes (i.e., for this session only) to the
souper command-line options after selecting 7 from  main_menu().

The selections: 1-5, are the same exact functional operation as
from selecting 1-5 on main_menu().
====================
*/
menu2:
   say ''
   say '   Any changed option settings are in force for this session only.'
   say ''
   say 'Press:'
   say '1  Only import Mail'
   say '2  Only import News Articles'
   say '3  Only import, but both Mail AND News'
   say '4  Only export (send Mail, Posts, Replies, and Follow-ups)'
   say '5  Everything: Get mail and news AND send Posts, Replies, and Follow-ups'
   say 'Pressing Esc key exits now.  Enter Selection:'

do until pos(choice, '12345') \= 0
   choice = SysGetKey('NOECHO')
   select
      when choice = Escape then signal goodbye
      when pos(choice, '12345') = 0 then
        do
           say ''
           say 'Selection' choice || '.  Must be 1-5 or Escape key.  Try again...'
           say ''
        end
      otherwise NOP
   end
   say ''
   say 'Selection: ' choice
   say ''
end
RETURN choice

/*
=========================================================
dialup_server()

Starts dialers.  As dialer is starting up and logging in,
wait_for_interface() starts a timed wait.  When we connect,
the wait_for_interface() senses a new ppp, slip, etc.
interface by interpreting the output of netstat.exe run with the -r
option, and this subroutine ends. If we time out, the
wait_for_interface() senses that and we exit YARNDIAL.

We start by reassigning some variables depending upon the
connection_type, then we start the actual dialup.

The dial variable was assigned 0 or 1 in the get_current_connection()
subroutine.  If dial=1 we must dial, if dial=0, we were connected to
the right provider already and do not dial.

=========================================================
*/
dialup_server:
/*
=============
connection_type 1 is for IAK Dialer only
=============
*/
if connection_type = 1 then        /* IAK Dialer only */
   do
      say 'Connecting to IBM/IGN/Advantis via the IAK Dialer...'
      if dial then
        do
        dialing_msg = login_ID.1 'dialing' account '<password> via use of IAK Dialer'
        say dialing_msg
        end
   end        /* if connection_type = 1 */

if pos(connection_type, '34') \= 0 then
   do
      if dial then
        do
        if connection_type = 3 then dialing_msg = 'Dialing with a PPP.EXE or SLIP.EXE dialup string'
        if connection_type = 4 then dialing_msg = 'Dialing' host_app 'with' alt_dialer_exe
        say dialing_msg
        end
   end    /* if connection_type 3 or 4 */

/*
=============
For connection_type 6 (especially), but also for
5 and 7, we are a bit more flexible about where
some parms we need may be found in YD_PARMS.DAT
=============
*/
if pos(connection_type, '567') \= 0 then
   do
      if connection_type = 5 then
        do
           dialing_msg = 'YD_PARMS.DAT was manually configured: Dialing with',
        || crlf || 'dialup_string in YD_PARMS.DAT...'
           say dialing_msg
        end

      if connection_type = 6 then
        do
           say 'Will not attempt to validate vs. parameters in YD_PARMS.DAT'
           dialing_msg = 'Trying to use any currently established connection...'
           say dialing_msg
        end

      if connection_type = 7 then
        do
           say 'Will not attempt to validate vs. parameters in YD_PARMS.DAT'
           say 'Dialing with dialup_string in YD_PARMS.DAT...'
        end
   end        /* if connection_type 5, 6 or 7 */

/*
===================
Dial up.
Unless we are connection_type 6, we wait for
sl0 or ppp0 interface before going on to get/send
mail or news.  Or if we time out after 'wait'
seconds, we exit
===================
*/
if connection_type = 1 & dial then
   do
     call make_if_list
     interpret dialup_string

 /* 'wait' = seconds to wait for a connect */
      call wait_for_interface wait, 0
      if \found_interface then
        do
           timeout = 1
           say ''
           say 'Dialer timed out.  Exiting...'
           call time 'R'  /* No connection.  We zero the elapsed-time clock */
           t = 0
           if local_error_trapping then signal on error
           signal goodbye
        end
    end

if pos(connection_type, '3457') \=0 & dial then
   do
      call make_if_list
      interpret dialup_string
      call wait_for_interface wait, 0
      if \found_interface then
        do
           timeout = 1
           say ''
           say 'Dialer timed out.  Exiting...'
           call time 'R'
           t = 0
           if local_error_trapping then signal on error
           signal goodbye
        end
   end
RETURN

/*
============================
import_mail()
import_news()
exporter()
catchup_on_news()

These four routines are the ones which call SOUPER.EXE
or VSOUP.EXE

Vs_auth_string_login.k = [login_ID.k[:pwd.k]@]
Vs_auth_string_pop.k = [pop_ID.k[:pop_pwd.k]@]
(the square brackets embrace optional parameters) are
the VSoup authorization strings for use of either the
Login_ID and PWD, or the POP_ID and POP_PWD.
============================
*/

import_mail:
x = directory(mail_incoming_dir.k)        /* Change to this directory */
/* Set or reset the NNTPSERVER environment variable to default_news */
      x = value('NNTPSERVER', default_news.k, 'OS2ENVIRONMENT')

say 'Importing mail from' popsrvr.k

areas_file = mail_incoming_dir.k || '\areas'
msgs_file = mail_incoming_dir.k || '\*.msg'

signal off error
signal off failure

/* Go and retrieve the mail.  Souper and VSoup generate
an areas file and a series of *.msg files */
if \vsoup then
   do
      if getmail_autho.k = 1 then
        souper_exe souper_getmail_std_options souper_getmail_xtra_options popsrvr.k pop_id.k pop_pwd.k
      if getmail_autho.k = 2 then
        souper_exe souper_getmail_std_options souper_getmail_xtra_options popsrvr.k login_ID.k pwd.k
      if getmail_autho.k = 3 then
        souper_exe souper_getmail_std_options souper_getmail_xtra_options popsrvr.k
   end
else
   do
      if remote then call add_hyphenM_to_vsoup_options  /* Serves as a kind of log */

      if getmail_autho.k = 1 then
        vsoup_exe vsoup_getmail_std_options vsoup_getmail_xtra_options ,
        'pop3://' || Vs_auth_string_pop.k || popsrvr.k

      if getmail_autho.k = 2 then
        vsoup_exe vsoup_getmail_std_options vsoup_getmail_xtra_options ,
        'pop3://' || Vs_auth_string_login.k || popsrvr.k

      if getmail_autho.k = 3 then
        vsoup_exe vsoup_getmail_std_options vsoup_getmail_xtra_options ,
        'pop3://' || popsrvr.k
   end
if file_is_there(areas_file) & file_is_there(msgs_file) then
   zip_exe 'soup.zip areas *.msg 2>&1>nul'        /* zip only if file(s) there to be zipped */

/* Now back up that soup.zip, up to two levels of backup (if such backup is selected) */
if make_mail_soupzip_backup & stream('soup.zip', 'c', 'query exists') \= '' then
   do
      if stream('soup.zik', 'c', 'query exists') \= '' then
        'copy soup.zik soup.zkk 2>&1>nul'
      if stream('soup.zip', 'c', 'query exists') \= '' then
        'copy soup.zip soup.zik 2>&1>nul'
   end

/* Import the soup.zip into YARN */
if stream('soup.zip', 'c', 'query exists') \= '' then import_exe 'soup.zip'

if local_error_trapping then signal on error
if local_error_trapping then signal on failure
say ''
RETURN


import_news:
x = directory(news_incoming_dir.k)
x = value('NNTPSERVER', default_news.k, 'OS2ENVIRONMENT')
say 'Importing news from' default_news.k

areas_file = news_incoming_dir.k || '\areas'
msgs_file = news_incoming_dir.k || '\*.msg'

signal off error
signal off failure
if \vsoup then
    do
      if getnews_autho.k = 1 then
        souper_exe souper_getnews_std_options souper_getnews_xtra_options default_news.k pop_id.k pop_pwd.k
      if getnews_autho.k = 2 then
        souper_exe souper_getnews_std_options souper_getnews_xtra_options default_news.k login_ID.k pwd.k
      if getnews_autho.k = 3 then
        souper_exe souper_getnews_std_options souper_getnews_xtra_options default_news.k
   end
else
   do
      if remote then add_hyphenM_to_vsoup_options  /* Serves as a kind of log */
      if getnews_autho.k = 1 then
        vsoup_exe vsoup_getnews_std_options vsoup_getnews_xtra_options ,
        'nntp://' || Vs_auth_string_pop.k || default_news.k

      if getnews_autho.k = 2 then
        vsoup_exe vsoup_getnews_std_options vsoup_getnews_xtra_options ,
        'nntp://' || Vs_auth_string_login.k || default_news.k

      if getnews_autho.k = 3 then
        vsoup_exe vsoup_getnews_std_options vsoup_getnews_xtra_options ,
        'nntp://' || default_news.k
   end

if file_is_there(areas_file) & file_is_there(msgs_file) then
   zip_exe 'soup.zip areas *.msg  2>&1>nul'

/* Now back up that soup.zip, up to two levels of backup (if such backup is selected) */
if make_news_soupzip_backup & stream('soup.zip', 'c', 'query exists') \= '' then
   do
      if stream('soup.zik', 'c', 'query exists') \= '' then
        'copy soup.zik soup.zkk 2>&1>nul'
     if stream('soup.zip', 'c', 'query exists') \= '' then
        'copy soup.zip soup.zik 2>&1>nul'
   end


if stream('soup.zip', 'c', 'query exists') \= '' then import_exe 'soup.zip'

if local_error_trapping then signal on error
if local_error_trapping then signal on failure
say ''
RETURN

exporter:
say 'Exporting posts, replies, follow-ups to' mail_gw.1
/* if a reply-packet exists, send mail */
if stream(reply_packet, 'c', 'query exists') \= '' then
   do
      /* Change to outgoing drive and directory */
      x = directory(yarn_outgoing_dir)
      x = value('NNTPSERVER', default_news.1, 'OS2ENVIRONMENT')
      'copy' reply_packet rpname || '.BAK>nul'
      unzip_exe reply_packet
      signal off error
      signal off failure
      if \vsoup then
        do
        if send_autho.1 = 1 then
        souper_exe souper_send_std_options souper_send_xtra_options mail_gw.1 pop_id.1 pop_pwd.1
        if send_autho.1 = 2 then
        souper_exe souper_send_std_options souper_send_xtra_options mail_gw.1 login_ID.1 pwd.1
        if send_autho.1 = 3 then
        souper_exe souper_send_std_options souper_send_xtra_options mail_gw.1
        end
      else
        do
           if remote then add_hyphenM_to_vsoup_options
             /* Serves as a kind of log */
           if send_autho.1 = 1 then
           vsoup_exe vsoup_send_std_options vsoup_send_xtra_options ,
        'smtp://' || Vs_auth_string_pop.1 || mail_gw.1

           if send_autho.1 = 2 then
           vsoup_exe vsoup_send_std_options vsoup_send_xtra_options ,
        'smtp://' || Vs_auth_string_login.1 || mail_gw.1

           if send_autho.1 = 3 then
           vsoup_exe vsoup_send_std_options vsoup_send_xtra_options ,
        'smtp://' || mail_gw.1

        end
      'erase' reply_packet
   end
else        /* tell us nothing waiting to be sent */
   do
      replies_zip = 0
      say ''
      say reply_packet 'not found (no replies are waiting to be sent).'
   end

if local_error_trapping then signal on error
if local_error_trapping then signal on failure
RETURN

/*
================
catchup_on_news()

Communicates with news server to determine how many articles are unread,
and updates the NEWSRC file in the HOME directory to leave as "unread"
the number "How_Many" of yet-to-be downloaded  articles
================
*/
catchup_on_news:
x = directory(news_incoming_dir.k)
say ''
say 'Communicating with news server' default_news.k
say 'to update our NEWSRC...'
if \vsoup then
   do
      if getnews_autho.k = 1 then
        souper_exe '-c' || How_Many default_news.k pop_id.k pop_pwd.k
      if getnews_autho.k = 2 then
        souper_exe '-c' || How_Many default_news.k login_ID.k pwd.k
      if getnews_autho.k = 3 then
        souper_exe '-c' || How_Many default_news.k
   end
else
   do
      if remote then add_hyphenM_to_vsoup_options  /* Serves as a kind of log */
      if getnews_autho.k = 1 then
        vsoup_exe '-c' || How_Many 'nntp://' || Vs_auth_string_pop.k || default_news.k

      if getnews_autho.k = 2 then
        vsoup_exe '-c' || How_Many 'nntp://' || Vs_auth_string_login.k || default_news.k

      if getnews_autho.k = 3 then
        vsoup_exe '-c' || How_Many 'nntp://' || default_news.k
   end
say 'Each group in NEWSRC file caught up for all but last' How_Many 'articles'
say 'for Internet Service Provider #' || k
say 'Articles not marked as read can be retrieved in the next or a later operation.'
RETURN

/*
=====================
catch()

For catching up on news.  Sets the How_Many variable.
How_Many is number of unread news articles (max) we
retrieve from each newsgroup (all the older ones
in each newsgroup are marked as read)
=====================
*/
Catch:
How_Many = ''
call SysCls
say 'News catchup was selected'
say ''
say ''
say 'Mark every article not yet downloaded in'
say 'each newsgroup as read except for the last n articles.'
do until DataType(How_Many,'W')
   say 'Enter n (Max number to be transferred to you).'
   prompt = 'It must be a whole number  (Esc exits now):'
   say prompt
   parse value SysCurPos() with row col
   row  = row - 1
   col = length(prompt) + 2
   call SysCurPos row, col
   pull How_Many .
   if How_Many = Escape then
      do
        say 'Esc pressed, Quitting...'
        signal goodbye
      end
   if DataType(How_Many) = 0 then
      say 'Whole number only. Try Again.'
end
RETURN

/*
===================
fix_import_message()
fix_import()

if for some reason the imported mail or news files
were not zipped and/or they were not imported into
YARN repositories correctly (for example, if your
machine crashed or if you had yarn running while
SOUPER was fetching them), this option may be able
to zip into soup.zip any that were unzipped at the
time, and will process the soup.zip and import the
messages.  In case YARN's news history or spool files
might have become corrupted in the process or has
independently become corrupted, it will also (try to)
rebuild it.

If you backed-up soup.zip files, rename the back up or
recopy it to the mail or news retrieval directory, and
this routine will re-process it.

Before we do anything, though, we kill slip, ppp,
IAKdialer, etc., so we are doing whatever we do (which
takes a long time) while off-line.
=================
*/
fix_import_message:
say 'If on-line, we will get off line.  This may take several seconds...'
call kill_dialers_slip_ppp_slattach        /* Kill these and slattach, too */
        /* and in-joy if we are connection_type 4 */

say crlf || 'IMPORTING WAS INTERRUPTED? NEED TO REBUILD YARN History File?'
say ''
say 'If either you did not complete the importing of news or mail and/or'
say 'if YARN''s History File has become corrupted, we can now try to complete'
say 'the importing of mail and news and also do news file rebuilds.'
say 'The rebuild of news spool and history files may take some time...'
say ''
say 'Don''t bother with this unless'
say ' o  You think you have a problem.'
say ''
say ' o  Fetching and importing of mail and/or news was interrupted.'
say ''
say ' o  You want to restore a backed-up soup.zip file (for mail, or'
say '    for news, or for both) by copying soup.zip backups into their'
say '    respective mail or news retrieval directories, for re-import into'
say '    Yarn.  BUT BEFORE you restore the SOUP.ZIP''s, run this rebuild'
say '    once to clean up any unzipped retrieval debris.'
say ''
say 'CTRL-Q quits now without doing anything.  Any other key continues'
say 'the rebuild: '

if SysGetKey('NOECHO') = ctrl_Q then signal Goodbye
RETURN

/*
=================
Now fix the import
=================
*/
fix_import:
rebuilt = 1        /* set flag, so don't have to re-kill already-killed dialers */

signal off notready
signal off error
signal off failure
say 'Ignore any messages about not finding areas or *.msg files'
say 'to zip or about zip errors.'
say ''
/* First try reimport for mail */
x = directory(mail_incoming_dir.k)
say 'Trying to re-zip, re-import mail (dir:' mail_incoming_dir.k || ')'

areas_file = mail_incoming_dir.k || '\areas'
msgs_file = mail_incoming_dir.k || '\*.msg'

if file_is_there(areas_file) & file_is_there(msgs_file) then
   zip_exe 'soup.zip areas *.msg  2>&1>nul'
if stream('soup.zip', 'c', 'query exists') \= '' then        /* scrub import if no zipfile */
   import_exe 'soup.zip'

/* Then attempt rebuild for news */
x = directory(news_incoming_dir.k)
say 'Trying to re-zip, re-import/rebuild for news (dir:' news_incoming_dir.k        ||')'

areas_file = news_incoming_dir.k || '\areas'
msgs_file = news_incoming_dir.k || '\*.msg'

if file_is_there(areas_file) & file_is_there(msgs_file) then
   zip_exe 'soup.zip areas *.msg  2>&1>nul'
if stream('soup.zip', 'c', 'query exists') \= '' then        /* scrub import if no zipfile */
   import_exe 'soup.zip'
rebuild_exe '-s'        /*fixes spool file, rebuilds history file */
rebuild_exe '-o'        /* rebuilds history and overview files */

if local_error_trapping then signal on failure
if local_error_trapping then signal on notready
if local_error_trapping then signal on error
say ''
RETURN


/*
======================
add_hyphenM_to_vsoup_options()

-M creates status message which is stored as an incoming
e-mail.  It can serve as a logging when YARNDIAL is run
remotely, i.e, called up by a timer program.  This routine
appends -M to the vsoup options.  There is no harm done
if a -M as an option was previously configured.

This program is called only if VSoup is the program used to
communicate (send/get/post mail/news, and only if remote=1
which it will be if there is a command-line argument setting
the variable CHOOSE (corresponds to the main-menu choice
to get mail, news, etc.)  If a CHOOSE argument is detected,
the wariable remote is set to 1.
======================
*/
add_hyphenM_to_vsoup_options:
   vsoup_getmail_xtra_options = vsoup_getmail_xtra_options '-M'
   vsoup_getnews_xtra_options = vsoup_getnews_xtra_options '-M'
   vsoup_send_xtra_options = vsoup_send_xtra_options '-M'
RETURN

/*
======================
kill_dialers_slip_ppp_slattach()

kill these, and tell us about it
======================
*/

kill_dialers_slip_ppp_slattach:
say ''
if rebuilt then signal depart
if \do_not_kill then
   do
      say 'Killing dialer(s), slip.exe, ppp.exe, etc., if up...'
      call kill_all        /* next routine does the contract */
      say 'We are off-line now.'
   end
if do_not_kill then
  do
     say 'Beeping to remind you that YOU MAY STILL BE CONNECTED!'
     say 'When ready to disconnect, run LOGOFF.CMD or close down dialer.'
     call beep 1000, 200
     call beep 32767, 25  /* Too high pitched, inaudible, an improvised pause. */
     call beep 1000, 200
   end
say ''
t = time('E')        /* elapsed time, souper/vsoup processes only */
RETURN

kill_all:        /* calls to this routine kill everything quietly */
call close_down 'DIALER'
call close_down 'SLIP'
call close_down 'PPP'
call close_down 'SLATTACH'
call close_down 'SLIPPM'
call close_down 'ILINK2'
if alt_dialer \= 'DIALER',
   & alt_dialer \= 'SLIP',
   & alt_dialer \= 'PPP',
   & alt_dialer \= 'SLIPPM',
   & alt_dialer \= 'ILINK2',
   & alt_dialer \= 'IN-JOY' then
      call close_down alt_dialer
if stream(killjoy_exe, 'c', 'query exists') \= '' then
   do
      killjoy_exe
      call SysSleep 2        /* settle time */
   end
call close_down 'IN-JOY'
call SysSleep 2        /* just in case, wait a bit and re-kill */
call close_down 'DIALER'
call close_down 'SLIP'
call close_down 'PPP'
call close_down 'SLATTACH'
call close_down 'SLIPPM'
call close_down 'ILINK2'
if alt_dialer \= 'DIALER',
   & alt_dialer \= 'SLIP',
   & alt_dialer \= 'PPP',
   & alt_dialer \= 'SLIPPM',
   & alt_dialer \= 'ILINK2',
   & alt_dialer \= 'IN-JOY' then
      call close_down alt_dialer
if stream(killjoy_exe, 'c', 'query exists') \= '' then
   do
      killjoy_exe
      call SysSleep 2        /* settle time */
   end
call close_down 'IN-JOY'
if interface_removal \= 0 then
   call routings_to_hosts(interf_prefix)        /* and clear out interfaces */
RETURN


/*
=========================================
close_down(process)

Close down a process (such as slip or ppp or slippm) with
GO.EXE using the -ka option kills all instances of 'process'.
No harm done if 'process' not running  and we try to close it down.
=========================================
*/
close_down:
parse upper arg process
signal off error
go_exe '-cp' process '>NUL'        /* returns RC=1 if process is running and 0 if not */
if RC=1 & process = 'DIALER' then
   do
      call is_IAKdialer_running
      if IAKdialer_is_running then
        do
/* Only try to close this way if IAK duller is confirmed to be running */
           process '-c' /* hope IAK dialer is at least v 1.33 where -c option supported */
           call SysSleep 2 /* settle time, IAK Dialer is funny */
           say '   If this window was minimized for a few seconds: perfectly normal.'
        end
   end
/* try to shut down in-joy with IN-JOY's own killjoy.exe */
if RC=1 & process = 'IN-JOY' then
   do
      if stream(killjoy_exe, 'c', 'query exists') \= '' then killjoy_exe
      call SysSleep 2        /* settle time */
   end
go_exe '-ka' process '>NUL'  /* do a kill whether running or not */
if local_error_trapping then signal on error

RETURN

/*
=================
routings_to_hosts(interf_prefix)

Only called if interface_removal is non-zero.

Examines routing table host routes reported out by running
        netstat -r
and then
if interface_removal = 1
        and if IN-JOY is the dialer and if the interf_prefix is IN-JOY's,
        deletes that routing entry.
if interface_removal = 2
        whatever the dialer and interf_prefix deletes all routing entries.


Why do this?  IN-JOY sometimes leaves a phantom routing in the tables
and it persists, once there, when other dialers are started after
that happens.
=================
*/
routings_to_hosts:
parse arg if_prefix
if_prefix = translate(if_prefix)
ifp_length = length(if_prefix)

call rxqueue 'CREATE', queue_ydint        /* (re)create internal queue */
call rxqueue 'SET', queue_ydint        /* set internal queue */
/* do queued(); parse pull; end */        /* If there is anything in it, clear it out */

'netstat -r | rxqueue' queue_ydint        /* send output to the queue */
do queued()
   dest = ''
   rtr = ''
   interf = ''
   parse pull netstat_line
   parse var netstat_line dest rtr .
   dest = strip(dest, 'B')
   rtr = strip(rtr, 'B')
   if words(netstat_line) > 0  then
      do
         interf = word(netstat_line, words(netstat_line))
         interf = strip(interf, 'B')
      end
   else iterate
   select
/* A headings line (first word is 'destination' or 'metric')? Discard the line */
      when translate(dest) = 'DESTINATION' then iterate
      when translate(dest) = 'METRIC' then iterate

/* Blank dest or rtr? Discard the line, 'route delete' won't work */
      when dest = '' | rtr = '' then iterate

/* If interface_removal=1, IN-JOY, but not our interface,
also discard the line */
      when interface_removal = 1 & alt_dialer = 'IN-JOY',
        & translate(left(interf, ifp_length)) \= if_prefix then
        iterate

/* If interface_removal=1 and not IN-JOY,
discard the line */
      when interface_removal = 1 & alt_dialer \= 'IN-JOY' then iterate

/* Anything else, delete the routing */
      otherwise
        'route -h delete' dest rtr
   end        /* of Select */
end        /* of Do queued() */

do queued(); parse pull; end        /* If there is anything in queue, clear it out */
call rxqueue 'SET', queue_ydext        /* reset to whatever queue may have been in use before */
RETURN



/*
=====================
restore_zip()

Chance to restore zipfile if sending didn't
seem to go right
=====================
*/

restore_zip:
rpname_bak = rpname || '.BAK'
/* if we were exporting posts and replies and if there was a reply_packet */
if pos(choice, 'xxx45xx') \= 0 & timeout = 0 & replies_zip then
   do
      say '     If you got an error sending posts and replies, press'
      say '     CONTROL-R now to restore' reply_packet
      say '     for re-transmission in a later session, but do this'
      say '     only if you got an error.'
      say '     Otherwise press any other key to continue exiting.'
      if SysGetKey('NOECHO') = ctrl_R then
        if stream(rpname_bak, 'c', 'query exists') \= '' then
        do
        say 'Restoring' reply_packet
        'copy' rpname_bak reply_packet '2>&1>null'
        end
      else say 'No' rpname_bak 'to restore'
   end
RETURN

/*
================
toss_old_news()

Chance to remove old news using the expire program
===============
*/
toss_old_news:
   Prompt = 'Remove old (expired) yarn messages (Y/N)?'
   say prompt
   parse value SysCurPos() with row col
   row  = row - 1
   col = length(prompt) + 2
   call SysCurPos row, col
   if translate(SysGetKey('NOECHO')) = 'Y' then
      do
        say ''
        say 'Removing expired news' || crlf
        expire_exe '-o'        /* Remove old messages */
      end
RETURN

/*
===================
connect_stats()

How long were we on line retrieving or sending stuff?
==================
*/
connect_stats:
con_time = '   Retrieval and sending of news and/or mail took' trunc((t/60), 2) 'mins'
if t \= 0 then say con_time
RETURN



/*
===================
parms_from_ydparms_dat()

Assign parameters based on what is in YDPARMS_DAT
==================
*/
parms_from_ydparms_dat:

/* Can we find ydparms_dat file? */

home = directory()        /* Where we are executing this pgm from */
home = translate(home)

ydparms_dat = home || '\' || filespec('name', ydparms_dat)
/* All the parameters we need are in ydparms_dat.
Abort if can't locate the ydparms_dat file. Means we
never ran the installer */

if stream(ydparms_dat, 'c', 'query exists') = '' then
   do
      go_exe = home || '\' || go_exe        /* assume that's where it is */
      call beep 1000, 200
      say 'Cannot find YD_PARMS.DAT, the file containing parameters'
      say 'YARNDIAL needs in order to run.  This is normal if you have'
      say 'not yet run the installer,' ydinstl_cmd || '.'
      say ''
      say 'Aborting.  Press any key to exit.  Then run' ydinstl_cmd
      call SysGetKey 'NOECHO'
      exit
   end
/* OK, we found it.  Initialize some vars, then get parameters from YD_PARMS.DAT */
/*
do i = 1 to number_of_ISP
   isp_active.i = 0
   login_ID.i = ''
   pwd.i = ''
   pop_ID.i = ''
   pop_pwd.i = ''
   popsrvr.i = ''
   default_news.i = ''
   mail_gw.i = ''
   getmail_autho.i = 1
   getnews_autho.i = 1
   send_autho.i = 1
end
*/
say 'Please wait while parameters load and we perform our setup...'
n = find_equate_lines_in_datafile(ydparms_dat)
i = 1
number_of_ISPs = 1
/*
====================
Strip out all leading and trailing blanks and tabs
from parsed left and right sides of the equal sign.
Leave any internal ones alone
====================
*/

do until i = n
   parse var line.i parm.i '=' val.i
   parm.i = translate(parm.i)
   do until parm.i = stripped_parm.i & val.i = stripped_val.i
      stripped_parm.i = strip(parm.i, 'B')
      parm.i = strip(stripped_parm.i, 'B', tab)
      stripped_val.i = strip(val.i, 'B')
      val.i = strip(stripped_val.i, 'B', tab)
   end
   isp_parm = ''        /* clear these 2 things */
   isp_num = '0'
   parse var parm.i isp_parm '.' isp_num
   if abbrev(line.i, '#') then NOP
   else
        /* set up our variables */
      select
        when parm.i = 'HOME' then HOME = val.i
        when parm.i = 'YARN' then YARN = val.i
        when parm.i = 'CONNECTION_TYPE' then connection_type = val.i
        when parm.i = 'INTERFACE_REMOVAL' then interface_removal = val.i
        when parm.i = 'HOST_APP' then host_app = val.i
        when parm.i = 'INTERF_PREFIX' then interf_prefix = val.i
        when parm.i = 'DIALUP_STRING' then dialup_string = val.i
        when parm.i = 'DO_NOT_KILL_CONNECTION' then do_not_kill_connection = val.i
        when parm.i = 'DNK_STRING' then dnk_string = val.i
        when parm.i = 'OVERRIDE_DNK_DURING_REMOTE' then
           override_dnk_during_remote = val.i
        when parm.i = 'USER' then user = val.i
        when parm.i = 'HOST' then host = val.i
        when parm.i = 'ACCOUNT' then account = val.i
        when parm.i = 'VSOUP' then vsoup = val.i
        when parm.i = 'ZIP_EXE' then zip_exe = val.i
        when parm.i = 'UNZIP_EXE' then unzip_exe = val.i
        when parm.i = 'REPLY_PACKET' then reply_packet = val.i
        when parm.i = 'SOUPER_EXE' then souper_exe = val.i
        when parm.i = 'VSOUP_EXE' then vsoup_exe = val.i
        when parm.i = 'IMPORT_EXE' then import_exe = val.i
        when parm.i = 'EXPORT_EXE' then export_exe = val.i
        when parm.i = 'EXPIRE_EXE' then expire_exe = val.i
        when parm.i = 'REBUILD_EXE' then rebuild_exe = val.i
        when parm.i = 'KILLJOY_EXE' then killjoy_exe = val.i
        when parm.i = 'ALT_DIALER_EXE' then
           do
              alt_dialer_exe = val.i
              call parse_altdialerexe
           end
        when parm.i = 'GO_EXE' then go_exe = val.i
        when parm.i = 'SOUPER_GETMAIL_STD_OPTIONS'
        then souper_getmail_std_options = val.i
        when parm.i = 'SOUPER_GETMAIL_XTRA_OPTIONS'
        then souper_getmail_xtra_options = val.i
        when parm.i = 'SOUPER_GETNEWS_STD_OPTIONS' then
           souper_getnews_std_options = val.i
        when parm.i = 'SOUPER_GETNEWS_XTRA_OPTIONS' then
           souper_getnews_xtra_options = val.i
        when parm.i = 'SOUPER_SEND_STD_OPTIONS' then
           souper_send_std_options = val.i
        when parm.i = 'SOUPER_SEND_XTRA_OPTIONS' then
           souper_send_xtra_options = val.i
        when parm.i = 'VSOUP_GETMAIL_STD_OPTIONS' then
           vsoup_getmail_std_options = val.i
        when parm.i = 'VSOUP_GETMAIL_XTRA_OPTIONS' then
           vsoup_getmail_xtra_options = val.i
        when parm.i = 'VSOUP_GETNEWS_STD_OPTIONS' then
           vsoup_getnews_std_options = val.i
        when parm.i = 'VSOUP_GETNEWS_XTRA_OPTIONS' then
           vsoup_getnews_xtra_options = val.i
        when parm.i = 'VSOUP_SEND_STD_OPTIONS' then
           vsoup_send_std_options = val.i
        when parm.i = 'VSOUP_SEND_XTRA_OPTIONS' then
           vsoup_send_xtra_options = val.i
        when parm.i = 'WAIT' then wait = val.i
        when parm.i = 'ASK' then ASK = val.i
        when parm.i = 'IS1' then IS1 = val.i
        when parm.i = 'IS2' then IS2 = val.i
        when parm.i = 'RS1' then RS1 = val.i
        when parm.i = 'RS2' then RS2 = val.i
        when parm.i = 'FS1' then FS1 = val.i
        when parm.i = 'FS2' then FS2 = val.i
        when parm.i = 'PIN' then PIN = val.i
        when parm.i = 'PROVIDER' then PROVIDER = val.i
        when parm.i = 'SAVE_PWD' then SAVE_PWD = val.i
        when parm.i = 'PHONE_NUMBER' then PHONE_NUMBER = val.i
        when parm.i = 'HANGUP' then HANGUP = val.i
        when parm.i = 'SCRIPT' then SCRIPT = val.i
        when parm.i = 'SERVICE' then SERVICE = val.i
        when parm.i = 'YOURIP' then YOURIP = val.i
        when parm.i = 'DESTIP' then DESTIP = val.i
        when parm.i = 'NETMASK' then NETMASK = val.i
        when parm.i = 'MTU_SIZE' then MTU_SIZE = val.i
        when parm.i = 'VJ_COMP' then VJ_COMP = val.i
        when parm.i = 'PRIMARY_INF' then PRIMARY_INF = val.i
        when parm.i = 'HOSTNAME' then HOSTNAME = val.i
        when parm.i = 'DOMAIN_NAME' then DOMAIN_NAME = val.i
        when parm.i = 'DNS' then DNS = val.i
        when parm.i = 'DNS2' then DNS2 = val.i
        when parm.i = 'DEFAULT_WWW' then DEFAULT_WWW = val.i
        when parm.i = 'DEFAULT_GOPHER' then DEFAULT_GOPHER = val.i
        when parm.i = 'REPLY_DOMAIN' then REPLY_DOMAIN = val.i
        when parm.i = 'REPLY_ID' then REPLY_ID = val.i
        when parm.i = 'MODEM_TYPE' then MODEM_TYPE = val.i
        when parm.i = 'COMPORT' then COMPORT = val.i
        when parm.i = 'BAUD' then BAUD = val.i
        when parm.i = 'DATABITS' then DATABITS = val.i
        when parm.i = 'PARITY' then PARITY = val.i
        when parm.i = 'DIAL_MODE' then DIAL_MODE = val.i
        when parm.i = 'PREFIX' then PREFIX = val.i
        when parm.i = 'PREFIX_ANS' then PREFIX_ANS = val.i
        when parm.i = 'INIT' then INIT = val.i
        when parm.i = 'INIT2' then INIT2 = val.i
        when parm.i = 'DISABLE' then DISABLE = val.i
        when parm.i = 'DISABLE_SEQ' then DISABLE_SEQ = val.i
        when parm.i = 'DIAL_PREFIX' then DIAL_PREFIX = val.i
        when parm.i = 'AUTOSTART' then AUTOSTART = val.i
        when parm.i = 'TOTAL_CONNECT' then TOTAL_CONNECT = val.i
        when isp_parm = 'ISP_ACTIVE' then
           do        /* check for a syntax error */
              ISP_ACTIVE.isp_num = val.i
              if  \DataType(isp_num,'W') then
                 do
                    call beep 1000, 200
                    say ''
                    say 'Fatal Error in' ydparms_dat
                    say parm.i 'found.'
                    say 'The index X in ISP_ACTIVE.X must be an integer.'
                    say 'Aborting.  Edit' ydparms_dat 'to correct.'
                    signal goodbye
                 end
              if val.i \= 1 & val.i \= 0 then
                 do
                    call beep 1000, 200
                    say ''
                    say 'Fatal Error in' ydparms_dat
                    say parm.i 'must be set equal either to 0 or 1'
                    if val.i = '' then say parm.i 'is now blank.'
                    if pos(val.i, 'oO') \= 0 then
                    say '      (the letter ''O'')'
                    say 'Aborting.  Edit' ydparms_dat 'to correct.'
                    signal goodbye
                 end
              if isp_num > number_of_ISPs then
                 number_of_ISPs = isp_num        /* counts up the ISP's */
           end
        when isp_parm = 'LOGIN_ID' then login_ID.isp_num = val.i
        when isp_parm = 'PWD' then pwd.isp_num = val.i
        when isp_parm = 'ENCR_PWD' then encr_pwd.isp_num = val.i
        when isp_parm = 'POP_ID' then pop_ID.isp_num = val.i
        when isp_parm = 'POP_PWD' then pop_pwd.isp_num = val.i
        when isp_parm = 'ENCR_POP_PWD' then encr_pop_pwd.isp_num = val.i
        when isp_parm = 'POPSRVR' then popsrvr.isp_num = val.i
        when isp_parm = 'DEFAULT_NEWS' then default_news.isp_num = val.i
        when isp_parm = 'MAIL_GW' then mail_gw.isp_num = val.i
        when isp_parm = 'GETMAIL_AUTHO' then getmail_autho.isp_num = val.i
        when isp_parm = 'GETNEWS_AUTHO' then getnews_autho.isp_num = val.i
        when isp_parm = 'SEND_AUTHO' then send_autho.isp_num = val.i
        otherwise NOP
      end    /* select */
   i = i + 1
end   /* do until...*/

/* So now we've gotten everything.  Process some of it */

do i = 1 to number_of_ISPs        /* if no servers, assume the isp is inactive */
   if popsrvr.i = '' & default_news.i = '' then isp_active.i = 0
   if pos(getnews_autho.i, '123') \= 0 then getnews_autho.i = 1
   if pos(getmail_autho.i, '123') \= 0 then getmail_autho.i = 1
end

/* Translation Table to decode the passwords */

o21 = '&\<=>|()! *+"''-/,#$%.0123456789:;?'
o22 = '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^'
o23 = '_`abcdefghijklmnopqrstuvwxyz{}~'
e21 = '&\<=>|()u *+"''-/,MI$kUHgW[_A5%w~Fh'
e22 = 't?K^l0jJP{98xBadb1nZimRyY]4}`o'
e23 = 'E;67V@vS:C.sNGzcefQpqTr!2#XDLO3'

do i = 1 to number_of_ISPs
/* These next 2 lines have the effect of ignoring whatever was found as
an encrypted password if an un-encrypted one was found.  In other
words, if both were in the YD_PARMS.DAT file, the UN-ENCRYPTED
password is given precedence (easier to enter, change, etc.). */
   if pop_pwd.i = '' then
      pop_pwd.i = translate(encr_pop_pwd.i, e21||e22||e23, o21||o22||o23)

   if pwd.i = '' then
      pwd.i = translate(encr_pwd.i, e21||e22||e23, o21||o22||o23)
end

/* These do more parameter massaging */
call parse_DNKstring
call build_vsoup_auth_strings

RETURN

/*
============
parse_DNKstring()

DO NOT KILL OPTION
If the DO_NOT_KILL_CONNECTION parameter in YD_PARMS.DAT =1
we can have the option come up in the main menu to kill or not
to kill the connection when YARNDIAL finishes.  If it is zero,
we always kill the connection at the end.

dnk.1 thru .7 are the "do-not-kill" alternatives to
1-7 and on the main menu.  If do_not_kill is enabled (=1)
you can execute the same functions as 1-7 but dialers, slip,
etc. are not shut down when done.

We parse the dnk_string to the 7 individual dnk.i alternate chars.
============
*/
parse_DNKstring:
/* Was there an erroneous value for do_not_kill_connection?  If so, set to 0 */
if pos(do_not_kill_connection, '01') = 0 then do_not_kill_connection = 0

/* Parse the string into individual characters, unless there was no string */
if length(dnk_string) > 7 then dnk(string) = left(dnk_string, 7)
if dnk_string \= '' then
   do i = 1 to length(dnk_string)
      if substr(dnk_string, i, 1) \= '' & substr(dnk_string, i, 1) \= ' ' then
        dnk.i = substr(dnk_string, i, 1)
      else dnk.i = i

      if i = 6 then dnk.i = '6'
   end
/* now reconstruct the dnk_string */
dnk_string = dnk.1 || dnk.2 || dnk.3 || dnk.4 || dnk.5 || dnk.6 || dnk.7


RETURN

/*
==================
parse_altdialerexe()

Get alt_dialer_exe filename.  Strip path, "." and extension,
and also strip any options that may have been entered.
alt_dialer_exe stores the name of the dialer executable.
==================
*/
parse_altdialerexe:
parse var alt_dialer_exe alt_dialer_name alt_dialer_options        /* strip options */
alt_dialer_name = translate(alt_dialer_name)        /* upper case */
alt_dialer_name = filespec('name', alt_dialer_name)        /* eliminate drive and path */
parse var alt_dialer_name alt_dialer '.' ext        /*...and extension */


/*  (Re)set HOME and YARN environmental
variables, and set EMXOPT to 40 file handles */
x = SetLocal()
x = value('home', home, 'OS2ENVIRONMENT')
x = value('yarn', yarn, 'OS2ENVIRONMENT')

emx_env = '-h40 -c -n'
x = value('emxopt', EMX_ENV, 'OS2ENVIRONMENT')
RETURN

/*
===========
build_vsoup_auth_strings()

Construct the VSoup authorization strings for use of either the
Login_ID and PWD and the POP_ID and POP_PWD.

Vs_auth_string_login.k = [login_ID.k[:pwd.k]@]
Vs_auth_string_pop.k = [pop_ID.k[:pop_pwd.k]@]
where the square brackets embrace optional parameters.

These are used in a format such as
   pop3://[pop_ID.k[:pop_pwd.k]@]pop3-host.k
or    pop3:// || Vs_auth_string_pop.k|| pop3-host.k
==========
*/
build_vsoup_auth_strings:
do k = 1 to number_of_ISPs
   if login_ID.k = '' & pwd.k = '' then
      Vs_auth_string_login.k = ''
   if login_ID.k \= '' & pwd.k = '' then
      Vs_auth_string_login.k = login_ID.k || '@'
   if login_ID.k = '' & pwd.k \= '' then
      Vs_auth_string_login.k = ':' || pwd.k || '@'
   if login_ID.k \= '' & pwd.k \= '' then
      Vs_auth_string_login.k =  login_ID.k || ':' || pwd.k || '@'

   if pop_ID.k = '' & pop_pwd.k = '' then
      Vs_auth_string_pop.k = ''
   if pop_ID.k \= '' & pop_pwd.k = '' then
      Vs_auth_string_pop.k = pop_ID.k || '@'
   if pop_ID.k = '' & pwd.k \= '' then
      Vs_auth_string_pop.k = ':' || pop_pwd.k || '@'
   if pop_ID.k \= '' & pwd.k \= '' then
      Vs_auth_string_pop.k =  pop_ID.k || ':' || pop_pwd.k || '@'
end
RETURN

/*
======================
find_equate_lines_in_datafile()

Called by parms_from_ydparms_dat()
The dat file is set up to use a # as the first char on a dataline
to indicate that the line is a comment line, and to use a
backslash ('\') as the final character on a dataline to
mean the line is continued on the line following.  First
we reconstitute those lines that have continuations,
then we search through those lines for an '=' sign as
other than the first character.  We eliminate from
consideration any line with a '#' as the first character
as that signifies the line is a comment line.
======================
*/
find_equate_lines_in_datafile:
arg filename
n = 1
do while lines(filename) > 0
   data_line.n = linein(filename)
   select
      when right(data_line.n, 1) = '\' then        /* concatenating continuations */
        do until right(data_line.n, 1) \= '\'
        data_line_n_with_right_slash_stripped =,
        strip(right(data_line.n,1), 'T', '\')
        next_data_line = linein(filename)
        data_line.n = data_line_n_with_right_slash_stripped || next_data_line
        end

/* only lines without a leading # and with an = qualify */
      when pos('=', data_line.n) > 0 & \abbrev(data_line.n, '#') then
        do
        line.n = data_line.n
        n = n + 1
        end
      otherwise NOP
   end
end
RETURN n

/*
====================
souper_options()

Chance to modify the souper options on a
one-time-only basis
====================
*/
souper_options:
call SysCls
souper_getnews_xtra_options = '' /* the defaults */
souper_getmail_xtra_options = ''
souper_send_xtra_options = ''
vsoup_getnews_xtra_options = ''
vsoup_getmail_xtra_options = ''
vsoup_send_xtra_options = ''
option1 = ''
option2 = ''
option3 = ''
option4 = ''

say ''
say 'SOUPER OPTIONS SCREEN'
say 'You can select these as one-time-only options when souper runs.'
do until opts = 6
   say ''
   say 'Press:'
   say '  1 Set maximum news packetsize (default is 2048KB [2.048MB])'
   say '  2 Do not retrieve newsgroup articles containing more than set'
   say '    number of lines in the body (default is: no limit)'
   say '    You get to set the number of lines.'
   say '  3 Do catchup on news.  Mark all as read except last m unread'
   say '    news articles in each group.  You set m.'
   say '  4 For mail: read-only.  Do not empty POP3 mailbox or update NEWSRC file'
   say '  5 Default all four of the above.'
   say '  6 DONE.  (MUST press 6 to exit this screen)'
   do until pos(opts,'123456') \= 0
      say ''
      prompt = 'Select 1-6:'
      say prompt
        parse value SysCurPos() with row col
        row  = row - 1
        col = length(prompt) + 2
        call SysCurPos row, col
      opts = SysGetKey('NOECHO')
      say ''
   end
   select
      when opts = 1 then call max_news_packet
      when opts = 2 then call max_news_lines
      when opts = 3 then
        do
        say ''
        say ''
        say ''
        call catch
        do_catchup_on_news = 1
        say 'All but' How_Many 'articles (each group) max. will be marked read.'
        end
      when opts = 4 then call read_only_getmail_mode
      when opts = 5 then
        do
        option1 = ''
        option2 = ''
        option3 = ''
        option4 = ''
        choice = 7        /* go back with same value for choice as we came with */
        say ''
        say 'Accepting defaults for all three options'
        say ''
        say ''
        say 'Press any key to continue'
        call SysGetKey 'NOECHO'
        end
      otherwise NOP
   end
end

souper_getnews_xtra_options = strip(souper_getnews_xtra_options, 'B')
souper_getnews_xtra_options = souper_getnews_xtra_options option1
souper_getnews_xtra_options = strip(souper_getnews_xtra_options, 'B')
souper_getnews_xtra_options = souper_getnews_xtra_options option2
souper_getnews_xtra_options = strip(souper_getnews_xtra_options, 'B')
souper_getnews_xtra_options = souper_getnews_xtra_options option3
souper_getnews_xtra_options = strip(souper_getnews_xtra_options, 'B')

souper_getmail_xtra_options = strip(souper_getmail_xtra_options, 'B')
souper_getmail_xtra_options = souper_getmail_xtra_options option4
souper_getmail_xtra_options = strip(souper_getmail_xtra_options, 'B')

vsoup_getnews_xtra_options = strip(vsoup_getnews_xtra_options, 'B')
vsoup_getnews_xtra_options = vsoup_getnews_xtra_options option1
vsoup_getnews_xtra_options = strip(vsoup_getnews_xtra_options, 'B')
vsoup_getnews_xtra_options = vsoup_getnews_xtra_options option2
vsoup_getnews_xtra_options = strip(vsoup_getnews_xtra_options, 'B')
vsoup_getnews_xtra_options = vsoup_getnews_xtra_options option3
vsoup_getnews_xtra_options = strip(vsoup_getnews_xtra_options, 'B')

vsoup_getmail_xtra_options = strip(vsoup_getmail_xtra_options, 'B')
vsoup_getmail_xtra_options = vsoup_getmail_xtra_options option4
vsoup_getmail_xtra_options = strip(vsoup_getmail_xtra_options, 'B')

say ''
say 'Final Souper command-line option settings now are:'
say 'GETNEWS souper.exe options:' souper_getnews_std_options souper_getnews_xtra_options
say 'GETMAIL souper.exe options:' souper_getmail_std_options souper_getmail_xtra_options
say 'SENDING souper.exe options:' souper_send_std_options souper_send_xtra_options
say ''
say '...or for vsoup:'
say 'GETNEWS vsoup.exe options:' vsoup_getnews_std_options vsoup_getnews_xtra_options
say 'GETMAIL vsoup.exe options:' vsoup_getmail_std_options vsoup_getmail_xtra_options
say 'SENDING vsoup.exe options:' vsoup_send_std_options vsoup_send_xtra_options
say ''
say 'Press any key to continue'
call SysGetKey 'NOECHO'

if do_catchup_on_news then
do
   k = 1
   call catchup_on_news   /* do the catchup right now! */

   if number_of_ISPs > 1 then
      do k = 2 to number_of_ISPs
         if isp_active.k = 0 then iterate
         if default_news.k = 0 then iterate
         call beep 1000, 200
         say ''
         say 'Do catchup on other newsservers (Y/N)?'
         if \remote then
            do
               continue = SysGetKey('NOECHO')
               if pos(continue, 'yY') \= 0 then leave
            end
         x = value('NNTPSERVER', default_news.k, 'OS2ENVIRONMENT')
         call catchup_on_news
      end
   end
RETURN


max_news_packet:
     do until datatype(option1, 'W')
        call SysCls
        say ''
        say 'Enter a number in kilobytes for maximum news packet size.'
        say '2048 is typical. 0 sets packet size to unlimited.'
        say ''
        prompt = 'Enter number of kilobytes now:'
        say prompt
        parse value SysCurPos() with row col
        row  = row - 1
        col = length(prompt) + 2
        call SysCurPos row, col
        pull option1
        if \DataType(option1, 'W') then say 'Must be whole number or zero.'
     end
     say ''
     say 'Maximum packet size for news is set to' option1 'kilobytes'
     option1 = '-k' option1
     say ''
     say ''
     say 'Press any key to continue'
     call SysGetKey 'NOECHO'
RETURN

max_news_lines:
      call SysCls
      do until datatype(option2, 'W')
        say ''
        say 'Do not retrieve articles with more than this many lines'
        say 'in the body of the article.  Enter 0 for unlimited (the'
        say 'usual default for souper).'
        say ''
        prompt = 'Enter maximum lines:'
        say prompt
        parse value SysCurPos() with row col
        row  = row - 1
        col = length(prompt) + 2
        call SysCurPos row, col
        pull option2
        if \DataType(option2, 'W') then say 'Must be whole number or zero.'
     end
     say ''
     say 'Reject newsgroup articles with more than' option2 'lines in body.'
     if option2 = 0 then option2 = ''
        else option2 = '-l' option2
     say ''
     say ''
     say 'Press any key to continue'
     call SysGetKey 'NOECHO'
RETURN

read_only_getmail_mode:
      call SysCls
      do until pos(option4, 'YN') \=0
        say ''
        say 'For mail: You can set to read-only.  Retrieves mail but'
        say 'does not empty POP3 mailbox.'
        say ''
        say 'Set to Read-Only Mode?'
        prompt = 'Y sets Read-Only mode, N (normal default) doesn''t:'
        say prompt
        parse value SysCurPos() with row col
        row  = row - 1
        col = length(prompt) + 2
        call SysCurPos row, col
        pull option4
     end
     if option4 ='Y' then
        do
        say 'Read-Only mode set'
        option4 = '-r'
        end
     else
        do
        say 'Regular (not Read-Only) mode set'
        option4 = ''
        end
     say ''
     say ''
     say 'Press any key to continue'
     call SysGetKey 'NOECHO'
RETURN


/*
==============================================
are_there_interfaces_up()

Checks for active router interfaces.  We look specifically
for an interface with the same characters in interf_prefix
(or at least, for its forst n characters where n=length of
interf_prefix).  Returns ifprefix_interf_up=1 if found.

Then, whatever the prefix, checks whether any interface(s)
are up whether its prefix is interf_prefix, sl, ppp, slip,
lan, l, or whatever.  Returns some_interf_up=1 if found.

We obliterate upper/lower case distinctions in the prefix.
i.e., ppp is the same as PPP.
==============================================
*/

are_there_interfaces_up:
if_prefix = translate(interf_prefix)

some_interf_up = 0
ifprefix_interf_up = 0
some_interf_up = 0
dest = ''
interface = ''

call rxqueue 'CREATE', queue_ydint        /* (re)create internal queue */
call rxqueue 'SET', queue_ydint        /* set internal queue */
/* do queued(); parse pull; end */        /* If there is anything in it, clear it out */

netstat_line = ''
'netstat -r | rxqueue /LIFO' queue_ydint        /* send output to the queue */
do queued()
   pull netstat_line /* interface may be last word */
   dest = word(netstat_line, 1)
   dest = strip(dest, 'B')
   if dest = 'DESTINATION' then iterate /* line is a heading line, discard */
   if dest = 'METRIC' then iterate /* line is a heading line, discard */
   if words(netstat_line) > 0 then
      do
         interface = word(netstat_line, words(netstat_line))
         if left(interface, length(interf_prefix)) = if_prefix then
            ifprefix_interf_up = 1
         if interface \= '' then some_interf_up = 1      /* anything */
      end
   else iterate
end

do queued(); parse pull; end        /* If there is anything in queue, clear it out */
call rxqueue 'SET', queue_ydext        /* reset to whatever queue may have been in use before */
RETURN

/*
=====================
make_if_list()

Creates a string of all router interfaces detected,
with spaces as separators.  The interfaces are
translated to upper case before being recorded in the string.


possible examples of what an if _list will look like:
if_list = 'PPP3 PPP1 SL0'
if_list = ''        (none detected)
if_list = 'SL0'

if_list  includes all interface types; they can be mixed

make_if_list() returns the list (as a string, if_list)
We obliterate upper/lower case distinctions:  i.e., ppp
becomes PPP.
=====================
*/
make_if_list:

if_list = ''
dest = ''
interface = ''

call rxqueue 'CREATE', queue_ydint        /* (re)create internal queue */
call rxqueue 'SET', queue_ydint        /* set internal queue */
/* do queued(); parse pull; end */        /* If there is anything in it, clear it out */

'netstat -r | rxqueue /LIFO' queue_ydint        /* send output to the queue */
do queued()
   pull netstat_line /* interface may be last word */
      if words(netstat_line) > 0 then
         do
            interface = word(netstat_line, words(netstat_line))
            dest = word(netstat_line, 1)
            dest = strip(dest, 'B')
            if dest = 'DESTINATION' then iterate /* line is the heading line, discard */
            if dest = 'METRIC' then iterate /* line is the heading line, discard */
/* if interface is not in the list, add it */
            if pos(interface, if_list) = 0 then if_list = if_list interface
         end
      else iterate
end

do queued(); parse pull; end        /* If there is anything in queue, clear it out */
call rxqueue 'SET', queue_ydext        /* reset to whatever queue may have been in use before */
RETURN if_list

/*
==============================================
wait_for_interface()

Waits for a new interface to become active, which is
deduced from comparison of interface(s) returned by NETSTAT.EXE -r
to the string prepared before starting the dialer of all
(any) pre-existing interfaces (if_list).

Takes two arguments which are
   total_delay        the wait until timeout, seconds
   quiet        quiet mode if 1, verbose mode if 0

Returns the variable found_interface which =1 if
a new interface is detected or =0 if we time out
before finding a new one.  Upper/lower case differences do not matter.
==============================================
*/

wait_for_interface:
parse arg total_delay, quiet

recheck_delay = 1        /* recheck interval in seconds */
if_prefix = translate(interf_prefix)
ifp_length = length(interf_prefix)

say 'Waiting for' service '(' || interf_prefix || ') - maximum wait =' total_delay 'second(s)'

found_interface = 0        /* clear to not found */

call rxqueue 'CREATE', queue_ydint        /* (re)create internal queue */
call rxqueue 'SET', queue_ydint        /* set internal queue */
/* do queued(); parse pull; end */        /* If there is anything in it, clear it out */

do index = 1 to total_delay by recheck_delay        /* Periodically check avail. routes */
   call SysSleep recheck_delay        /* Minor delay, then check for routes */
   'netstat -r | rxqueue /LIFO' queue_ydint        /* send output to the queue */

   do queued()
      pull netstat_line        /* May have interface as last word in line */
      dest = word(netstat_line, 1)
      dest = strip(dest, 'B')
      if dest = 'DESTINATION' then iterate /* line is the heading line, discard */
      if dest = 'METRIC' then iterate /* line is the heading line, discard */
         if words(netstat_line) > 0 then
            do
               interface = word(netstat_line, words(netstat_line))
               if left(interface, ifp_length) = if_prefix then        /* Check for interface */
                  do
                     if pos(interface, if_list) = 0 then
                        do
                           found_interface = 1 /* (new) , we did not time out */
                           if \quiet then say 'interface' interface 'detected'
                              leave index
                        end
                   end        /* of If Left(interface, ifp_length) = if_prefix */
            end   /* if words(...) */
   end        /* of Do Queued() */
end        /* of Do Index */

do queued(); parse pull; end        /* If there is anything in queue, clear it out */
call rxqueue 'SET', queue_ydext        /* reset to whatever queue may have been in use before */
RETURN found_interface

/*
=================
file_is_there()

Finds files using wild cards
=================
*/
file_is_there: procedure
file.1 = ''
arg file
call SysFileTree file, 'file', 'FO'
if file.1 = '' then there = 0
if file.1 \= '' then there = 1
file.1 = ''
RETURN there


/*
==============================================
HANDLING OF ERROR TRAPS

ReXX Errors (failure, halt, syntax, novalue, error,
novalue) that occur with SIGNAL ON XXXXX (XXXXX = failure,
halt, etc.) are diverted (we jump) to one of these
where the error and the offending line are identified.
==============================================
*/

   FAILURE:
   say 'Rexx FAILURE condition' rc 'in line' sigl ':' errortext(rc)
   say sourceline(sigl)

   call beep 300, 500
   do_not_kill = 0
   call rxqueue 'CREATE', queue_ydint        /* (re)create internal queue */
   call rxqueue 'DELETE', queue_ydint
   call rxqueue 'SET', queue_ydext
   signal goodbye
   RETURN


   HALT:
   say 'Rexx HALT condition' rc 'in line' sigl ':' errortext(rc)
   say sourceline(sigl)

   call beep 300, 500
   do_not_kill = 0
   call rxqueue 'CREATE', queue_ydint
   call rxqueue 'DELETE', queue_ydint
   call rxqueue 'SET', queue_ydext
   signal goodbye
   RETURN


   SYNTAX:
   say 'Rexx SYNTAX error' rc 'in line' sigl ':' errortext(rc)
   say sourceline(sigl)

   call beep 300, 500
   do_not_kill = 0
   call rxqueue 'CREATE', queue_ydint
   call rxqueue 'DELETE', queue_ydint
   call rxqueue 'SET', queue_ydext
   signal goodbye
   RETURN


   NOTREADY:
   say 'Rexx NOTREADY condition' rc 'in line' sigl ':' errortext(rc)
   say sourceline(sigl)

   call beep 300, 500
   do_not_kill = 0
   call rxqueue 'CREATE', queue_ydint
   call rxqueue 'DELETE', queue_ydint
   call rxqueue 'SET', queue_ydext
   signal goodbye
   RETURN


   ERROR:
   say 'Rexx ERROR condition' rc 'in line' sigl ':' errortext(rc)
   say sourceline(sigl)

   call beep 300, 500
   do_not_kill = 0
   call rxqueue 'CREATE', queue_ydint
   call rxqueue 'DELETE', queue_ydint
   call rxqueue 'SET', queue_ydext
   signal goodbye
   RETURN


   NOVALUE:
   say 'Rexx NOVALUE condition' rc 'in line' sigl ':' errortext(rc)
   say sourceline(sigl)

   call beep 300, 500
   do_not_kill = 0
   call rxqueue 'CREATE', queue_ydint
   call rxqueue 'set', queue_ydint
   call rxqueue 'DELETE', queue_ydint
   call rxqueue 'SET', queue_ydext
   signal goodbye
   RETURN