OS/2 Shareware BBS: 35 Internet/35-Internet.zip/mail19.zip/mail.cmd

OS/2 REXX Batch file | 1993-05-26 | 33KB | 975 lines

/* Tiny Mail..  by [e-mail] (or [e-mail])

   NOTE: Please read MAIL.CFG file, and configure MAIL.CMD before
  using it.

Version: 1.8  -- Adds more RexxUtil functions for speed.

Version: 1.7a -- added support for signature file as g.signature
               - fixed @erase of out.fil to g.outfile
               - fixed variable g.AllNotebookall to g.AllNotebook
               - acquired tcpip\etc from environment
               - update bindir with info from etcdir
               - fixed bug in location of all.notebook which
                 could appear in working directory
               - if g.AllNotebook is null then don't log
               - 1.7a updated made by Lionel Dyck
                 [e-mail]

This little program allows you to mail using TCP/IP's
SENDMAIL command. To receive mail, you need to have SENDMAIL
alive, but LAMAIL is not required to be active.

If you just type MAIL, it will display you the current mail
items on your \tcpip\etc\mail box. It assumes the default
drive.

You can also type MAIL userid@address    to send mail messages.

Comments? Suggestions? Please let me know. Let's improve this
little program!
**/

Parse arg destination '(' options

Call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs'
Call SysLoadFuncs

/* Locate TCP directory, so that 'tcp' contains something like
   'C:\TCPIP'
*/
Parse value value("ETC",,"OS2ENVIRONMENT") with tcp'\ETC'

/* DO NOT modify them here. Modify MAIL.CFG instead! */
g. = ''
g.myself = '[e-mail]'
g.signature = tcp'\signatur.txt'
g.screensize = word(SysTextScreenSize(),1)-4 /* lines */
g.UseCLS = 1
g.namefile = tcp'\turgut.nam'
g.defaultdomain = '.BITNET'
g.etcdir = tcp'\ETC'
g.bindir = tcp'\BIN'
g.editor = ''
g.detachSendmail = 0
g.displayAgent = ''
g.AllNotebook = 'All.Notebook'
g.OutFile = 'C:\Mailout.fil'


z = 'ETC DPATH PATH'
do i=1 to words(z)
   conf = SysSearchPath(subword(z,i,1),'MAIL.CFG')
   if conf¬='' Then Leave
End
If conf = '' Then Say 'Warning: MAIL.CFG is not found in PATH!'

/* Load lines with equal signs.. */
Parse value SysCurPos() with row .
Say
If row>4 Then row=row-1
Call SysCurPos row,0
Say 'Reading' conf
Call SysCurPos row,0
Call SysFileSearch "=",conf,'conf.'
If conf.0 < 1 Then
   Say 'Warning: NO lines were read from' conf
Say 'Interpreting' conf'      '
Call SysCurPos row,0
Do i=1 to conf.0
   Interpret conf.i
End
drop conf.
If ¬exist(g.bindir'\SENDMAIL.EXE') Then Do
   Say 'The program could not find' g.bindir'\SENDMAIL.EXE.'
   Say 'MAIL.CMD requires IBM TCP/IP 1.2.1 or above.'
   exit 1
end

Do while options ¬= ''
   parse upper var options option optionss
   If left(option,4) = 'FILE' Then parse var options inputfile options
End

/* did they use MAIL user@node syntax? */
If destination ¬= '' Then do
   subject = ''
   Call MailSend
   exit
end

Say 'Scanning for mail..                         '
Call SysCurPos row,0

Call Load_Mail
i=1
do nextmail=1 while mails¬=''
   fn = subword(mails,i,1)
   if fn = '' Then Exit
   Do show=1 to 999
     call display fn
     Say '<S>endNewMail  <#>Skip  <R>eply  <D>elete  <K>eep  <F>orward',
      ' <HX>Exit'
     pull option
     Select
       when option = '' Then Leave /* blank return */
       When option = '#' Then Do
           Say 'The # is not a real option - it simply means that you can'
           Say 'enter a number to skip to the message with that number.'
           call pressany
       End
       When option = 'R' Then Call Reply
       When option = 'D' Then Do
          Call Delete
          Leave
       End
       When option = 'K' Then Leave
       When option = 'F' Then Call Forward
       When option = 'S' Then do 1
           Say 'Enter destination address for new message:'
           parse pull destination
           if destination = '' Then Leave
           Call MailSend
       End
       When option = 'HX' Then exit
       When datatype(option,'N') Then Do
          i = option
          Leave
       End
       Otherwise nop
     End
   End /* keep showing */
   i = i + 1
