/****************************************************************************/
/*  NEWNEWS.CMD - an ka9q compatible OS/2 nntp client                       */
/*  Copyright (C) 1995 Alex Chapman <alex@mercer.demon.co.uk>               */
/*                                                                          */
/*  This program is free software; you can redistribute it and/or modify    */
/*  it under the terms of the GNU General Public License as published by    */
/*  the Free Software Foundation; either version 2 of the License, or       */
/*  (at your option) any later version.                                     */
/*                                                                          */
/*  This program is distributed in the hope that it will be useful,         */
/*  but WITHOUT ANY WARRANTY; without even the implied warranty of          */
/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           */
/*  GNU General Public License for more details.                            */
/*                                                                          */
/*  You should have received a copy of the GNU General Public License       */
/*  along with this program; if not, write to the Free Software             */
/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.               */
/*                                                                          */
/*  Requires rxsock.zip from IBM Employee Written Software                  */
/*  <ftp://src.doc.ic.ac.uk/packages/os2/ibm/ews/rxsock.zip>                */
/*                                                                          */
/*  Last Modified: 18th September, 1995                                     */
    Version = 1.63
/****************************************************************************/

/************************************************************/
/* Change History                                           */
/************************************************************/
/* 0.1  950115  First version                               */
/* 0.11 950115  fixed nntp.dat problem                      */
/* 0.12 950116  put in workaround for history problem       */
/* 0.13 950116  last newsgroup empty problem                */
/* 0.14 950117  change logging of #! rnews 1234 lines       */
/* 0.15 950122  request multiple newsgroups in a newnews    */
/* 0.16 950124  only accept 200/201 as reply to connect     */
/* 0.17 950127  set nntp clock back a few minutes           */
/* 0.18 950128  improved lock/unlock routines               */
/* 0.19 950129  added GNU public license                    */
/* 0.20 950131  removed GNU license for purposes of testing */
/* 0.21 950131  improved code a little and added logging    */
/* 0.22 950201  implemented getfile                         */
/* 0.23 950203  fixed newtime setting in nntp.dat in morning*/
/* 0.24 950203  os/2 rexx thinks that ' .' == '.'           */
/* 0.25 950203  'NEWNEWS F' deletes all .lck files and runs */
/* 0.26 950203  provide measure of throughput               */
/* 0.27 950203  implemented stacked article requests        */
/* 0.28 950204  send control messages through queue         */
/* 0.29 950205  workaround for nntp update                  */
/* 0.50 950205  Final Beta Release                          */
/* 0.51 950207  Divide by zero error                        */
/* 0.52 950211  Around midnight problem                     */
/* 1.00 950211  First Release                               */
/* 1.01 950219  improved stacking <paul@barnett.demon.co.uk>*/
/* 1.02 950219  Implemented dot transparency                */
/* 1.03 950220  Wasn't releasing sockets on bad replies     */
/* 1.04 950304  wind nntp back 5 minutes if not before 00:05*/
/* 1.05 950305  allow for retries if nntp server too busy   */
/* 1.06 950305  slight change to queue sequence             */
/* 1.07 950318  moved queueing into SendMsg routine         */
/* 1.08 950410  read ka9q root directory from KA9Q env var. */
/* 1.09 950410  unlock files if user presses CTRL+BREAK     */
/* 1.10 950410  fixed ReadNNTP to ignore blank lines        */
/* 1.11 950414  added ControlQ to expose for procedures     */
/* 1.12 950414  added maximum articles to download variable */
/* 1.20 950508  read settings from newnews.ini              */
/* 1.21 950515  patch for rnews article length count        */
/* 1.22 950521  moved call to readinifile                   */
/* 1.23 950527  implemented NEWGROUPS request option        */
/* 1.24 950529  fixed writing to NEWGROUP file              */
/* 1.25 950530  added checking of ini file settings         */
/* 1.26 950601  negative max_articles disables feature      */
/* 1.27 950606  display messages when fetching new groups   */
/* 1.28 950607  rearrange collecting of articles            */
/* 1.29 950614  added first part of kill file support       */
/* 1.30 950618  unstacked kill file implementation          */
/* 1.31 950619  fixed one or two problems with kill files   */
/* 1.32 950620  beta release of newnews - unstacked kill    */
/* 1.33 950621  use WARPDIS as the rexx queue               */
/* 1.34 950705  Fixed max_articles disabling feature        */
/* 1.35 950710  Implementing stacking in kill file fetching */
/* 1.36 950710  Fixed x//stack and nextmessage problems     */
/* 1.37 950711  "stack" needs to be at least 2*stack large  */
/* 1.38 950716  misscalculated loop size for stacking       */
/* 1.39 950716  get rid of // and sx clever thing           */
/* 1.40 950716  beta release of newnews - stacked kill      */
/* 1.41 950718  move queue settings into ini file           */
/* 1.42 950718  display newsgroups to which article posted  */
/* 1.43 950717  add option to run unbatcher after collection*/
/* 1.44 950721  fixed problem in non-kill file reporting    */
/* 1.45 950722  add I param for ini file selection          */
/* 1.46 950723  max_articles = -1 should work now...honest  */
/* 1.47 950727  get file not overriding the kill file       */
/* 1.48 950727  force unlock problem fixed                  */
/* 1.49 950813  use GMT on NEWNEWS and NEWGROUPS commands   */
/* 1.50 950813  temporary fix for suspected missing news    */
/* 1.51 950814  implement use of server DATE command        */
/* 1.52 950814  don't read history file every retry         */
/* 1.53 950814  move determining of hostname outside restart*/
/* 1.54 950815  accept more responses to date command       */
/* 1.55 950907  kill_headers option to kill header & article*/
/* 1.56 950907  430 message abbreviated                     */
/* 1.57 950909  improved messages during news collection    */
/* 1.58 950909  rnews_patch works for kill files now        */
/* 1.59 950909  kill_afterthefact fetches then kills        */
/* 1.60 950913  GetWholeArticles needed to expose some vars */
/* 1.61 950913  GET file must override any kill action      */
/* 1.62 950916  Bad Artithmetic Conversion (headerend)      */
/* 1.63 950918  Was killing when shouldn't have been        */
/************************************************************/

