OS/2 Shareware BBS: 35 Internet/35-Internet.zip/steward8.zip/Message.cmd

OS/2 REXX Batch file | 1996-06-27 | 31KB | 1,069 lines

/* Steward Version 1.1 Build 8 */
/* Message Module */
/*
 * A mailing list processor in Rexx by Paul Hethmon
 *
 */

/* variable declarations */

Steward = 'Steward'
StewardVersion = 'Version 1.1 Build 8'
StewardDate = '26 June 1996'
uppercase = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
lowercase = 'abcdefghijklmnopqrstuvwxyz'
Env = 'OS2ENVIRONMENT'
FALSE = 0
TRUE = 1

/* Set to 1 to enable debug output */
Debug = TRUE
/* Set to 1 to enable logging */
Log = TRUE
LogFile = ''
ETime1 = 0
ETime2 = 0
Author = ''
AdminFile = ''
AdminSubject = ''
AdminTo = ''

/* Variables normally read from the configuration file */
/* These values are provided as defaults only */
HomeDir = 'c:'
LogDir = 'c:'
ListDir = 'c:'
Mailer = 'hmailer'
WhereAmI = 'steward'
WhoAmI = Steward
WhoAmIOwner = 'postmaster@'WhereAmI
MasterPassword = 'steward'

/* The following are set on a per list basis */
AdminPassword = 'steward-list'
Administrivia = 0
ListOwner = WhoAmIOwner
Advertise = '*'
ApprovePassword = 'steward-pass'
DoArchive = 0
Moderated = 0
NoList = 0
Precedence = 1
ListHeader = 1
ListFooter = ''
DoDigest = 0
DigestVolume = 0
DigestIssue = 0
DigestName = ''
DigestRmHeader = 1
DigestFronter = ''
DigestFooter = ''
DigestSubs = TRUE
SubscribePolicy = 'open'
ReplyTo = ''
SubjectPrefix = 'Steward-List: '
OpenPosting = FALSE
WelcomeFile = ''
CaseInsensitive = FALSE

/* Some other global variables */
HeadFrom = ''
HeadTo = ''
HeadReplyTo = ''
HeadSubject = ''
HeadDate = ''
HeadCc = ''
HeadSender = ''
HeadEmail = ''
Email = ''
Approved = FALSE
PassWord = ''

/* The external functions we need */
call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName'
call RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'
call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'
call RxFuncAdd 'SysSleep', 'RexxUtil', 'SysSleep'

/* start main function */
/* The first arg is who the message was sent to.
 * The second is the filename. We're responsible
 * for cleaning up the file if needed.
 */
parse arg ListName MsgFile

if Debug = TRUE then say 'ListName =' ListName 'MsgFile =' MsgFile

call on error name ErrHandler

say 'Reading Master Configuration File Now.'

/* Read the master configuration file now */
rc = ReadMasterCf()
if rc = FALSE then
  do
  say 'Unable to read master configuration file. Failing.'
  ErrFile = SysTempFileName('?????.err', '?')
  rc = stream(ErrFile, 'C', 'OPEN WRITE')
  rc = lineout(ErrFile, 'Steward Error File', )
  rc = lineout(ErrFile, 'You must rerun Steward with the recipient name and', )
  rc = lineout(ErrFile, 'message file name listed below in order to process', )
  rc = lineout(ErrFile, 'this message.', )
  rc = lineout(ErrFile, 'Rcpt =' Rcpt, )
  rc = lineout(ErrFile, 'MsgFile =', MsgFile, )
  rc = stream(ErrFile, 'C', 'CLOSE')
  exit
  end

/* change to the Steward Home Directory */
Junk = directory(HomeDir)

if Debug = TRUE then
  do
  say 'LogDir =' LogDir
  say 'HomeDir = ' HomeDir
  say 'ListDir =' ListDir
  say 'Junk =' Junk
  end

if Log = TRUE then do
  ETime1 = time('E')
  call StartLog
  call WriteLog('ListName =' ListName)
  call WriteLog('MsgFile =' MsgFile)
  end

/* Process the message */
call DoMessage

/* Make sure the tmp file is deleted */
rc = SysFileDelete(MsgFile)