End
exit 0

Reply:
   /* first lines are iffy */
   do i=1 to 4
     line = LINEIN(fn)
   end
   Do while lines(fn)>0
       line = LINEIN(fn)
       if line = '' then leave
       Queue line
   End
   rc = LINEOUT(fn,,) /* FINIS */
   Parse value '' with date subject origin replyto cc from
   Call LSV822IN queued(),'FROM DATE SUBJECT REPLYTO ORIGIN RCPT SENDER'
   Parse var result retcode . '15'x data
   said = 0
   Do while data¬=''
      Parse var data kwd value'15'x data
      Select
        When kwd = 'DATE'    Then date = value
        When kwd = 'SUBJECT' Then subject = value
        When kwd = 'REPLYTO' Then replyto = replyto,
           word(value,1)'@'word(value,2)
        When kwd = 'ORIGIN'  Then origin  = origin,
           word(value,1)'@'word(value,2)
        When kwd = 'CC'      Then cc = cc word(value,1)'@'word(value,2)
        When kwd = 'FROM'    Then from = from word(value,1)'@'word(value,2)
        When kwd = 'TO' Then Nop
        When kwd = 'TAG' Then Nop
        Otherwise Do
           Say kwd value
           said = 1
        End
      End /* select */
   End
   If said then Call pressany

   destination = from
   If replyto ¬= '' Then destination = replyto
   If cc ¬= '' Then destination = destination cc
   If strip(destination) = '' Then Do
      Say 'Cannot determine mail origin.'
      Return
   End
   If translate(left(subject,3))='RE:' Then subject=substr(subject,4)
     Else subject = 'Re:'subject
   Call MailSend subject
   Return

Delete:
   '@ERASE 'fn
   /* fix INBOX now.. */
   inbox  = g.etcdir'\MAIL\INBOX.NDX'
   outbox = g.etcdir'\MAIL\INBOX.TMP'
   If ¬exist(inbox) Then Return /* all done! */
   If exist(outbox) Then '@ERASE' outbox
   do while lines(inbox)
      line = LINEIN(inbox)
      Parse var line 28 dfn dft .
      if g.etcdir'\MAIL\'dfn'.'dft = fn Then Iterate
      rc = LINEOUT(outbox,line)
      if rc¬=0 Then Call Fatal 'Error writing' outbox 'rc='rc
   end
   rc = LINEOUT(inbox,,)
   rc = LINEOUT(outbox,,)
   '@ERASE' inbox
   '@REN' outbox 'INBOX.NDX'
   Return


Forward:
   Say 'Enter complete destination address or nickname:'
   parse pull un
   if un = '' Then Return
   if pos('@',un) = 0 Then
       Parse value SearchNickName(un) with un .
   if pos('.',un)=0  then un=un||g.defaultdomain
   If exist('MAIL.TMP') Then '@ERASE MAIL.TMP'
   line = LINEIN(fn)
   do while (lines(fn)>0)
       line = LINEIN(fn)
       rc = LINEOUT("MAIL.TMP",line)
       if rc¬=0 Then Do
          Say 'Error' rc 'writing MAIL.TMP'
          Exit rc
       End
   end
   rc = LINEOUT(fn,,)
   rc = LINEOUT('MAIL.TMP',,)

   If g.DetachSendmail Then
      '@DETACH 'g.bindir'\SENDMAIL -af MAIL.TMP -f' g.myself un
   Else
      g.bindir'\SENDMAIL -af MAIL.TMP -f' g.myself un
   if rc¬=0 then
      Say 'Warning:' g.bindir'\SENDMAIL failed.'
   else say 'Successful delivery.'
   '@ERASE MAIL.TMP'
   Return