arg gnu .

port     = 119                                      /* NNTP port       */
crlf     = d2c(13)||d2c(10)                         /* CR + LF         */
ControlQ = ''                                       /* Control Queue   */
CurrentQ = ''                                       /* Current Queue   */
buffer   = ''                                       /* Empty buffer    */
attempts = 0                                        /* Attempts so far */
inifile  = 'NEWNEWS.INI'                            /* INI file        */
force_unlock = 'NO'                                 /* delete *.lck    */

Say 'NEWNEWS.CMD - OS/2 nntp client (version' version')'
Say 'Copyright (C) 1995 Alex Chapman'
Say "NEWNEWS comes with ABSOLUTELY NO WARRANTY; for details type 'NEWNEWS w'."
Say 'This is free software, and you are welcome to redistribute it under certain'
Say "conditions; type `NEWNEWS c' for details."
Say

call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs

Call RxFuncAdd 'RXMATCHLOADFUNCS', 'rxmatch', 'RXMATCHLOADFUNCS'
Call RXMATCHLOADFUNCS

Select
  When gnu = 'C' Then Do
    Call ShowConditions
    Exit 0
  End
  When gnu = 'W' Then Do
    Call ShowWarranty
    Exit 0
  End
  When gnu = 'H' | gnu = '?' Then Do
    Exit 0
  End
  When gnu = 'F' Then Do
    force_unlock = 'YES'
  End
  When gnu = 'Q' Then Do
    Say 'The Q parameter is now obsolete, and has been superceded by the use of'
    Say 'the ini settings queue_messages and queue_name'
    Exit 0
  End
  When Left(gnu, 1) = 'I' Then Do
    inifile = Substr(gnu, 2)
  End
  When gnu<>'' Then Do
    Say 'Invalid parameter.  Process terminated.'
    Exit 0
  End
  Otherwise
End

Call ReadINIFile inifile, 'NEWNEWS'
Call CheckParameters

If force_unlock = 'YES' Then Do
  Call UnlockFiles
End

If queue_messages = 'YES' Then Do
  ControlQ = queue_name
  CurrentQ = RXQUEUE('Create', ControlQ)
  If CurrentQ<>ControlQ Then Do
    Call RXQUEUE 'Delete', CurrentQ
  End
  CurrentQ = RXQUEUE('Set', ControlQ)
  Call SendMsg '<NEWNEWS> START'
End

Call RxFuncAdd 'SockLoadFuncs', 'RxSock', 'SockLoadFuncs'
Call SockLoadFuncs('QUIET')

/* Read NNTP.DAT file */
Call ReadNNTP nntp_dat

/* Read History file */
Call ReadHistory history

/* Read KILL file (if it exists) */
killline. = 0
keepline. = 0
If kill_articles = 'YES' | kill_afterthefact = 'YES' Then Do
  Call ReadKillFile kill_file
End

Say 'NNTPSERVER' server
retcode = SockGetHostByName(server, 'host.!')
If retcode = 0 Then Do
  Say 'SockGetHostByName()' errno
  Call Log 'SockGetHostByName()' errno
  Call UnLockFiles
  Call SendMsg '<NEWNEWS> FAIL SOCK' errno
  Exit errno
End

server = host.!addr;

Say 'NNTPSERVER' server

Restart:      /* Restart from here in event of retry */
If attempts > retries Then Do
  Say 'NEWNEWS quits after' attempts 'retries'
  Call Log 'NEWNEWS quits after' attempts 'retries'
  Call SendMsg '<NEWNEWS> FAIL NNTP 400'
  Exit 0
End
Else Do
  attempts = attempts + 1
  Say 'NEWNEWS attempt' attempts
  Call Log 'NEWNEWS attempt' attempts
End

/* Lock all files */
Call LockFiles

Call time 'R'  /* Reset elapsed timer */
stage = 1      /* 1 = MsgIDS 2 = Articles */
time. = 0      /* time spent in stage     */
BytesSent. = 0 /* outgoing bytes in stage */
BytesRecv. = 0 /* incoming bytes in stage */

