home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / bsmtp43a.zip / BSmtp.Cmd < prev    next >
OS/2 REXX Batch file  |  2000-05-07  |  29KB  |  806 lines
  1. /******************************************************************************
  2. *                                 BSMTP/2                                     *
  3. *                           (c) 2000 by IzzySoft                              *
  4. *******************************************************************************
  5. *          Send content of BSMTP format files to an SMTP server               *
  6. * Syntax:                                                                     *
  7. *          BSMTP <InFile> [<Hostname> [<Port>]]                               *
  8. *            where <InFile>   is the name of the BSMTP file to process        *
  9. *                  <Hostname> is the name of the host running the server      *
  10. *                  <Port>     is the port used (if not standard port 25)      *
  11. *******************************************************************************
  12. * needs nvt.dll !! (from rxtelnet package: rxtelnet.zip on hobbes)            *
  13. * needs rxu.dll !! (from rxu package     : rxu1a.zip    on hobbes)            *
  14. ******************************************************************************/
  15.  
  16.   version    = '0.43a'
  17.  
  18. /* Read commandline arguments */
  19.  
  20.   parse arg infile a_hostname a_port
  21.  
  22. /* Programm structure */
  23.  
  24.   Call Load_Lib                             /* load REXX libs */
  25.   Call Config                               /* do the configuration */
  26.   Call Logo                                 /* Cls and Logo */
  27.   if infile = '' then signal error_syntax
  28.   Call Init_Socket                          /* open connection to SMTP */
  29.   Call Open_Infile                          /* read input bsmtp file to stem */
  30.   BSmtp.ReadLine = 1                        /* in what line are we? */
  31.   MailCount      = 0                        /* This is Mail number x */
  32.   DeliveredCount = 0                        /* numbers of delivered mails */
  33.   Do While ( BSmtp.ReadLine < BSmtp.0 )     /* send content of input file */
  34.     MailCount = MailCount + 1
  35.     MajorDomo.Mail = 0                      /* Mail is not to a Mailing List */
  36.     Call ReadMail                           /* Preparing Mail. stem */
  37.     If MajorDomo.Is Then Call TestMail      /* check if ToLocal or even List *
  38.                                              * (needs only to be called when *
  39.                                              * MajorDomo function used;      *
  40.                                              * MajorDomo is called from here *
  41.                                              * if necessary                  */
  42.     Call Envelope
  43.     if connected = 0 then leave
  44.     Call MailData
  45.     if connected = 0 then leave
  46.     If ( Mail.Bounced = 1 ) Then Call BounceMail
  47.     /* If ( Mail.Bounced = 2 ) Then Call FailedBounce */ /* just notify postmaster */
  48.   End
  49.   If DeletePkt then
  50.    Do
  51.     If (MailCount = DeliveredCount) then
  52.       do
  53.         rc = SysFileDelete(infile)
  54.         Call ScrPut '- All Msgs sent successfully, packet deleted.'
  55.         Call WriteLog '- All Msgs delivered successfully, packet deleted.'
  56.       end /* do if MailCount */
  57.    End /* do if DeletePkt */
  58.   Call Quit                                    /* shutdown connection */
  59.   Exit                                         /* leave the program */
  60.  
  61. /* =======================================================[ subroutines ]=== */
  62.  
  63. /* -----------------------------------------------------[ configuration ]--- */
  64.  
  65. Config:
  66.  
  67.   parse source . . maindir                           /* get source directory */
  68.   parse value reverse(maindir) with '\' maindir
  69.   maindir = reverse(maindir)
  70.  
  71.   DeletePkt = 0                       /* delete pkt if all msgs sent ok? */
  72.   port   = 25                                                /* set defaults */
  73.   connected  = 0
  74.   debug      = 0                      /* debug info ? = 1 */
  75.   LogFile    = 'bsmtp.log'
  76.   BadMailDir = 'BadMail'              /* directory to put bad mail */
  77.   hostname   = ''
  78.   LocalDomain      = 'qumran.org'     /* domain for listmails */
  79.   MajorDomo.Is     = 0                /* act as MajorDomo? = 1 */
  80.   ListFile         = 'maillist.cfg'   /* list definition */
  81.   MajorDomo.Cmd    = 'QMDomo.Cmd'     /* Cmd for MajorDomo */
  82.   MajorDomo.Weasel = 0                /* Weasel-Style Call? */
  83.   TimeOut          = 1000
  84.   UseLogLevel      = '+!$-#x'
  85.   ScrLogLevel      = '+!$-#x'
  86.  
  87.   Call read_cfg                                   /* read in the config file */
  88.   If ( a_hostname <> '' ) Then hostname = a_hostname
  89.   If ( a_port     <> '' ) Then port     = a_port
  90.   LocalHost        = value('hostname',,'OS2ENVIRONMENT')||'.'||LocalDomain
  91.  
  92.   Call WriteLog "+ BSmtp/2 v"||version||" coming up"
  93.   Call WriteLog "$ ├ Using main configuration file "config_file
  94.   Call WriteLog "$ └ Using list configuration file "ListFile
  95.  
  96.   If MajorDomo.Is Then Call List_Cfg             /* read in list definitions */
  97.  
  98.   EOT = '04'x /* diamond */
  99.   ACK = '06'x /* spade */
  100.   BEL = '07'x /* dot */
  101.   OUT = '18'x /* up-arrow */
  102.   IN  = '19'x /* down-arrow */
  103.  
  104.   signal on halt                                 /* signals */
  105.   signal on error
  106.   signal on syntax
  107.  
  108. Return
  109.  
  110. /* ----------------------- Konfiguration einlesen -------------------------- */
  111.  
  112. read_cfg:
  113.  
  114.   config_file = maindir'\BSmtp.Cfg'                 /* KonfigDatei festlegen */
  115.  
  116.   Zeile = 0
  117.   Do While lines(config_file)
  118.     Zeile = Zeile + 1
  119.     Parse Value linein(config_file) with KeyWord KeyContent ';' .
  120.     KeyWord = translate(strip(KeyWord))
  121.     KeyContent = strip(KeyContent)
  122.     Select
  123.       When KeyWord = 'DEBUG'
  124.         then Debug = 1
  125.       When KeyWord = 'DELETEPKT'
  126.         then DeletePkt = 1
  127.       When KeyWord = 'LOGFILE'
  128.         then LogFile = KeyContent
  129.       When KeyWord = 'HOSTNAME'
  130.         then hostname = KeyContent
  131.       When KeyWord = 'PORT'
  132.         then port = KeyContent
  133.       When KeyWord = 'TIMEOUT'
  134.         then TimeOut = KeyContent
  135.       When KeyWord = 'BADMAILDIR'
  136.         then BadMailDir = KeyContent
  137.       When KeyWord = 'LOCALDOMAIN'
  138.         then LocalDomain = KeyContent
  139.       When KeyWord = 'MAJORDOMO'
  140.         then MajorDomo.Is = 1
  141.       When KeyWord = 'LISTFILE'
  142.         then ListFile = KeyContent
  143.       When KeyWord = 'LOGLEVEL'
  144.         then UseLogLevel = KeyContent
  145.       When KeyWord = 'SCRLEVEL'
  146.         then UseScrLevel = KeyContent
  147.       When KeyWord = ';'
  148.         then nop
  149.       When KeyWord = '#'
  150.         then nop
  151.       When KeyWord = ''
  152.         then nop
  153.       Otherwise
  154.         signal error_keyword
  155.     End /* Select */
  156.   End /* Do While lines(config_file) */
  157.  
  158. Return
  159.  
  160. /* ------------------------------------------------[ list configuration ]--- */
  161.  
  162. List_Cfg:
  163.  
  164.   Call ScrPut "# Opening "||ListFile||" and reading it into variable MailLists."
  165.   Call WriteLog "# Opening "||ListFile||" and reading it into variable MailLists."
  166.   rc = RxExecI(ListFile,,'MailLists.','s')  /* Read ListFile into stem MailLists */
  167.   Parse Var rc InLines InBytes
  168.   Say "Read "||InBytes||" Bytes in "||InLines||" lines."
  169.   Call WriteLog "x Read "||InBytes||" Bytes in "||InLines||" lines."
  170.   If InLines = 0                               /* InFile not found or empty! */
  171.     then signal value error_fileopen('List-Konfigurations-Datei 'ListFile)
  172.   ListCount = 0
  173.   ListNames = ''
  174.   Do i = 1 To MailLists.0                      /* Lines of MailList.Cfg */
  175.     Parse Value MailLists.i With ListName Participant
  176.     rc = WordPos(ListName,ListNames)
  177.     If (rc <> 0)
  178.       Then Do
  179.         TempNr = MailList.rc.0 + 1
  180.         MailList.rc.TempNr = Participant
  181.         MailList.rc.0 = TempNr
  182.         Drop TempNr
  183.       End
  184.       Else Do
  185.         Select
  186.           When KeyWord = ';'
  187.             then nop
  188.           When KeyWord = '#'
  189.             then nop
  190.           When KeyWord = ''
  191.             then nop
  192.           Otherwise Do
  193.             ListCount = ListCount + 1
  194.             ListNames = ListNames||" "||ListName
  195.             MailList.ListCount.1 = Participant
  196.             MailList.ListCount.0 = 1
  197.           End /* otherwise */
  198.         End /* Select */
  199.       End /* else do */
  200.   End /* Do i */
  201.  
  202. Return
  203.  
  204. /* ----------------------------------------------------[ load libraries ]--- */
  205.  
  206. Load_Lib:
  207.  
  208.   If RxFuncQuery('NvtQuery') \= 0 Then
  209.    Do
  210.     call RxFuncAdd "NvtLoadFuncs","Nvt","NvtLoadFuncs"
  211.     call NvtLoadFuncs
  212.     call RxFuncDrop "NvtLoadFuncs"
  213.    End
  214.   If RxFuncQuery('SysLoadFuncs') \= 0 Then
  215.    Do
  216.     Call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  217.     Call SysLoadFuncs
  218.    End
  219.   If RxFuncQuery('RxUQuery') \= 0 Then
  220.    Do
  221.     call rxfuncadd "rxuinit","rxu","rxuinit"
  222.     call rxuinit
  223.    End
  224.  
  225. Return
  226.  
  227. /* --------------------------------------------------------[ print logo ]--- */
  228.  
  229. Logo:
  230. call SysCls
  231. say '   ************************************************************************'
  232. say '   *          BSMTP/2 v'version'                (c) 2000 by IzzySoft          *'
  233. say '   *                                                                      *'
  234. say '   *     This software is protected by the GNU General Public License     *'
  235. say '   *    version 2.  No warranty is given! (see the file named COPYING)    *'
  236. say '   ************************************************************************'
  237. say ''
  238. Return
  239.  
  240.  
  241. /* ---------------------------------------------------------[ Write Log ]--- */
  242.  
  243. WriteLog:
  244.  parse arg loglevel message
  245.  if ( pos(loglevel,useloglevel) = 0 ) then return
  246.  if loglevel = "x" then loglevel = " "
  247.  parse value date("E") with Tag "/" Monat "/" Jahr
  248.  Datum = Tag||"."||Monat"."||Jahr
  249.  if message <> ''
  250.   then call lineout LogFile, loglevel Datum time() message
  251.   else call lineout LogFile, ''
  252.  call stream ln,"c","Close"
  253. return
  254.  
  255. /* --------------------------------------------------------[ Put2Screen ]--- */
  256.  
  257. ScrPut:
  258.  parse arg scrlevel message
  259.  if ( pos(scrlevel,usescrlevel) = 0 ) then return
  260.  if loglevel = "x" then loglevel = " "
  261.  if message <> ''
  262.   then Say message
  263.   else Say ''
  264. return
  265.  
  266. /* -------------------------------------------------------[ init socket ]--- */
  267.  
  268. Init_Socket:
  269. Call ScrPut '$ Port is: '||port
  270.   socket = Telnet(hostname,port)
  271.  
  272.   if socket = ''
  273.     then do
  274.         Call ScrPut '! telnet connection failed'
  275.         Call WriteLog '! Telnet connection to '||hostname||':'||port||' failed'
  276.         Call Quit
  277.         Exit 12
  278.       end
  279.     else do
  280.       connected = 1
  281.       Call WriteLog '+ Opened telnet connection to '||hostname||' on Port '||port
  282.       Call ScrPut '$ status='tctl(socket) BEL
  283.       Data2Sock = 'HELO '||LocalHost
  284.       c = Tput(socket,Data2Sock)            /* say "HELO" to the SMTP server */
  285.       do forever
  286.         SockData = Tget(socket,TimeOut)
  287.         if debug then dummy = lineout('session.log','<'||SockData)
  288.         select
  289.           when SockData = EOT then leave    /* intro done, send mail */
  290.           when SockData = ''
  291.             then do; connected = 0; return; end;
  292.           otherwise                /* normally 2 lines: 220 <server>, 250 OK */
  293.             Call ScrPut '+ '||SockData
  294.         end /* select */
  295.       end /* do forever */
  296.     end /* else do (if connection) */
  297.  
  298. Return
  299.  
  300. /* -------------------------------------------------------[ open infile ]--- */
  301.  
  302. Open_Infile:
  303.  
  304.   Call ScrPut "# Opening "||InFile||" and reading it into variable BSmtp."
  305.   Call WriteLog "# Opening "||InFile||" and reading it into variable BSmtp."
  306.   rc = RxExecI(InFile,,'BSmtp.','s')          /* Read InFile into stem BSmtp */
  307.   Parse Var rc InLines InBytes
  308.   Call ScrPut "# Read "||InBytes||" Bytes in "||InLines||" lines."
  309.   Call WriteLog "# Read "||InBytes||" Bytes in "||InLines||" lines."
  310.   If InLines = 0                               /* InFile not found or empty! */
  311.     then signal value error_fileopen('Eingabedatei 'infile)
  312.  
  313. Return
  314.  
  315. /* -------------------------------------------------------[ parse mails ]--- */
  316.  
  317. ReadMail:
  318.  
  319.   Say ''
  320.   Call ScrPut "x Reading Message number "||MailCount||":"
  321.   Mail.Bounced   = 0                            /* original mail, no bounce */
  322.   Mail.Env.To.0  = 0                            /* no recipient yet */
  323.   MajorDomo.Mail = 0                            /* assume no mailing list */
  324.   Call ScrPut "$ - Evaluating Envelope..."
  325.  
  326.   Do Until ( BSmtp.Line = 'DATA' )             /* read envelope */
  327.     Line = BSmtp.ReadLine
  328.     Parse Value BSmtp.Line with KeyWordA ':' KeyValue
  329.     Parse Upper Value KeyWordA with KeyWord
  330.     Select
  331.       When KeyWord = 'MAIL FROM' Then Mail.Env.From = KeyValue
  332.       When KeyWord = 'RCPT TO' Then
  333.         Do
  334.           i = Mail.Env.To.0
  335.           i = i + 1                            /* one more recipient */
  336.           Mail.Env.To.i = KeyValue             /* add recipient */
  337.           Mail.Env.To.0 = i                    /* recipient added */
  338.         End
  339.       When KeyWord = 'DATA' Then nop
  340.       When BSmtp.ReadLine = BSmtp.0 Then       /* End of Data reached */
  341.         Do
  342.           Call Quit
  343.           Exit 9 /* unexpected end of data */
  344.         End
  345.       Otherwise nop                            /* illegal Data in Envelope? */
  346.     End /* Select */
  347.     BSmtp.ReadLine = BSmtp.ReadLine + 1
  348.   End /* Envelope */
  349.  
  350.   Mail.1 = 'Received: by '||LocalHost||' (BSmtp/2 v'||version||'); '
  351.   Mail.1 = Mail.1||Date('N')||' '||Time()
  352.   Mail.0 = 1                                   /* no mail data yet but above */
  353.   i      = 1                                   /* line-counter */
  354.   Mail.ReplyTo  = ''                           /* init header VARs */
  355.   Mail.ReplyToZ = 0
  356.   Mail.Sender   = Mail.Env.From
  357.   Mail.FromZ    = 0
  358.   Mail.To.0     = 0
  359.   Mail.To.Z1    = 0
  360.  
  361.   Call ScrPut "$ - Evaluating Header..."
  362.   Do Until ( Mail.i = '' )                    /* read & interpret header */
  363.     i = i + 1
  364.     Line = BSmtp.ReadLine
  365.     Mail.i = BSmtp.Line
  366.     Parse Value Mail.i with KeyWordA ':' KeyValue
  367.     Parse Upper Value KeyWordA with KeyWord
  368.     Select
  369.       When KeyWord = 'TO' Then                 /* Recipients of current mail */
  370.         Do
  371.           If ( Mail.To.Z1 = 0  ) Then Mail.To.Z1 = i
  372.           k = Mail.To.0
  373.           k = k + 1
  374.           Mail.To.k = KeyValue
  375.           Mail.To.0 = k
  376.           Drop k                               /* remove temp VAR */
  377.         End /* Do 'TO' */
  378.       When KeyWord = 'SENDER' Then Mail.Sender = KeyValue
  379.       When KeyWord = 'FROM' Then
  380.         Do
  381.           Parse Value Mail.i With 'From:' Mail.From
  382.           Mail.From = Strip(Mail.From)
  383.           If ( Mail.FromZ = 0 ) Then Mail.FromZ = i
  384.         End /* Do 'FROM' */
  385.       When KeyWord = 'REPLY-TO' Then
  386.       Do
  387.         Mail.ReplyTo = KeyValue
  388.         Mail.ReplyToZ = i
  389.       End /* Do 'REPLY-TO' */
  390.       Otherwise nop
  391.     End /* Select */
  392.     Mail.HeadZ = i
  393.     BSmtp.ReadLine = BSmtp.ReadLine + 1
  394.   End /* Do Header */
  395.  
  396.   If Mail.ReplyToZ = 0 Then Do                /* insert Reply-To if missing */
  397.     Mail.ReplyTo  = Mail.From
  398.     Mail.i        = 'Reply-To: '||Mail.ReplyTo
  399.     Mail.ReplyToZ = i
  400.     i             = i + 1
  401.     Mail.i        = ''
  402.   End
  403.  
  404.   Call ScrPut "$ - Storing Body..."
  405.   Do Until ( BSmtp.Line = '..' )                /* read & store body */
  406.     i = i + 1
  407.     Line = BSmtp.ReadLine
  408.     If ( BSmtp.Line = '..' ) Then Mail.i = '.'
  409.       Else Mail.i = BSmtp.Line
  410.     BSmtp.ReadLine = BSmtp.ReadLine + 1
  411.   End /* Do Body */
  412.  
  413.   Mail.0 = i
  414.   Drop i
  415.  
  416. Return
  417.  
  418. /* ------------------------------------------------------[ Domain Check ]--- */
  419.  
  420. IsOurDomain:
  421.  Parse Arg MailAddress
  422.  Select
  423.    When Pos('>',MailAddress) <> 0
  424.     Then Parse Upper Value MailAddress With '<' UserName '@' UpperDomainName '>'
  425.    When Pos(')', MailAddress) <> 0
  426.     Then Parse Upper Value MailAddress With UserName '@' UpperDomainName Dummy
  427.    Otherwise Parse Upper Value MailAddress With UserName '@' UpperDomainName
  428.  End /* Select */
  429.  Parse Upper Var LocalDomain UpperListDomain
  430.  If ( UpperDomainName = UpperListDomain )
  431.   Then Return 1
  432.   Else Return 0
  433.  
  434. /* ------------------------------------------------[ Test Mail if local ]--- */
  435.  
  436. TestMail:
  437.  
  438.   Call ScrPut "x Checking Message number "||MailCount||":"
  439.   TDAddress.0 = 0
  440.   Do i = 1 To Mail.Env.To.0
  441.     If IsOurDomain(Mail.Env.To.i) Then Do
  442.       Call ScrPut "- - Rcpt To local user ("||Mail.Env.To.i||") - checking if ListMail."
  443.       Call WriteLog "- Rcpt To local user ("||Mail.Env.To.i||") - checking if ListMail."
  444.       Do k = 1 To Words(ListNames)
  445.         Select
  446.           When Pos('>',Mail.Env.To.i) <> 0
  447.            Then Parse Upper Value Mail.Env.To.i With '<' TempUser '@' dummy
  448.           Otherwise Parse Upper Value Mail.Env.To.i With TempUser '@' dummy
  449.         End /* Select */
  450.         Parse Upper Value Word(ListNames,k) With TempList
  451.         If ( TempUser = TempList ) Then Do
  452.           MajorDomo.Mail = 1
  453.           Call ScrPut "x - Mail to MailingList: "||TempList
  454.           Call WriteLog "x Mail to MailingList: "||TempList
  455.           TNr           = TDAddress.0 + 1       /* insert mailing list into */
  456.           TDAddress.TNr = Mail.Env.To.i         /* temporary storage */
  457.           TDAddress.0   = TNr
  458.           Mail.Env.To.i = '$deleted$'           /* mark address for removal */
  459.         End /* IsList */
  460.       End /* Do k */
  461.     End /* If IsOurDomain */
  462.   End /* Do i */
  463.   
  464.   If MajorDomo.Mail Then
  465.     Do
  466.       TMAddress.0 = 0
  467.       Do i = 1 To Mail.Env.To.0
  468.         If Mail.Env.To.i = '$deleted$' Then Nop
  469.         Else Do
  470.           TNr           = TMAddress.0 + 1
  471.           TMAddress.TNr = Mail.Env.To.i
  472.           TMAddress.0   = TNr
  473.         End
  474.       End
  475.       Mail.Env.To.0 = 1                        /* Truncate Envelope-To */
  476.       Do i = 1 To TDAddress.0
  477.         Mail.Env.To.1 = TDAddress.i            /* prepare for QMDomo */
  478.         Call ScrPut "x - Mail is to our lists, invoking QMDomo."
  479.         Call WriteLog "x └ Mail is to our lists, invoking QMDomo."
  480.         If \ MajorDomo.Weasel
  481.           Then Call QMDomo
  482.  
  483.         Call Envelope                          /* Now send the ListMail */
  484.         if connected = 0 then signal error_connection
  485.         Call MailData
  486.         if connected = 0 then signal error_connection
  487.         If ( Mail.Bounced = 1 ) Then Call BounceMail
  488.       End
  489.  
  490.       Mail.Env.To.0 = 0                        /* completely truncate Env.To */
  491.       Do i = 1 To TMAddress.0                  /* rebuild Env-To w/o listmail */
  492.         TNr             = Mail.Env.To.0 + 1
  493.         Mail.Env.To.TNr = TMAddress.i
  494.         Mail.Env.To.0   = TNr
  495.       End
  496.     End
  497.    Else
  498.     Do
  499.       Call ScrPut "x - Mail is not to any of our lists."
  500.       Call WriteLog "x └ Mail is not to any of our lists."
  501.     End
  502.  
  503.   Drop TempUser TempList dummy TNr TDAddress. TMAddress.
  504.  
  505. Return /* From TestMail */
  506.  
  507.  
  508. /* --------------------------------------------------------[ Major Domo ]--- */
  509.  
  510. QMDomo: PROCEDURE EXPOSE Mail. ListNames MailList. LocalDomain
  511.  
  512.   TListNames = ''
  513.   Do i = 1 To Words(ListNames)                   /* TListnames includes Domain */
  514.     TListNames = TListNames||' '||Word(ListNames,i)||'@'||LocalDomain
  515.   End
  516.  
  517.   Parse Upper Value TListNames With ListNames
  518.  
  519.   Do k = 1 To Words(ListNames)
  520.     If Pos('<',Mail.Env.To.1) <> 0
  521.       Then Parse Upper Value Mail.Env.To.1 With '<' TUser '>' Dummy
  522.       Else Parse Upper Value Mail.Env.To.1 With TUser Dummy
  523.     If ( TUser = Word(ListNames,k) ) Then Do
  524.       Mail.Env.To.0 = 0
  525.       Do l = 1 To MailList.k.0
  526.         If Pos('<',MailList.k.l) <> 0
  527.           Then Parse Value MailList.k.l With '<' TMUser '>' Dummy
  528.           Else Parse Value MailList.k.l With TMUser Dummy
  529.         TempNr = Mail.Env.To.0 + 1
  530.         Mail.Env.To.TempNr = '<'||TMUser||'>' /* Append to end of RCPT TO list */
  531.         Mail.Env.To.0 = TempNr
  532.       End
  533.       Mail.Env.From = 'owner-'||Word(TListNames,k)
  534.       TempNr        = Mail.ReplyToZ
  535.       Mail.TempNr   = 'Reply-To: <'Word(TListNames,k)'>'
  536.       Mail.ReplyTo  = Word(TListNames,k)
  537.       Drop TempNr TMUser
  538.       Leave
  539.     End
  540.   End
  541.  
  542. Return
  543.  
  544. /* -----------------------------------------------------[ send envelope ]--- */
  545.  
  546. Envelope:
  547.  
  548.   receivers  = 0                                       /* no receiver yet ;) */
  549.   Failed.0   = 0                                   /* nothing bounced yet ;) */
  550.   If ( Mail.Bounced ) = 0 Then
  551.     Call WriteLog "x Processing Msg Nr. "MailCount
  552.   Else Call WriteLog "x Processing Bounce from Msg Nr. "MailCount
  553.  
  554.   SockData = ToSocket('MAIL FROM:'||Mail.Env.From)            /* Send 'FROM' */
  555.  
  556.   Do i = 1 To Mail.Env.To.0
  557.     SockData = ToSocket('RCPT TO:'||Mail.Env.To.i)
  558.     Parse Value SockData With rc rc_comment
  559.     Select
  560.       when rc = '000' then leave                     /* connection broken */
  561.       when rc = '250' then do 
  562.         receivers = receivers + 1                    /* '250 mailbox ok' */
  563.         Call WriteLog "+ Delivering to "||Mail.Env.To.i
  564.         Call ScrPut "+ Delivering to "||Mail.Env.To.i
  565.         End
  566.       /*  when rc = '551' then */       /* administrative reject (spam?) */
  567.       /*  when rc = '553' then */                  /* '553 user unknown' */
  568.       otherwise
  569.         Select
  570.           When ( Mail.Bounced = 0 ) Then Do
  571.             /* notice failure for further processing */
  572.             k = Failed.0 + 1
  573.             Failed.k = Mail.Env.To.i
  574.             Failed.Data.k = SockData
  575.             Failed.0 = k
  576.             /* Write Msg to BadMailDir */
  577.             If (Failed.0 = 1) Then Do
  578.               BadMsg = BadMailDir||'\'||SysTempFileName(????.MSG)
  579.               rc = LineOut(BadMsg,'MAIL FROM:'||Mail.Env.From)
  580.               do k = 1 To Mail.Env.To.0
  581.                 rc = LineOut(BadMsg,'RCPT TO:'||Mail.Env.To.k)
  582.               end
  583.               rc = stream(BadMsg,'c','close')
  584.               rc = RxExecO(BadMsg,'a','Mail.','s')
  585.             End /* Do (Failed.0 = 1) */
  586.             /* Make entry to LogFile about rejected msg */
  587.             Call WriteLog "!  Mail rejected, response was: "||SockData
  588.             Call WriteLog "!  ├ Mail could not be delivered to "||Mail.Env.To.i
  589.             Call WriteLog "!  └ Message was saved to "||BadMsg
  590.            End
  591.           When ( Mail.Bounced = 1 ) Then Do
  592.             Call WriteLog "!  Mail rejected, response was: "||SockData
  593.             Call WriteLog "!  ├ it is a bounce mail, so sender was bounced again!"
  594.             Call WriteLog "!  └ original message was already saved to "||BadMsg
  595.            End
  596.           Otherwise Do
  597.             Call WriteLog "! Mail rejected, response was: "||SockData
  598.             Call WriteLog "! ├ it is a notify of failed bounce to postmaster!!!"
  599.             Call WriteLog "! └ original message was already saved to "||BadMsg
  600.            End
  601.           Drop k rc
  602.         End /* Select */
  603.     End /* Select */
  604.   End /* 'RCPT TO' */
  605.  
  606.   if ( Failed.0 > 0 ) then Mail.Bounced = Mail.Bounced + 1
  607.   if ( receivers > 0) then do
  608.     SockData = ToSocket('DATA')
  609.     SockData = Tget(socket,TimeOut)
  610.     if debug then dummy = lineout('session.log','<'||SockData)
  611.     parse value SockData with rc rc_comment
  612.     select
  613.       when rc = '354' then         /* '354 socket to me' => all ok */
  614.         do
  615.           SockData = Tget(socket,TimeOut)
  616.           if debug then dummy = lineout('session.log','<'||SockData)
  617.           parse value SockData with rc rc_comment
  618.           if rc <> EOT then nop   /* "AfterBurner" Diamond */
  619.         end
  620.       when rc = EOT then nop /* what does the Diamond have to do here? */
  621.       otherwise
  622.         connection = 0
  623.         if debug then dummy = lineout('session.log','! Trouble! socket sent '||rc)
  624.         return
  625.     end /* select */
  626.   end /* if receivers */
  627.  
  628. Return
  629.  
  630. /* ----------------------------------------------------[ send to socket ]--- */
  631.  
  632. ToSocket:
  633.  
  634.   Parse Arg Data2Sock
  635.   if debug then dummy = lineout('session.log','>'||Data2Sock)
  636.   c = Tput(socket,Data2Sock)                          /* send to socket */
  637.   if c <> 0                                        /* connection broken */
  638.     then do; connected = 0; return '000 connection broken' ; end;
  639.   Sock2Data = Tget(socket,TimeOut)
  640.   if debug then dummy = lineout('session.log','<'||Sock2Data)
  641.   select
  642.     when Sock2Data = EOT  then nop        /* "AfterBurner" Diamond */
  643.     when Sock2Data = ''
  644.       then do; connected = 0; return Sock2Data; end;
  645.     otherwise
  646.       Call ScrPut "$ "||Sock2Data
  647.   end /* select */
  648.  
  649. Return Sock2Data
  650.  
  651. /* ---------------------------------------------------------[ send mail ]--- */
  652.  
  653. MailData:
  654.  
  655.   if connected = 0 then return
  656.   if receivers > 0 then do                  /* mail is to be delivered */
  657.     If ( Mail.Bounced = 1 ) Then Call BounceHeader
  658.     Do i = 1 To Mail.0
  659.       If Debug Then dummy = lineout('session.log','>'||Mail.i)
  660.       putline = Mail.i
  661.       islong  = Length(putline)
  662.       Do Until (islong < 256)              /* tput() is limited to 256 chars */
  663.         islong = Length(putline)
  664.         if (islong > 255) then
  665.           do
  666.             linepart = Left(putline,255)||"="             /* imitate mime LF */
  667.             putline  = SubStr(putline,256,islong-255)
  668.           end
  669.           else linepart = putline
  670.         Data2Sock = Tput(socket,linepart)
  671.         if Data2Sock <> 0 then do; connected = 0; leave; end;
  672.       End /* Do Until */
  673.       Drop islong putline linepart
  674.       if ( Mail.i = '.' ) Then
  675.         do
  676.           SockData = Tget(socket,TimeOut)
  677.           if debug then do
  678.             dummy = lineout('session.log','<'||SockData)
  679.             dummy = Lineout('session.log','! End of Mail reached!')
  680.           end
  681.           parse value SockData with rc rc_comment
  682.           select
  683.             when rc = '250' then do             /* '250 OK' => all ok */
  684.               Call ScrPut '- Mail sent successfully.'
  685.               Call WriteLog '- └ delivered successfully.'
  686.               DeliveredCount = DeliveredCount + 1
  687.               leave
  688.             end
  689.             otherwise nop
  690.           end /* select */
  691.         end /* do */
  692.     End /* Do to Mail.0 */
  693.    End /* Do receivers */
  694.   Else Return
  695.   Drop Data2Sock SockData rc rc_comment
  696.  
  697. Return
  698.  
  699. BounceHeader:
  700.  
  701.   Do k = 1 To Failed.Msg.0
  702.     If Debug Then dummy = lineout('session.log','>'||Failed.Msg.k)
  703.     Data2Sock = Tput(socket,Failed.Msg.k)
  704.     if Data2Sock <> 0 then do; connected = 0; leave; end;
  705.   End
  706.  
  707. Return
  708.  
  709. /* -------------------------------------------------------[ bounce mail ]--- */
  710.  
  711. BounceMail:
  712.  
  713.   Mail.Env.To.1 = Mail.Env.From
  714.   Mail.Env.To.0 = 1
  715.   Mail.Env.From = "postmaster@"||LocalDomain
  716.   Mail.From     = "Mailer Daemon <postmaster@"||LocalDomain||">"
  717.  
  718.   Failed.Msg.1  = "From: Mailer Daemon <postmaster@"||LocalDomain||">"
  719.   Failed.Msg.2  = "To: "Mail.Env.To.1
  720.   Failed.Msg.3  = ""
  721.   Failed.Msg.4  = "Your mail was not delivered to the following recipient(s):"
  722.   Failed.Msg.5   = ""
  723.   Do i = 6 To ( Failed.0 + 5 )
  724.     k = i - 5
  725.     Failed.Msg.i = "  "||Failed.k||": "||Failed.Data.k
  726.   End
  727.   Failed.Msg.i   = ""
  728.   i = i + 1
  729.   Failed.Msg.i  = "There will be no further attempts to deliver this mail."
  730.   i = i + 1
  731.   Failed.Msg.i   = ""
  732.   Failed.Msg.0  = i
  733.  
  734.   Say "Sending BounceMail with "Failed.Msg.0" lines:"
  735.   Call Envelope
  736.   Call MailData
  737.  
  738. Return
  739.  
  740. /* ----------------------------------------------------[ error messages ]--- */
  741.  
  742.   error_keyword:
  743.     Say ' W A R N I N G ! ! !'
  744.     Say 'Unknown KeyWord 'KeyWord' on line 'Zeile' of 'config_file
  745.     Say 'Programm aborted'
  746.     Exit 1                        /* Rexx error 1: "Invalid function number" */
  747.  
  748.   error_syntax:
  749.     Call Logo
  750.     Say ''
  751.     Say 'Syntax:'
  752.     Say '  BSMTP <InFile> [<Hostname> [<Port>]]'
  753.     Say '    where <InFile>   is the name of the BSMTP file to process'
  754.     Say '          <Hostname> is the name of the host running the server'
  755.     Say '          <Port>     is the port used (if not standard port 25)'
  756.     Call SysSleep 2
  757.     Exit 1
  758.  
  759.   error_fileopen:
  760.     Parse Arg Datei
  761.     Say ' W A R N I N G ! ! !'
  762.     Say Datei' could not be opened!'
  763.     Say 'Programm aborted.'
  764.     Call WriteLog "! "Datei" could not be opened!"
  765.     Call WriteLog "! Programm aborted."
  766.     Call quit
  767.     Exit 2                                 /* Rexx error 2: "File not found" */
  768.  
  769.   error_connection:
  770.     Say '!!! Connection lost !!!'
  771.     Say 'Programm aborted.'
  772.     Call WriteLog "! Connection lost!"
  773.     Call WriteLog "! Programm aborted."
  774.     Call quit
  775.     Exit 11                              /* ErrorLevel 11: "Connection lost" */
  776.  
  777.   syntax:
  778.    say '! syntax'
  779.   error:
  780.    say '! error'
  781.   halt:
  782.    say '! halt'
  783.  
  784.  
  785. /* -----------------------------------------------[ shutdown connection ]--- */
  786.  
  787.  
  788.   quit:
  789.    c = Tput(socket,'QUIT')
  790.    call Tquit socket
  791.    Call WriteLog '+ Closed sockets.'
  792.    Call WriteLog "+ BSmtp/2 v"||version||" closing down"
  793.    Call WriteLog "x"
  794.  
  795. /* remove comment if you want to DeRegister the Rexx Libraries
  796.  * 
  797.  * call RxFuncAdd "NvtDropFuncs","Nvt","NvtDropFuncs"
  798.  * call NvtDropFuncs
  799.  * call RxFuncDrop "NvtDropFuncs"
  800.  *
  801.  * call RxuTerm
  802.  *
  803.  * call SysDropFuncs
  804.  */
  805.    return
  806.