http/content-disposition/non-us-ascii-filename.cgi

#!/usr/bin/perl
use strict;
use Encode;
use encoding qw(iso-2022-jp);
use CGI qw(param);

sub token ($) {
  my $s = shift;
  $s =~ s/[^0-9A-Za-z_+.-]//g;
  $s;
}
sub escape ($) {
  my $s = shift;
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s;
}
sub ascii_html ($) {
  my $s = shift;
  $s =~ s!([^\x20-\x7E])!sprintf '<code>%02X</code>', ord $1!ge;
  $s;
}
sub check ($$$) {
  my ($name, $label, $defval) = @_;
  qq(<label><input type="checkbox" name="@{[escape $name]}" @{[$defval eq 'on' ? 'checked="checked"' : '']} />@{[escape $label]}</label>);
}
sub select_options ($$$) {
  my ($name, $vals, $defval) = @_;
  my $r = qq(<select name="@{[escape $name]}">);
  for (@$vals) {
    $r .= qq(<option value="@{[escape $_]}">@{[escape $_]}</option>);
  }
  $r .= qq(</select>);
  $r;
}

my $filename = q(ファイル×1);

my $charset = token param ('charset') || 'iso-8859-1';
my $charset_specify = param ('no-charset') ? 0 : 1;
my $disposition = token param ('disposition') || 'inline';

my $encode = param ('encode');
if ($encode eq 'bare') {
  $filename = 'filename="' . encode ($charset, $filename) . '"';
} else {
  $filename = encode ($charset, $filename);
  $filename =~ s/([^0-9A-Za-z_+.-])/sprintf '%%%02X', ord $1/ge;
  $filename = 'filename*=' . $filename;
}

print <<EOH;
Content-Type: text/html@{[$charset_specify?qq(; charset=$charset):'']}
Content-Disposition: $disposition; $filename

<!DOCTYPE html SYSTEM>
<title>Example file</title>
<style type="text/css" media="all">
  code { color: gray; text-decoration: underline }
</style>

File content

<pre>
Content-Type: text/html@{[$charset?escape qq(; charset=$charset):'']}
Content-Disposition: @{[escape $disposition]}; @{[ascii_html escape $filename]}
</pre>


<form action="@{[escape $ENV{SCRIPT_NAME}]}" method="post">
<dl>
<dl>Content Disposition type
  <dt>@{[select_options 'disposition', [qw/inline attachment form-data file x-unknown-value/], $disposition]}
<dt>Charset
  <dd>@{[select_options 'charset', [qw/iso-8859-1 us-ascii utf-8 iso-2022-jp euc-jp shift_jis/], $charset]}</dd>
  <dd>@{[check 'no-charset', 'Don\'t use charset parameter', not $charset_specify]}
<dt>Encoding
  <dd>@{[select_options 'encode', [qw/bare 2231 /], $encode]}
<dt><input type="submit" />
</dl>
</form>
EOH

1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			use Encode;
4			use encoding qw(iso-2022-jp);
5			use CGI qw(param);
6
7			sub token ($) {
8			my $s = shift;
9			$s =~ s/[^0-9A-Za-z_+.-]//g;
10			$s;
11			}
12			sub escape ($) {
13			my $s = shift;
14			$s =~ s/&/&/g;
15			$s =~ s/</</g;
16			$s;
17			}
18			sub ascii_html ($) {
19			my $s = shift;
20			$s =~ s!([^\x20-\x7E])!sprintf '<code>%02X</code>', ord $1!ge;
21			$s;
22			}
23			sub check ($$$) {
24			my ($name, $label, $defval) = @_;
25			qq(<label><input type="checkbox" name="@{[escape $name]}" @{[$defval eq 'on' ? 'checked="checked"' : '']} />@{[escape $label]}</label>);
26			}
27			sub select_options ($$$) {
28			my ($name, $vals, $defval) = @_;
29			my $r = qq(<select name="@{[escape $name]}">);
30			for (@$vals) {
31			$r .= qq(<option value="@{[escape $_]}">@{[escape $_]}</option>);
32			}
33			$r .= qq(</select>);
34			$r;
35			}
36
37			my $filename = q(ファイル×1);
38
39			my $charset = token param ('charset') \|\| 'iso-8859-1';
40			my $charset_specify = param ('no-charset') ? 0 : 1;
41			my $disposition = token param ('disposition') \|\| 'inline';
42
43			my $encode = param ('encode');
44			if ($encode eq 'bare') {
45			$filename = 'filename="' . encode ($charset, $filename) . '"';
46			} else {
47			$filename = encode ($charset, $filename);
48			$filename =~ s/([^0-9A-Za-z_+.-])/sprintf '%%%02X', ord $1/ge;
49			$filename = 'filename*=' . $filename;
50			}
51
52			print <<EOH;
53			Content-Type: text/html@{[$charset_specify?qq(; charset=$charset):'']}
54			Content-Disposition: $disposition; $filename
55
56			<!DOCTYPE html SYSTEM>
57			<title>Example file</title>
58			<style type="text/css" media="all">
59			code { color: gray; text-decoration: underline }
60			</style>
61
62			File content
63
64			<pre>
65			Content-Type: text/html@{[$charset?escape qq(; charset=$charset):'']}
66			Content-Disposition: @{[escape $disposition]}; @{[ascii_html escape $filename]}
67			</pre>
68
69
70			<form action="@{[escape $ENV{SCRIPT_NAME}]}" method="post">
71			<dl>
72			<dl>Content Disposition type
73			<dt>@{[select_options 'disposition', [qw/inline attachment form-data file x-unknown-value/], $disposition]}
74			<dt>Charset
75			<dd>@{[select_options 'charset', [qw/iso-8859-1 us-ascii utf-8 iso-2022-jp euc-jp shift_jis/], $charset]}</dd>
76			<dd>@{[check 'no-charset', 'Don\'t use charset parameter', not $charset_specify]}
77			<dt>Encoding
78			<dd>@{[select_options 'encode', [qw/bare 2231 /], $encode]}
79			<dt><input type="submit" />
80			</dl>
81			</form>
82			EOH
83