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

OS/2 REXX Batch file | 1996-06-27 | 37KB | 1,246 lines

/* Steward Version 1.1 Build 8 */
/* Administration 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 = ''
ListName = ''

/* Variables normally read from the configuration file */
/* These values are provided as defaults only */
HomeDir = 'c:'
LogDir = 'c:'
ListDir = 'c:'
Mailer = 'hmailer'
WhereAmI = 'hostname'
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
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 following addresses are always rejected from admin requests */
BadAddrs = 'postmaster' 'mailer-daemon' 'listserv',
           'majordomo'

/* 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

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

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

call DoAdmin

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

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

exit

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

DoAdmin:

NoRequests = TRUE

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

call ParseHeaders  /* first get the header info */

/* Figure out who to send mail back to */
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
if Log = TRUE then call WriteLog('Email from' HeadEmail)

/* Look for bad addresses such as postmaster, majordomo, etc. */
parse var HeadEmail User '@' Domain
User = translate(User, lowercase, uppercase)
do i = 1 to words(BadAddrs)
  if User = word(BadAddrs, i) then do
    rc = stream(MsgFile, 'c', 'close')
    say 'Calling errors. BadAddrs found.'
    call Errors(ListName MsgFile)
    exit
    end
  end

/* 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('no tempfile')
  end

/* write the headers to the outfile */
AdminSubject = WhoAmI 'Results'
if HeadReplyTo <> '' then
  AdminTo = HeadReplyTo
else if HeadFrom <> '' then
  AdminTo = HeadFrom
AdminFile = OutFile
call WriteAdminHeaders

if Debug = TRUE then say 'Admin Headers written'

/* now look for admin requests */
do while lines(MsgFile) <> 0         /* until end of file */
  Line = linein(MsgFile)             /* get a line of the file */
  parse var Line Cmd Rest            /* look for a command */
  if Cmd <> '' then do               /* if not null */
    Cmd = strip(Cmd, 'B', ' ')       /* remove any blanks */
    Cmd = translate(Cmd, lowercase, uppercase)
    select
      when Cmd = 'approved:' then do
        /* Save the approved password in case the subscribe request */
        /* needs it because of a closed list subscription policy */
        PassWord = strip(Rest, 'B', ' ')
        end
      when Cmd = 'subscribe' | Cmd = 'sub' then do
        call DoSubscribe
        rc = lineout(OutFile, '', )
        NoRequests = FALSE
        end
      when Cmd = 'end' then do
        rc = lineout(OutFile, '>>>'Cmd, )
        rc = lineout(OutFile, 'Ending command processing.', )
        leave
        end
      when Cmd = 'unsubscribe' | Cmd = 'unsub' then do
        call DoUnSubscribe
        rc = lineout(OutFile, '', )
        NoRequests = FALSE
        end
      when Cmd = 'help' then do
        call DoHelp
        rc = lineout(OutFile, '', )
        NoRequests = FALSE
        end
      when Cmd = 'lists' | Cmd = 'list' then do
        call DoLists
        rc = lineout(OutFile, '', )
        NoRequests = FALSE
        end
      otherwise do
        rc = lineout(OutFile, '>>>'Cmd Rest, )
        rc = lineout(OutFile, 'Unknown command ignored.', )
        rc = lineout(OutFile, '', )
        end
    end /* select */
  end   /* if Cmd <> '' */
end     /* do while lines */

if NoRequests = TRUE then do
  /* send them help since we didn't find a valid command */
  rc = lineout(OutFile, 'No valid commands found in your message. Sending help instead.', )
  call DoHelp
  end

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

if Debug = TRUE then say 'Preparing to send msg back.'

/* the admin requests are processed, now send the message back */
/* first create a file with the email address in it */
EmailFile = SysTempFileName('e?????.tmp', '?')
rc = stream(EmailFile, 'C', 'OPEN WRITE')  /* open the file for writing */
if rc <> 'READY:' then do
  call WriteLog('no emailfile')
  end

if HeadEmail <> '' then
  rc = lineout(EmailFile, HeadEmail, )
