home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Spezial
/
SPEZIAL2_97.zip
/
SPEZIAL2_97.iso
/
ANWEND
/
ONLINE
/
IMPRO
/
STEWARD.ZIP
/
message.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1997-08-09
|
34KB
|
1,174 lines
/* Steward Version 1.2 */
/* Message Module */
/*
* A mailing list processor in Rexx by Paul Hethmon
*
* Made minor modifications so Steward can run under Object REXX.
* 07 Aug 1997 - Bill Schindler
*/
/* variable declarations */
Steward = 'Steward'
StewardVersion = 'Version 1.2'
StewardDate = '9 August 1997'
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 = 'example.com'
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
ListFronter = ''
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 = ''
HeadOther.0 = 0
Email = ''
Approved = FALSE
PassWord = ''
TmpDir = ''
FirstLine = ''
/* The following addresses are always rejected from msg requests */
BadAddrs = 'postmaster' 'mailer-daemon' 'listserv',
'majordomo' 'steward' 'steward-owner'
/* 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
parse var ListName ListName '@' Domain
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
TmpDir = value('TMP',,Env)
/* Process the message */
call DoMessage
/* Make sure the tmp file is deleted */
rc = SysFileDelete(MsgFile)
say 'Delete for message file:' rc
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
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
/* 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
/* 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. HeadEmail =' HeadEmail)
/* we must close the msg file now */
rc = stream(MsgFile, 'c', 'close')
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. */
/* create a temp file for the outgoing message */
OutFile = SysTempFileName(TmpDir'\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
call WriteListHeaders
/* See if there is a fronter to prepend to the message */
if ListFronter <> '' then do
FileName = ListDir'\'ListName'\'ListFronter
rc = LockOpen(FileName 'READ')
if rc = TRUE then do
do while lines(FileName) <> 0 /* until end of file */
Line = linein(FileName) /* get a line of the file */
rc = lineout(OutFile, Line, ) /* output it */
end
rc = LockClose(FileName)
end
end
/* The actual message */
if Moderated = FALSE & FirstLine <> '' then do /* don't forget the first line */
rc = lineout(OutFile, FirstLine, )
end
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
/* See if there is a footer to append to the message */
if ListFooter <> '' then do
FileName = ListDir'\'ListName'\'ListFooter
rc = LockOpen(FileName 'READ')
if rc = TRUE then do
do while lines(FileName) <> 0 /* until end of file */
Line = linein(FileName) /* get a line of the file */
rc = lineout(OutFile, Line, ) /* output it */
end
rc = LockClose(FileName)
end
end
rc = stream(MsgFile, 'C', 'CLOSE') /* close both files */
rc = stream(OutFile, 'C', 'CLOSE')
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(TmpDir'\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, '--------------------------------------------------', )
if FirstLine <> '' then do /* don't forget the first line */
rc = lineout(OutFile, FirstLine, )
end
/* 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(TmpDir'\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(TmpDir'\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 */
/* Write out the other headers from the message */
do i = 1 to HeadOther.0
rc = lineout(OutFile, HeadOther.i, )
end i
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
FirstLine = Line
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
if Log = TRUE then call WriteLog('Opening file:' FileName)
rc = LockOpen(FileName 'READ') /* open the file locking it */
if rc = FALSE then do
if Log = TRUE then call WriteLog('Unable to open listname file')
return FALSE /* return FALSE if cannot open */
end
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 do
if Log = TRUE then call WriteLog('Unable to open listname file')
return FALSE /* return FALSE if cannot open */
end
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,
HeadOther.
say 'ParseHeaders starting'
idx = 1
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
when Key = 'x-listname' then /* don't repeat the listname */
nop
when Key = 'status' then /* don't repeat the status */
nop
when Key = 'priority' then /* don't repeat the priority */
nop
when Key = 'x-olddate' then /* don't repeat the x-olddate */
nop
when Key = 'return-path' then /* don't repeat the return-path */
nop
otherwise do
HeadOther.idx = Line
idx = idx + 1
end
end /* select */
Line = linein(MsgFile)
end /* do while */
HeadOther.0 = idx - 1 /* save the number of extra header lines */
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 ListFronter ListFooter WhereAmI
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 = 'ListFronter' then
ListFronter = Val
when Key = 'ListFooter' then
ListFooter = 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 = 'WhereAmI' then
WhereAmI = 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')
action = 'SEEK <0' /*wfs 7-Aug-1997*/
IF IsOREXX() THEN /*wfs 7-Aug-1997*/
action = action 'WRITE' /*wfs 7-Aug-1997*/
rc = stream(FileName, 'C', action) /* 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')
action = 'SEEK <0' /*wfs 7-Aug-1997*/
IF IsOREXX() THEN /*wfs 7-Aug-1997*/
action = action 'WRITE' /*wfs 7-Aug-1997*/
rc = stream(FileName, 'C', action) /* 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')
action = 'SEEK <0' /*wfs 7-Aug-1997*/
IF IsOREXX() THEN /*wfs 7-Aug-1997*/
action = action 'WRITE' /*wfs 7-Aug-1997*/
rc = stream(FileName, 'C', action) /* 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)
l = l - i
if l > 0 then Subject = right(Subject, l)
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
/* ------------------------------------------------------------------ */
IsOREXX: PROCEDURE /*wfs 7-Aug-1997*/
PARSE VERSION rx ver dt
RETURN rx = 'OBJREXX'
/* ------------------------------------------------------------------ */
/* ------------------------------------------------------------------ */