if Log = TRUE then do
  ETime2 = time('E')
  call StopLog
  end

exit

/* ------------------------------------------------------------------ */

DoMessage:

/* Read the per list configuration file */
call ReadListCf(ListName)

if Debug = TRUE then say 'Processing message now'
if Log = TRUE then call WriteLog('Processing message now')

rc = stream(MsgFile, 'C', 'OPEN READ')  /* open the file for reading */
if rc <> 'READY:' then do
  call WriteLog('Could not open message file.')
  return
  end

call ParseHeaders  /* first get the header info */

if HeadReplyTo <> '' then
  HeadEmail = HeadReplyTo
else
  HeadEmail = HeadFrom
/* now clean up the email address */
HeadEmail = NormalizeEmail(HeadEmail)
HeadEmail = translate(HeadEmail, lowercase, uppercase)

if Debug = TRUE then say 'HeadEmail =' HeadEmail

/* create a temp file for the outgoing message */
OutFile = SysTempFileName('f?????.tmp', '?')
rc = stream(OutFile, 'C', 'OPEN WRITE')  /* open the file for writing */
if rc <> 'READY:' then do
  call WriteLog('Could not create temp file for outgoing message.')
  end

if Debug = TRUE then
  do
  say 'ListName =' ListName
  say 'HeadEmail =' HeadEmail
  end
if Log = TRUE then
  do
  call WriteLog('ListName =' ListName)
  call WriteLog('HeadEmail =' HeadEmail)
  end

/* now check and see if this person is on the list */
if CanPost(ListName HeadEmail) = FALSE then do
  if Debug = TRUE then say 'Cannot post.'
  if Log = TRUE then call WriteLog('Cannot post.')
  call ReturnErrorMsg   /* also close and delete the message file */
  return
  end

if Debug = TRUE then say 'Sender can post.'
if Log = TRUE then call WriteLog('Sender can post.')

/* See if it needs a moderator's approval */
if Moderated = TRUE then do
  if CheckForApproval() = FALSE then do  /* this post not approved, send to moderator */
    call SendToModerator                 /* this will also close the message file */
    if Debug = TRUE then say 'Sending msg to moderator for approval.'
    if Log = TRUE then call WriteLog('Sending msg to moderator for approval.')
    return
    end
  end

if Debug = TRUE then say 'Message ok to send to list.'
if Log = TRUE then call WriteLog('Message ok to send to list.')

/* if we're here, then this is a non-moderated list or an approved post */
/* the CheckForApproval function has already digested the approval header */
/* so that it is not sent to the list also. Now send the message out. */

call WriteListHeaders

do while lines(MsgFile) <> 0         /* until end of file */
  Line = linein(MsgFile)             /* get a line of the file */
  rc = lineout(OutFile, Line, )      /* write it to the outfile */
  end

rc = stream(MsgFile, 'C', 'CLOSE')   /* close both files */
rc = stream(OutFile, 'C', 'CLOSE')

if ListFooter <> '' then do
  Footer = ListDir'\'ListName'\'ListFooter
  rc = AppendLock(Footer OutFile)
  end

if Debug = TRUE then say 'Headers and Msg written to outfile.'

/* now create the file with the email addresses in it */
FileName = ListDir'\'ListName'\'ListName
/* create a temp file for the email addresses */
EmailFile = SysTempFileName('e?????.tmp', '?');
/* copy the list's email addresses to the temporary name */
rc = CopyLock(FileName EmailFile)

if Log = TRUE then do
  call WriteLog('Mail from:' ListName'-owner@'WhereAmI)
  call WriteLog('Emailfile:' EmailFile)
  call WriteLog('Msgfile:' OutFile)
  call LogRcpt(EmailFile)
  end

if Debug = TRUE then say 'EmailFile ready.'

/* Save to the archives if requested */
if DoArchive = TRUE then do
  call SaveArchive(OutFile)
  end

/* Save to the digest if we're running this list as a digest too */
if DoDigest = TRUE then do
  call SaveDigest(OutFile)
  end

if Debug = TRUE then say 'Starting mailer.'

/* start the mail program to send the message out */
Mailer ListName'-owner@'WhereAmI EmailFile OutFile