/* Open Socket */
socket  = SockSocket('AF_INET', 'SOCK_STREAM', 0)
If socket < 0 Then Do
  Say 'SockSocket()' errno
  Call UnLockFiles
  Call SendMsg '<NEWNEWS> FAIL SOCK' errno
  Exit errno
End

signal on halt

Call Log '-------------------------------------------------------------'
Call Log 'NEWNEWS version' version 'started' date() time()

/* Connect Socket */
server.!family = 'AF_INET'
server.!port   = port
server.!addr   = server

retcode = SockConnect(socket,'server.!')
If retcode < 0 Then Do
  Say 'SockConnect()' errno
  Call UnLockFiles
  Call SendMsg '<NEWNEWS> FAIL SOCK' errno
  Exit errno
End

/* Get response from connect */
reply = GetResponse(socket)

If reply <> 200 & reply <> 201 Then Do
  Say 'Failed.  Reply was' allreply
  Call UnLockFiles
  If reply = 400 Then Do          /* Retry for busy */
    retcode = SockSoClose(socket)
    If retcode < 0 Then Do
      Say 'SockSoClose()' errno
      Exit errno
    End
    If attempts <= retries & retry_delay > 0 Then Do
      Say 'NEWNEWS about to retry... sleeping for' retry_delay
      Call SysSleep retry_delay
    End
    Signal Restart
  End
  Call SendMsg '<NEWNEWS> FAIL NNTP' reply
  Call halt
End

Say 'Connected.  Reply was' allreply

/* Get DATE and TIME that the server thinks it is */
Call GetServerDate socket

/* Handle the GET file before everything else */
msgid. = ''
msgid.0 = 0
count = ReadGetFile()
If count > 0 Then Do
  totalmsg = count
  Say 'GET IDS    (' count ')'
  Call GetArticles socket 'GET'
  Call SysFileDelete getfile
End

msgid. = ''
msgid.0 = 0
newsgroups = ''
commandlength = 512 - Length('NEWNEWS  000000 000000 GMT') - 2 /* CR LF */
Do i = 1 to group.0
  If Length(newsgroups) + Length(group.i) > commandlength Then Do
    newsgroups = Left(newsgroups, Length(newsgroups) - 1)
    Say newsgroups
    count = GetMsgIds(socket, LastDate, LastTime, newsgroups)
    newsgroups = ''
    Say 'Headers    (' count ')'
  End
  newsgroups = newsgroups||group.i','
End
newsgroups = Left(newsgroups, Length(newsgroups) - 1)
Say newsgroups
count = GetMsgIds(socket, LastDate, LastTime, newsgroups)
newsgroups = ''
Say 'Headers    (' count ')'
totalmsg = 0
duplicate = 0
crosspost = 0
Do i = 1 to msgid.0
  MessageID = msgid.i
  If hit.MessageID = 0 & ((max_articles < 1) | (totalmsg < max_articles)) Then Do
    totalmsg = totalmsg + 1
    hit.MessageID = 2
  End
  Else Do
    msgid.i = ''
    If hit.MessageID = 1 Then duplicate = duplicate + 1
    If hit.MessageID = 2 Then crosspost = crosspost + 1
  End
End
Say 'Duplicate  (' duplicate ')'
Say 'Crossposts (' crosspost ')'
Say 'Download   (' totalmsg ')'
If max_articles = totalmsg Then Do
  Say '*maximum article limit reached for this session'
  Call Log '*maximum article limit reached for this session'
End
Call Log 'Duplicate  (' duplicate ')'
Call Log 'Crossposts (' crosspost ')'
Call Log 'Download   (' totalmsg ')'

time.stage = time('R')  /* Elapsed time for message ids */
stage = stage + 1

If totalmsg > 0 Then Do
  Call GetArticles socket 'KILL'
End

If fetch_newgroups = 'YES' Then Do
  retcode = GetNewGroups(socket, LastDate, LastTime)
End

time.stage = time('R')  /* Elapsed time for articles */

/* Report and log times */
Call ReportTimes

/* Update NNTP.DAT */
If totalmsg > 0 & (totalmsg < max_articles | max_articles = -1) Then Do
   Call UpdateNNTP(nntp_dat)
End

/* UnLock all files */
Call UnLockFiles

/* Start Unbatcher if configured */
If unbatch_news = 'YES' Then Do
  /* If there is a BATCH.TXT file */
  If Stream(batch_txt, 'c', 'query exists') <> '' Then Do
    Call Log 'Unbatching <'unbatch_command'>'
    Say 'Unbatching news...'
    '@START /C' unbatch_command '2>NUL'
    If RC <> 0 Then Do
      Say 'Failed to start unbatcher:' unbatch_command
      Say 'Check settings in NEWNEWS.INI'
      Call Log 'Unbatching failed to start RC='RC
    End
  End
End

Call Log 'NEWNEWS version' version 'completed' date() time()
Call Log '-------------------------------------------------------------'

Call SendMsg '<NEWNEWS> STOP NEWNEWS' totalmsg
Call halt

