Forum OpenACS Q&A: Re: ns_sendmail replacement?
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
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.
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
}
