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 >
OS/2 REXX Batch file  |  1997-08-09  |  34KB  |  1,174 lines
  1. /* Steward Version 1.2 */
  2. /* Message Module */
  3. /*
  4.  * A mailing list processor in Rexx by Paul Hethmon
  5.  *
  6.  * Made minor modifications so Steward can run under Object REXX.
  7.  *         07 Aug 1997 - Bill Schindler
  8.  */
  9.  
  10. /* variable declarations */
  11.  
  12. Steward = 'Steward'
  13. StewardVersion = 'Version 1.2'
  14. StewardDate = '9 August 1997'
  15. uppercase = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  16. lowercase = 'abcdefghijklmnopqrstuvwxyz'
  17. Env = 'OS2ENVIRONMENT'
  18. FALSE = 0
  19. TRUE = 1
  20.  
  21. /* Set to 1 to enable debug output */
  22. Debug = TRUE
  23. /* Set to 1 to enable logging */
  24. Log = TRUE
  25. LogFile = ''
  26. ETime1 = 0
  27. ETime2 = 0
  28. Author = ''
  29. AdminFile = ''
  30. AdminSubject = ''
  31. AdminTo = ''
  32.  
  33. /* Variables normally read from the configuration file */
  34. /* These values are provided as defaults only */
  35. HomeDir = 'c:'
  36. LogDir = 'c:'
  37. ListDir = 'c:'
  38. Mailer = 'hmailer'
  39. WhereAmI = 'example.com'
  40. WhoAmI = Steward
  41. WhoAmIOwner = 'postmaster@'WhereAmI
  42. MasterPassword = 'steward'
  43.  
  44. /* The following are set on a per list basis */
  45. AdminPassword = 'steward-list'
  46. Administrivia = 0
  47. ListOwner = WhoAmIOwner
  48. Advertise = '*'
  49. ApprovePassword = 'steward-pass'
  50. DoArchive = 0
  51. Moderated = 0
  52. NoList = 0
  53. Precedence = 1
  54. ListHeader = 1
  55. ListFronter = ''
  56. ListFooter = ''
  57. DoDigest = 0
  58. DigestVolume = 0
  59. DigestIssue = 0
  60. DigestName = ''
  61. DigestRmHeader = 1
  62. DigestFronter = ''
  63. DigestFooter = ''
  64. DigestSubs = TRUE
  65. SubscribePolicy = 'open'
  66. ReplyTo = ''
  67. SubjectPrefix = 'Steward-List: '
  68. OpenPosting = FALSE
  69. WelcomeFile = ''
  70. CaseInsensitive = FALSE
  71.  
  72. /* Some other global variables */
  73. HeadFrom = ''
  74. HeadTo = ''
  75. HeadReplyTo = ''
  76. HeadSubject = ''
  77. HeadDate = ''
  78. HeadCc = ''
  79. HeadSender = ''
  80. HeadEmail = ''
  81. HeadOther.0 = 0
  82.  
  83. Email = ''
  84. Approved = FALSE
  85. PassWord = ''
  86. TmpDir = ''
  87. FirstLine = ''
  88.  
  89. /* The following addresses are always rejected from msg requests */
  90. BadAddrs = 'postmaster' 'mailer-daemon' 'listserv',
  91.            'majordomo' 'steward' 'steward-owner'
  92.  
  93. /* The external functions we need */
  94. call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName'
  95. call RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'
  96. call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'
  97. call RxFuncAdd 'SysSleep', 'RexxUtil', 'SysSleep'
  98.  
  99. /* start main function */
  100. /* The first arg is who the message was sent to.
  101.  * The second is the filename. We're responsible
  102.  * for cleaning up the file if needed.
  103.  */
  104. parse arg ListName MsgFile
  105.  
  106. parse var ListName ListName '@' Domain
  107. if Debug = TRUE then say 'ListName =' ListName 'MsgFile =' MsgFile
  108.  
  109. call on error name ErrHandler
  110.  
  111. say 'Reading Master Configuration File Now.'
  112.  
  113. /* Read the master configuration file now */
  114. rc = ReadMasterCf()
  115. if rc = FALSE then
  116.   do
  117.   say 'Unable to read master configuration file. Failing.'
  118.   ErrFile = SysTempFileName('?????.err', '?')
  119.   rc = stream(ErrFile, 'C', 'OPEN WRITE')
  120.   rc = lineout(ErrFile, 'Steward Error File', )
  121.   rc = lineout(ErrFile, 'You must rerun Steward with the recipient name and', )
  122.   rc = lineout(ErrFile, 'message file name listed below in order to process', )
  123.   rc = lineout(ErrFile, 'this message.', )
  124.   rc = lineout(ErrFile, 'Rcpt =' Rcpt, )
  125.   rc = lineout(ErrFile, 'MsgFile =', MsgFile, )
  126.   rc = stream(ErrFile, 'C', 'CLOSE')
  127.   exit
  128.   end
  129.  
  130. /* change to the Steward Home Directory */
  131. Junk = directory(HomeDir)
  132.  
  133. if Debug = TRUE then
  134.   do
  135.   say 'LogDir =' LogDir
  136.   say 'HomeDir = ' HomeDir
  137.   say 'ListDir =' ListDir
  138.   say 'Junk =' Junk
  139.   end
  140.  
  141. if Log = TRUE then do
  142.   ETime1 = time('E')
  143.   call StartLog
  144.   call WriteLog('ListName =' ListName)
  145.   call WriteLog('MsgFile =' MsgFile)
  146.   end
  147.  
  148. TmpDir = value('TMP',,Env)
  149. /* Process the message */
  150. call DoMessage
  151.  
  152. /* Make sure the tmp file is deleted */
  153. rc = SysFileDelete(MsgFile)
  154. say 'Delete for message file:' rc
  155.  
  156. if Log = TRUE then do
  157.   ETime2 = time('E')
  158.   call StopLog
  159.   end
  160.  
  161. exit
  162.  
  163. /* ------------------------------------------------------------------ */
  164.  
  165. DoMessage:
  166.  
  167. /* Read the per list configuration file */
  168. call ReadListCf(ListName)
  169.  
  170. if Debug = TRUE then say 'Processing message now'
  171. if Log = TRUE then call WriteLog('Processing message now')
  172.  
  173. rc = stream(MsgFile, 'C', 'OPEN READ')  /* open the file for reading */
  174. if rc <> 'READY:' then do
  175.   call WriteLog('Could not open message file.')
  176.   return
  177.   end
  178.  
  179. call ParseHeaders  /* first get the header info */
  180.  
  181. if HeadReplyTo <> '' then
  182.   HeadEmail = HeadReplyTo
  183. else
  184.   HeadEmail = HeadFrom
  185. /* now clean up the email address */
  186. HeadEmail = NormalizeEmail(HeadEmail)
  187. HeadEmail = translate(HeadEmail, lowercase, uppercase)
  188.  
  189. if Debug = TRUE then say 'HeadEmail =' HeadEmail
  190.  
  191. if Debug = TRUE then
  192.   do
  193.   say 'ListName =' ListName
  194.   say 'HeadEmail =' HeadEmail
  195.   end
  196. if Log = TRUE then
  197.   do
  198.   call WriteLog('ListName =' ListName)
  199.   call WriteLog('HeadEmail =' HeadEmail)
  200.   end
  201.  
  202. /* Look for bad addresses such as postmaster, majordomo, etc. */
  203. parse var HeadEmail User '@' Domain
  204. User = translate(User, lowercase, uppercase)
  205. do i = 1 to words(BadAddrs)
  206.   if User = word(BadAddrs, i) then do
  207.     rc = stream(MsgFile, 'c', 'close')
  208.     say 'Calling errors. BadAddrs found.'
  209.     call Errors(ListName MsgFile)
  210.     exit
  211.     end
  212.   end
  213.  
  214. /* now check and see if this person is on the list */
  215. if CanPost(ListName HeadEmail) = FALSE then do
  216.   if Debug = TRUE then say 'Cannot post.'
  217.   if Log = TRUE then call WriteLog('Cannot post. HeadEmail =' HeadEmail)
  218.   /* we must close the msg file now */
  219.   rc = stream(MsgFile, 'c', 'close')
  220.   call ReturnErrorMsg   /* also close and delete the message file */
  221.   return
  222.   end
  223.  
  224. if Debug = TRUE then say 'Sender can post.'
  225. if Log = TRUE then call WriteLog('Sender can post.')
  226.  
  227. /* See if it needs a moderator's approval */
  228. if Moderated = TRUE then do
  229.   if CheckForApproval() = FALSE then do  /* this post not approved, send to moderator */
  230.     call SendToModerator                 /* this will also close the message file */
  231.     if Debug = TRUE then say 'Sending msg to moderator for approval.'
  232.     if Log = TRUE then call WriteLog('Sending msg to moderator for approval.')
  233.     return
  234.     end
  235.   end
  236.  
  237. if Debug = TRUE then say 'Message ok to send to list.'
  238. if Log = TRUE then call WriteLog('Message ok to send to list.')
  239.  
  240. /* if we're here, then this is a non-moderated list or an approved post */
  241. /* the CheckForApproval function has already digested the approval header */
  242. /* so that it is not sent to the list also. Now send the message out. */
  243.  
  244. /* create a temp file for the outgoing message */
  245. OutFile = SysTempFileName(TmpDir'\f?????.tmp', '?')
  246. rc = stream(OutFile, 'C', 'OPEN WRITE')  /* open the file for writing */
  247. if rc <> 'READY:' then do
  248.   call WriteLog('Could not create temp file for outgoing message.')
  249.   end
  250.  
  251. call WriteListHeaders
  252.  
  253. /* See if there is a fronter to prepend to the message */
  254. if ListFronter <> '' then do
  255.   FileName = ListDir'\'ListName'\'ListFronter
  256.   rc = LockOpen(FileName 'READ')
  257.   if rc = TRUE then do
  258.     do while lines(FileName) <> 0         /* until end of file */
  259.       Line = linein(FileName)             /* get a line of the file */
  260.       rc = lineout(OutFile, Line, )       /* output it */
  261.     end
  262.     rc = LockClose(FileName)
  263.   end
  264. end
  265.  
  266. /* The actual message */
  267. if Moderated = FALSE & FirstLine <> '' then do  /* don't forget the first line */
  268.   rc = lineout(OutFile, FirstLine, )
  269.   end
  270. do while lines(MsgFile) <> 0         /* until end of file */
  271.   Line = linein(MsgFile)             /* get a line of the file */
  272.   rc = lineout(OutFile, Line, )      /* write it to the outfile */
  273.   end
  274.  
  275. /* See if there is a footer to append to the message */
  276. if ListFooter <> '' then do
  277.   FileName = ListDir'\'ListName'\'ListFooter
  278.   rc = LockOpen(FileName 'READ')
  279.   if rc = TRUE then do
  280.     do while lines(FileName) <> 0         /* until end of file */
  281.       Line = linein(FileName)             /* get a line of the file */
  282.       rc = lineout(OutFile, Line, )       /* output it */
  283.     end
  284.     rc = LockClose(FileName)
  285.   end
  286. end
  287.  
  288. rc = stream(MsgFile, 'C', 'CLOSE')   /* close both files */
  289. rc = stream(OutFile, 'C', 'CLOSE')
  290.  
  291. if Debug = TRUE then say 'Headers and Msg written to outfile.'
  292.  
  293. /* now create the file with the email addresses in it */
  294. FileName = ListDir'\'ListName'\'ListName
  295. /* create a temp file for the email addresses */
  296. EmailFile = SysTempFileName(TmpDir'\e?????.tmp', '?');
  297. /* copy the list's email addresses to the temporary name */
  298. rc = CopyLock(FileName EmailFile)
  299.  
  300. if Log = TRUE then do
  301.   call WriteLog('Mail from:' ListName'-owner@'WhereAmI)
  302.   call WriteLog('Emailfile:' EmailFile)
  303.   call WriteLog('Msgfile:' OutFile)
  304.   call LogRcpt(EmailFile)
  305.   end
  306.  
  307. if Debug = TRUE then say 'EmailFile ready.'
  308.  
  309. /* Save to the archives if requested */
  310. if DoArchive = TRUE then do
  311.   call SaveArchive(OutFile)
  312.   end
  313.  
  314. /* Save to the digest if we're running this list as a digest too */
  315. if DoDigest = TRUE then do
  316.   call SaveDigest(OutFile)
  317.   end
  318.  
  319. if Debug = TRUE then say 'Starting mailer.'
  320.  
  321. /* start the mail program to send the message out */
  322. Mailer ListName'-owner@'WhereAmI EmailFile OutFile
  323.  
  324. return
  325.  
  326. /* ------------------------------------------------------------------ */
  327.  
  328. SendToModerator:
  329.  
  330. if Log = TRUE then call WriteLog('Sending msg to moderator for approval.')
  331.  
  332. /* write the headers first */
  333. TimeZone = value( 'TZ', , Env)
  334. TmpTime = time('N')
  335. DayOfWeek = date('W')
  336. DayOfWeek = left(DayOfWeek, 3)
  337. TmpDate = date('N')
  338. rc = lineout(OutFile, 'Date:' DayOfWeek',' TmpDate TmpTime TimeZone, )
  339. rc = lineout(OutFile, 'Sender:' WhoAmI'-owner <'WhoAmI'-owner@'WhereAmI'>', )
  340. rc = lineout(OutFile, 'From:' WhoAmI '<'WhoAmI'@'WhereAmI'>', )
  341. rc = lineout(OutFile, 'Reply-To:' ListName'@'WhereAmI, )
  342. rc = lineout(OutFile, 'Subject: Approval Request for' ListName, )
  343. rc = lineout(OutFile, 'To:' ListOwner, )
  344. rc = lineout(OutFile, '', )
  345. rc = lineout(OutFile, 'Approved: ', )
  346. rc = lineout(OutFile, '', )
  347. rc = lineout(OutFile, '--------------------------------------------------', )
  348. rc = lineout(OutFile, 'From:' HeadFrom, )
  349. rc = lineout(OutFile, 'To:' HeadTo, )
  350. rc = lineout(OutFile, 'Subject:' HeadSubject, )
  351. rc = lineout(OutFile, '--------------------------------------------------', )
  352.  
  353. if FirstLine <> '' then do  /* don't forget the first line */
  354.   rc = lineout(OutFile, FirstLine, )
  355.   end
  356. /* now copy the rest of the message */
  357. do while lines(MsgFile) <> 0         /* until end of file */
  358.   Line = linein(MsgFile)             /* get a line of the file */
  359.   rc = lineout(OutFile, Line, )      /* write it to the outfile */
  360.   end
  361.  
  362. rc = stream(MsgFile, 'C', 'CLOSE')   /* close both files */
  363. rc = stream(OutFile, 'C', 'CLOSE')
  364.  
  365. EmailFile = SysTempFileName(TmpDir'\e?????.tmp', '?')
  366. rc = stream(EmailFile, 'C', 'OPEN WRITE')  /* open the file for writing */
  367. if rc <> 'READY:' then do
  368.   call SendError('no emailfile')
  369.   end
  370. rc = lineout(EmailFile, ListOwner, )
  371. rc = stream(EmailFile, 'C', 'CLOSE')
  372.  
  373. /* now mail it to the moderator */
  374. Mailer WhoAmI'@'WhereAmI EmailFile OutFile
  375.  
  376. return
  377.  
  378. /* ------------------------------------------------------------------ */
  379.  
  380. ReturnErrorMsg:
  381.  
  382. if Debug = TRUE then say 'Returning error msg to sender.'
  383. if Log = TRUE then call WriteLog('Returning error msg to sender.')
  384.  
  385. /* write the headers first */
  386. AdminSubject = 'Your Message To' ListName
  387. if HeadReplyTo <> '' then
  388.   AdminTo = HeadReplyTo
  389. else if HeadFrom <> '' then
  390.   AdminTo = HeadFrom
  391. AdminFile = OutFile
  392. call WriteAdminHeaders
  393.  
  394. rc = lineout(OutFile, 'Your message to the list' ListName 'has been rejected.', )
  395. rc = lineout(OutFile, '', )
  396. rc = lineout(OutFile, 'You are not a member of the list. For help on subscribing to', )
  397. rc = lineout(OutFile, 'the list, please send a message to' WhoAmI'@'WhereAmI 'with', )
  398. rc = lineout(OutFile, 'the word "help" in the body of the message.', )
  399. rc = lineout(OutFile, '', )
  400. rc = lineout(OutFile, 'Your humble mailing list software,', )
  401. rc = lineout(OutFile, '', )
  402. rc = lineout(OutFile, WhoAmI, )
  403.  
  404. rc = stream(OutFile, 'C', 'CLOSE')
  405.  
  406. EmailFile = SysTempFileName(TmpDir'\e?????.tmp', '?')
  407. rc = stream(EmailFile, 'C', 'OPEN WRITE')  /* open the file for writing */
  408. if rc <> 'READY:' then do
  409.   call SendError('no emailfile')
  410.   end
  411. rc = lineout(EmailFile, HeadEmail, )
  412. rc = stream(EmailFile, 'C', 'CLOSE')
  413.  
  414. if Debug = TRUE then say 'Starting mailer.'
  415.  
  416. /* now mail it to the hapless emailer */
  417. Mailer WhoAmI'@'WhereAmI EmailFile OutFile
  418.  
  419. return
  420.  
  421. /* ------------------------------------------------------------------ */
  422. /*
  423.  * Write out our standard headers for a list message
  424.  *
  425.  */
  426.  
  427. WriteListHeaders:  /* note that we have full access to all globals here */
  428.  
  429. /* Write out the other headers from the message */
  430. do i = 1 to HeadOther.0
  431.   rc = lineout(OutFile, HeadOther.i, )
  432.   end i
  433.  
  434. TimeZone = value( 'TZ', , Env)
  435. TmpTime = time('N')
  436. DayOfWeek = date('W')
  437. DayOfWeek = left(DayOfWeek, 3)
  438. TmpDate = date('N')
  439. /* we put in the local time for date so that posts are chronological */
  440. rc = lineout(OutFile, 'Date:' DayOfWeek',' TmpDate TmpTime TimeZone, )
  441. /* for those that want it, here's the original date */
  442. rc = lineout(OutFile, 'X-OldDate:' HeadDate, )
  443.  
  444. rc = lineout(OutFile, 'Sender:' ListName'-owner <'ListName'-owner@'WhereAmI'>', )
  445. if ListHeader = TRUE then
  446.   rc = lineout(OutFile, 'X-Listname:' ListName'@'WhereAmI, )
  447.  
  448. if ReplyTo <> '' then
  449.   rc = lineout(OutFile, 'Reply-To:' ReplyTo, )
  450. else if HeadReplyTo <> '' then
  451.   rc = lineout(OutFile, 'Reply-To:' HeadReplyTo, )
  452. else if HeadFrom <> '' then
  453.   rc = lineout(OutFile, 'Reply-To:' HeadFrom, )
  454.  
  455. /* if we set replyto to the sender, then list the list as a CC */
  456. if ReplyTo = '' then
  457.   rc = lineout(OutFile, 'Cc:' ListName '<'ListName'@'WhereAmI'>', )
  458.  
  459. rc = lineout(OutFile, 'From:' HeadFrom, )
  460. rc = lineout(OutFile, 'To:' HeadTo, )
  461.  
  462. if SubjectPrefix <> '' then
  463.   do
  464.   TmpSubject = ReWriteSubject(HeadSubject)
  465.   rc = lineout(OutFile, 'Subject:' SubjectPrefix TmpSubject, )
  466.   end
  467. else
  468.   rc = lineout(OutFile, 'Subject:' HeadSubject, )
  469.  
  470. rc = lineout(OutFile, '', )
  471.  
  472. return
  473.  
  474. /* ------------------------------------------------------------------ */
  475. /* 
  476.  * Check for the approval header for this list
  477.  *
  478.  */
  479.  
  480. CheckForApproval:
  481.  
  482. if Debug = TRUE then say 'Checking msg for approval.'
  483. if Log = TRUE then call WriteLog('Checking msg for approval.')
  484.  
  485. Line = ''
  486. do while Line = ''          /* look for first non-blank line */
  487.   Line = linein(MsgFile)
  488.   if lines(MsgFile) = 0 then return FALSE
  489.   end
  490.  
  491. FirstLine = Line
  492. parse var Line Key ':' Val
  493. Key = translate(Key, lowercase, uppercase)
  494. if Key = 'approved' & Val = ApprovePassword then do
  495.   return TRUE
  496.   end
  497.  
  498. return FALSE
  499.  
  500. /* ------------------------------------------------------------------ */
  501.  
  502. IsList: procedure expose ListDir TRUE FALSE Debug Log LogFile
  503.  
  504. parse arg ListName
  505.  
  506. if Debug = TRUE then say 'Checking for list' ListName
  507. if Log = TRUE then call WriteLog('Checking for list' ListName)
  508.  
  509. /* First check to see if this is a digest request */
  510. parse var ListName List '-' Digest
  511. Digest = translate(Digest, lowercase, uppercase)
  512. if Digest = 'digest' then
  513.   DirName = ListDir'\'List'\Digests'
  514. else  
  515.   DirName = ListDir'\'ListName
  516.  
  517. rc = SysFileTree(DirName, s., 'D')
  518. if rc = 0 & s.0 = 1 then
  519.   return TRUE
  520. else
  521.   return FALSE
  522.  
  523. return FALSE  /* safety net */
  524.  
  525. /* ------------------------------------------------------------------ */
  526.  
  527. CanPost: procedure expose ListDir TRUE FALSE Debug Log LogFile OpenPosting,
  528.          lowercase uppercase
  529.  
  530. parse arg ListName Email
  531.  
  532. if OpenPosting = TRUE then return TRUE /* bypass member checks */
  533.  
  534. if Debug = TRUE then say 'Checking if' Email 'is a list member of' ListName
  535. if Log = TRUE then call WriteLog('Checking if' Email 'is a list member of' ListName)
  536.  
  537. /* First check to see if this is a digest request */
  538. parse var ListName List '-' Digest
  539. Digest = translate(Digest, lowercase, uppercase)
  540. if Digest = 'digest' then
  541.   FileName = ListDir'\'List'\'List
  542. else  
  543.   FileName = ListDir'\'ListName'\'ListName
  544.  
  545. Sub = FALSE
  546.  
  547. if Log = TRUE then call WriteLog('Opening file:' FileName)
  548.  
  549. rc = LockOpen(FileName 'READ')  /* open the file locking it */
  550. if rc = FALSE then do
  551.   if Log = TRUE then call WriteLog('Unable to open listname file')
  552.   return FALSE                   /* return FALSE if cannot open */
  553.   end
  554.  
  555. Email = translate(Email, lowercase, uppercase)
  556.  
  557. do while lines(FileName) <> 0         /* until end of file */
  558.   Line = linein(FileName)             /* get a line of the file */
  559.   Line = translate(Line, lowercase, uppercase)
  560.   if Line = Email then do
  561.     Sub = TRUE
  562.     leave
  563.     end
  564. end
  565.  
  566. rc = LockClose(FileName)
  567.  
  568. if Sub = TRUE then return TRUE
  569.  
  570. /* Now check the digest members */
  571. FileName = FileName'.digest'
  572. rc = LockOpen(FileName 'READ')  /* open the file locking it */
  573. if rc = FALSE then do
  574.   if Log = TRUE then call WriteLog('Unable to open listname file')
  575.   return FALSE                   /* return FALSE if cannot open */
  576.   end
  577.  
  578. do while lines(FileName) <> 0         /* until end of file */
  579.   Line = linein(FileName)             /* get a line of the file */
  580.   Line = translate(Line, lowercase, uppercase)
  581.   if Line = Email then do
  582.     Sub = TRUE
  583.     leave
  584.     end
  585. end
  586.  
  587. rc = LockClose(FileName)
  588.  
  589. return Sub
  590.  
  591. /* ------------------------------------------------------------------ */
  592. /*
  593.  * Normalize the email address into a SMTP form
  594.  *
  595.  */
  596.  
  597. NormalizeEmail: procedure expose Author
  598.  
  599. parse arg All
  600.  
  601. rc = pos('<', All, )
  602. if rc = 0 then
  603.   do
  604.   /* in case some mailers use () instead of <> */
  605.   All = translate(All, '<', '(')
  606.   All = translate(All, '>', ')')
  607.   end
  608.  
  609. parse var All Part1 '<' Part2 '>' Part3
  610.  
  611. rc = pos('@', Part1, )
  612. if rc <> 0 then 
  613.   do
  614.   Part1 = strip(Part1, 'B', )  /* we must strip any blanks leftover */
  615.   if Part2 <> '' then Author = Part2
  616.   else if Part3 <> '' then Author = Part3
  617.   else Author = Part1
  618.   return Part1
  619.   end
  620.  
  621. rc = pos('@', Part2, )
  622. if rc <> 0 then
  623.   do
  624.   Part2 = strip(Part2, 'B', )
  625.   if Part1 <> '' then Author = Part1
  626.   else if Part3 <> '' then Author = Part3
  627.   else Author = Part2
  628.   return Part2
  629.   end
  630.  
  631. rc = pos('@', Part3, )
  632. if rc <> 0 then
  633.   do
  634.   Part3 = strip(Part3, 'B', )
  635.   if Part2 <> '' then Author = Part2
  636.   else if Part1 <> '' then Author = Part1
  637.   else Author = Part3
  638.   return Part3
  639.   end
  640.  
  641. return ''  /* error finding SMTP email address */
  642.  
  643. /* ------------------------------------------------------------------ */
  644. /*
  645.  * Parse RFC822 headers
  646.  *
  647.  */
  648.  
  649. ParseHeaders: procedure expose HeadTo HeadFrom HeadReplyTo MsgFile HeadSubject ,
  650.               lowercase uppercase HeadDate HeadCc HeadSender Log FALSE TRUE LogFile,
  651.               HeadOther. 
  652.  
  653. say 'ParseHeaders starting'
  654.  
  655. idx = 1
  656.  
  657. Line = linein(MsgFile)                /* get a line of the file */
  658. do while Line <> ''                   /* until end of headers */
  659.   parse var Line Key ':' Val          /* separate out the components */
  660.   Key = translate(Key, lowercase, uppercase)
  661.   select
  662.     when Key = 'to' then
  663.       HeadTo = Val
  664.     when Key = 'reply-to' then
  665.       HeadReplyTo = Val
  666.     when Key = 'from' then
  667.       HeadFrom = Val
  668.     when Key = 'subject' then
  669.       HeadSubject = Val
  670.     when Key = 'date' then
  671.       HeadDate = Val
  672.     when Key = 'cc' then
  673.       HeadCc = Val
  674.     when Key = 'sender' then
  675.       HeadSender = Val
  676.     when Key = 'x-listname' then /* don't repeat the listname */
  677.       nop
  678.     when Key = 'status' then /* don't repeat the status */
  679.       nop
  680.     when Key = 'priority' then /* don't repeat the priority */
  681.       nop
  682.     when Key = 'x-olddate' then /* don't repeat the x-olddate */
  683.       nop
  684.     when Key = 'return-path' then /* don't repeat the return-path */
  685.       nop
  686.     otherwise do
  687.       HeadOther.idx = Line
  688.       idx = idx + 1
  689.       end
  690.     end   /* select */
  691.   Line = linein(MsgFile)
  692. end       /* do while */
  693.  
  694. HeadOther.0 = idx - 1  /* save the number of extra header lines */
  695.  
  696. if Log = TRUE then
  697.   do
  698.   say 'Writing headers info to log file'
  699.   call WriteLog('ParseHeaders Info:')
  700.   call WriteLog('To:' HeadTo)
  701.   call WriteLog('From:' HeadFrom)
  702.   call WriteLog('Reply-to:' HeadReplyTo)
  703.   call WriteLog('Subject:' HeadSubject)
  704.   end
  705.  
  706. return
  707.  
  708. /* ------------------------------------------------------------------ */
  709. /*
  710.  * Read the master configuration file
  711.  *
  712.  */
  713.  
  714. ReadMasterCf: procedure expose HomeDir LogDir ListDir Mailer WhereAmI WhoAmI ,
  715.               WhoAmIOwner MasterPassword Env TRUE FALSE Debug
  716.  
  717. if Debug = TRUE then say 'Reading Steward configuration file.'
  718.  
  719. /* Find out where the configuration file should be */
  720. StewardCf = value('steward_cf',,Env)
  721. /* StewardCf = value('steward_cf_test',,Env) */
  722.  
  723. /* If its not defined then assume wherever we are */
  724. if StewardCf = '' then do
  725.   StewardCf = '.'
  726.   end
  727.  
  728. FileName = StewardCf'\steward.cf'
  729.  
  730. rc = LockOpen(FileName 'READ')  /* open the file locking it */
  731. if rc = FALSE then
  732.   return FALSE                   /* return FALSE if cannot open */
  733.  
  734. /* now read the configuration file */
  735. do while lines(FileName) <> 0         /* until end of file */
  736.   Line = linein(FileName)             /* get a line of the file */
  737.   parse var Line Line '#' Comment     /* separate out any comments */
  738.   if Line <> '' then do               /* if not null */
  739.     parse var Line Key '=' Val        /* find the key and value */
  740.     if Key <> '' then do
  741.       Val = strip(Val, 'B', ' ')      /* remove any blanks */
  742.       Key = strip(Key, 'B', ' ')
  743.       select
  744.         when Key = 'HomeDir' then
  745.           HomeDir = Val
  746.         when Key = 'LogDir' then
  747.           LogDir = Val
  748.         when Key = 'ListDir' then
  749.           ListDir = Val
  750.         when Key = 'Mailer' then
  751.           Mailer = Val
  752.         when Key = 'WhereAmI' then
  753.           WhereAmI = Val
  754.         when Key = 'WhoAmI' then
  755.           WhoAmI = Val
  756.         when Key = 'WhoAmIOwner' then
  757.           WhoAmIOwner = Val
  758.         when Key = 'MasterPassword' then
  759.           MasterPassword = Val
  760.         otherwise nop
  761.         end   /* select */
  762.       end     /* if Key <> '' */
  763.     end       /* if Line <> '' */
  764.  
  765.   Key = ''
  766.  
  767. end /* end do while */
  768.  
  769. rc = LockClose(FileName)
  770.  
  771. if Debug = TRUE then say 'Steward.cf file read.'
  772.  
  773. return TRUE
  774.  
  775. /* ------------------------------------------------------------------ */
  776. /*
  777.  * Read the per list configuration file
  778.  *
  779.  */
  780.  
  781. ReadListCf: procedure expose ListDir AdminPassword ListOwner Administrivia,
  782.             Advertise ApprovePassword DoArchive Moderated NoList Precedence,
  783.             ListHeader SubscribePolicy ReplyTo SubjectPrefix TRUE FALSE,
  784.             DoDigest DigestRmHeader DigestVolume DigestIssue DigestFronter,
  785.             DigestFooter DigestName Debug Log LogFile OpenPosting WelcomeFile,
  786.             DigestSubs CaseInsensitive ListFronter ListFooter WhereAmI
  787.  
  788. parse arg ListName
  789.  
  790. if Debug = TRUE then say 'Reading list configuration file for' ListName
  791.  
  792. /* First check to see if this is a digest request */
  793. parse var ListName List '-' Digest
  794. Digest = translate(Digest, lowercase, uppercase)
  795. if Digest = 'digest' then
  796.   FileName = ListDir'\'List'\'List'.cf'
  797. else  
  798.   FileName = ListDir'\'ListName'\'ListName'.cf'
  799.  
  800. if Debug = TRUE then say 'Reading filename "'FileName'"'
  801.  
  802. rc = LockOpen(FileName 'READ')  /* open the file locking it */
  803. if rc = FALSE then
  804.   return FALSE                   /* return FALSE if cannot open */
  805.  
  806. /* now read the configuration file */
  807. do while lines(FileName) <> 0         /* until end of file */
  808.   Line = linein(FileName)             /* get a line of the file */
  809.   parse var Line Line '#' Comment     /* separate out any comments */
  810.   if Line <> '' then do               /* if not null */
  811.     parse var Line Key '=' Val        /* find the key and value */
  812.     if Key <> '' then do
  813.       Val = strip(Val, 'B', ' ')      /* remove any blanks */
  814.       Key = strip(Key, 'B', ' ')
  815. /*      say Key '=' Val */
  816.       select
  817.         when Key = 'AdminPassword' then
  818.           AdminPassword = Val
  819.         when Key = 'ListOwner' then
  820.           ListOwner = Val
  821.         when Key = 'Administrivia' then
  822.           Administrivia = Val
  823.         when Key = 'Advertise' then
  824.           Advertise = Val
  825.         when Key = 'ApprovePassword' then
  826.           ApprovePassword = Val
  827.         when Key = 'DoArchive' then
  828.           DoArchive = Val
  829.         when Key = 'Moderated' then
  830.           Moderated = Val
  831.         when Key = 'NoList' then
  832.           NoList = Val
  833.         when Key = 'Precedence' then
  834.           Precedence = Val
  835.         when Key = 'ListHeader' then
  836.           ListHeader = Val
  837.         when Key = 'SubscribePolicy' then
  838.           SubscribePolicy = Val
  839.         when Key = 'ReplyTo' then
  840.           ReplyTo = Val
  841.         when Key = 'SubjectPrefix' then
  842.           SubjectPrefix = Val
  843.         when Key = 'ListFronter' then
  844.           ListFronter = Val
  845.         when Key = 'ListFooter' then
  846.           ListFooter = Val
  847.         when Key = 'DoDigest' then
  848.           DoDigest = Val
  849.         when Key = 'DigestRmHeader' then
  850.           DigestRmHeader = Val
  851.         when Key = 'DigestVolume' then
  852.           DigestVolume = Val
  853.         when Key = 'DigestIssue' then
  854.           DigestIssue = Val
  855.         when Key = 'DigestName' then
  856.           DigestName = Val
  857.         when Key = 'DigestFronter' then
  858.           DigestFronter = Val
  859.         when Key = 'DigestFooter' then
  860.           DigestFooter = Val
  861.         when Key = 'OpenPosting' then
  862.           OpenPosting = Val
  863.         when Key = 'WelcomeFile' then
  864.           WelcomeFile = Val
  865.         when Key = 'DigestSubs' then
  866.           DigestSubs = Val
  867.         when Key = 'CaseInsensitive' then
  868.           CaseInsensitive = Val
  869.         when Key = 'WhereAmI' then
  870.           WhereAmI = Val
  871.         otherwise nop
  872.         end   /* select */
  873.       end     /* if Key <> '' */
  874.     end       /* if Line <> '' */
  875.  
  876.   Key = ''
  877.  
  878. end /* end do while */
  879.  
  880. rc = LockClose(FileName)
  881.  
  882. return TRUE
  883.  
  884. /* ------------------------------------------------------------------ */
  885. /*
  886.  * Save the current message to the archive database
  887.  *
  888.  */
  889.  
  890. SaveArchive: procedure expose ListDir ListName Debug Log FALSE TRUE LogFile
  891.  
  892. parse arg MsgFile
  893.  
  894. if Debug = TRUE then say 'Saving msg to archive.'
  895. if Log = TRUE then call WriteLog('Saving msg to archive.')
  896.  
  897. /* Today's date */
  898. TmpDate = date('E')
  899. parse var TmpDate TmpDay '/' TmpMon '/' TmpYear
  900.  
  901. /* create the filename */
  902. FileName = ListDir'\'ListName'\Archives\'TmpYear'.'TmpMon
  903.  
  904. /* open the file */
  905. rc = LockOpen(FileName 'WRITE')
  906. action = 'SEEK <0'                               /*wfs 7-Aug-1997*/
  907. IF IsOREXX() THEN                                /*wfs 7-Aug-1997*/
  908.   action = action 'WRITE'                        /*wfs 7-Aug-1997*/
  909. rc = stream(FileName, 'C', action)      /* go to end of file */
  910.  
  911. /* the separator line */
  912. rc = lineout(FileName, '', )
  913. rc = lineout(FileName, '===== Message Separator ==========================', )
  914. rc = lineout(FileName, '', )
  915.  
  916. /* copy the new message to it */
  917. rc = LockOpen(MsgFile 'READ')
  918. do while lines(MsgFile) <> 0         /* until end of file */
  919.   Line = linein(MsgFile)             /* get a line of the file */
  920.   rc = lineout(FileName, Line, )
  921.   end
  922.  
  923. rc = LockClose(MsgFile)
  924. rc = LockClose(FileName)
  925.  
  926. return
  927.  
  928.  
  929. /* ------------------------------------------------------------------ */
  930. /*
  931.  * Save the current message to the digest database
  932.  *
  933.  */
  934.  
  935. SaveDigest: procedure expose ListDir ListName TRUE FALSE HeadFrom HeadReplyTo,
  936.                              HeadSubject HeadDate HeadCc HeadSender HeadTo Debug,
  937.                              Log LogFile DigestSubs Author
  938.  
  939. parse arg MsgFile
  940.  
  941. if Debug = TRUE then say 'Saving msg to digest.'
  942. if Log = TRUE then call WriteLog('Saving msg to digest.')
  943.  
  944. /* Today's date */
  945. TmpDate = date('E')
  946. parse var TmpDate TmpDay '/' TmpMon '/' TmpYear
  947.  
  948. /* create the filename */
  949. FileName = ListDir'\'ListName'\Digests\'TmpYear'.'TmpMon'.'TmpDay
  950.  
  951. /* open the file */
  952. rc = LockOpen(FileName 'WRITE')
  953. action = 'SEEK <0'                               /*wfs 7-Aug-1997*/
  954. IF IsOREXX() THEN                                /*wfs 7-Aug-1997*/
  955.   action = action 'WRITE'                        /*wfs 7-Aug-1997*/
  956. rc = stream(FileName, 'C', action)      /* go to end of file */
  957.  
  958. /* the separator lines */
  959. rc = lineout(FileName, '', )
  960. rc = lineout(FileName, '===== Message Separator ==========================', )
  961. rc = lineout(FileName, '', )
  962.  
  963. /* copy the new message to it */
  964. rc = LockOpen(MsgFile 'READ')
  965.  
  966. Line = linein(MsgFile)    /* First skip the rewritten headers */
  967. do while Line <> ''
  968.   Line = linein(MsgFile)
  969.   end
  970.  
  971. /* Now write out the headers we want */
  972. if HeadDate <> '' then
  973.   rc = lineout(FileName, 'Date:' HeadDate, )
  974.  
  975. if DigestRmHeader = FALSE then do
  976.   if HeadSender <> '' then
  977.     rc = lineout(FileName, 'Sender:' HeadSender, )
  978.   if HeadCc <> '' then
  979.     rc = lineout(FileName, 'Cc:' HeadCc, )
  980.   if HeadTo <> '' then
  981.     rc = lineout(FileName, 'To:' HeadTo, )
  982.   end
  983.   
  984. if HeadFrom <> '' then
  985.   rc = lineout(FileName, 'From:' HeadFrom, )
  986. if HeadReplyTo <> '' then
  987.   rc = lineout(FileName, 'Reply-To:' HeadReplyTo, )
  988. if HeadSubject <> '' then
  989.   rc = lineout(FileName, 'Subject:' HeadSubject, )
  990. rc = lineout(FileName, '', )
  991.  
  992. do while lines(MsgFile) <> 0         /* until end of file */
  993.   Line = linein(MsgFile)             /* get a line of the file */
  994.   rc = lineout(FileName, Line, )
  995.   end
  996.  
  997. rc = LockClose(MsgFile)
  998. rc = LockClose(FileName)
  999.  
  1000. /* Check to see if we need to save subject lines for the digest */
  1001. if DigestSubs = TRUE then
  1002.   do
  1003.   FileName = FileName'.subs'
  1004.   /* open the file */
  1005.   rc = LockOpen(FileName 'WRITE')
  1006. action = 'SEEK <0'                               /*wfs 7-Aug-1997*/
  1007. IF IsOREXX() THEN                                /*wfs 7-Aug-1997*/
  1008.   action = action 'WRITE'                        /*wfs 7-Aug-1997*/
  1009.   rc = stream(FileName, 'C', action)      /* go to end of file */
  1010.   /* show subject and then the author */
  1011.   rc = lineout(FileName, HeadSubject ':' Author, )
  1012.   rc = LockClose(FileName)
  1013.   end
  1014.  
  1015. return
  1016.  
  1017.  
  1018. /* ------------------------------------------------------------------ */
  1019.  
  1020. StartLog: procedure expose LogDir LogFile ETime1 ETime2 Debug FALSE TRUE
  1021.  
  1022. FileName = LogDir'\?????.log'
  1023. if Debug = TRUE then 
  1024.   do
  1025.   say 'FileName =' FileName
  1026.   say 'LogDir =' LogDir
  1027.   end
  1028.  
  1029. LogFile = SysTempFileName(FileName, '?')
  1030.  
  1031. if LogFile = '' then
  1032.   do
  1033.   say 'Cannot create temporary file.'
  1034.   say 'Setting logfile to NUL'
  1035.   LogFile = 'NUL'
  1036.   Log = FALSE
  1037.   return
  1038.   end
  1039.  
  1040. if Debug = TRUE then say 'LogFile =' LogFile
  1041.  
  1042. rc = stream(LogFile, 'C', 'OPEN WRITE')
  1043.  
  1044. TmpTime = time('N')
  1045. TmpDate = date('N')
  1046.  
  1047. rc = lineout(LogFile, 'Date:' TmpDate, )
  1048. rc = lineout(LogFile, 'Time:' TmpTime, )
  1049.  
  1050. return
  1051.  
  1052. /* ------------------------------------------------------------------ */
  1053.  
  1054. StopLog: procedure expose LogFile LogDir ETime1 ETime2 Debug FALSE TRUE
  1055.  
  1056. ETime = ETime2 - Etime1
  1057.  
  1058. if Debug= TRUE then say 'Elapsed Time =' ETime
  1059.  
  1060. call WriteLog('Elapsed Time:' ETime)
  1061. call WriteLog('')
  1062. call WriteLog('=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=')
  1063. call WriteLog('')
  1064.  
  1065. rc = stream(LogFile, 'C', 'CLOSE')
  1066.  
  1067. PermLog = LogDir'\steward.log'
  1068.  
  1069. call AppendLock(LogFile PermLog)
  1070.  
  1071. rc = SysFileDelete(LogFile)
  1072.  
  1073. return
  1074.  
  1075. /* ------------------------------------------------------------------ */
  1076.  
  1077. WriteLog: procedure expose LogFile
  1078.  
  1079. parse arg String
  1080.  
  1081. rc = lineout(LogFile, String, )
  1082.  
  1083. return
  1084.   
  1085. /* ------------------------------------------------------------------ */
  1086.  
  1087. ErrHandler:
  1088.  
  1089. SIGerrCode = RC
  1090. StewardErrLog = 'Steward.err'
  1091.  
  1092. if Debug = TRUE then say 'Identified error while executing line #'Sigl'   RC = ['SIGerrCode']'
  1093. if Debug = TRUE then say '['SourceLine(Sigl)']'
  1094. rc = lineout( StewardErrLog, '     -----', )
  1095. rc = lineout( StewardErrLog, 'Error ['SIGerrCode'] while executing line #'Sigl, )
  1096. rc = lineout( StewardErrLog, '['SourceLine(Sigl)']')
  1097.  
  1098. return
  1099.  
  1100.  
  1101. /* ------------------------------------------------------------------ */
  1102.  
  1103. ReWriteSubject: procedure expose SubjectPrefix
  1104.  
  1105. parse arg Subject
  1106.  
  1107. TmpSubj = translate(Subject, lowercase, uppercase)
  1108.  
  1109. i = lastpos(SubjectPrefix, Subject, )
  1110. if i <> 0 then 
  1111.   do
  1112.   /* find the end of where the subject prefix is */
  1113.   i = i + length(SubjectPrefix)
  1114.   l = length(Subject)
  1115.   l = l - i
  1116.   if l > 0 then Subject = right(Subject, l)
  1117.   end
  1118.  
  1119. /* Now look for a "Re:" in the subject line */
  1120. i = lastpos('re:', TmpSubj, )
  1121. if i <> 0 then 
  1122.   Subject = 'Re:' Subject
  1123.  
  1124. return Subject
  1125.  
  1126. /* ------------------------------------------------------------------ */
  1127. /*
  1128.  * Write out our standard headers for an admin message
  1129.  *
  1130.  */
  1131.  
  1132. WriteAdminHeaders: procedure expose AdminTo WhoAmI WhereAmI AdminSubject AdminFile,
  1133.                    Env
  1134.  
  1135. TimeZone = value( 'TZ', , Env)
  1136. TmpTime = time('N')
  1137. DayOfWeek = date('W')
  1138. DayOfWeek = left(DayOfWeek, 3)
  1139. TmpDate = date('N')
  1140. rc = lineout(AdminFile, 'Date:' DayOfWeek',' TmpDate TmpTime TimeZone, )
  1141. rc = lineout(AdminFile, 'Sender:' WhoAmI'-owner <'WhoAmI'-owner@'WhereAmI'>', )
  1142. rc = lineout(AdminFile, 'From:' WhoAmI'-owner <'WhoAmI'-owner@'WhereAmI'>', )
  1143. rc = lineout(AdminFile, 'Reply-To:' WhoAmI '<'WhoAmI'@'WhereAmI'>', )
  1144. rc = lineout(AdminFile, 'To:' AdminTo, )
  1145. rc = lineout(AdminFile, 'Subject:' AdminSubject, )
  1146. rc = lineout(AdminFile, '', )
  1147.  
  1148. return
  1149.  
  1150. /* ------------------------------------------------------------------ */
  1151.  
  1152. LogRcpt:
  1153.  
  1154. parse arg FileName
  1155.  
  1156. rc = stream(FileName, 'c', 'open read')
  1157. do while lines(FileName) <> 0         /* until end of file */
  1158.   Line = linein(FileName)             /* get a line of the file */
  1159.   call WriteLog('Rcpt:' Line)
  1160.   end
  1161. rc = stream(FileName, 'c', 'close')
  1162.  
  1163. return
  1164.  
  1165. /* ------------------------------------------------------------------ */
  1166. IsOREXX: PROCEDURE                               /*wfs 7-Aug-1997*/
  1167.   PARSE VERSION rx ver dt
  1168.   RETURN rx = 'OBJREXX'
  1169.  
  1170. /* ------------------------------------------------------------------ */
  1171. /* ------------------------------------------------------------------ */
  1172.  
  1173.  
  1174.