/* Report and log times */
ReportTimes: procedure expose crlf logfile time. BytesSent. BytesRecv. ControlQ CurrentQ

 stage.1 = 'Getting msg-ids'
 stage.2 = 'Getting article'
 totalstage = 3
 stage.totalstage     = 'Total throughput'
 time.totalstage      = 0
 BytesSent.totalstage = 0
 BytesRecv.totalstage = 0
 Do i = 1 to totalstage
   If time.i > 0 Then Do /* Can't divide by zero */
     bytes = BytesSent.i + BytesRecv.i
     throughput = bytes / time.i
     report = stage.i throughput 'bytes/sec (' bytes 'bytes'
     report = report time.i 'seconds )'
     Say report
     Call Log report
     If i < totalstage Then Do
       BytesSent.totalstage = BytesSent.totalstage + BytesSent.i
       BytesRecv.totalstage = BytesRecv.totalstage + BytesRecv.i
       time.totalstage = time.totalstage + time.i
     End
   End
 End
 Return

/* Lock all files */
LockFiles: procedure expose batch_txt history crlf logfile ControlQ CurrentQ

  Parse var batch_txt batch_lck '.' .
  batch_lck = batch_lck||'.LCK'
  Parse var history history_lck '.' .
  history_lck=history_lck||'.LCK'

  If Stream(batch_lck, 'c', 'query exists') <> '' Then Do
    Say 'Batch file locked' batch_lck
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS batch_lck'
    Exit 1
  End

  If Stream(history_lck, 'c', 'query exists') <> '' Then Do
    Say 'History file locked' history_lck
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS history_lck'
    Exit 1
  End

  If Stream(batch_lck, 'c', 'open write') <> 'READY:' Then Do
    Say 'Batch file lock failed' batch_lck
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS batch_lck'
    Exit 1
  End

  retcode = Stream(batch_lck, 'c', 'close')

  If Stream(history_lck, 'c', 'open write') <> 'READY:' Then Do
    Say 'History file lock failed' history_lck
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS history_lck'
    Exit 1
  End

  retcode = stream(history_lck, 'c', 'close')

  Return

/* Unlock all files */
UnLockFiles: procedure expose batch_txt history crlf logfile ControlQ CurrentQ

  Parse var batch_txt batch_lck '.' .
  batch_lck = batch_lck||'.LCK'
  Parse var history history_lck '.' .
  history_lck=history_lck||'.LCK'

  Call SysFileDelete batch_lck
  Call SysFileDelete history_lck

  Return


/* Fetch new groups and write into newgroup_file */
GetNewGroups: Procedure expose crlf logfile ControlQ CurrentQ newgroup_file,
                               buffer BytesSent. BytesRecv. stage
  Parse arg socket,LastDate,LastTime
  command = 'newgroups' LastDate LastTime 'GMT'
  Call Log '>>'command
  Say 'Fetching new groups created since' LastDate LastTime '...'
  command = command||crlf
  Call MySockSend socket, command
  reply = GetResponse(socket)
  If reply <> 231 Then Do
    Call Log '<<' reply
    Say 'Expected a 231 to indicate a list of groups to follow'
    Say 'Instead received following reply:' reply
  End
  Else Do
    retcode = Stream(newgroup_file, 'c', 'open write')
    If retcode <> 'READY:' Then Do
      Call Log 'Error opening ('newgroup_file')' retcode
      Say 'Error opening ('newgroup_file')' retcode
      Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
      Exit 1
    End
    Say 'New Newsgroups:' line.0
    Do i = 1 to line.0
      Call LINEOUT newgroup_file, line.i
    End
    retcode = Stream(newgroup_file, 'c', 'close')
  End
  Return 0

/* Read message ids into msgid. */
GetMsgIds: Procedure expose msgid. buffer crlf logfile BytesSent. BytesRecv.,
                            stage ControlQ CurrentQ
  Parse arg socket,LastDate,LastTime,newsgroups
  command = 'newnews' newsgroups LastDate LastTime 'GMT'
  Call Log '>>'command
  command = command||crlf
  Call MySockSend socket, command
  reply = GetResponse(socket)
  If reply <> 230 Then Do
    Say 'Expected a 230 to indicate a list of message ids to follow'
    Say 'Instead received following reply:' reply
    Call SendMsg '<NEWNEWS> FAIL NNTP' reply
    Exit reply
  End
  x = msgid.0
  Do i = 1 to line.0
    x = i + msgid.0
    msgid.x = line.i
  End
  msgid.0 = x
  Return line.0

/* Read message ids from get file and add to msgid. */
ReadGetFile: Procedure expose msgid. buffer crlf logfile getfile ControlQ CurrentQ
  x = msgid.0
  start = x
  retcode = Stream(getfile, 'c', 'open read')
  If retcode = 'READY:' Then Do
    Do While Lines(getfile)<>0
      x = x + 1
      msgid.x = LINEIN(getfile)
    End
    msgid.0 = x
    retcode = Stream(getfile, 'c', 'close')
  End
  Return (x - start)

