Perl - Отправляем файлы на сервер HTTP запросом
На самом деле, ничего оригинального, документации достаточно, даже более чем, хотя последее вызывают очень сильную тоску.
Поэтому, проще один раз практически показать, как и что делается, чем десять раз читать и наступать на грабли.
Условие: Есть какие-то бинарные файлы, которые лежат локально, есть сервер, на которые мы должны эти файлы положить, на этом сервере есть скрипт (обработчик формы) который занимается делает upload файлов
Задача: Данные файлы требуется добавить через web интерфейс (обработчик формы) на сервер, как будто мы браузер и отправили данные через форму.
Использование LWP::UserAgent
Алгоритм формирования запроса:
Создаем запрос (HTTP::Request);
Формируем для него заголовок (HTTP::Headers);
Для каждого параметра формируем контент (HTTP::Message);
Для каждого параметра контента формируем заголовок (HTTP::Headers);
Добавляем данные в тело контента;
Контент вставляем в тело запроса;
Создаем "браузер" (LWP::UserAgent);
Определяем для него заголовки;
Отправляем запрос;
Муторно как XML::LibXML, но зато надежно, итак:
Perl код (1)
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
# Это файл, который будем отправлять
my $file = './files/some_file.bin' ;
# Это URI по которому будем отсылать запрос
my $uri = 'http://somedomain.com/form/action/script' ;
my $ua = new LWP::UserAgent;
# Объект запроса
my $request = HTTP::Request->new ('POST' , $uri );
# Формируем разделитель, так как если мы его не укажем принудительно, то при $ua->request($request) он у нас не войдет в основной заголовок
# хотя, можно просто сделать $request->as_string после формирования объекта заголовка, тогда он подставится дефолтный, но не будем рисковать
my $boundary = 'X' ;
my @rand = ('a' ..'z' , 'A' ..'Z' );
for (0..14) {$boundary .= $rand [rand (@rand )];}
# Формируем заголовок:
$request ->header('Content-Type' => 'multipart/form-data; boundary=' .$boundary );
$request ->header('User-Agent' => 'Mozilla Firefox 5.0 :-) ' );
$request ->header('Referer' => 'http://somedomain.com/form ' );
$request ->protocol('HTTP/1.0' ); # Хотя это сделает LWP::UserAgent, но лучше сразу
# Формирование обычных, текстовых параметров формы
my $field = HTTP::Message->new (
[
'Content-Disposition' => 'form-data; name="fieldname "' ,
'Content-Type' => 'text/plain; charset=utf-8' ,
]); # Заголовок HTTP::Headers подставляем во время создания объекта HTTP::Message
$field ->add_content_utf8('somevalue ' ); # Как видно, somevalue должно быть в UTF-8
$request ->add_part($field );
# ... И так далее, для каждого текстового поля ...
# Формирование бинарных параметров формы
open (my $fh , '<' , $file );
# А можно сначала сделать заголовок, а потом уже применить к HTTP::Message
my $size = (stat $file )[7];
my $header = HTTP::Headers->new ;
$header ->header('Content-Disposition' => 'form-data; name="file "; filename="somefile.bin ' ); # Хотя filename можно вычислить и из имени файла
$header ->header('Content-Type' => 'application/octet-stream ' ); # Или соответсвующий типу файла
my $file_content = HTTP::Message->new ($header );
$file_content ->add_content($_ ) while <$fh >;
$request ->add_part($file_content );
close $fh ;
# ... И так далее, для каждого файла ...
my $response = $ua ->request($request );
if ($response ->is_success) {
print $response ->content
} else {
die $response ->status_line
}
Использование Socket
Все бы хорошо, но если у нас для передачи будет большой файл, то закачивать его целиком в память, что бы собрать запрос, не самая лучшая перспектива.
Поэтому возможно отправить запрос потоком через сокет:
Perl код (2)
#!/usr/bin/perl
use strict;
use warnings;
use HTTP::Headers;
use HTTP::Message;
use HTTP::Request;
use HTTP::Response;
use IO::Socket::INET;
# Это файл, который будем отправлять
my $file = './files/some_file.bin' ;
# Это URI по которому будем отсылать запрос
my $uri = 'http://somedomain.com/form/action/script' ;
# Так как мы будем использовать сокет, то нам нужен домен, порт и путь раздельно
my ($domain , $port , $path ) = $uri =~ m/^(?:https?\:\/\/)?([^\/\:]+)(?:\:(\d+))?(.+)$/ ;
$port ||= 80; # По умолчанию
# Велосипед - это, конечно хорошо, но формировать заголовки и небинарное тело запроса можно спокойно и с помощью готового модуля
my $header = HTTP::Headers->new ; $header ->header('Content-Type' => 'multipart/form-data' );
my $request = HTTP::Request->new ('POST' , $uri , $header ); # Вместо $path у нас $uri, так быть и должно ;-)
$request ->protocol('HTTP/1.0' ); # Странно, что по-умолчанию HTTP::Request протокол не ставит, поэтому выставляем сами
# Для небольших объемов данных, например текстовые поля, велосипед тоже будет лишним
# (SFCI) Условия те же, что и в предыдущем коде (1)
my $field = HTTP::Message->new (
[
'Content-Disposition' => 'form-data; name="fieldname "' ,
'Content-Type' => 'text/plain; charset=utf-8' ,
]);
$field ->add_content_utf8('somevalue ' ); # И тут тоже utf8
$request ->add_part($field );
# ... И так далее, для каждого текстового поля ...
# Далее наш запрос, но без файлов разделяем на основной заголовок и первую часть контента
# Делим регулярным выражением ибо $request->headers->as_string не возвращает первую строку запроса, а именно - команду POST,
# а собирать строку самостоятельно, можно конечно, но лень.
my ($head , $content ) = $request ->as_string =~ m/^(.+?)\n\n(.+)$/s ;
# Контент у нас не закончен, поэтому отрезаем --[LF][EOF]
$content = substr ($content , 0, -4);
# а так же boundary
$content =~ s/(\-\-[^\n]+)$//s ;
my $boundary = $1 ;
# Считаем предварительную длинну запроса
my $length = length $content ;
# Теперь наши файлы:
my $files = [];
my $size = (stat $file )[7];
my $f_header = HTTP::Headers->new ;
$f_header ->header('Content-Disposition' => 'form-data; name="file "; filename="somefile.bin ' );
$f_header ->header('Content-Type' => 'application/octet-stream ' );
$f_header = $boundary ."\n" .$f_header ->as_string."\n" ;
# Прибаляем к длинне запроса
$length += length $f_header ;
$length += $size ;
# Собственно, процедура ниже только лишь для случаев, когда фалов много.
# Тогда, нам сначала нужно посчитать длинну контента, ибо она (длинна) будет указываться в основном заголовке
push @{$files} , {header => $f_header , file => $file };
# ... И так далее, для каждого файла ...
# Итак у нас все готово
$length += length $boundary .'--' ; # Концевую строку тоже считаем
# Открываем сокет
my $socket = IO::Socket::INET->new ($domain .':' .$port ) || die $! ;
# К основному заголовку длинну
$head .= "\nContent-Length: " .$length ;
# Отправляем в сокет заголовок и первую (текстовую) часть контента
print $socket $head ;
print $socket "\n\n" ;
print $socket $content ;
foreach my $file (@{$files} ) {
print $socket $file ->{header };
open (my $fh , '<' , $file ->{file });
print $socket $_ while <$fh >;
print $socket "\n" ;
close $fh ;
}
# Отсылаем сокету конец файла
print $socket $boundary .'--' ;
# Отсылаем сокету конец файла
shutdown ($socket , 1);
# Получаем из сокета ответ и разбираем его
my $response = HTTP::Response->parse( join ('' , <$socket >) );
if ($response ->is_success) {
print $response ->content
} else {
die $response ->status_line
}
Well done
(SFCI) Хочу заметить, всё что выделено в коде курсивом, должно быть заменено соответсвующими значениями условия задачи.
Примечание: SFCI - Special for copipaster's idiots. Без комментариев.
автор: Сергей Томулевич aka Phoinix