Very simple to send full email. I guess may help Socket.
Here below sample:
use Socket;
use POSIX qw(strftime);
return 1;
sub email_send {
my $self = shift;
my ($proto, $iaddr, $port, $sin);
$self->{message} =~ s/\>\;/>/g;
$self->{message} =~ s/\<\;/</g;
$self->{message} =~ s/\"\;/"/g;
###########################################################################
# Open socket to SMTP server
###########################################################################
$proto = getprotobyname('tcp');
socket(SOCK, AF_INET, SOCK_STREAM, $proto);
$iaddr = gethostbyname($conf->{smtpserver});
$port = getservbyname('smtp', 'tcp');
$sin = sockaddr_in($port, $iaddr);
connect(SOCK, $sin);
my (@to,@cc,@bcc);
@to = split (/,\s/, $self->{to});
@cc = split (/,\s/, $self->{cc});
@bcc = split (/,\s/, $self->{bcc});
$self->{message} =~ s/\n\.[\r|\n]/\n. $1/g;
$self->{message} =~ s/<(?:[^>'"]*|(['"]).*?\1)*>//gs;
my $date = strftime("%a, %d %b %Y %T %z (%Z)", gmtime);
###########################################################################
# Send message
###########################################################################
my $bad = "No";
send SOCK, "HELO $conf->{domain}\r\n", 0;
recv SOCK, $junk, 512, 0;
if ($junk =~ /^5/) {
$bad = "Yes";
}
send SOCK, "MAIL From:<$self->{from}>\r\n", 0;
recv SOCK, $junk, 512, 0;
if ($junk =~ /^5/) {
$bad = "Yes";
}
foreach $line (@to) {
send SOCK, "RCPT To:<$line>\r\n", 0;
}
foreach $line (@cc) {
send SOCK, "RCPT To:<$line>\r\n", 0;
}
foreach $line (@bcc) {
send SOCK, "RCPT To:<$line>\r\n", 0;
}
recv SOCK, $junk, 512, 0;
if ($junk =~ /^5/) {
$bad = "Yes";
}
send SOCK, "DATA\r\n", 0;
recv SOCK, $junk, 512, 0;
if ($junk =~ /^5/) {
$bad = "Yes";
}
if ($self->{resent}) {
send SOCK, "Resent-From: $resent\r\n", 0;
}
send SOCK, "Date: $date\r\n", 0;
send SOCK, "To: $self->{to}\r\n", 0;
if ($self->{cc}) {
send SOCK, "Cc: $self->{cc}\r\n", 0;
}
if (!($self->{resent})) {
send SOCK, "Subject: $self->{subject}\r\n", 0;
send SOCK, "X-Mailer: $version\r\n", 0;
send SOCK, "X-URL: $x_url\r\n", 0;
}
if ($self->{attachment}) {
my $type = $query->uploadInfo($self->{attachment})->{"Content-Type"};
my $boundary = "-ELICOMSOFT-ATTACH-BOUNDARY-" . time . "---";
my @filename = split(/\/|\\|:/, $self->{attachment});
send SOCK, "MIME-Version: 1.0\r\n", 0;
send SOCK, "Content-Type: multipart/mixed; ", 0;
send SOCK, "boundary=\"$boundary\"\r\n", 0;
send SOCK, "\r\n--$boundary\r\n", 0;
send SOCK, "Content-type: text/plain\r\n\r\n", 0;
send SOCK, "$message\r\n", 0;
send SOCK, "\r\n--$boundary\r\n", 0;
send SOCK, "Content-Type: $type; name=\"$filename[-1]\"\r\n", 0;
send SOCK, "Content-Transfer-Encoding: BASE64\r\n", 0;
send SOCK, "Content-Description:\r\n\r\n", 0;
while (<$self->{attachment}>) { $temp .= $_; }
send SOCK, encode_base64($temp), 0;
send SOCK, "--$boundary--", 0;
send SOCK, "\r\n.\r\n", 0;
} else {
send SOCK, "Subject: $self->{subject}\r\n", 0;
send SOCK, "\r\n$self->{message}\r\n.\r\n", 0;
#}
recv SOCK, $junk, 512, 0;
if ($junk =~ /^5/) {
$bad = "Yes";
}
send SOCK, "QUIT\r\n", 0;
recv SOCK, $junk, 512, 0;
if ($junk =~ /^5/) {
$bad = "Yes";
}
close SOCK;
##end sock sending
if ($bad eq "No"){
return 1
}
if ($bad eq "Yes"){
return 0
}
}
Вот и все))
Вариант для распечатки
Программирование под UNIX (Public)
on
06-Май-01, 08:52 (MSK)