/* Test if article should be killed on basis of header */
KillArticle: Procedure expose killline. line. keepline. logfile
  keep = 0
  kill = 0
  Do i = 1 to keepline.0 While keep = 0
    Do j = 1 to line.0 While keep = 0
      If RXMATCHIT(line.j, keepline.i) = 0 Then Do
        Call Log 'KEEPLINE' keepline.i
        Call Log 'MATCHES ' line.j
        keep = 1
      End
    End
  End
  If keep = 0 Then Do
    Do i = 1 to killline.0 While kill = 0
      Do j = 1 to line.0 While kill = 0
        If RXMATCHIT(line.j, killline.i) = 0 Then Do
          Call Log 'KILLLINE' killline.i
          Call Log 'MATCHES ' line.j
          kill = 1
        End
      End
    End
  End
  Return kill

/* Get Articles and write to batch_txt */

GetArticles:  Procedure expose batch_txt msgid. buffer history totalmsg,
                               crlf logfile BytesSent. BytesRecv. stage,
                               stack ControlQ CurrentQ rnews_patch killline.,
                               keepline. kill_headers kill_afterthefact,
                               kill_articles
  Parse arg socket command
  Call Log 'GetArticles: command =<'command'>'
  If killline.0 = 0 | command = 'GET' | kill_articles <> 'YES' Then Do
    Call GetWholeArticles socket command
  End
  Else Do
    Call GetHeadAndBody socket
  End
  Return


GetHeadAndBody:  Procedure expose batch_txt msgid. buffer history totalmsg,
                                  crlf logfile BytesSent. BytesRecv. stage,
                                  stack ControlQ CurrentQ rnews_patch killline.,
                                  keepline. kill_headers
  Parse arg socket
  Say '[n.b. kill file use reduces performance by approx. 50%]'
  Say '[     set kill_articles = NO in newnews.ini to disable]'
  If kill_headers = 'YES' Then Do
    Say '[ n.b. headers of killed articles will not appear in batch.txt ]'
    Say '[      set kill_headers = NO in newnews.ini to keep them in it ]'
  End
  retcode = Stream(batch_txt, 'c', 'open write')
  If retcode <> 'READY:' Then Do
    Say 'Error opening ('batch_txt')' retcode
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
    Exit 1
  End
  retcode = Stream(history, 'c', 'open')
  If retcode <> 'READY:' Then Do
    Say 'Error opening ('history')' retcode
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
    Exit 1
  End
  retcode = Stream(history, 'c', 'seek <1')   /* Look at last char */
  junk = charin(history)
  if c2d(junk)=26 Then Do                     /* If it's an EOF    */
    retcode = Stream(history, 'c', 'seek -1') /* overwrite it      */
  End
  nextmessage = 0
  ss. = '' ; in = 0 ; out = 0
  target. = '????'
  Do x = 1 to ((2 * msgid.0) + stack)
    If x <= msgid.0 & msgid.x = '' Then iterate
    If x <= msgid.0 Then Do
      command = 'HEAD' msgid.x
      Call Log '>>'command
      command = command||crlf
      Call MySockSend socket, command
      in = in + 1
      ss.in = 'H' in msgid.x
    End
    If x >= stack Then Do
      out = out + 1
      Parse var ss.out type n msgid
      ss.out = ''
      If type = 'H' Then Do
        reply = GetResponse(socket)
        If line.0 = 0 Then Do
          nextmessage = nextmessage + 1
          Say reply '('nextmessage'/'totalmsg')' msgid
        End
        Else Do
          size.n = line.0 /* 1 character count for a crlf */
          Do j = 1 to line.0
            size.n = size.n + Length(line.j)
            article.n.j = line.j
            If Left(line.j, 11) = 'Newsgroups:' Then Do
              Parse var line.j . target.n
            End
          End
          If rnews_patch = '1' Then Do      /* rnews crlf = 2 */
            size.n = size.n + line.0 /* +1 (=2) character count for a crlf */
          End
          If rnews_patch = '2' Then Do      /* cheeky fix */
            lastline = line.0
            line.lastline = line.lastline || Left(' ', line.0, ' ')
          End
          article.n.0 = line.0
          If KillArticle() = 0 Then Do
            command = 'BODY' msgid
            Call Log '>>'command
            command = command||crlf
            Call MySockSend socket, command
            in = in + 1
            ss.in = 'B' n msgid
          End
          Else Do
            nextmessage = nextmessage + 1
            If kill_headers = 'YES' Then Do
              Say '*evaporate* ('nextmessage'/'totalmsg')' msgid target.n
              Call Log 'article and header killed' msgid
              Call LINEOUT history, msgid
            End
            Else Do
              Say '*kill* ('nextmessage'/'totalmsg')' msgid target.n
              Call Log 'article killed' msgid
              rnews = '#! rnews' size.n
              Call LINEOUT batch_txt, rnews
              Do j = 1 to article.n.0
                Call LINEOUT batch_txt, article.n.j
              End
              Call LINEOUT history, msgid
            End
          End
        End
      End
      If type = 'B' Then Do
        reply = GetResponse(socket)
        nextmessage = nextmessage + 1
        If line.0 = 0 Then Do
          Say reply '('nextmessage'/'totalmsg')' msgid
        End
        Else Do
          Say '('nextmessage'/'totalmsg')' msgid target.n
          size.n = size.n + line.0 /* 1 character count for a crlf */
          Do j = 1 to line.0
            size.n = size.n + Length(line.j)
          End
          size.n = size.n + 1 /* for line between HEAD and BODY */
          If rnews_patch = '1' Then Do      /* rnews crlf = 2 */
            size.n = size.n + line.0 /* +1 (=2) character count for a crlf */
            size.n = size.n + 1 /* +1 (=2) for line between head and body */
          End
          If rnews_patch = '2' Then Do      /* cheeky fix */
            lastline = line.0
            line.lastline = line.lastline || Left(' ', line.0, ' ')
          End
          rnews = '#! rnews' size.n
          Call LINEOUT batch_txt, rnews
          Do j = 1 to article.n.0
            Call LINEOUT batch_txt, article.n.j
          End
          Call LINEOUT batch_txt, ''
          Do j = 1 to line.0
            Call LINEOUT batch_txt, line.j
          End
          Call LINEOUT history, msgid
        End
      End
    End
  End
  retcode = Stream(history, 'c', 'close')
  retcode = Stream(batch_txt, 'c', 'close')
  Return


