open MAIL, '|/path/to/your/sendmail -t'; # Pipe к sendmail
print MAIL "From: mailrobot@my.host\n",
"To: webmaster@my.host\n",
"Subject: Wow! I got some mail for you!!!\n\n",
$message;
close MAIL or die "Sendmail failed: $!";
#!/usr/bin/perl -w
use strict;
use Mail::Mailer;
my $mailer = new Mail::Mailer;
my %headers;
$headers{"To"} = 'apavel';
$headers{"Subject"} = 'Привет';
my $body = "Привет!\nКак дела?";
$mailer->open(\%headers);
print $mailer $body;
$mailer->close;
#!/usr/bin/perl -w
use strict;
use MIME::Entity;
my $message = MIME::Entity->build(
To => 'apavel',
Subject => "Пошлые анекдоты и голые девки",
Data => ["Пошлые анекдоты тут"],
Charset => "koi8-r",
Encoding=> "8bit",
);
$message->attach(
Path => "naked_girls.jpg",
Type => "image/jpg",
Encoding => "base64",
Disposition=>"attachment",
);
open SENDMAIL, "|/usr/sbin/sendmail -t" or die "sendmail: $!";
$message->print(\*SENDMAIL);
close SENDMAIL or die "sendmail failed: $!";
Гарантированно -- никак. Вы можете проверить адрес на правильность синтаксиса при помощи Email::Valid. И все. Если нужен гарантированно правильный e-mail для web-сайта, вы можете воспользоваться методом от Алексея Тутубалина: требовать пароль для доступа к информации, а сам пароль высылать по электронной почте. Тогда человек должен будет указать свой e-mail, конечно же, если ему интересна эта информация с вашего сайта.
Самое простое - прописать ваш скрипт в .forward или /etc/aliases:
.forward:
| /path/to/your/script
/etc/aliases
pupkins: "|/path/to/yours/script"
Более подробно смотрите в документации на ваш MTA.
Скрипт должен читать из стандартного потока ввода. Например:
#!/usr/bin/perl
open (F,">/tmp/mbox") or die $!;
while (<STDIN>) {
print F $_;
}
close (F);
письмо состоит из двух частей - заголовка и тела.
Заголовок состоит из пары: имя заголовка и значение заголовка, разделенные
двоеточием ":", например:
test
(более подробно смотрите в rfc 822, 2822). Тело письма - просто текст.
Пример скрипта для разбора письма.
#!/usr/bin/perl
# Читаем письмо со стандартного потока ввода STDIN
my (%head, @body); # %head - пары { header => value }
# @body - тело письма
{
local $/ = ""; # читаем все до пустой строки - разделителя
my $head = <STDIN>; # заголовка и тела письма
$head =~ s|\n\s+| |gs; # если значение заголовка длинное,
# то он переносится на следующую строку и
# начинается с пробельного символа. соединяем строку
my @head = split /\n/,$head; # делим по строкам заголовок;
# разделяем строку вида Subject: test на пары "Subject" и "test",
# и возвращаем их как "subject" => "test"
%head = map { my ($a,$b) = split (/:\s+/,$_,2); lc $a => $b } @head;
# теперь в %head собраны все заголовки и их значения
# предупреждение: я не рассматриваю случай присутствия в заголовке
# письма одинаковых заголовков (как то "Received:") - как их сделать -
# ваша задача.
}
@body = <STDIN>; # теперь в body тело письма, и с ним можно работать.
Теперь можно смотреть на $head{'content-type'} и решать, что с ним
делать.
#!/usr/bin/perl -w
use strict;
use MIME::Parser;
# Построить объект MIME::Parser для разбора письма
my $parser = new MIME::Parser;
# Сохранять временные файлы в /tmp
$parser->output_under("/tmp");
# Разобрать STDIN.
my $entity = $parser->parse(\*STDIN);
# Теперь $entity -- это объект MIME::Entity
# Получить какой-нибудь заголовок письма можно у $entity->head (объект MIME::Head):
my $subject = $entity->head->get('Subject');
# Если это письмо состоит из одной части, то ее можно получить так:
my $body = $entity->body_as_string;
# ... Но в 1996 netscape выкатила свой MUA, который по-дефолту отправлял одно
# и тоже сообщение в HTML и text/plain и легкая жизнь для разработчиков
# почтовых систем закончилась. Пришлось разбирать MIME.
if ($entity->is_multipart) {
for (my $i = 0; $i < $entity->parts(); $i++) {
my $part = $entity->parts($i);
# Теперь $part -- это объект MIME::Entity, содержащий одну из частей этого
# этого письма. Обратите внимание, что $part в некоторых случаях
# может тоже содержать другие части, например, для MIME типа message/rfc822,
# так что в общем случае, на этом месте должна быть рекурсивная подпрограмма
# разбора
# Открыть эту часть для чтения
my $IO = $part->bodyhandle->open("r") or die "open body: $!";
while (defined($_ = $IO->getline)) {
# Делать чего-то с ней
}
$IO->close();
}
} else {
# Это сообщение из одной части:
$entity->body_as_string;
}
# Удалить временные файлы
$entity->purge();
Можно использовать MIME::Words,
#!/usr/bin/perl -w
use MIME::Words qw(:all);
use Convert::Cyrillic;
use strict;
my $string = 'Re: =?KOI8-R?B?0sHCz9TB ?= c MIME =?KOI8-R?B?zsE= ?= perl ';
# Простой вариант:
my $decoded = decode_mimewords($subject);
# Но он не выдает информации о кодировке, так что лучше использовать
# другую форму вызова:
my $decoded = join("", map {xcode(${$_}[1], ${$_}[0])} decode_mimewords($string)
print "decoded: $decoded\n";
# процедура перекодирования из чарсета, используемого в сообщении
# в koi8
sub xcode {
my ($charset, $src) = @_;
my %charsets = (
'windows-1251'=>'WIN',
'iso8859-5'=>'ISO',
'koi8-r'=>'KOI8',
'koi8r'=>'KOI8',
'koi8-u'=>'KOI8',
'utf-8'=>'UTF8',
'utf8'=>'UTF8'
);
return $src unless ($charsets{lc($charset)});
Convert::Cyrillic::cstocs($charsets{lc($charset)}, 'KOI8', $src);
}
Используя Net::POP3.
#!/usr/bin/perl -w
use strict;
use Net::POP3;
my $server = "oops";
my $pop = new Net::POP3($server);
# Залогинится
my $msgs = $pop->login("alladin", "opensesame");
# login возвращает undef, если не удалось залогинится и число сообщений
# в почтовом ящике, если удалось.
die "Login failed" if not defined $msgs;
print "$msgs сообщений\n";
# Список сообщений. list возвращает ссылку на хэш, ключами которого являются
# номера сообщений, а значениями -- размер письма в байтах.
my %list = %{$pop->list};
for my $msg_num (keys(%list)) {
print "#$msg_num - $list{$msg_num} байт\n";
# Получить сообщение. get вернет ссылку на массив строк
my $msg = $pop->get($msg_num);
# сделать с ним чего-нибудь
open F, ">msg$msg_num" or die "msg$msg_num: $!";
print F join("", @$msg);
close F;
# Отметить сообщение для удаления. Оно будет удалено
# при закрытии коннекта к серверу
$pop->delete($msg_num);
}
# Закрыть соединение с сервером
$pop->quit();