Работа с Сокетами в Perl: Загрузка файлов на удаленный сервер


Работа с Сокетами в Perl: Загрузка файлов на удаленный сервер
Задача: Загрузить имеющийся файл на другой сервер через форму. Например у нас есть несколько сайтов, в базу данных которых нам надо добавить картинку-баннер со своего сервера, с описанием и своими личными данными (логин, пароль). Для этого будем использовать прямое соединение с сервером.
Задача: Загрузить имеющийся файл на другой сервер через форму. Например у нас есть несколько сайтов, в базу данных которых нам надо добавить картинку-баннер со своего сервера, с описанием и своими личными данными (логин, пароль). Для этого будем использовать прямое соединение с сервером.

Предположим Вы работаете менеджером по рекламе и вам необходимо подгружать один баннер в десяток другой баннерных систем. Чтобы не возится с каждым баннером, можно написать программу, автоматизирующую процесс подгрузки баннеров на несколько сайтов, защищенных паролем в хидден-поле(безопасность для данного примера работает при клиенте с аутентификацией через хидден-поля). Используя встроенную упаковку CGI.pm пакетов multipart/from можно напороться на то, что CGI.pm формируетй такой пакет, который может не разобрать программа, написанная, скажем на языке C. Т.е. CGI.pm формирует пакеты не совсем согласно rfc1867. Чтобы избежать этого неудобства, можно посылать картинки, используя Socket.pm. Т.е. нужно сформировать и отправить пакет в точности с rfc1867, который является стандартом для всех языков программирования. Ниже представлена программа, реализующая эту задачу:

#!/usr/bin/perl -w


if ((!defined $ARGV[0]) || ($ARGV[0] =~ /^-h/i)) {
        print << '__HELP_END__';
This script sends banners to www.kuku.ru. Usage:
./set_banner.pl <image_filename>
__HELP_END__
        exit(1);
}


my $filename = shift @ARGV;
my %accounts = (
        'vovka'  => ['123321', 13]
);
my ($login, $data);
while (($login,$data) = each %accounts) {
        my %params = (
                image_filename  => $filename,
                login           => $login,
                password        => $data->[0],
                profile         => $data->[1]
        );
        #print join ":",  %params;
        send_banner(%params);
}
exit(0);


sub send_banner(%)
{
        my %params = @_;
        open FILE, $params{image_filename} or die "Can't open imagefile: $!";
        binmode(FILE);
        my $image_data = <FILE>;
        close FILE;
        %params = (%params,  (
                host            => 'www.kuku.ru',
                script_uri      => 'account/addimage.html',
                url             => 'www.rrrr.ru',
                image_data      => $image_data,
                ratio           => '0',
                alt             => 'Новости на www.rrrr.ru'
        ));
        use IO::Socket;
        my $socket = IO::Socket::INET->new(
                PeerAddr => $params{host},
                PeerPort => 80,
                Proto    => 'tcp' 
        ) 
                or die "Can't connect: $!";


my $body = ''. << "__END_OF_BODY__";
-----------------------------7d02d3301bfa0846
Content-Disposition: form-data; name="user"

$params{login}

-----------------------------7d02d3301bfa0846
Content-Disposition: form-data; name="password"

$params{password}

-----------------------------7d02d3301bfa0846
Content-Disposition: form-data; name="image"; filename="$params{image_filename}"
Content-Type: image/gif
Content-Transfer-Encoding: binary

$params{image_data}
-----------------------------7d02d3301bfa0846
Content-Disposition: form-data; name="href"

$params{url}

-----------------------------7d02d3301bfa0846
Content-Disposition: form-data; name="profile"

$params{profile}

-----------------------------7d02d3301bfa0846
Content-Disposition: form-data; name="ratio"

$params{ratio}

-----------------------------7d02d3301bfa0846
Content-Disposition: form-data; name="alt"

$params{alt}

__END_OF_BODY__

$body .= '-----------------------------7d02d3301bfa0846--';


my $content_length = length($body);
my $header = '' . << "__END_OF_HEADER__";
POST $params{script_uri} HTTP/1.1
Accept: */*
Accept-Language: ru
User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows NT; DigExt)
Content-Length: $content_length
Content-Type: multipart/form-data; boundary=---------------------------7d02d3301bfa0846
Host: $params{host}
__END_OF_HEADER__
        print $header . "\n" . $body;
        print $socket $header . "\n\n" . $body;
        while (<$socket>) {
                print;
        }
        close $socket;
}
1;


Оценить Статью:  
1   2   3   4   5   6   7   8   9   10    

« Назад
SAPE все усложнил?

MainLink - простая и прибыльная продажа ссылок!

Последние поступления:

Размещена 10 августа 2020 года

Я по ТВ видел, что через 10 лет мы будем жить лучше, чем в Германии...
Я не понял, что это они с Германией сделать хотят?!

читать далее…

ТехЗадание на Землю

Размещена 14 марта 2018 года

Пpоект Genesis (из коpпоpативной пеpеписки)

читать далее…

Шпаргалка по работе с Vim

Размещена 05 декабря 2017 года

Vim довольно мощный редактор, но работа с ним не всегда наглядна.
Например если нужно отредактировать какой-то файл например при помощи crontab, без знания специфики работы с viv никак.

читать далее…

Ошибка: Error: Cannot find a valid baseurl for repo

Размещена 13 сентабря 2017 года

Если возникает ошибка на centos 5 вида
YumRepo Error: All mirror URLs are not using ftp, http[s] or file.
Eg. Invalid release/

читать далее…

Linux Optimization

Размещена 30 июля 2012 года

Prelink

читать далее…