GetWholeArticles:  Procedure expose batch_txt msgid. buffer history totalmsg,
                                    crlf logfile BytesSent. BytesRecv. stage,
                                    stack ControlQ CurrentQ rnews_patch,
                                    kill_afterthefact keepline. killline.
  Parse arg socket command
  If kill_afterthefact = 'YES' & command <> 'GET' Then Do
    Say '[ n.b. all articles will be fetched before processing kill file  ]'
    Say '[      set kill_afterthefact = NO in newnews.ini to prevent this ]'
  End
  retcode = Stream(batch_txt, 'c', 'open write')
  If retcode <> 'READY:' Then Do
    Say 'Error opening ('batch_txt')' retcode
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
    Exit 1
  End
  retcode = Stream(history, 'c', 'open')
  If retcode <> 'READY:' Then Do
    Say 'Error opening ('history')' retcode
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
    Exit 1
  End
  retcode = Stream(history, 'c', 'seek <1')   /* Look at last char */
  junk = charin(history)
  if c2d(junk)=26 Then Do                     /* If it's an EOF    */
    retcode = Stream(history, 'c', 'seek -1') /* overwrite it      */
  End
  nextmessage = 0
  output = 0                         /* ARTICLE <msgid.output> being sent */
  target. = '????'
  Do input = 1 to msgid.0                       /* msgid.input being read */
    Do While output < ,
             min(msgid.0,input+stack) /* send stack ARTICLE commands */
      output = output + 1

      If msgid.output='' Then Iterate

      command = 'ARTICLE' msgid.output
      Call Log '>>'command
      command = command||crlf
      Call MySockSend socket, command
    End

    If msgid.input='' Then Iterate

    reply = GetResponse(socket)
    size = line.0 /* 1 character count for a crlf */
    nextmessage = nextmessage + 1
    If line.0 = 0 Then Do
      Say reply '('nextmessage'/'totalmsg')' msgid.input
    End
    Else Do
      If rnews_patch = '1' Then Do      /* rnews crlf = 2 */
        size = size + line.0 /* +1 (=2) character count for a crlf */
      End
      If rnews_patch = '2' Then Do      /* cheeky fix */
        lastline = line.0
        line.lastline = line.lastline || Left(' ', line.0, ' ')
      End
      header_end = 0
      real_length = line.0
      Do j = 1 to line.0
        size = size + Length(line.j)
        If header_end = 0 & line.j = '' Then header_end = j - 1
      End
      line.0 = header_end
      If kill_afterthefact<>'YES' | command='GET' | KillArticle()=0 Then Do
        line.0 = real_length
        Do j = 1 to header_end
          If Left(line.j, 11) = 'Newsgroups:' Then Do
            Parse var line.j . target.input
          End
        End
        rnews = '#! rnews' size
        Call LINEOUT batch_txt, rnews
        Do j = 1 to line.0
          Call LINEOUT batch_txt, line.j
        End
        Call LINEOUT history, msgid.input
        Say '('nextmessage'/'totalmsg')' msgid.input target.input
      End
      Else Do
        Say '*DISCARDED* ('nextmessage'/'totalmsg')' msgid.input
      End
    End
  End
  retcode = Stream(history, 'c', 'close')
  retcode = Stream(batch_txt, 'c', 'close')
  Return


/* read KILL. to determine the articles which should be killed */

ReadKillFile: Procedure expose killline. crlf logfile ControlQ CurrentQ keepline.

  Parse arg kill_file
  killline. = ''
  killline.0 = 0
  retcode = Stream(kill_file, 'c', 'open read')
  If retcode <> 'READY:' Then Do
    Say 'No kill file available'
    Call Log 'No kill file available ('kill_file')'
    Return
  End
  Say 'Reading' kill_file
  Call Log 'Reading' kill_file
  kill = 0
  keep = 0
  Do While Lines(kill_file) <> 0
    next = LINEIN(kill_file)
    If Left(next, 1) = '!' Then Do
      keep = keep + 1
      keepline.keep = Substr(next, 2)
      Call Log 'KEEP' keepline.keep
    End
    Else Do
      kill = kill + 1
      killline.kill = next
      Call Log 'KILL' killline.kill
    End
  End
  killline.0 = kill
  keepline.0 = keep
  Return


