use strict; use warnings; package App::DubiousHTTP::Tests::Mime; use App::DubiousHTTP::Tests::Common; use MIME::Base64 'encode_base64'; SETUP( 'mime', "no all MIME makes sense for HTTP", <<'DESC', Various tests with multipart contents. Most systems do not handle multipart in a special way but Firefox often just uses the last part and ignores the rest while Opera additionally interprets Content-Transfer-Encoding header. DESC # ---------------------- Tests ------------------------------------ [ 'VALID: single parts' ], [ MUSTBE_VALID, 'single' => 'single part'], [ VALID, 'single,ct64',"single part with Content-Transfer-Encoding base64 header but unencoded data" ], [ 'INVALID: single part with base64 content' ], [ INVALID, 'single,ct64,base64',"single part with Content-Transfer-Encoding base64 and encoded data" ], [ 'INVALID: content packed into multipart messages' ], [ INVALID, 'mixed',"multipart/mixed" ], [ INVALID, 'mixed,ct64,base64',"multipart/mixed with Content-Transfer-Encoding base64" ], [ INVALID, 'related',"multipart/related" ], [ INVALID, 'related,ct64,base64',"multipart/related with Content-Transfer-Encoding base64" ], # only supported in older IE [ 'INVALID: MHTML' ], [ INVALID, 'related,mhtml',"multipart/related with mhtml schema" ], [ INVALID, 'mixed,mhtml',"multipart/mixed with mhtml schema" ], [ INVALID, 'multi-plain,mhtml',"text/plain with mhtml schema" ], [ INVALID, 'related,mhtml,base64',"multipart/related with mhtml schema base64" ], [ INVALID, 'mixed,mhtml,base64',"multipart/mixed with mhtml schema base64" ], [ INVALID, 'multi-plain,mhtml,base64',"text/plain with mhtml schema base64" ], ); sub make_response { my ($self,$page,$spec) = @_; return make_index_page() if $page eq ''; my ($hdr,$data) = content($page,$self->ID."-".$spec) or die "unknown page $page"; my $version = '1.1'; my %spec = map { $_ => 1 } split(',',$spec); my $resp = "HTTP/$version 200 ok\r\n"; my $multi = delete $spec{mixed} ? 'multipart/mixed' : delete $spec{related} ? 'multipart/related' : delete $spec{'multi-plain'} ? 'text/plain' : ''; if ( $multi ) { $resp .= "Content-type: $multi; boundary=foobar\r\n"; my $part = $hdr; $part .= "Content-transfer-Encoding: base64\r\n" if delete $spec{ct64}; $data = encode_base64($data) if delete $spec{base64}; $part .= "Content-length: ".length($data)."\r\n\r\n$data\r\n"; my $body = "\r\n". "--foobar\r\nContent-Location: p1\r\n$part". "--foobar\r\nContent-Location: p2\r\n$part". "--foobar--\r\n"; $resp .= "Content-length: ".length($body)."\r\n\r\n$body"; } else { $resp .= "Content-transfer-Encoding: base64\r\n" if delete $spec{ct64}; $data = encode_base64($data) if delete $spec{base64}; $resp .= "Content-length: ".length($data)."\r\n\r\n$data"; } return $resp; } 1;