Новичок
Профиль
Группа: Участник
Сообщений: 14
Регистрация: 6.8.2006
Репутация: нет
Всего: нет
|
Вот мой скрипт целиком. Вроде бы везде убрал логины, пароли и домены. Если не убрал где-то - не обращай внимания, пожалуйста. | Код |
#!/usr/local/bin/perl
############################################################################
#### Load needed modules.
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use MIME::Base64; #для кодирования авторизационных параметров, темы и тела письма
use IO::Socket; #для общения с SMTP-сервером
#######################################################################
#### Declair some variables we know we will use thoughout the cgi
my ($sth, $table, $dbaction, $actiondb, $tableaction, $actiontable, $colsaction, @actioncols, $column, $columnaction, $actioncolumn);
#### Set server variables
my $defaulthost = "";
my $defaultdb = "";
my $defaultusername = "";
my $defaultpassword = "";
my $body = "";
my $header= "";
my $printedheader = 0;
my $path = "/bin:/usr/bin:/usr/local/bin";
#### Create the query struct to get form data
my $query = new CGI;
my $thiscgi = $query->url();
#### Get the username and password if exists from the form
#### or else use the defaults
my ($host, $username, $password, $database);
$host = "localhost";
$database = "...";
$username = "...";
$password = "...";
$table = $query->param("table") || "";
my $error = 0;
my @DATATYPE = ("tinyint","smallint","meduimint","int","bigint","float","double","decimal","varchar","char","tinyblob","blob","mediumblob","longblob","timestamp","date","time","datetime","text","enum");
#### Connect to the database $defaultdb becasue there doesnt
#### seem to be a way to connect to just the server with
#### out specifying a database. If $defaultdb does not exists
#### An invalid login error will occour
my $dbh = DBI->connect("DBI:mysql:$database:$host", $username, $password) || error('connect');
##########################
##########################
if (my $j eq 'asd') {
#############################################################
# submit_query #
# #
# Print out the reseults the the SQL query #
# #
#############################################################
} elsif ($query->param("sending") ne "") {
printheader();
open (COUNT,"/home/.../cgi-bin/db/num.dat");
my $num = <COUNT>;
close (COUNT);
while ($num < 100) {
my $sqlstr = "SELECT Email FROM testmail WHERE Num=$num";
$sth = $dbh->prepare($sqlstr) || sqlerror("Unable to prepare query: ".$dbh->errstr);
$sth->execute || sqlerror("Unable to execute query: ".$dbh->errstr);
my $names = $sth->{NAME};
print "";
foreach my $name (@$names) {
print "";
}
print "";
my ($col, $gotdata);
while (my @data = $sth->fetchrow_array) {
print "";
foreach $col (@data) {
my $Email = $col;
##########################
my $mailbox = '[email protected]'; # ящик-отправитель
my $mailpwd = 'password'; # пароль
my $mailrcpt = "$Email"; # ящик-получатель
my $subj = 'Concurso Banco Espaсol';
my $text1 = "Estimado(a) ";
my $text2 = '
Gracias por su participaciуn en el concurso.
La informaciуn y las noticias diarias estбn en el nuestro Facebook.
Saludos cordiales,
El equipo de
www.....com';
my $mail = "$text1$text2";
#открываем сокет к SMTP-серверу
my $socket = IO::Socket::INET->new('mail.small-solutions.com:26');
defined $socket or die "ERROR: $!\n";
# читаем ответ
if(ReadReply() ne 220){print "Error de conexiуn = $message\n"; $socket->close(); }
# здороваемся с сервером - не стал использовать ehlo,
# потому что расширенные возможности не требуются
$socket->print ("ehlo lo\n");
# получаем ответ и проверяем код
if(ReadReply() != 250){print "Error en el servidor = $message\n"; $socket->close(); exit}
# теперь проводим авторизацию
$socket->print("AUTH LOGIN\n");
# получаем ответ
if(ReadReply() ne 334){print "Error de autorizaciуn = $message\n"; $socket->close(); exit}
# кодируем логин-пароль
$socket->print(encode_base64($mailbox).encode_base64($mailpwd));
# после авторизации выдается две строчки
ReadReply();
if(ReadReply() ne 235){print "Error de autorizaciуn = $message\n"; $socket->close(); exit}
# начинаем транзакцию - даем команду отправки письма
$socket->print('mail from: '."$mailbox\n");
if(ReadReply() ne 250){print "Error en el buzуn del remitente = $message\n"; $socket->close(); exit}
# указываем получателя
$socket->print("rcpt to: $mailrcpt\n");
if(ReadReply() ne 250){print "Error en el buzon del destinatario = $message = La direccion de correo electronico es incorrecta\n"; $socket->close(); exit}
# теперь начинаем формировать письмо
$socket->print("data\n");
if(ReadReply() ne 354){print "Error en la formaciуn de las letras = $message\n"; $socket->close(); exit}
# теперь сформируем тему письма, перекодировав ее из юникода в ср-1251
# и потом закодировав все это в base64.
# Таким образом, в теме письма можно нормально писать по русски
# Если вы используете другую кодировку в системе и/или при подготовке
# этого скрипта под свои нужды - скорректируйте создание конвертера в начале
# или вообще откажитесь от него
$subj = encode_base64($subj);
$subj =~ s/\n//ig; # уберем символы перевода строки
$subj =~ s/\r//ig; # и возврата каретки, поскольку они все ломают :)
$subj = '=?Windows-1252?B?'.$subj.'?=';
# создадим тело письма
$msg = encode_base64($mail);
# здесь формируем заголовок, минимальная версия
$body = "Mime-Version: 1.0\n";
$body .= "Content-Type: multipart/mixed; boundary=\"-\"\n\n";
# вставляем тело письма
$body .= "---\nContent-Type: text/plain;\n\tcharset=\"Windows-1252\"\nContent-Transfer-Encoding: base64\n\n$msg\n";
# и наконец соберем письмо в одну переменную :)
$mailmessage = "From:Autor<$mailbox>\nTo:$mailrcpt\nSubject:$subj\n$body\n.\n";
# скинем письмо серверу
$socket->print($mailmessage);
# и посмотрим что получилось
if(ReadReply() ne 250){print "Error al enviar mensajes = $message\n"; $socket->close(); exit}
# если дошли до этого места, значит письмо ушло
$socket->close();
sub ReadReply{
# процедура чтения ответа от сервера
# цикл используется для того, чтобы прочитать многострочный ответ
# например, при выдаче ответа на команду EHLO
# формат строк
# Трехзначное число-пробел или дефис-текстовое сообщение
# причем, если ответ многострочный, то дефис используется во всех
# строках, кроме последней, в которой используется пробел
# именно по этому признаку и будет определятся конец цикла
# и возвращаемый код будет браться также из последней строки
$val = 1;
while($val eq 1){
$r = <$socket>;
$val = $r =~ m/^\d{3}-/g;
}
($reply,$message) = split(/ /,$r,2);
return $reply;
}
##########################
# bump up the counter
open (NEWCOUNT,">/home/.../cgi-bin/db/num.dat");
$num += 1;
print NEWCOUNT $num;
close (NEWCOUNT);
chmod (0777, "/home/.../cgi-bin/db/num.dat");
}
}
print "";
$gotdata = 1;
}
if (!$gotdata && !$error) {
print font("black:4:arial","Successful query, but no data returned");
} else {
print "";
}
}
#############################################################
# default page #
# #
# Print the login screen to connect to the server #
# #
#############################################################
else {
printheader();
print "<html><head><title>Error!</title></head>$body\n";
print "</body></html>\n";
}
print "";
#### Disconnect at the end of the script
$sth->finish if $sth;
$dbh->disconnect;
#############################################################
# subs #
# #
# Variuos subs for handleing repetitive tasks #
# #
#############################################################
#### font sub for printing stings in different fonts
sub font {
#### arg0 is in format color:size:face
my $options = $_[0];
my ($color, $size, $face) = split(/:/, $options);
my $string = $_[1];
return "<font color=\"$color\" size=\"$size\" face=\"$face\">$string</font>";
}
#### error sub for various errors
sub error {
printheader();
my($error, $errstr);
$error = shift;
$errstr = shift;
print "<html><head><title>Error!</title></head>$body\n";
if ($error eq 'connect') {
print "<br><center><h1>Error connecting to database</h1></center>\n";
print "<p>This could be caused by an invalid username or password or you do not have permission to connect to the database specified.</p>\n";
print "Native MySQL error: <i>$errstr</i>";
} elsif ($error eq 'action') {
print "<br><center><h1>Error Performing Action</h1></center>\n";
print "<p>This could be caused by insufficient privieges on selected database.</p>\n";
print "Native MySQL error: <i>$errstr</i>";
} elsif ($error eq 'selecttables') {
print "<br><center><h1>Error</h1></center>\n";
print "<p>You must select at least one table to be backed up.</p>\n";
} elsif ($error eq 'symlink') {
print "<br><center><h1>Error</h1></center>\n";
print "<p>Symbolic link encountered while opening a temp file.</p>\n";
}
exit;
}
#### sqlerror: print the error from an sql query
sub sqlerror {
printheader();
my $errstr = shift;
$error = 1;
print "<font color=black size=4 face=arial>$errstr</font><br>\n";
}
#### Print header only if it has not been printed
sub printheader {
if (!$printedheader) {
print "Content-type: text/html\n\n";
$printedheader = 1;
}
}
|
Комментарии. На сервере находится файл num.dat в котором первоначально записана "1" Скрипт начинает работать, берет эту единицу. Выполняет запрос SELECT, которым выбирает запись под номером 1 Это и есть первый адрес мыла. Дальше скрипт формирует письмо и отправляет его по этому (выбранному из БД) адресу. Отправив письмо, он увеличивает значение в num.dat на единицу, т.е. там становится 2. Цикл возвращается. Теперь SELECT дает запись номер 2 Это опять адрес мыла. Адрес правильный и выбирается из БД правильно (это я проверял), ничего лишнего, ни пробелов, ничего... Но на второй записи соединения с почтовым сервером не происходит. Не могу понять почему? Поможешь? |
Использование SMTP на Perl, Не работает скрипт при использ-и цикла 
Загрузка ...