/* Determine server date and time from DATE command */

GetServerDate: Procedure expose NewDate NewTime crlf logfile ControlQ CurrentQ,
                                buffer BytesSent. BytesRecv. stage

  Parse arg socket
  Say 'Attempting to fetch server date/time:'
  command = 'date'
  Call Log '>>'command
  command = command||crlf
  Call MySockSend socket, command
  reply = GetResponse(socket)
  If reply > 299 Then Do
    Call Log '<<'allreply
    Say 'Server does not understand DATE command'
  End
  Else Do
    Parse var allreply . serverdate .
    NewDate = Substr(serverdate, 3, 6)
    NewTime = Substr(serverdate, 9, 6)
    Call Log 'server date:'NewDate 'time:'NewTime
    Say 'Server date:'NewDate 'time:'NewTime
  End
  Return 0

/* read NNTP.DAT to determine newsserver, date and time last complete */
/* news read, and all the groups to read                              */

ReadNNTP: Procedure expose server LastDate LastTime group. NewDate NewTime,
                           crlf logfile ControlQ CurrentQ
  Parse arg nntp_dat
  Say 'Reading' nntp_dat
  retcode = Stream(nntp_dat, 'c', 'open read')
  If retcode <> 'READY:' Then Do
    Say 'Error opening ('nntp_dat')' retcode
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
    Exit 1
  End
  Parse value linein(nntp_dat) with server LastDate LastTime
  Say server LastDate LastTime
  NumGroups = 0
  Do While Lines(nntp_dat) <> 0
    NumGroups = NumGroups + 1
    group.NumGroups = LINEIN(nntp_dat)
    group.NumGroups = Strip(group.NumGroups)
    If group.NumGroups = '' Then NumGroups = NumGroups - 1
  End
  group.0 = NumGroups
  retcode = Stream(nntp_dat, 'c', 'close')
  NewDate = Right(date('s'), 6)
  NewTime = WindTimeBack5Minutes(time('n'))
  Return

/* Update date and time in NNTP.DAT */

UpdateNNTP: Procedure expose NewDate NewTime crlf logfile ControlQ CurrentQ
  Parse arg nntp_dat
  Say 'Updating' nntp_dat
  retcode = Stream(nntp_dat, 'c', 'open')
  If retcode <> 'READY:' Then Do
    Say 'Error opening ('nntp_dat')' retcode
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
    Exit 1
  End
  Parse value linein(nntp_dat) with server LastDate LastTime
  retcode = Stream(nntp_dat, 'c', 'seek =1')
  Call LINEOUT nntp_dat, server NewDate NewTime
  retcode = Stream(nntp_dat, 'c', 'close')
  Return

/* read history file to mark all message ids listed in it as already read */
ReadHistory: Procedure expose hit. crlf logfile ControlQ CurrentQ
  Parse arg history
  hit. = 0
  Say 'Reading' history
  retcode = Stream(history, 'c', 'open read')
  If retcode <> 'READY:' Then Do
    Say 'Error opening ('history')' retcode
    Call SendMsg '<NEWNEWS> FAIL NEWNEWS' retcode
    Exit 1
  End
  Do While Lines(history) <> 0
    MessageId = LINEIN(history)
    hit.MessageId = 1
  End
  retcode = Stream(history, 'c', 'close')
  Return

/* Close socket */
halt:
  If CurrentQ <> '' Then Do
    Call RXQUEUE 'Set', CurrentQ
  End
  Say 'Closing socket...'
  retcode = SockSoClose(socket)
  If retcode < 0 Then Do
    Say 'SockSoClose()' errno
    Exit errno
  End
  Call UnLockFiles
  Exit 0

/* recv() multiple lines and store in line. */

GetResponse:     procedure expose line. buffer crlf logfile ControlQ CurrentQ,
                                  BytesSent. BytesRecv. stage allreply

  Parse arg socket .
  replies = '100 215 220 221 222 223 230 231'
  line. = ''
  line.0 = 0
  response = GetResponseLine(socket)
  allreply = response
  Parse var response reply junk
  Call Log '<<'response
  If WordPos(reply, replies) = 0 Then Do
    Return reply
  End
  Call Log '++additional lines'
  numline = 0
  inheader = 1
  Do Until line = '.' & Length(line) = 1
    line = GetResponseLine(socket)
    if line <> '.' | Length(line) <> 1 Then Do
      numline = numline + 1
      If line = '' Then inheader = 0
      If Left(line, 1) = '.' Then Do   /* Transparency, as per rfc821 */
        line = Substr(line, 2)
      End
      If Left(line, 5) = 'From ' & inheader = 0 Then Do
        line = '>' || line
      End
      line.numline = line
      line = ''           /* Not interested in line if we get in here */
    End
    Else Do
      numline = numline + 1
      line.numline = ''     /* blank line to separate messages */
    End
  End
  line.0 = numline - 1
  Call Log '--total lines received (including .):'numline
  Return reply

/* recv() a single line */

