Forum OpenACS Q&A: Re: ns_sendmail replacement?

Collapse
Posted by Bart Teeuwisse on

Til is right indeed.

It is a suprise that my qmail mailer has been so forgiving.

To remain RFC 2821 compliant, the extraction of the e-mail addresses should be moved from ns_sendmail to _ns_sendmail like so:


proc ns_sendmail { to from subject body {extraheaders {}} {bcc {}} } {

    ## Takes comma-separated values in the "to" parm
    ## Multiple To and BCC addresses are handled appropriately.
    ## Original ns_sendmail functionality is preserved.

    ## Cut out carriage returns
    regsub -all "\n" $to "" to
    regsub -all "\r" $to "" to
    regsub -all "\n" $bcc "" bcc
    regsub -all "\r" $bcc "" bcc

    ## Split to into a proper list
    set tolist_in [split $to ","]
    set bcclist_in [split $bcc ","]

    ## Get smtp server into, if none then use localhost
    set smtp [ns_config ns/parameters smtphost]
    if [string match "" $smtp] {
        set smtp [ns_config ns/parameters mailhost]
    }
    if [string match "" $smtp] {
        set smtp localhost
    }
    set timeout [ns_config ns/parameters smtptimeout]
    if [string match "" $timeout] {
        set timeout 60
    }
    set smtpport [ns_config ns/parameters smtpport]
    if [string match "" $smtpport] {
        set smtpport 25
    }

    set tolist [list]
    foreach toaddr $tolist_in {
        lappend tolist "[string trim $toaddr]"
    }

    set bcclist [list]
    if ![string match "" $bcclist_in] {
        foreach bccaddr $bcclist_in {
            lappend bcclist "[string trim $bccaddr]"
        }
    }

    ## Send it along to _ns_sendmail
    _ns_sendmail $smtp $smtpport $timeout $tolist $bcclist \
            $from $subject $body $extraheaders
}

proc _ns_sendmail {smtp smtpport timeout tolist bcclist \
        from subject body extraheaders} {

    ## Put the tolist in the headers
    set rfcto [join $tolist ", "]

    ## Build headers
    set msg "To: $rfcto\nFrom: $from\nSubject: $subject\nDate: [ns_httptime [ns_time]]"

    ## Insert extra headers, if any (not for BCC)
    if ![string match "" $extraheaders] {
        set size [ns_set size $extraheaders]
        for {set i 0} {$i < $size} {incr i} {
            append msg "\n[ns_set key $extraheaders $i]: [ns_set value $extraheaders $i]"
        }
    }

    ## Blank line between headers and body
    append msg "\n\n$body\n"

    ## Terminate body with a solitary period
    foreach line [split $msg "\n"] {
        if [string match . $line] {
            append data .
        }
        append data $line
        append data "\r\n"
    }
    append data .

    ## Open the connection
    set sock [ns_sockopen $smtp $smtpport]
    set rfp [lindex $sock 0]
    set wfp [lindex $sock 1]

    ## Perform the SMTP conversation
    if { [catch {
        _ns_smtp_recv $rfp 220 $timeout
        _ns_smtp_send $wfp "HELO AOLserver [ns_info hostname]" $timeout
        _ns_smtp_recv $rfp 250 $timeout

        ## Extract "from" email address
        if [regexp {.*<(.*)>} $from ig address] {
            set from $address
        }
        _ns_smtp_send $wfp "MAIL FROM: $from" $timeout
        _ns_smtp_recv $rfp 250 $timeout

        ## Loop through To list via multiple RCPT TO lines
        foreach toto $tolist {
            if [regexp {.*<(.*)>} $toto ig address] {
                set toto $address
            }
            _ns_smtp_send $wfp "RCPT TO: $toto" $timeout
            _ns_smtp_recv $rfp 250 $timeout
        }

        ## Loop through BCC list via multiple RCPT TO lines
        ## A BCC should never, ever appear in the header.  Ever.  Not even.
        foreach bccto $bcclist {
            if [regexp {.*<(.*)>} $bccto ig address] {
                set bccto $address
            }
            _ns_smtp_send $wfp "RCPT TO: $bccto" $timeout
            _ns_smtp_recv $rfp 250 $timeout
        }

        _ns_smtp_send $wfp DATA $timeout
        _ns_smtp_recv $rfp 354 $timeout
        _ns_smtp_send $wfp $data $timeout
        _ns_smtp_recv $rfp 250 $timeout
        _ns_smtp_send $wfp QUIT $timeout
        _ns_smtp_recv $rfp 221 $timeout
    } errMsg ] } {
        ## Error, close and report
        close $rfp
        close $wfp
        return -code error $errMsg
    }

    ## Close the connection
    close $rfp
    close $wfp
}

