|
ru.cgi.perl
- RU.CGI.PERL ------------------------------------------------------------------
From : Alexander Russkih 2:468/75 15 Dec 2000 11:32:06
To : All
Subject : Re: PERL+SENDMAIL:
--------------------------------------------------------------------------------
.MSGID: 2:468/75 e670b6b9
.REPLY: ddt.demos.su 9701ada9
.RFC-Path: nomebase.deadface!not-for-mail
.RFC-Message-ID: <3A39D706.F86517D9@homebase.deadface>
.RFC-References: <90tdom$20ss$1@ddt.demos.su>
.RFC-NNTP-Posting-Host: homebase.deadface
.RFC-X-Trace: homebase.deadface 976869127 590 10.0.10.1 (15 Dec 2000 08:32:07
GMT)
.RFC-X-Complaints-To: usenet@homebase.deadface
.RFC-NNTP-Posting-Date: 15 Dec 2000 08:32:07 GMT
.RFC-X-Accept-Language: ru, uk, en
Subject: Re: PERL+SENDMAIL:
=?koi8-r?Q?=CF=D4=D0=D2=C1=D7=C9=D4=D8=20=C6=C1=CA=CC?=
Reply-To: alex@unio.kherson.ua
vsbelashov@obs.omsk.ru wrote:
> Может делал кто?
>
> Как из скрипта на PERL отправить файл через SENDMAIL.
> Простое-то сообщение - легко, а вот с файлом ...
> Можно примерчик, а можно и где почитать
>
> PERL и SENDMAIL на Linux.
посмотри на этот "примерчик". может поможет? ;)
############################################################################
#
#
# send_email() Version
1.5 #
# Written by Craig Patchett
craig@patchett.com #
# and Matthew Wright
mattw@worldwidemart.com #
# Created 10/4/96 Last Modified
3/31/97 #
#
#
# Copyright 1997 Craig Patchett & Matthew Wright. All Rights
Reserved. #
# This subroutine is part of The CGI/Perl Cookbook from John Wiley &
Sons. #
# License to use this program or install it on a server (in original
or #
# modified form) is granted only to those who have purchased a copy of
The #
# CGI/Perl Cookbook. (This notice must remain as part of the source
code.) #
#
#
# Function: Sends an email message and optional attached files
via #
# a direct connection to an SMTP
server. #
#
#
# Usage: &send_email($subject, $from, $to[, $cc, $bcc,
$body, #
# $files,
$encoding]); #
#
#
# Variables: $subject -- String containing subject of
message. #
# Example 'Buy the CGI/Perl
Cookbook!' #
# $from -- String containing email address of
person #
# sending message. An associated name
can #
# follow the address if placed in
parentheses. #
# Example 'me@home.com (My
Name)' #
# $to -- String containing email addresses to
send #
# message to. Multiple addresses should
be #
# separated by commas. Associated
names #
# can follow each address if placed
in #
#
parentheses. #
# Example 'him@place.com
(Name),her@place.com' #
# $cc -- String containing email addresses to
send #
# copies of the message to. Same format as
$to.#
# $bcc -- String containing email addresses to
send #
# blind copies of the message to (i.e.,
nobody #
# else receiving the message will know
that #
# copies were sent to these addresses).
Same #
# format as
$to. #
# $body -- Full path to file containing the body of
the #
# message or text containing body of
message #
# (if $body doesn't begin with a
directory #
# delimiter and contains at least one
space #
# then the subroutine assumes it
contains #
# message
text). #
# Example
'/home/user/body.txt' #
# Example 'This is message
text.' #
# $files -- String containing a list of full
paths, #
# separated by commas, to files to be
attached #
# to the
message. #
# Example '/home/user/file1,
/home/user/file2' #
# $encoding -- String containing a list of encoding
types, #
# separated by commas, to match the list
of #
# files in $file. Valid types are:
text, #
# uuencode,
base64 #
# Example 'text,
base64' #
#
#
# Returns: 0 if
successful #
# 1 if error creating socket and connecting to
server #
# 2, @bad_addresses if addresses in *to, *cc, or *bcc
were #
# rejected by the server. (Note: Just because
addresses #
# were not rejected does not ensure they are
valid.) #
# 3 if error initiating conversation with
server #
# 4 if error specifying message
sender #
# 5 if error specifying message
recipients #
# 6 if error initiating message body
transfer #
# 7 if error sending message
body #
# 8 if error shutting down
server #
# 9 if file couldn't be opened or
found #
# 10 if uuencode
error #
# 11 if base 64 encode
error #
#
#
# Uses Global: $Error_Message for descriptive error
messages #
# $SMTP_SERVER for the name of the SMTP
server #
# $WEB_SERVER for the name of the server running
the #
#
script #
#
#
# Requires:
base64.pl #
#
chkemail.pl #
#
error.pl #
#
uuencode.pl #
#
#
# Files Created:
None #
#
#
############################################################################
use Socket;
sub send_email {
local($subject, $from, $to, $cc, $bcc, $body, $files, $encoding) =
@_;
local($i, $mime_id, $error, $name, $status, $message) = '';
local(@MIME_FILES, @MIME_TYPES, @ATTACH_FILES, @ENCODING) = ();
# Attempt to set default values if globals aren't set
if (!$WEB_SERVER) { $WEB_SERVER = $ENV{'SERVER_NAME'} }
if (!$WEB_SERVER) {
$Error_Message = "$WEB_SERVER is not set.";
return(1);
}
if (!$SMTP_SERVER) {
$SMTP_SERVER = "smtp.$WEB_SERVER";
$SMTP_SERVER =~ s/^smtp\.[^.]+\.([^.]+\.)/smtp.$1/;
}
# Split the input into arrays where needed, since values are passed
# as strings separated by commas.
local(@to) = split(/, */, $to);
local(@cc) = split(/, */, $cc);
local(@bcc) = split(/, */, $bcc);
local(@attach_files) = split(/, */, $files);
local(@encoding) = split(/, */, $encoding);
# Check to see what file encoding is being used and if necessary,
set the
# mime flag and id.
for ($i = 0; $i < @attach_files; ++$i) {
if (!(-e $attach_files[$i])) {
$Error_Message = "$attach_files[$i] does not exist.";
return(9);
}
if ($encoding[$i] eq 'base64') {
push(@MIME_FILES, $attach_files[$i]);
push(@MIME_TYPES, $encoding[$i]);
}
else {
push(@ATTACH_FILES, $attach_files[$i]);
push(@ENCODING, $encoding[$i]);
}
}
if (@MIME_FILES) {
push(@ATTACH_FILES, @MIME_FILES);
push(@ENCODING, @MIME_TYPES);
$mime_id = 'CGI_Perl_Cookbook_-' . time;
}
# SMTP commands end in CRLF (\015\012)
local($CRLF) = "\015\012";
# Set up other variables
local($SMTP_SERVER_PORT) = 25;
local($AF_INET) = ($] > 5 ? AF_INET : 2);
local($SOCK_STREAM) = ($] > 5 ? SOCK_STREAM : 1);
local(@bad_addresses) = ();
$, = ', ';
$" = ', ';
# Translate hostnames to corresponding addresses and pack
local($local_address) = (gethostbyname($WEB_SERVER))[4];
local($local_socket_address) = pack('S n a4 x8', $AF_INET, 0,
$local_address);
local($server_address) = (gethostbyname($SMTP_SERVER))[4];
local($server_socket_address) = pack('S n a4 x8', $AF_INET,
$SMTP_SERVER_PORT, $server_address);
# Translate protocol name to corresponding number
local($protocol) = (getprotobyname('tcp'))[2];
# Make the socket filehandle
if (!socket(SMTP, $AF_INET, $SOCK_STREAM, $protocol)) {
$Error_Message = "Could not make socket filehandle ($!).";
return(1);
}
# Give the socket an address
bind(SMTP, $local_socket_address);
# Connect to the server
if (!(connect(SMTP, $server_socket_address))) {
$Error_Message = "Could not connect to server ($!).";
return(1);
}
# Set the socket to be line buffered
local($old_selected) = select(SMTP);
$| = 1;
select($old_selected);
# Set regex to handle multiple line strings
$* = 1;
# Read first response from server (wait for .75 seconds first)
select(undef, undef, undef, .75);
sysread(SMTP, $_, 1024);
# Initiate a conversation with the server
print SMTP "HELO $WEB_SERVER$CRLF";
sysread(SMTP, $_, 1024);
while (/(^|(\r?\n))[^0-9]*((\d\d\d).*)$/g) { $status = $4; $message
= $3}
if ($status != 250) { $Error_Message = $message; return(3) }
# Tell the server where we're sending from
print SMTP "MAIL FROM:<$from>$CRLF";
sysread(SMTP, $_, 1024);
if (!/[^0-9]*250/) { $Error_Message = $_; return(4) }
# Tell the server where we're sending to
local($good_addresses) = 0;
foreach $address (@to, @cc, @bcc) {
if ($address) {
# Make sure address is enclosed in <>
$address =~ /(\(.*\))/;
$name = $1 ? "$1 " : '';
$address =~ /([^<)\s]+@\S+\.[^>(\s]+)/;
$address = "<$1>";
# Hand it to the server
print SMTP "RCPT TO:$address$CRLF";
sysread(SMTP, $_, 1024);
/[^0-9]*(\d\d\d)/;
if ($1 ne '250') { push(@bad_addresses, "$name$address", $_)
}
else { ++$good_addresses }
}
}
if (!$good_addresses) {
$Error_Message = $_;
return(5, @bad_addresses)
}
# Give the server the message header
print SMTP "DATA$CRLF";
sysread(SMTP, $_, 1024);
if (!/[^0-9]*354/) { $Error_Message = $_; return(6) }
print SMTP "To: @to$CRLF";
print SMTP "From: $from$CRLF";
print SMTP "CC: @cc$CRLF" if $cc;
print SMTP "Subject: $subject$CRLF";
# If there are mime files to attach, we need special headers.
if ($mime_id) {
print SMTP "x-sender: $from$CRLF";
print SMTP "x-mailer: CGI/Perl Cookbook$CRLF";
print SMTP "Mime-Version: 1.0$CRLF";
print SMTP "Content-Type: multipart/mixed;
boundary=\"$mime_id\"$CRLF$CRLF";
print SMTP "--$mime_id$CRLF";
print SMTP "Content-Type: text/plain;
charset=\"US-ASCII\"$CRLF$CRLF";
}
else { print SMTP $CRLF }
# Output the message body.
if ($body) {
if (!($body =~ /^[\\\/:]/) && ($body =~ /\s/)) { print SMTP
$body }
elsif (-e $body && -T $body) { &parse_template($body, *SMTP) }
}
print SMTP $CRLF;
# Attach each file.
for ($i = 0; $i < @ATTACH_FILES; ++$i) {
$attach_file = $ATTACH_FILES[$i];
$encoding = $ENCODING[$i];
# Split the filename by directories. / for unix, \ for dos, :
for mac
$attach_file =~ /[\\\/:]([^\\\/:]+)$/g;
$filename = $1;
# Attach text file.
if ($encoding eq 'text' && -e $attach_file) {
if (!(open(TEXT, $attach_file))) {
$Error_Message = "Can't open text file $attach_file
* Message split, to be continued *
--- Mozilla 4.7 [en] (X11; I; Linux 2.2.17 i586)
* Origin: Homebase DEAD'FACE. Unio Mystica Group. (2:468/75)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
| Тема: |
Автор: |
Дата: |
|
Re: PERL+SENDMAIL: |
Alexander Russkih |
15 Dec 2000 11:32:06 |
|
|
