multipart/form-dataで送信する際、任意のfilename値を指定する

LWPでできるかなって思ってたら、すぐできなかったのでSocket叩いて書いたけど、
調べたら普通にLWPで出来た。ですよねー。

use LWP::UserAgent;
use HTTP::Request::Common;

my $ua = new LWP::UserAgent;
my $res=$ua->request(
	POST('http://192.168.11.254/upload',
		Content_Type => 'multipart/form-data',
		Content => [ 'file' => ['test.txt', '/tmp/test.txt'] ]
	)
);

出力例

POST /upload HTTP/1.1
TE: deflate,gzip;q=0.3
Connection: TE, close
Host: 192.168.11.254
User-Agent: libwww-perl/5.837
Content-Length: 134
Content-Type: multipart/form-data; boundary=xYzZY

--xYzZY
Content-Disposition: form-data; name="file"; filename="/tmp/test.txt"
Content-Type: text/plain

Hello World

--xYzZY--

パラメータ名'file'に'test.txt'の内容を吐き出すけど、
filenameは'/tmp/test.txt'とするようになる。
filenameの値を信じてる手抜きアップローダならごにょごにょ。

お蔵入りしたもの。multipart/form-dataを自力で書き出すだけ。

use strict;
use warnings;
use IO::Socket::INET;

run();

sub run{
	my $ip = '127.0.0.1';
	my $port = '3000';

	my $path = '/upload';
	my $boundary = '---------------------------9930139772306';
	my $name = 'file';
	my $filename = '../test.txt';
	my $type = 'application/octet-stream';

	my $sock = IO::Socket::INET->new(PeerAddr => $ip,
		PeerPort => $port,
		Proto => 'tcp');
	open(my $FH1, '<', 'test.txt') || die;
	open(my $FH2, '<', 'sample.mp4') || (close($FH1), die);
	sendMultipartFormData($sock, {
		host => 'rying.net',
		path => $path,
		boundary => $boundary,
		autoclose => 1,
		debugoutput => *STDOUT,
		sendbuffersize => 1024 * 64,
		
		data => [
			{
				name => 'file',
				filename => 'output.test.txt',
				type => $type,
				body => $FH1,
				encoding => 'binary',
			},
			{
				name => 'file',
				filename => 'output.sample.mp4',
				type => $type,
				body => $FH2,
				encoding => 'binary',
			},
			{
				name => 'mode',
				body => 'up',
			}
		]
	});
	print while <$sock>;
	$sock->close();
}

sub sendMultipartFormData{
	my $sock = shift || die;
	my $args = shift || die; # hash ref
	my $host = defined($args->{host}) ? delete($args->{host}) : die;
	my $path = defined($args->{path}) ? delete($args->{path}) : die;
	my $originalboundary = defined($args->{boundary}) ? delete($args->{boundary}) : die;
	my $autoclose = delete($args->{autoclose});
	my $debugoutput = delete($args->{debugoutput});
	my $sendbuffersize = delete($args->{sendbuffersize});
	my $datalist = defined($args->{data}) ? delete($args->{data}) : die;
	if(ref $datalist eq 'HASH'){
		$datalist = [$datalist];
	}elsif(ref $datalist ne 'ARRAY'){
		die;
	}
	
	# boundary
	my $boundary = "\r\n--" . $originalboundary . "\r\n";
	my $lastboundary = "\r\n--" . $originalboundary . "--\r\n";
	
	# 総ファイルサイズ算出とデータの確認
	my $totalheadersize = 0;
	my $totalfilesize = 0;
	foreach my $data(@$datalist){
		use bytes;
		if(!exists($data->{name}) || !exists($data->{body})){
			die;
		}
		my $name = $data->{name};
		my $filename = $data->{filename};
		my $type = $data->{type};
		my $encoding = $data->{encoding};
		my $body = $data->{body}; # text or FileHandle
		my $bodysize = $data->{bodysize};
		if(not defined $bodysize){
			# FileHandle
			if(ref $body eq 'GLOB' || ref eq 'IO::File'){
				seek($body, 0, 2);
				$bodysize = tell($body);
				seek($body, 0, 0);
			}elsif(ref $body eq ''){
				$bodysize = bytes::length($body);
			}else{
				die;
			}
			$data->{bodysize} = $bodysize;
		}
		$totalfilesize += $bodysize;
		
		$totalheadersize += bytes::length($boundary); # boundary
		$totalheadersize += bytes::length($name) + 40; # "Content-Disposition: form-data; name="$name";"
		$totalheadersize += 12 + bytes::length($filename) if $filename; # " filename="$filename""
		$totalheadersize += 2; # "\r\n"(Content-Disposition)
		$totalheadersize += 14 + bytes::length($type) + 2 if $type; # "Content-Type: $type\r\n"
		$totalheadersize += 27 + bytes::length($encoding) + 2 if $encoding; # "Content-Transfer-Encoding: $encoding\r\n"
		$totalheadersize += 2; # "\r\n"
	}
	
	use bytes;
	my $contentlength = $totalheadersize - 2 + $totalfilesize + bytes::length($lastboundary); # ヘッダとボディの境界の"\r\n"は含めないため。
	no bytes;
	
	# データ送信
	binmode $sock || die;
	$sock->autoflush(1);
	my $header = 
		"POST $path HTTP/1.1\r\n".
		"Connection: close\r\n".
		"Host: $host\r\n".
		"Content-Type: multipart/form-data; boundary=$originalboundary\r\n".
		"Content-Length: $contentlength\r\n";
		
	print $sock $header;
	print $debugoutput $header if($debugoutput);
	
	foreach my $data(@$datalist){
		my $name = $data->{name};
		my $filename = $data->{filename};
		my $body = $data->{body}; # text or FileHandle
		my $type = $data->{type};
		my $encoding = $data->{encoding};
		my $contentdisposition = qq{Content-Disposition: form-data; name="$name";};
		if($filename){
			$contentdisposition .= qq{ filename="$filename"};
		}
		$contentdisposition .="\r\n";
		my $contenttype = $type ? "Content-Type: $type\r\n" : "";
		my $contenttransferencoding = $encoding ? "Content-Transfer-Encoding: $encoding\r\n" : "";
		
		print $sock $boundary;
		print $sock $contentdisposition;
		print $sock $contenttype;
		print $sock $contenttransferencoding;
		print $sock "\r\n";
		
		if($debugoutput){
			print $debugoutput $boundary;
			print $debugoutput $contentdisposition;
			print $debugoutput $contenttype;
			print $debugoutput $contenttransferencoding;
			print $debugoutput "\r\n";
		}
		
		if(ref $body){
			my $buf;
			if($encoding){
				binmode $body || die;
			}
			print $debugoutput "[$filename]" if($debugoutput); 
			while(read($body, $buf, $sendbuffersize)){
				print $sock $buf;
			}
			if($autoclose){
				close $body;
			}
		}else{
			print $sock $body;
			print $debugoutput $body if($debugoutput); 
		}
		$sock->flush();
	}
	
	print $debugoutput $lastboundary if($debugoutput); 
	print $sock $lastboundary;
}