/Bart

Collapse
Posted by Tilmann Singer on
I don't think that's right:
        ## Loop through To list via multiple RCPT TO lines
        foreach toto $tolist {
            if [regexp {.*<(.*)>} $toto ig address] {
                set toto $address
            }
            _ns_smtp_send $wfp "RCPT TO: $toto" $timeout
            _ns_smtp_recv $rfp 250 $timeout
        }
The rfc specifies it like this:
MAIL FROM:<userx@y.foo.org>
RCPT TO:<userc@d.bar.org>
so aolserver would have to do that:
        ## Loop through To list via multiple RCPT TO lines
        foreach toto $tolist {
            if [regexp {.*<(.*)>} $toto ig address] {
                set toto $address
            }
            _ns_smtp_send $wfp "RCPT TO:<$toto>" $timeout
            _ns_smtp_recv $rfp 250 $timeout
        }
and while we're at it we might as well join the processing of the $tolist above and the $bcclist - they do the same.
Collapse
Posted by Tilmann Singer on
Here's a patch against the original sendmail.tcl that hopefully includes all corrections. I'll try to submit it on aolserver's bug tracker on sourceforge (last time I tried it was not working due to timeouts).

*** root/aolserver/tcl/sendmail.tcl	Fri Aug 11 22:04:10 2000
--- aolserver/modules/tcl/sendmail.tcl	Fri Jan 17 12:34:59 2003
***************
*** 96,120 ****
  	set smtpport 25
      }
  
-     ## Extract "from" email address
-     if [regexp {.*<(.*)>} $from ig address] {
- 	set from $address
-     }
-     
      set tolist [list]
      foreach toaddr $tolist_in {
- 	if [regexp {.*<(.*)>} $toaddr ig address] {
- 	    set toaddr $address
- 	}
  	lappend tolist "[string trim $toaddr]"
      }
      
      set bcclist [list]
      if ![string match "" $bcclist_in] {
  	foreach bccaddr $bcclist_in {
- 	    if [regexp {.*<(.*)>} $bccaddr ig address] {
- 		set bccaddr $address
- 	    }
  	    lappend bcclist "[string trim $bccaddr]"
  	}
      }
--- 96,109 ----
***************
*** 160,165 ****
--- 149,157 ----
      set rfp [lindex $sock 0]
      set wfp [lindex $sock 1]
  
+     ## Strip "from" email address
+     regexp {.*<(.*)>} $from ig from
+ 
      ## Perform the SMTP conversation
      if { [catch {
          _ns_smtp_recv $rfp 220 $timeout
***************
*** 168,183 ****
  	_ns_smtp_send $wfp "MAIL FROM:<$from>" $timeout
  	_ns_smtp_recv $rfp 250 $timeout
  	
! 	## Loop through To list via multiple RCPT TO lines
! 	foreach toto $tolist {
! 	    _ns_smtp_send $wfp "RCPT TO:<$toto>" $timeout
! 	    _ns_smtp_recv $rfp 250 $timeout	
! 	}
! 	
! 	## Loop through BCC list via multiple RCPT TO lines
  	## A BCC should never, ever appear in the header.  Ever.  Not even.
! 	foreach bccto $bcclist {
! 	    _ns_smtp_send $wfp "RCPT TO:<$bccto>" $timeout
  	    _ns_smtp_recv $rfp 250 $timeout
  	}
  	
--- 160,173 ----
          _ns_smtp_send $wfp "MAIL FROM:<$from>" $timeout
          _ns_smtp_recv $rfp 250 $timeout
          
!         ## Loop through To and Bcc list via multiple RCPT TO lines
          ## A BCC should never, ever appear in the header.  Ever.  Not even.
!         foreach toto [concat $tolist $bcclist] {
! 
!             # Transform "Fritz <fritz@foo.com>" into "fritz@foo.com".
!             regexp {.*<(.*)>} $toto ig toto
! 
!             _ns_smtp_send $wfp "RCPT TO:<$toto>" $timeout
              _ns_smtp_recv $rfp 250 $timeout    
          }