else
  rc = lineout(EmailFile, WhoAmIOwner, )
rc = stream(EmailFile, 'C', 'CLOSE')

if Debug = TRUE then say 'Sending mail now.'

/* now start the mailer */
Mailer WhoAmI'-owner@'WhereAmI EmailFile OutFile

return

/* ------------------------------------------------------------------ */
/*
 * Process a request to show what lists are available.
 *
 */

DoLists:

if Log = TRUE then call WriteLog('Returning available lists.')
if Debug = TRUE then say 'Returning available lists.'

Email = HeadEmail

rc = lineout(OutFile, '>>>' Cmd Rest, )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'Lists available here include:', )
rc = lineout(OutFile, '', )

ListNames = ListDir'\*'

rc = SysFileTree(ListNames, s., 'DO')   /* only directories */

if rc = 0 then do i = 1 to s.0
  ListName = s.i                       /* we only need the name */
  ListName = strip(ListName, 'B', )    /* eliminate extra spaces */
  x = lastpos('\', ListName)           /* pull off the directory alone */
  List = substr(ListName, x + 1)
  call ReadListCf(List)                /* read the config file */
  if NoList = FALSE then               /* if it's ok to show it */
    do
    if Debug = TRUE then say 'List Name:' List
    rc = lineout(OutFile, 'List Name:' List, )
    ListInfo = ListName'\'List'.info'
    rc = SysFileTree(ListInfo, lc., 'F')
    if rc = 0 & lc.0 = 1 then
      do
      /* send back the info file also */
      rc = LockOpen(ListInfo 'READ')
      if rc = TRUE then
        do
          do while lines(ListInfo) <> 0
          Line = linein(ListInfo)
          rc = lineout(OutFile, Line, )
          end
        rc = LockClose(ListInfo)
        end
      end
    rc = lineout(OutFile, '', )  /* put a blank line between lists */
    end
end

return

/* ------------------------------------------------------------------ */
/* Find out the listname and email address for this request */

WhoAndWhat:

parse arg Part1 Part2

say 'Part1 =' Part1
say 'Part2 =' Part2
/* Figure out the listname and email address first */
i = words(Rest)
select
  when i = 2 then  /* we have a listname and email address */
    do
    ListName = Part1
    Email = Part2
    say 'Assigning ListName and Email'
    return TRUE
    end
  when i = 1 then  /* we have either a listname or email address */
    do
    rc = IsList(Part1)
    if rc = TRUE then
      do
      ListName = Part1
      Email = HeadEmail
      end
    else
      do
      Email = Part1
      end
    return TRUE
    end
  when i = 0 then  /* use listname and heademail */
    do
    Email = HeadEmail
    return TRUE
    end
  otherwise        /* bad number of arguments */
    do
    rc = lineout(OutFile, 'I do not understand your command.', )
    return FALSE
    end
end

return

/* ------------------------------------------------------------------ */
/*
 * Process a unsubscribe request
 *
 */

DoUnSubscribe:

rc = lineout(OutFile, '>>>' Cmd Rest, )

if Debug = TRUE then say 'Processing unsubscribe request.'
if Log = TRUE then call WriteLog('Processing unsubscribe request.')

rc = WhoAndWhat(Rest)      /* find out the listname and email address */
if rc = FALSE then return  /* bad command line */

/* First, make sure the list is valid */
rc = IsList(ListName)
if rc = FALSE then do
  rc = lineout(OutFile, 'Sorry, the list' ListName 'does not exist.', )
  return
  end
call ReadListCf(ListName)
if PassWord = ApprovePassword then
  Approved = TRUE
else
  Approved = FALSE

/* if email doesn't match and not approved, do nothing */
if Email <> HeadEmail & Approved = FALSE then do
  rc = lineout(OutFile, 'Your email address given does not match the email address', )
  rc = lineout(OutFile, 'in the message headers. Request refused.', )
  return
  end

/* Everything has been approved, take them off the list */
rc = IsMember(ListName Email)
if rc = TRUE then do
  rc = UnSubscribe(ListName Email)
  if rc = TRUE then do
    rc = lineout(OutFile, 'You have been unsubscribed to list' ListName'.', )
    if Email <> HeadEmail then call SpecialReply('unsub')
    end
  else
    rc = lineout(OutFile, 'Sorry, unable to unsubscribe you to the list' ListName'.', )
  end
else
  rc = lineout(OutFile, 'You are not subscribed to the list' ListName'.', )

return

/* ------------------------------------------------------------------ */
/*
 * Process a subscribe request
 *
 */

DoSubscribe:

rc = lineout(OutFile, '>>>' Cmd Rest, )

if Debug = TRUE then say 'Processing subscribe request.'
if Log = TRUE then call WriteLog('Processing subscribe request.')

rc = WhoAndWhat(Rest)      /* find out the listname and email address */
if rc = FALSE then return  /* bad command line */

/* First, make sure the list is valid */
rc = IsList(ListName)
if rc = FALSE then do
  rc = lineout(OutFile, 'Sorry, the list' ListName 'does not exist.', )
  say 'The list' ListName 'does not exist.'
  return
  end
call ReadListCf(ListName)
if PassWord = ApprovePassword then
  Approved = TRUE
else
  Approved = FALSE

/* if emails don't match and not approved, do nothing for them */
if Email <> HeadEmail & Approved = FALSE then do
  say 'Email mismatch. Subscribe denied.'
  rc = lineout(OutFile, 'Your email address given does not match the email address', )
  rc = lineout(OutFile, 'in the message headers. Request refused.', )
  return
  end

say 'Checking if' Email 'is a member.'
/* We have a good ListName and Email now */
rc = IsMember(ListName Email)
if rc = FALSE then do
  /* Check and see if we can subscribe them now */
  if SubscribePolicy = 'open' | Approved = TRUE then do
    rc = Subscribe(ListName Email)
    if rc = TRUE then do
      rc = lineout(OutFile, 'You have been subscribed to list' ListName'.', )
      rc = lineout(OutFile, 'Messages will be sent to the email address:' Email, )
      if Email <> HeadEmail then call SpecialReply('sub')
      if WelcomeFile <> '' then do
        rc = SendWelcome(ListName Email)
        end
      end
    else
      rc = lineout(OutFile, 'Sorry, unable to subscribe you to the list' ListName'.', )
    end
  else do /* closed list and no approval yet */
    rc = lineout(OutFile, 'Your request for a subscription will be forwarded to the moderator for approval.', )
    call SubscribeApproval
    end  /* end of subscribepolicy not open */
  end    /* end of if rc = FALSE */
else
  rc = lineout(OutFile, 'You are already subscribed to the list' ListName'.', )

return

/* ------------------------------------------------------------------ */
/* Someone was either subscribed/unsubscribed to the list by the list */
/* owner. Send that person a message telling them their request was   */
/* approved. */

SpecialReply:

parse arg Type

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

/* Create the proper headers */
AdminTo = Email
if Type = 'sub' then
  AdminSubject = ListName 'Subscription Approved'
else
  AdminSubject = ListName 'Unsubscription Approved'
AdminFile = ReplyFile
call WriteAdminHeaders

/* Now insert the message */
if Type = 'sub' then do
  rc = lineout(ReplyFile, 'Your request to subscribe to the list "'ListName'" has', )
  rc = lineout(ReplyFile, 'been approved by the list owner.', )
  rc = lineout(ReplyFile, '', )
  rc = lineout(ReplyFile, 'You will receive list messages at the following email address:', )
  rc = lineout(ReplyFile, '    >>' Email '<<', )
  rc = lineout(ReplyFile, '', )
  end
else do
  rc = lineout(ReplyFile, 'Your request to unsubscribe to the list "'ListName'" has', )
  rc = lineout(ReplyFile, 'been approved by the list owner.', )
  rc = lineout(ReplyFile, '', )
  rc = lineout(ReplyFile, 'You will no longer receive list messages at the following email address:', )
  rc = lineout(ReplyFile, '    >>' Email '<<', )
  rc = lineout(ReplyFile, '', )
  end

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

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

if Debug = TRUE then say 'Sending special reply mail now.'

/* now start the mailer */
Mailer WhoAmI'-owner@'WhereAmI EmailFile ReplyFile

return

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

UnSubscribe: procedure expose ListDir TRUE FALSE Debug Log LogFile CaseInsensitive ,
             lowercase uppercase

parse arg ListName Email

if Debug = TRUE then say 'Now doing the unsubcribe operation.'
if Log = TRUE then call WriteLog('Now doing the unsubcribe operation.')

/* 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'.digest'
else
  FileName = ListDir'\'ListName'\'ListName

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

TmpFile = SysTempFileName('u????.tmp', '?')
rc = stream(TmpFile, 'C', 'OPEN WRITE')  /* open the file for writing */
if rc <> 'READY:' then do
  call WriteLog('no tempfile')
  end
/* always lowercase */
Email = translate(Email, lowercase, uppercase)

NoNames = TRUE

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 & Line <> '' then do
    NoNames = FALSE
    rc = lineout(TmpFile, Line, )     /* save this name */
    end
end

if NoNames = TRUE then
  rc = lineout(TmpFile, '', )           /* make sure at least one byte file */

rc = LockClose(FileName)
rc = stream(TmpFile, 'C', 'CLOSE')

/* replace the old members list with the new one */
rc = CopyLock(TmpFile FileName)
/* Delete the temporary */
rc = SysFileDelete(TmpFile)

return TRUE

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

SubscribeApproval:

if Log = TRUE then call WriteLog('Sending SubscribeApproval request to moderator')
if Debug = TRUE then say 'Doing SubscribeApproval.'

TmpFile = SysTempFileName('f?????.tmp', '?')
rc = stream(TmpFile, 'C', 'OPEN WRITE')
parse var rc rc ':'
if rc <> 'READY' then do
  if Debug = TRUE then say 'Unable to create temp file.'
  if Log = TRUE then call WriteLog('Unable to create temporary file in SubscribeApproval.')
  return
  end

/* write the headers first */
AdminSubject = 'Approval Request for' ListName
AdminTo = ListOwner
AdminFile = TmpFile
call WriteAdminHeaders
rc = lineout(TmpFile, 'Approved: ', )
rc = lineout(TmpFile, '', )
rc = lineout(TmpFile, 'subscribe' ListName Email, )
rc = lineout(TmpFile, 'end', )
rc = lineout(TmpFile, '', )
rc = lineout(TmpFile, '--------------------------------------------------', )
rc = lineout(TmpFile, 'From:' HeadFrom, )
rc = lineout(TmpFile, 'To:' HeadTo, )
rc = lineout(TmpFile, 'Subject:' HeadSubject, )
rc = lineout(TmpFile, '--------------------------------------------------', )

rc = LockClose(TmpFile)

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

if Debug = TRUE then say 'Mailing request to moderator.'
/* now mail it to the moderator */
Mailer WhoAmI'-owner@'WhereAmI EmailFile TmpFile

return

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

IsList: procedure expose ListDir TRUE FALSE Debug Log LogFile lowercase uppercase

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 */

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

IsMember: procedure expose ListDir TRUE FALSE Debug Log LogFile ,
          CaseInsensitive lowercase uppercase

parse arg ListName Email

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'.digest'
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
    say 'Found user already as member.'
    leave
    end
end

rc = LockClose(FileName)

if Sub = TRUE then return TRUE

return FALSE

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

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

parse arg ListName Email

if Debug = TRUE then say 'Doing subscribe operation.'
if Log = TRUE then call WriteLog('Doing subscribe operation.')
if Log = TRUE then call WriteLog('New member =' Email)

/* 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'.digest'
else
  FileName = ListDir'\'ListName'\'ListName

if Log = TRUE then call WriteLog('Updating file' FileName 'with new member.')

rc = LockOpen(FileName 'WRITE')  /* open the file locking it */
if rc = FALSE then do
  if Log = TRUE then call WriteLog('Cannot open' FileName 'for updating. File Locked.')
  return FALSE                    /* return FALSE if cannot open */
  end

rc = stream(FileName, 'C', 'SEEK <0')      /* go to end of file */
Email = translate(Email, lowercase, uppercase)
rc2 = lineout(FileName, Email, )           /* save the new email address */

rc = LockClose(FileName)

if rc2 <> 0 then do
  if Log = TRUE then call WriteLog('Failure to write to' FileName '.')
  return FALSE
  end

if Log = TRUE then call WriteLog(FileName 'updated with new member.')

return TRUE

/* ------------------------------------------------------------------ */
/*
 * 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 */

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

WriteAdminHeaders: procedure expose AdminTo WhoAmI WhereAmI AdminSubject AdminFile ,
                   Env lowercase uppercase

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

/* ------------------------------------------------------------------ */
/*
 * 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

/* ------------------------------------------------------------------ */
/*
 * Send the person a help message
 *
 */

DoHelp:

if Debug = TRUE then say 'Sending help to sender.'
if Log = TRUE then call WriteLog('Sending help to sender.')

if Email == '' then do          /* find their email address */
  Email = HeadEmail
end

rc = lineout(OutFile, '>>>' Cmd Rest, )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'This is the' Steward 'mailing list software,' StewardVersion, )
rc = lineout(OutFile, 'of' StewardDate'.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, Steward 'understands the following commands:', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'subscribe <listname> [<address>]', )
rc = lineout(OutFile, '  Subscribe yourself to the named <listname>.', )
rc = lineout(OutFile, '  <address> is optional.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'unsubscribe <listname> [<address>]', )
rc = lineout(OutFile, '  Unsubscribe yourself to the named <listname>.', )
rc = lineout(OutFile, '  <address> is optional.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'help', )
rc = lineout(OutFile, '  Send this message.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'lists', )
rc = lineout(OutFile, '  Show the lists available from this server.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'end', )
rc = lineout(OutFile, '  Stop processing commands (useful if your mailer adds a signature).', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'Commands should be sent in the body of the email message to', )
rc = lineout(OutFile, WhoAmI'@'WhereAmI'. Multiple commands may be included in one', )
rc = lineout(OutFile, 'message provided each is on its own line.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'Commands in the "Subject" field are ignored.', )
rc = lineout(OutFile, '', )
rc = lineout(OutFile, 'Questions should be sent to' WhoAmIOwner'.', )
rc = lineout(OutFile, '', )

return

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

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

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 lowercase uppercase

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
        otherwise nop
        end   /* select */
      end     /* if Key <> '' */
    end       /* if Line <> '' */

  Key = ''

end /* end do while */

rc = LockClose(FileName)

return TRUE

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

StartLog: procedure expose LogDir LogFile ETime1 ETime2 Debug FALSE TRUE

FileName = LogDir'\?????.log'
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

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

SendWelcome: procedure expose ListDir lowercase uppercase WelcomeFile,
             AdminSubject AdminTo AdminFile Mailer WhoAmI WhereAmI TRUE FALSE,
             Env

parse arg List1 Email1

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

/* Create and open a temporary file for the message */
MsgFile = SysTempFileName('msg?????.tmp', '?')
if MsgFile = '' then return

rc = stream(MsgFile, 'C', 'OPEN WRITE')
if rc <> 'READY:' then return

AdminSubject = 'Welcome to' List1
AdminTo = Email1
AdminFile = MsgFile
call WriteAdminHeaders
rc = stream(MsgFile, 'C', 'CLOSE')

call AppendLock(FileName MsgFile)

/* Create the email file */
EmailFile = SysTempFileName('email????.tmp', '?')
if EmailFile = '' then
  do
  rc = SysFileDelete(MsgFile)
  return
  end

rc = stream(EmailFile, 'C', 'OPEN WRITE')
if rc <> 'READY:' then
  do
  rc = SysFileDelete(MsgFile)
  return
  end

rc = lineout(EmailFile, Email1, )
rc = stream(EmailFile, 'C', 'CLOSE')

/* now mail it to them */
Mailer WhoAmI'-owner@'WhereAmI EmailFile MsgFile

return TRUE

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