return

/* ------------------------------------------------------------------ */

SendToModerator:

if Log = TRUE then call WriteLog('Sending msg to moderator for approval.')

/* write the headers first */
TimeZone = value( 'TZ', , Env)
TmpTime = time('N')
DayOfWeek = date('W')
DayOfWeek = left(DayOfWeek, 3)
TmpDate = date('N')
rc = lineout(OutFile, 'Date:' DayOfWeek',' TmpDate TmpTime TimeZone, )
rc = lineout(OutFile, 'Sender:' WhoAmI'-owner <'WhoAmI'-owner@'WhereAmI'>', )
rc = lineout(OutFile, 'From:' WhoAmI '<'WhoAmI'@'WhereAmI'>', )
rc = lineout(OutFile, 'Reply-To:' ListName'@'WhereAmI, )
rc = lineout(OutFile, 'Subject: Approval Request for' ListName, )
rc = lineout(OutFile, 'To:' ListOwner, )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'Approved: ', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, '--------------------------------------------------', )
rc = lineout(OutFile, 'From:' HeadFrom, )
rc = lineout(OutFile, 'To:' HeadTo, )
rc = lineout(OutFile, 'Subject:' HeadSubject, )
rc = lineout(OutFile, '--------------------------------------------------', )

/* now copy the rest of the message */
do while lines(MsgFile) <> 0         /* until end of file */
  Line = linein(MsgFile)             /* get a line of the file */
  rc = lineout(OutFile, Line, )      /* write it to the outfile */
  end

rc = stream(MsgFile, 'C', 'CLOSE')   /* close both files */
rc = stream(OutFile, 'C', 'CLOSE')

EmailFile = SysTempFileName('e?????.tmp', '?')
rc = stream(EmailFile, 'C', 'OPEN WRITE')  /* open the file for writing */
if rc <> 'READY:' then do
  call SendError('no emailfile')
  end
rc = lineout(EmailFile, ListOwner, )
rc = stream(EmailFile, 'C', 'CLOSE')

/* now mail it to the moderator */
Mailer WhoAmI'@'WhereAmI EmailFile OutFile

return

/* ------------------------------------------------------------------ */

ReturnErrorMsg:

if Debug = TRUE then say 'Returning error msg to sender.'
if Log = TRUE then call WriteLog('Returning error msg to sender.')

/* write the headers first */
AdminSubject = 'Your Message To' ListName
if HeadReplyTo <> '' then
  AdminTo = HeadReplyTo
else if HeadFrom <> '' then
  AdminTo = HeadFrom
AdminFile = OutFile
call WriteAdminHeaders

