Perl — Отправляем файлы на сервер HTTP запросом

На самом деле, ничего оригинального, документации достаточно, даже более чем, хотя последее вызывают очень сильную тоску. Поэтому, проще один раз практически показать, как и что делается, чем десять раз читать и наступать на грабли. Условие: Есть какие-то бинарные файлы, которые лежат локально, есть сервер, на которые мы должны эти файлы положить, на этом сервере есть скрипт (обработчик формы) который занимается делает upload файлов
Задача: Данные файлы требуется добавить через web интерфейс (обработчик формы) на сервер, как будто мы браузер и отправили данные через форму.

Использование LWP::UserAgent

Алгоритм формирования запроса:

• Создаем запрос (HTTP::Request);
• Создаем «браузер» (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 $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' => '<i>Mozilla Firefox 5.0 :-)</i>');
$request->header('Referer' => '<i>http://somedomain.com/form</i>');
$request->protocol('HTTP/1.0'); # Хотя это сделает LWP::UserAgent, но лучше сразу

# Формирование обычных, текстовых параметров формы
my $field = HTTP::Message->new(
                                [
                                    'Content-Disposition'   => 'form-data; name="<i>fieldname</i>"',
                                    'Content-Type'          => 'text/plain; charset=utf-8',
                                ]); # Заголовок HTTP::Headers подставляем во время создания объекта HTTP::Message
$field->add_content_utf8('<i>somevalue</i>'); # Как видно, 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="<i>file</i>"; filename="<i>somefile.bin</i>'); # Хотя filename можно вычислить и из имени файла
    $header->header('Content-Type' => '<i>application/octet-stream</i>'); # Или соответсвующий типу файла
    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="<i>fieldname</i>"',
                                    'Content-Type'          => 'text/plain; charset=utf-8',
                                ]);
$field->add_content_utf8('<i>somevalue</i>'); # И тут тоже 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="<i>file</i>"; filename="<i>somefile.bin</i>');
$f_header->header('Content-Type' => '<i>application/octet-stream</i>');
$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. Без комментариев.