Load_Mail:
  mails = '' /* keeps filenames.. */
  rc = SysFileTree(g.etcdir"\MAIL\*.*",s,'B')
  If rc¬=0 Then Call Fatal("Cannot load mailbox")
  If s.0 = 0 Then Do
     Say 'No mail in your mailbox.'
     Return
  End
  Do i=1 to s.0
      fn = word(s.i,5)
      x = lastpos('\',fn)
      rest = substr(fn,x + 1)
      if ¬datatype(rest,'N') then iterate
      mails = mails fn
  End
  z = words(mails)
  s=''
  if z>1 then s = 's'
  if z = 0 then z = 'No'
  Say z 'new mail message's'.                '
  Return

Display:
procedure expose g.
arg fn
  lines = 0
  if g.useCLS Then Call SysCLS
  If g.DisplayAgent ¬='' Then Do
     '@'g.DisplayAgent fn
     Return
  End
  Say 'File:'fn
  do while lines(fn)>0
    line = LINEIN(fn)
    Say line
    count = trunc(length(line) / 80)
    if count < 1 then count = 1
    lines = lines + count
    if lines >= g.screensize then do
       say 'More? (Y/n/hx)'
       pull a
       if a = 'N' | a = 'NO' then leave
       If a = 'HX' Then do
         dummy = lineout(fn,,)  /* close file */
         Exit
       end
       lines = 0
       if g.useCLS then Call SysCLS
    end
  end
  dummy = lineout(fn,,)  /* close file */
   return

Exist:
procedure
arg fn
   rc  = SysFileTree(fn,s,'B')
   return s.0 > 0

/* Immediate commands are handled here */
Immediate_Command:
procedure expose g. fn SMdest destination typedany subject
Arg cmd options .
  Select
     when cmd = '/HELP' | cmd = '/?' then Do
        Say 'Available immediate commands are:'
        Say '       /MERGE fn.ft  - to append a file'
        Say '       /REDISP       - to redisplay mail'
        Say '       /ADD u@n      - add/display a recipient'
        Say '       /REMOVE u@n   - remove/display a recipient'
        Say '       /EXIT         - send message'
        Say '       /QUIT         - abort message'
        Say 'Any other line starting with a slash is left as-is.'
     End
     When cmd = '/MERGE' Then Do
        lines=0
        do while lines(options) > 0
          line = LINEIN(options)
          rc = LINEOUT(fn,line)
          if rc¬=0 then call fatal 'Error writing line to' fn
          lines=lines+1
        end
        rc = LINEOUT(options,,)
        Say 'Merge completed.' lines 'appended.'
        if typedany = 0 & lines>0 then typedany = 1
     End
     When cmd = '/REDISP' Then Do
        if g.useCLS Then Call SysCLS
        Say 'To:' destination
        If subject ¬= '' Then Say 'Subject:' subject
        Say 'Date:  'date() time()
        Say
        If exist(fn) Then '@TYPE' fn
     End
     When cmd = '/ADD' Then Do
       un = options; name = ''
       If un ¬= '' Then Do
         if pos('@',un)=0 Then
            parse value SearchNickName(options) with un name
         SMdest = SMdest','un
         if name¬='' then un= '"'name'" <'un'>'
         destination = destination','un
       End
       If left(destination,1)=',' Then destination = substr(destination,2)
       Call Immediate_Command '/REDISP'
     End
     When cmd = '/REMOVE' Then Do 1
       un = options; name = ''
       If un = '' Then Leave
       If Find(translate(SMdest),un)>0 Then
          SMdest = delword(SMdest,find(translate(SMdest),un),1)
       If Find(translate(destination),un)>0 Then
          destination = delword(destination,Find(translate(destination),un),1)
       Call Immediate_Command '/REDISP'
     End
     When cmd = '/QUIT' Then Return -1
     When cmd = '/EXIT' Then Return 2
     Otherwise Return 1 /* unknown cmd */
   End /* select */
   Return 0 /* command processed. */

/***********/
MailSend:
Procedure expose destination g.
Parse Arg subject

if g.useCLS then Call SysCLS

/* remove commas */
destination = translate(destination,' ',',')
newdest = ''
SMdest = '' /* sendmail doesnt accept full names ".." stuff */
do words(destination)
   parse var destination un destination
   if pos('@',un) = 0 Then
       Parse value SearchNickName(un) with un name
   else name = ''
   If pos('.',un) = 0 then un = un||g.defaultdomain
   SMdest = smdest','un
   If name¬='' Then un = '"'name'" <'un'>'
   newdest = newdest','un
end
destination = substr(newdest,2)
SMdest = substr(SMdest,2)

Say
Say 'To:' destination
If subject = '' Then Do
   Say 'Subject? (optional)'
   parse pull subject
End
Else
   Say 'Subject:' subject
Say 'Date:  'date() time()

fn = '\mailfile.tmp'
if Exist(fn) then '@ERASE' fn
fn2 = '\mailfile.tm1'
if Exist(fn2) then '@ERASE' fn2


If g.editor ¬='' Then Do /* external editor specified? */
   '@'g.editor fn
   If ¬exist(fn) Then Return
   Say 'Send message?'
   Pull yn
   If left(yn,1) ¬= 'Y' Then Return
   Signal DoneEdit
End

Say
Say 'Compose your mail, hit CTRL-K - ENTER when done. Use /? for help.'
Say
typedany = 0
Do forever
   parse pull blurb
   if left(blurb,1) = '/' Then Do
      rc = immediate_command(blurb)
      if rc = -1 Then do /* quit */
         typedany = 0
         leave
      End
      if rc = 0 Then Iterate /* command done */
      if rc = 2 Then Leave /* /exit */
   End
   t = c2d(left(blurb,1))
   if t<28 then leave /* control char?*/
      else typedany = 1
   rc = LINEOUT(fn,blurb,)
   if rc¬=0 then call fatal 'Error writing line to' fn
End

If ¬typedany Then Do
   Say 'Empty mailfile.. Not sent.'
   Return
End
rc = LINEOUT(fn,,)

DoneEdit:

/* Append header info */
rc = LINEOUT(fn2,'To:    'destination)
If subject¬='' then rc = LINEOUT(fn2,'Subject:' subject,)
rc = LINEOUT(fn2,'Date:  'date() time())
Do i=1 while g.Header.i¬=''
   rc = LINEOUT(fn2,g.Header.i)
End
rc = LINEOUT(fn2,'  ')
rc = LINEOUT(fn2,,)
'@COPY/B' fn2'+'fn g.outfile '> NUL'
'@ERASE' fn
'@ERASE' fn2

if exist(g.signature) = 1 then do
   '@COPY/B' g.outfile'+'g.signature fn2 '> NUL:'
   '@COPY/B' fn2 g.outfile '> NUL:'
   '@Erase' fn2
   end

blurb = 'Mail send to' SMdest
/* log note if g.allnotebook is not null */
if g.AllNotebook <> "" then do
   blurb = blurb',saved in' g.etcdir'\mail\'g.AllNotebook
   If exist(g.etcdir'\mail\'g.AllNotebook) then do
      fn2 = g.etcdir'\mail'fn2
      '@COPY/B' g.etcdir'\MAIL\'g.ALLNOTEBOOK'+'g.outfile fn2 '> NUL:'
      '@Del' g.etcdir'\mail\'g.allnotebook
      '@Rename' fn2 g.allnotebook
      end
   else
      '@COPY/B' g.outfile g.etcdir'\MAIL\'g.ALLNOTEBOOK '> NUL:'
end
Say blurb

if g.detachSendmail Then
  '@DETACH SENDMAIL -af' g.outfile '-f' g.myself SMdest
Else do
  'SENDMAIL -af' g.outfile '-f' g.myself SMdest
   If rc = 0 Then '@ERASE' g.outfile
End
Return

SearchNickName:
Procedure expose g.
arg nick .

load = 0
parse value '' with user node name
do both=1 while lines(g.namefile)>0
   line = strip(LINEIN(g.namefile))
   do while length(line)>1
      Parse var line ':'tag'.'value':'line
      tag = translate(tag)
      if tag = 'NICK' Then Do
         If load then Leave Both
         If translate(value) = nick Then load = 1 /* start loading */
         line=':'line
         Iterate
      End
      If ¬load then iterate
      Select
        When tag = 'USERID' Then user = value
        When tag = 'NODE'   Then node = value
        When tag = 'NAME'   Then name = value
        Otherwise Nop
      End
      line = ':'line
   End
End
rc = LINEOUT(g.namefile,,)
if words(user node)<2 then return nick
Return strip(user)'@'strip(node) name

Fatal:
parse arg blurb
   say blurb
   exit

isdelimiter:
parse arg argh
Return (pos(argh,'."%@!')>0)

Find:
Parse arg one,another
  Return pos(another,one)

pressany:
  say 'Press ENTER..'
  parse pull
  return


/**********************************************************************
*                                                                     *
* LSV822IN -- LISTEARN system, RFC822 input header parsing            *
*                                                                     *
*              LISTEARN List Processor, Release 1                     *
*           ----------------------------------------                  *
*        LISTEARN 1.0  (c) EARN Association 1989 is derived from:     *
*        LISTSERV 1.5o (c) Eric Thomas 1986,1987,1988,1989            *
*                                                                     *
*                                                                     *
* This program is public domain. It can be used in any academic, non- *
* commercial program without charge provided that the author is noti- *
* fied of the use (so that he can send fixes if need arise).          *
*                                                                     *
*                                                                     *
* Syntax: Call LSV822IN numlines<,options>                            *
*                                                                     *
* 'numlines' is  the number  of lines  that have  been placed  in the *
* program stack and constitute the input to LSV822IN. The recommended *
* approach is to place the  complete mailfile contents in the program *
* stack and make this number of  lines available to LSV822IN. It will *
* automatically stop  when the end of  the mail header (ie  the first *
* blank line)  is encountered,  and will report  how many  lines were *
* extracted from the program stack (see below).                       *
*                                                                     *
* 'options' is a string of  options controlling the amount and nature *
* of the  output generated  by LSV822IN. The  default value  is empty *
* string.                                                             *
*                                                                     *
*                                                                     *
* The result is of the following form:                                *
*                                                                     *
*     rc numread reserved '15'x field1 <'15'x field2 <'15'x...>>      *
*                                                                     *
* 'rc' is a return code.  0 indicates successful completion, 4 stands *
* for "warning  messages have  been issued but  the input  mail might *
* still be processable", and 8  indicates an error which should cause *
* rejection of the input file.                                        *
*                                                                     *
* 'numread' is the  number of lines that have been  obtained from the *
* program stack in the process of extracting the mail header from it. *
*                                                                     *
* 'reserved' is  one or  more word positions  which are  reserved for *
* future  use  and  should  be  discarded  by  the  caller  to  avoid *
* compatibility problems with future versions of the program.         *
*                                                                     *
*                                                                     *
* Each  "field" contains  some  form of  information  about the  mail *
* header or an error message. There  can be any number of fields, and *
* the caller  should not assume anything  on the order in  which they *
* appear. The format of a 'field' is the following:                   *
*                                                                     *
*           fieldname field-data                                      *
*                                                                     *
* Example:  W Duplicate 'To:' field encountered.                      *
*                                                                     *
* 'fieldname' is  an uppercase "name"  associated with the  field and *
* describing its contents.                                            *
*                                                                     *
* 'field-data' is  a mixed case  string which represent the  value of *
* the field.                                                          *
*                                                                     *
*                                                                     *
* The following fields are presently generated:                       *
*                                                                     *
* - I: informational message. These  are non-severe messages which do *
*   not cause the return code to be changed. The recommended disposal *
*   of these  messages is to  echo them on  the console log  file and *
*   discard them. They should not be sent back to the mail originator *
*   (but  it would  be acceptable  to  do so  if desired).  It is  an *
*   acceptable implementation  to discard all  informational messages *
*   without any further processing; however,  it is NOT an acceptable *
*   implementation  to reject  a  mailfile  because an  informational *
*   message has been issued.                                          *
*                                                                     *
* - W: warning message. These messages are issued whenever a possible *
*   error has  been detected in the  input data stream. It  should be *
*   echoed to the  console log file and it is  recommended to echo it *
*   to the mail originator as  well. The implementation can choose to *
*   reject  or process  the  mailfile  as desired,  but  there is  no *
*   warranty  that the  mail  header information  integrity has  been *
*   preserved. For example, a gateway  might have moved one line from *
*   the mail body  to the header, possibly causing  a warning message *
*   to be  issued by LSV822IN. The  mailfile might, or might  as well *
*   not, be meaningful to the calling program.                        *
*                                                                     *
* - E: error message. This is a severe error in the mail header which *
*   should cause the mailfile to be rejected. The message ought to be *
*   displayed on  the console log  file and  echoed back to  the mail *
*   originator if at all possible (a  good example of an E message is *
*   precisely "E Missing sender field ('From:'/'Sender:')" -- in that *
*   case the message ought to be echoed to a human operator instead). *
*                                                                     *
* - DATE: this is  the 'Resent-Date:' or 'Date:' field  from the mail *
*   message. It is automatically generated  if missing. Its format is *
*   exactly  what the  mailing system  had put  in the  corresponding *
*   field. It is supplied only if the 'DATE' option was specified.    *
*                                                                     *
* - FROM:  this is  the  'Resent-From:'/'From:'  field, in  "address" *
*   format (see below). It is provided  only if the 'FROM' option was *
*   specified. Note that there may  be several 'FROM' fields if there *
*   is a 'Resent-Sender:'/'Sender:' specification.                    *
*                                                                     *
* - SENDER:   this  is   the  'Resent-Sender:'/'Sender:'   field,  in *
*   "address" format (see below). It is provided only if the 'SENDER' *
*   option was specified.                                             *
*                                                                     *
* - ORIGIN:  this  is the  'Resent-Sender:'/'Resent-From:'/'Sender:'/ *
*   'From:'  field,  in  "address"   format.  This  field  is  unique *
*   and is always provided.                                           *
*                                                                     *
* - TO,  CC  and BCC:  this  is  one  recipient  out of  the  various *
*   'Resent-To:'/'To:',  'Resent-cc:'/'cc:' and  'Resent-bcc:'/'bcc:' *
*   fields, in  "address" format.  There may be  any number  of those *
*   fields.  They  are  only  provided  when  the  'RCPT'  option  is *
*   specified.                                                        *
*                                                                     *
* - SUBJECT: this is  the 'Subject:' field as it appears  in the mail *
*   header. It corresponds to the 'SUBJECT' option.                   *
*                                                                     *
* - REPLYTO:  this is  the  'Resent-Reply-To:'/'Reply-To:' field,  in *
*   "address" format. There  may be any number of  these fields. They *
*   correspond to the 'REPLYTO' option.                               *
*                                                                     *
* - MSGID: this  is the 'Resent-Message-ID:'/'Message-ID:'  field, as *
*   it appeared in the original tag.  This data is only provided when *
*   the 'MSGID' option is specified.                                  *
*                                                                     *
* - TAG:  these  fields  are  generated when  the  'COPY'  option  is *
*   present, and represent the contents of one of the original RFC822 *
*   fields from the input mail header, unfolded and in the same order *
*   as they were specified in the original header.                    *
*                                                                     *
*                                                                     *
*                                                                     *
* "address" format is defined as follows:                             *
*                                                                     *
*      userid domain name                                             *
*                                                                     *
*                                                                     *
* 'userid' is the "local portion" of the RFC822 address.              *
*                                                                     *
* 'domain'  is the  "domain portion"  of the  RFC822 address.  If the *
* 'BITNET'  option  is  specified,  any trailing  ".BITNET"  will  be *
* removed from 'domain'.                                              *
*                                                                     *
* 'name',  if  present,  is  the  person's  full  name  in  canonical *
* representation, ie with all quoting characters removed.             *
*                                                                     *
*                                                                     *
* This program is system-independent and  can run under any operating *
* system that supports REXX.                                          *
*                                                                     *
***********************************************************************
Update History:
10/29/91: Corrected wrapping of multi-line addresses. Spaces are added
          based on need, not blindly.
01/14/92: Corrected line>250 character problem.
07/24/92: FIX00119: Adds support for "user"@node format
11/18/92: FIX00137: corrects "user" <user@node> parsing
*/

LSV822IN:
procedure

 Arg numlines .,options
 output = ''
 numread = 0
 retcode = 0

 If numlines < 1 | ¬Datatype(numlines,'W') Then
  Do
    Call LSVerror 'Invalid parameter list -- "'Arg(1)'","'Arg(2)'".'
    Signal LSVexit
  End

 Do numlines
    numread = numread+1
    Parse pull line
    l.numread = Strip(Translate(line,,'0515'x),'T')
    If l.numread = '' Then Leave
 End

 i = 1
 BITNET = (Find(options,'BITNET') ¬== 0)
 copy = (Find(options,'COPY') ¬== 0)
 n. = 0
 k. = ''
 Do until i > numread
    line = l.i
    i = i+1
    Do while Left(l.i,1) == ' '
       t = i-1
       If length(l.t)<79 & ¬isdelimiter(left(strip(l.i),1)) Then
          line = line Strip(l.i)
       Else
          line = line||Strip(l.i)
       i = i+1
    End
    If Left(line,1) == ' ' Then
     Do
       Call Warning 'RFC822 field starting with a blank.',
           'Field ignored. Line:' i
       Iterate
     End
    Parse var line keyword':'data
    data = Strip(data)
    keyword = Translate(Strip(keyword))
    If length(keyword)>250 Then Do
       Call LSVerror 'Keyword too long line:' i
       Signal LSVexit
    End

    If Words(keyword) ¬== 1 Then
     Do
        Call Warning 'Invalid RFC822 field -- "'keyword'"'
        Iterate
     End
    If copy Then Call Outfield 'TAG' Strip(line)
    k.keyword = data
    n.keyword = n.keyword + 1
 End
 Drop l.

 If Find(options,'SUBJECT') ¬== 0 Then
  Do
    dolr = 'SUBJECT'; If n.dolr > 1 Then Call Duplicate 'Subject:'
    Call Outfield 'SUBJECT' k.dolr
  End

 If Find(options,'REPLYTO') ¬== 0 Then
  Do 1
     tag = First('RESENT-REPLY-TO REPLY-TO')
     If tag == ':' Then Leave
     If n.tag > 1 Then Call Duplicate 'Resent-Reply-To:/Reply-To:'
     input = k.tag
     Do while input ¬= ''
        Call Getaddress
        If result ¬== '' Then Call Outfield 'REPLYTO' result
     End
  End

 If Find(options,'DATE') ¬== 0 Then
  Do
    tag = First('RESENT-DATE DATE')
    If n.tag > 1 Then Call Duplicate 'Resent-Date:/Date:'
    If k.tag ¬= '' Then Call Outfield 'DATE' k.tag
                   Else Call Outfield 'DATE' Gendate()
  End

 If Find(options,'MSGID') ¬== 0 Then
  Do
    tag = First('RESENT-MESSAGE-ID MESSAGE-ID')
    If n.tag > 1 Then Call Duplicate 'Resent-Message-ID:/Message-ID:'
    If k.tag ¬= '' Then Call Outfield 'MSGID' k.tag
  End

 If Find(options,'RCPT') ¬== 0 Then
  Do
    Call Gendest 'TO','To'
    Call Gendest 'CC','cc'
    Call Gendest 'BCC','bcc'
  End

 If Find(options,'FROM') ¬== 0 Then Call Gendest 'FROM','From'
 If Find(options,'SENDER') ¬== 0 Then Call Gendest 'SENDER','Sender'

 tag = First('RESENT-SENDER RESENT-FROM SENDER FROM')
 If tag == ':' Then
  Do
    Call LSVerror '"From:"/"Sender:" field is missing.'
    Signal LSVexit
  End

 If n.tag > 1 Then Call Duplicate tag':'
 input = k.tag
 Call Getaddress
 If result = '' Then
  Do
    Call LSVerror 'Mail origin cannot be determined.'
    Call LSVerror 'Original tag was ->' tag':' k.tag
    Signal LSVexit
  End

 Call Outfield 'ORIGIN' result
 If input ¬= '' Then
     Call Warning 'More than one sender was specified.',
         'Second and following senders discarded.'

LSVexit:
 Return retcode numread '15'x||output

Inform:
 Call Outfield 'I' Arg(1)
 Return

Warning:
 Call Outfield 'W' Arg(1)
 retcode = Max(retcode,4)
 Return

LSVerror:
 Call Outfield 'E' Arg(1)
 retcode = Max(retcode,8)
 Return

Duplicate:
 Call Warning 'Field "'Arg(1)'" duplicated.',
     'Last occurence was retained.'
 Return

Outfield:
 If output == ''
  Then output = Arg(1)
  Else output = output||'15'x||Arg(1)
 Return

First:
 Parse arg search
 Do Words(search)
    Parse var search keyword search
    If n.keyword ¬== 0 Then Return keyword
 End
 Return ':' /* This keyword can not exist and will yield null string */

Gendate:
 Return Left(Date('W'),3)',' Subword(Date(),1,2),
     Left(Date('O'),2) Time() 'LCL'
Gendest:
 Parse arg tagname .,nicetag
 tag = First('RESENT-'tagname tagname)
 If tag == ':' Then Return
 If n.tag > 1 Then Call Duplicate 'Resent-'nicetag':/'nicetag':'
 input = k.tag
 Do while input ¬= ''
    Call Getaddress
    If result ¬= '' Then Call Outfield tagname result
 End
 Return

Getaddress: Procedure expose input output retcode options BITNET
 If input = '' Then Return ''
 userid = ''
 domain = ''
 name = ''
 string = ''
 quote = 0
 saved = 0
 special.0 = '\"@<>():;,'
 special.1 = '\"'
 special.2 = 'E0'x||'()'
 oinput = input
 Do while input ¬= ''
    i = Verify(input,special.quote,'M')
    If i == 0 Then i = Length(input)+1
    string = string||Left(input,i-1)
    Parse Value Substr(input,i) with c +1 input
    Select
      When c == '\' Then Call Backslash
      When c == '"' Then quote = ¬quote
      When Pos(c,'@<>():;,') == 0 Then string = string||c
      When c == ',' Then Leave
      When c == '<' Then Call Append 'name'
      When c == '>' Then Call Append 'domain'
      When c == '(' Then Call LSVsave
      When c == ')' Then Call Restore
      When c == '@' Then Do
         If pos('"'string'"@',space(oinput,0))>0 Then
            string='"'string'"'
         Call Append 'userid'
      End
      When c == ':' Then string = ''
      When c == ';' Then nop
    End
 End
 If saved ¬== 0 Then
     Call LSVerror 'Unmatched parenthesis in address field.'
 If domain = '' Then domain = string
                Else name = name string
 If BITNET & Translate(Right(domain,7)) == '.BITNET' Then
     domain = Left(domain,Length(domain)-7)
 userid = Space(userid)
 domain = Space(domain)
 If CheckDomain(userid) | CheckDomain(domain) Then Return ''
 If userid ¬== '' & domain ¬== '' Then
     Return Space(userid,0) Space(domain,0) Space(name)
 Call Inform 'Empty address field found and ignored.'
 If input = '' Then Return ''
 Return Getaddress()

Append:
 Arg appto
 If saved ¬== 0 Then Return
 Select
   When appto == 'NAME' Then name = name string
   When Value(appto) == '' Then Interpret appto '= string'
   Otherwise name = name string
 End
 string = ''
 Return

Backslash:
 Parse var input c +1 input
 string = string||c
 Return

LSVsave:
 saved = saved+1
 If saved ¬== 1 Then Return
 savestr = string
 string = ''
 quote = 2
 Return

Restore:
 saved = saved-1
 If saved ¬== 0 Then Return
 name = name string
 string = savestr
 quote = 0
 Return

CheckDomain:
 Arg string
 If BITNET Then splitters = '%.'
           Else splitters = '.'
 Do forever
    i = Pos(' ',string)
    If i == 0 Then Return 0
    If Pos(Substr(string,i-1,1),splitters) == 0 &,
        Pos(Substr(string,i+1,1),splitters) == 0 Then Return 1
    string = Substr(string,i+1)
 End

Isdelimiter:
parse arg argh
   Return (pos(argh,'."%@!')>0)