GetResponseLine: procedure expose buffer crlf logfile BytesRecv. stage,
                                  ControlQ CurrentQ

  Parse arg socket .
  Do While Pos(crlf, buffer) = 0
    retcode = SockRecv(socket, 'data', 10000)
    If retcode < 0 Then Do
      Say 'SockRecv()' errno
      Call SendMsg '<NEWNEWS> FAIL SOCK' errno
      Exit errno
    End
    buffer = buffer || data
  End
  data = Left(buffer, Pos(crlf, buffer) - 1)
  buffer = Substr(buffer, Pos(crlf, buffer) + 2)
  BytesRecv.stage = BytesRecv.stage + Length(data) + 2 /* for crlf */
  Return data

MySockSend: Procedure expose crlf logfile BytesSent. stage ControlQ CurrentQ

  Parse arg socket, data
  retcode = 0
  BytesSent.stage = BytesSent.stage + Length(data) + 2 /* for crlf */
  Do While retcode < Length(data)
    retcode = SockSend(socket, data)
    If retcode < 0 Then Do
      Say 'SockSend()' errno
      Call SendMsg '<NEWNEWS> FAIL SOCK' errno
      Exit errno
    End
    If retcode < Length(data) Then Do
      data = Substr(data, retcode + 1)
      retcode = 0
    End
  End
  Return

Log: Procedure expose logfile ControlQ CurrentQ

  Parse arg line
  retcode = Stream(logfile, 'c', 'open write')
  retcode = LINEOUT(logfile, line)
  retcode = Stream(logfile, 'c', 'close')
  Return

WindTimeBack5Minutes: Procedure expose logfile ControlQ CurrentQ

  Parse arg hh':'mm':'ss
  If mm >= 5 Then  Do      /* minutes 5 or more */
    mm = mm - 5
  End
  Else If hh > 0 Then Do   /* minutes less than 5 but hour 1 or more */
    mm = 60 + mm - 5
    hh = hh - 1
  End
  Else Do                  /* Less than 5 minutes after midnight */
    ss = 1                 /* Just wind back to midnight to avoid having */
    mm = 0                 /* to worry about months, leap years etc      */
  End
  If hh > 0 Then Do
    hh = hh - 1
  End
  Return Right(hh, 2, '0')||Right(mm, 2, '0')||Right(ss, 2, '0')

SendMsg: Procedure expose ControlQ CurrentQ

  Parse arg message
  If ControlQ <> '' & ControlQ <> 'CONTROLQ' Then Do
    Queue message
  End
  Return

CheckParameters:
  If DataType(max_articles) <> 'NUM' Then Do
    Say 'MAX_ARTICLES has an invalid setting ('max_articles')'
    Say 'Please correct NEWNEWS.INI and try again'
    Call Log 'NEWNEWS.INI: MAX_ARTICLES = 'max_articles
    Exit 1
  End
  Return

ReadINIFile:

  arg inifile, application
  file = Stream(inifile, 'c', 'query exists')
  If file = '' Then Do
    file = SysSearchPath('PATH',inifile)
  End
  If file = '' Then Do
    Say 'Unable to find' inifile
    Exit 1
  End
  Say 'inifile' file
  app = ''
  ini. = 0
  retcode = Stream(file, 'c', 'open read')
  If retcode <> 'READY:' Then Do
    Say 'Unable to open' file
    Exit 2
  End
  Do While Lines(file) <> 0
    line = LINEIN(file)
    If Left(line, 1) = '[' Then Do
      Parse Upper var line '[' app ']' .
    End
    Else Do
      If line <> '' & Left(line, 1) <> '#' Then Do
        If app = '' Then Do
          Say 'Invalid line in' file 'expected [application_name]'
          Exit 1
        End
        If app = application | app = 'DEFAULT' Then Do
          Parse var line varname '=' varvalue
          Parse Upper var varname varname
          varname = Strip(varname)
          varvalue = Strip(varvalue)
          If ini.varname = 0 | app = application Then Do
            retcode = Value(varname, varvalue)
            ini.varname = 1
          End
        End
      End
    End
  End
  retcode = Stream(file, 'c', 'close')
  Return

ShowWarranty:
  Say 'Because the program is licensed free of charge, there is no warranty'
  Say 'for the program, to the extent permitted by applicable law.  Except when'
  Say 'otherwise stated in writing the copyright holders and/or other parties'
  Say 'provide the program "as is" without warranty of any kind, either expressed'
  Say 'or implied, including, but not limited to, the implied warranties of'
  Say 'merchantability and fitness for a particular purpose.  The entire risk as'
  Say 'to the quality and performance of the program is with you.  Should the'
  Say 'program prove defective, you assume the cost of all necessary servicing,'
  Say 'repair or correction.'
  Say
  Say 'Read the GNU PUBLIC LICENSE for full details'
  Return

ShowConditions:
  Say 'You may copy and distribute verbatim copies of the Program''s'
  Say 'source code as you receive it, in any medium, provided that you'
  Say 'conspicuously and appropriately publish on each copy an appropriate'
  Say 'copyright notice and disclaimer of warranty; keep intact all the'
  Say 'notices that refer to this License and to the absence of any warranty;'
  Say 'and give any other recipients of the Program a copy of this License'
  Say 'along with the Program.'
  Say
  Say 'Read the GNU PUBLIC LICENSE for full details'
  Return