rc = lineout(OutFile, 'Your message to the list' ListName 'has been rejected.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'You are not a member of the list. For help on subscribing to', )
rc = lineout(OutFile, 'the list, please send a message to' WhoAmI'@'WhereAmI 'with', )
rc = lineout(OutFile, 'the word "help" in the body of the message.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'Your humble mailing list software,', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, WhoAmI, )

rc = stream(OutFile, 'C', 'CLOSE')

EmailFile = SysTempFileName('e?????.tmp', '?')
rc = stream(EmailFile, 'C', 'OPEN WRITE')  /* open the file for writing */
if rc <> 'READY:' then do
  call SendError('no emailfile')
  end
rc = lineout(EmailFile, HeadEmail, )
rc = stream(EmailFile, 'C', 'CLOSE')

if Debug = TRUE then say 'Starting mailer.'

/* now mail it to the hapless emailer */
Mailer WhoAmI'@'WhereAmI EmailFile OutFile

return

/* ------------------------------------------------------------------ */
/*
 * Write out our standard headers for a list message
 *
 */

WriteListHeaders:  /* note that we have full access to all globals here */

TimeZone = value( 'TZ', , Env)
TmpTime = time('N')
DayOfWeek = date('W')
DayOfWeek = left(DayOfWeek, 3)
TmpDate = date('N')
/* we put in the local time for date so that posts are chronological */
rc = lineout(OutFile, 'Date:' DayOfWeek',' TmpDate TmpTime TimeZone, )
/* for those that want it, here's the original date */
rc = lineout(OutFile, 'X-OldDate:' HeadDate, )

rc = lineout(OutFile, 'Sender:' ListName'-owner <'ListName'-owner@'WhereAmI'>', )
if ListHeader = TRUE then
  rc = lineout(OutFile, 'X-Listname:' ListName'@'WhereAmI, )

if ReplyTo <> '' then
  rc = lineout(OutFile, 'Reply-To:' ReplyTo, )
else if HeadReplyTo <> '' then
  rc = lineout(OutFile, 'Reply-To:' HeadReplyTo, )
else if HeadFrom <> '' then
  rc = lineout(OutFile, 'Reply-To:' HeadFrom, )

/* if we set replyto to the sender, then list the list as a CC */
if ReplyTo = '' then
  rc = lineout(OutFile, 'Cc:' ListName '<'ListName'@'WhereAmI'>', )

rc = lineout(OutFile, 'From:' HeadFrom, )
rc = lineout(OutFile, 'To:' HeadTo, )

if SubjectPrefix <> '' then
  do
  TmpSubject = ReWriteSubject(HeadSubject)
  rc = lineout(OutFile, 'Subject:' SubjectPrefix TmpSubject, )
  end
else
  rc = lineout(OutFile, 'Subject:' HeadSubject, )

rc = lineout(OutFile, '', )

return

/* ------------------------------------------------------------------ */
/*
 * Check for the approval header for this list
 *
 */

CheckForApproval:

if Debug = TRUE then say 'Checking msg for approval.'
if Log = TRUE then call WriteLog('Checking msg for approval.')

Line = ''
do while Line = ''          /* look for first non-blank line */
  Line = linein(MsgFile)
  if lines(MsgFile) = 0 then return FALSE
  end

parse var Line Key ':' Val
Key = translate(Key, lowercase, uppercase)
if Key = 'approved' & Val = ApprovePassword then do
  return TRUE
  end

return FALSE

/* ------------------------------------------------------------------ */

IsList: procedure expose ListDir TRUE FALSE Debug Log LogFile

parse arg ListName

if Debug = TRUE then say 'Checking for list' ListName
if Log = TRUE then call WriteLog('Checking for list' ListName)

/* First check to see if this is a digest request */
parse var ListName List '-' Digest
Digest = translate(Digest, lowercase, uppercase)
if Digest = 'digest' then
  DirName = ListDir'\'List'\Digests'
else
  DirName = ListDir'\'ListName

rc = SysFileTree(DirName, s., 'D')
if rc = 0 & s.0 = 1 then
  return TRUE
else
  return FALSE

return FALSE  /* safety net */

/* ------------------------------------------------------------------ */

CanPost: procedure expose ListDir TRUE FALSE Debug Log LogFile OpenPosting,
         lowercase uppercase

parse arg ListName Email

if OpenPosting = TRUE then return TRUE /* bypass member checks */

if Debug = TRUE then say 'Checking if' Email 'is a list member of' ListName
if Log = TRUE then call WriteLog('Checking if' Email 'is a list member of' ListName)

/* First check to see if this is a digest request */
parse var ListName List '-' Digest
Digest = translate(Digest, lowercase, uppercase)
if Digest = 'digest' then
  FileName = ListDir'\'List'\'List
else
  FileName = ListDir'\'ListName'\'ListName

Sub = FALSE

rc = LockOpen(FileName 'READ')  /* open the file locking it */
if rc = FALSE then
  return FALSE                   /* return FALSE if cannot open */

Email = translate(Email, lowercase, uppercase)

do while lines(FileName) <> 0         /* until end of file */
  Line = linein(FileName)             /* get a line of the file */
  Line = translate(Line, lowercase, uppercase)
  if Line = Email then do
    Sub = TRUE
    leave
    end
end

rc = LockClose(FileName)

if Sub = TRUE then return TRUE

/* Now check the digest members */
FileName = FileName'.digest'
rc = LockOpen(FileName 'READ')  /* open the file locking it */
if rc = FALSE then
  return FALSE                   /* return FALSE if cannot open */

do while lines(FileName) <> 0         /* until end of file */
  Line = linein(FileName)             /* get a line of the file */
  Line = translate(Line, lowercase, uppercase)
  if Line = Email then do
    Sub = TRUE
    leave
    end
end

rc = LockClose(FileName)

return Sub

/* ------------------------------------------------------------------ */
/*
 * Normalize the email address into a SMTP form
 *
 */

NormalizeEmail: procedure expose Author

parse arg All

rc = pos('<', All, )
if rc = 0 then
  do
  /* in case some mailers use () instead of <> */
  All = translate(All, '<', '(')
  All = translate(All, '>', ')')
  end

parse var All Part1 '<' Part2 '>' Part3

rc = pos('@', Part1, )
if rc <> 0 then
  do
  Part1 = strip(Part1, 'B', )  /* we must strip any blanks leftover */
  if Part2 <> '' then Author = Part2
  else if Part3 <> '' then Author = Part3
  else Author = Part1
  return Part1
  end

rc = pos('@', Part2, )
if rc <> 0 then
  do
  Part2 = strip(Part2, 'B', )
  if Part1 <> '' then Author = Part1
  else if Part3 <> '' then Author = Part3
  else Author = Part2
  return Part2
  end

rc = pos('@', Part3, )
if rc <> 0 then
  do
  Part3 = strip(Part3, 'B', )
  if Part2 <> '' then Author = Part2
  else if Part1 <> '' then Author = Part1
  else Author = Part3
  return Part3
  end

return ''  /* error finding SMTP email address */

/* ------------------------------------------------------------------ */
/*
 * Parse RFC822 headers
 *
 */

ParseHeaders: procedure expose HeadTo HeadFrom HeadReplyTo MsgFile HeadSubject ,
              lowercase uppercase HeadDate HeadCc HeadSender Log FALSE TRUE LogFile

say 'ParseHeaders starting'

Line = linein(MsgFile)                /* get a line of the file */
do while Line <> ''                   /* until end of headers */
  parse var Line Key ':' Val          /* separate out the components */
  Key = translate(Key, lowercase, uppercase)
  select
    when Key = 'to' then
      HeadTo = Val
    when Key = 'reply-to' then
      HeadReplyTo = Val
    when Key = 'from' then
      HeadFrom = Val
    when Key = 'subject' then
      HeadSubject = Val
    when Key = 'date' then
      HeadDate = Val
    when Key = 'cc' then
      HeadCc = Val
    when Key = 'sender' then
      HeadSender = Val
    otherwise nop
    end   /* select */
  Line = linein(MsgFile)
end       /* do while */

if Log = TRUE then
  do
  say 'Writing headers info to log file'
  call WriteLog('ParseHeaders Info:')
  call WriteLog('To:' HeadTo)
  call WriteLog('From:' HeadFrom)
  call WriteLog('Reply-to:' HeadReplyTo)
  call WriteLog('Subject:' HeadSubject)
  end

return

/* ------------------------------------------------------------------ */
/*
 * Read the master configuration file
 *
 */

ReadMasterCf: procedure expose HomeDir LogDir ListDir Mailer WhereAmI WhoAmI ,
              WhoAmIOwner MasterPassword Env TRUE FALSE Debug

if Debug = TRUE then say 'Reading Steward configuration file.'

/* Find out where the configuration file should be */
StewardCf = value('steward_cf',,Env)
/* StewardCf = value('steward_cf_test',,Env) */

/* If its not defined then assume wherever we are */
if StewardCf = '' then do
  StewardCf = '.'
  end

FileName = StewardCf'\steward.cf'

rc = LockOpen(FileName 'READ')  /* open the file locking it */
if rc = FALSE then
  return FALSE                   /* return FALSE if cannot open */

/* now read the configuration file */
do while lines(FileName) <> 0         /* until end of file */
  Line = linein(FileName)             /* get a line of the file */
  parse var Line Line '#' Comment     /* separate out any comments */
  if Line <> '' then do               /* if not null */
    parse var Line Key '=' Val        /* find the key and value */
    if Key <> '' then do
      Val = strip(Val, 'B', ' ')      /* remove any blanks */
      Key = strip(Key, 'B', ' ')
      select
        when Key = 'HomeDir' then
          HomeDir = Val
        when Key = 'LogDir' then
          LogDir = Val
        when Key = 'ListDir' then
          ListDir = Val
        when Key = 'Mailer' then
          Mailer = Val
        when Key = 'WhereAmI' then
          WhereAmI = Val
        when Key = 'WhoAmI' then
          WhoAmI = Val
        when Key = 'WhoAmIOwner' then
          WhoAmIOwner = Val
        when Key = 'MasterPassword' then
          MasterPassword = Val
        otherwise nop
        end   /* select */
      end     /* if Key <> '' */
    end       /* if Line <> '' */

  Key = ''

end /* end do while */

rc = LockClose(FileName)

if Debug = TRUE then say 'Steward.cf file read.'

return TRUE

/* ------------------------------------------------------------------ */
/*
 * Read the per list configuration file
 *
 */

ReadListCf: procedure expose ListDir AdminPassword ListOwner Administrivia,
            Advertise ApprovePassword DoArchive Moderated NoList Precedence,
            ListHeader SubscribePolicy ReplyTo SubjectPrefix TRUE FALSE,
            DoDigest DigestRmHeader DigestVolume DigestIssue DigestFronter,
            DigestFooter DigestName Debug Log LogFile OpenPosting WelcomeFile,
            DigestSubs CaseInsensitive ListFooter

parse arg ListName

if Debug = TRUE then say 'Reading list configuration file for' ListName

/* First check to see if this is a digest request */
parse var ListName List '-' Digest
Digest = translate(Digest, lowercase, uppercase)
if Digest = 'digest' then
  FileName = ListDir'\'List'\'List'.cf'
else
  FileName = ListDir'\'ListName'\'ListName'.cf'

if Debug = TRUE then say 'Reading filename "'FileName'"'

rc = LockOpen(FileName 'READ')  /* open the file locking it */
if rc = FALSE then
  return FALSE                   /* return FALSE if cannot open */

/* now read the configuration file */
do while lines(FileName) <> 0         /* until end of file */
  Line = linein(FileName)             /* get a line of the file */
  parse var Line Line '#' Comment     /* separate out any comments */
  if Line <> '' then do               /* if not null */
    parse var Line Key '=' Val        /* find the key and value */
    if Key <> '' then do
      Val = strip(Val, 'B', ' ')      /* remove any blanks */
      Key = strip(Key, 'B', ' ')
/*      say Key '=' Val */
      select
        when Key = 'AdminPassword' then
          AdminPassword = Val
        when Key = 'ListOwner' then
          ListOwner = Val
        when Key = 'Administrivia' then
          Administrivia = Val
        when Key = 'Advertise' then
          Advertise = Val
        when Key = 'ApprovePassword' then
          ApprovePassword = Val
        when Key = 'DoArchive' then
          DoArchive = Val
        when Key = 'Moderated' then
          Moderated = Val
        when Key = 'NoList' then
          NoList = Val
        when Key = 'Precedence' then
          Precedence = Val
        when Key = 'ListHeader' then
          ListHeader = Val
        when Key = 'SubscribePolicy' then
          SubscribePolicy = Val
        when Key = 'ReplyTo' then
          ReplyTo = Val
        when Key = 'SubjectPrefix' then
          SubjectPrefix = Val
        when Key = 'DoDigest' then
          DoDigest = Val
        when Key = 'DigestRmHeader' then
          DigestRmHeader = Val
        when Key = 'DigestVolume' then
          DigestVolume = Val
        when Key = 'DigestIssue' then
          DigestIssue = Val
        when Key = 'DigestName' then
          DigestName = Val
        when Key = 'DigestFronter' then
          DigestFronter = Val
        when Key = 'DigestFooter' then
          DigestFooter = Val
        when Key = 'OpenPosting' then
          OpenPosting = Val
        when Key = 'WelcomeFile' then
          WelcomeFile = Val
        when Key = 'DigestSubs' then
          DigestSubs = Val
        when Key = 'CaseInsensitive' then
          CaseInsensitive = Val
        when Key = 'ListFooter' then
          ListFooter = Val
        otherwise nop
        end   /* select */
      end     /* if Key <> '' */
    end       /* if Line <> '' */

  Key = ''

end /* end do while */

rc = LockClose(FileName)

return TRUE

/* ------------------------------------------------------------------ */
/*
 * Save the current message to the archive database
 *
 */

SaveArchive: procedure expose ListDir ListName Debug Log FALSE TRUE LogFile

parse arg MsgFile

if Debug = TRUE then say 'Saving msg to archive.'
if Log = TRUE then call WriteLog('Saving msg to archive.')

/* Today's date */
TmpDate = date('E')
parse var TmpDate TmpDay '/' TmpMon '/' TmpYear

/* create the filename */
FileName = ListDir'\'ListName'\Archives\'TmpYear'.'TmpMon

/* open the file */
rc = LockOpen(FileName 'WRITE')
rc = stream(FileName, 'C', 'SEEK <0')      /* go to end of file */

/* the separator line */
rc = lineout(FileName, '', )
rc = lineout(FileName, '===== Message Separator ==========================', )
rc = lineout(FileName, '', )

/* copy the new message to it */
rc = LockOpen(MsgFile 'READ')
do while lines(MsgFile) <> 0         /* until end of file */
  Line = linein(MsgFile)             /* get a line of the file */
  rc = lineout(FileName, Line, )
  end

rc = LockClose(MsgFile)
rc = LockClose(FileName)

return


/* ------------------------------------------------------------------ */
/*
 * Save the current message to the digest database
 *
 */

SaveDigest: procedure expose ListDir ListName TRUE FALSE HeadFrom HeadReplyTo,
                             HeadSubject HeadDate HeadCc HeadSender HeadTo Debug,
                             Log LogFile DigestSubs Author

parse arg MsgFile

if Debug = TRUE then say 'Saving msg to digest.'
if Log = TRUE then call WriteLog('Saving msg to digest.')

/* Today's date */
TmpDate = date('E')
parse var TmpDate TmpDay '/' TmpMon '/' TmpYear

/* create the filename */
FileName = ListDir'\'ListName'\Digests\'TmpYear'.'TmpMon'.'TmpDay

/* open the file */
rc = LockOpen(FileName 'WRITE')
rc = stream(FileName, 'C', 'SEEK <0')      /* go to end of file */

/* the separator lines */
rc = lineout(FileName, '', )
rc = lineout(FileName, '===== Message Separator ==========================', )
rc = lineout(FileName, '', )

/* copy the new message to it */
rc = LockOpen(MsgFile 'READ')

Line = linein(MsgFile)    /* First skip the rewritten headers */
do while Line <> ''
  Line = linein(MsgFile)
  end

/* Now write out the headers we want */
if HeadDate <> '' then
  rc = lineout(FileName, 'Date:' HeadDate, )

if DigestRmHeader = FALSE then do
  if HeadSender <> '' then
    rc = lineout(FileName, 'Sender:' HeadSender, )
  if HeadCc <> '' then
    rc = lineout(FileName, 'Cc:' HeadCc, )
  if HeadTo <> '' then
    rc = lineout(FileName, 'To:' HeadTo, )
  end

if HeadFrom <> '' then
  rc = lineout(FileName, 'From:' HeadFrom, )
if HeadReplyTo <> '' then
  rc = lineout(FileName, 'Reply-To:' HeadReplyTo, )
if HeadSubject <> '' then
  rc = lineout(FileName, 'Subject:' HeadSubject, )
rc = lineout(FileName, '', )

do while lines(MsgFile) <> 0         /* until end of file */
  Line = linein(MsgFile)             /* get a line of the file */
  rc = lineout(FileName, Line, )
  end

rc = LockClose(MsgFile)
rc = LockClose(FileName)

/* Check to see if we need to save subject lines for the digest */
if DigestSubs = TRUE then
  do
  FileName = FileName'.subs'
  /* open the file */
  rc = LockOpen(FileName 'WRITE')
  rc = stream(FileName, 'C', 'SEEK <0')      /* go to end of file */
  /* show subject and then the author */
  rc = lineout(FileName, HeadSubject ':' Author, )
  rc = LockClose(FileName)
  end

return


/* ------------------------------------------------------------------ */

StartLog: procedure expose LogDir LogFile ETime1 ETime2 Debug FALSE TRUE

FileName = LogDir'\?????.log'
if Debug = TRUE then
  do
  say 'FileName =' FileName
  say 'LogDir =' LogDir
  end

LogFile = SysTempFileName(FileName, '?')

if LogFile = '' then
  do
  say 'Cannot create temporary file.'
  say 'Setting logfile to NUL'
  LogFile = 'NUL'
  Log = FALSE
  return
  end

if Debug = TRUE then say 'LogFile =' LogFile

rc = stream(LogFile, 'C', 'OPEN WRITE')

TmpTime = time('N')
TmpDate = date('N')

rc = lineout(LogFile, 'Date:' TmpDate, )
rc = lineout(LogFile, 'Time:' TmpTime, )

return

/* ------------------------------------------------------------------ */

StopLog: procedure expose LogFile LogDir ETime1 ETime2 Debug FALSE TRUE

ETime = ETime2 - Etime1

if Debug= TRUE then say 'Elapsed Time =' ETime

call WriteLog('Elapsed Time:' ETime)
call WriteLog('')
call WriteLog('=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=')
call WriteLog('')

rc = stream(LogFile, 'C', 'CLOSE')

PermLog = LogDir'\steward.log'

call AppendLock(LogFile PermLog)

rc = SysFileDelete(LogFile)

return

/* ------------------------------------------------------------------ */

WriteLog: procedure expose LogFile

parse arg String

rc = lineout(LogFile, String, )

return

/* ------------------------------------------------------------------ */

ErrHandler:

SIGerrCode = RC
StewardErrLog = 'Steward.err'

if Debug = TRUE then say 'Identified error while executing line #'Sigl'   RC = ['SIGerrCode']'
if Debug = TRUE then say '['SourceLine(Sigl)']'
rc = lineout( StewardErrLog, '     -----', )
rc = lineout( StewardErrLog, 'Error ['SIGerrCode'] while executing line #'Sigl, )
rc = lineout( StewardErrLog, '['SourceLine(Sigl)']')

return


/* ------------------------------------------------------------------ */

ReWriteSubject: procedure expose SubjectPrefix

parse arg Subject

TmpSubj = translate(Subject, lowercase, uppercase)

i = lastpos(SubjectPrefix, Subject, )
if i <> 0 then
  do
  /* find the end of where the subject prefix is */
  i = i + length(SubjectPrefix)
  l = length(Subject)
  Subject = right(Subject, l - i)
  end

/* Now look for a "Re:" in the subject line */
i = lastpos('re:', TmpSubj, )
if i <> 0 then
  Subject = 'Re:' Subject

return Subject

/* ------------------------------------------------------------------ */
/*
 * Write out our standard headers for an admin message
 *
 */

WriteAdminHeaders: procedure expose AdminTo WhoAmI WhereAmI AdminSubject AdminFile,
                   Env

TimeZone = value( 'TZ', , Env)
TmpTime = time('N')
DayOfWeek = date('W')
DayOfWeek = left(DayOfWeek, 3)
TmpDate = date('N')
rc = lineout(AdminFile, 'Date:' DayOfWeek',' TmpDate TmpTime TimeZone, )
rc = lineout(AdminFile, 'Sender:' WhoAmI'-owner <'WhoAmI'-owner@'WhereAmI'>', )
rc = lineout(AdminFile, 'From:' WhoAmI'-owner <'WhoAmI'-owner@'WhereAmI'>', )
rc = lineout(AdminFile, 'Reply-To:' WhoAmI '<'WhoAmI'@'WhereAmI'>', )
rc = lineout(AdminFile, 'To:' AdminTo, )
rc = lineout(AdminFile, 'Subject:' AdminSubject, )
rc = lineout(AdminFile, '', )

return

/* ------------------------------------------------------------------ */

LogRcpt:

parse arg FileName

rc = stream(FileName, 'c', 'open read')
do while lines(FileName) <> 0         /* until end of file */
  Line = linein(FileName)             /* get a line of the file */
  call WriteLog('Rcpt:' Line)
  end
rc = stream(FileName, 'c', 'close')

return

/* ------------------------------------------------------------------ */
/* ------------------------------------------------------------------ */