鐃緒申鐃緒申鮓�てわ申鐃緒申鐃緒申鐃殉わ申覆鐃緒申覆辰鐃緒申里如鐃�
鐃緒申鐃緒申呂鐃緒申辰鐃緒申鐃緒申鐃緒申鐃緒申箸鐃緒申鐃緒申函鐃�
鐃緒申鐃緒申鐃緒申鐃叔みわ申鐃緒申鐃淑わ申里任鐃緒申鐃�nms-cgi鐃祝わ申侫鐃緒申鐃緒申襯�鐃獣プワ申鐃緒申鐃緒申鐃緒申鐃緒申鐃淑わ申鐃獣わ申鐃塾で削申鐃殉わ申鐃緒申鐃緒申鐃緒申鐃緒申他鐃塾「よく鐃夙わ申CGI鐃竣なども、鐃緒申鐃緒申鐃緒申鐃緒申鐃祝みわ申覆鐃重削申錣件申討鐃緒申鐃緒申鐃緒申鐃循￥申鐃夙わ申鐃緒申鐃緒申鐃祝わ申鐃緒申个鐃緒申鐃緒申里任呂覆鐃緒申鐃緒申箸鐃緒申鐃獣て削申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申任鐃緒申鐃�
鐃淑駕申鐃緒申鐃緒申鐃緒申鐃緒申澆鐃緒申討鐃緒申泙鐃緒申鐃�
- 鐃緒申鐃淑器申鐃暑型鐃塾ワ申鐃緒申鐃緒申廛箸任鐃緒申襪鰹申鐃�
鐃縮の醐申鐃緒申鐃緒申鐃薯すわ申函鐃�Core Module鐃緒申鐃緒申鐃緒申動鐃緒申鐃緒申鐃夙￥申Perl Version 鐃叔わ申鐃緒申鐃緒申Unicode鐃殉わ申蠅�鐃緒申鐃緒申鐃緒申鐃銃逸申鐃�5.8.1鐃淑常申鐃緒申鐃緒申蠅件申討鐃緒申泙鐃緒申鐃�
HTML鐃淑ど刻申鐃淳でわ申鐃緒申鐃緒申弔離侫鐃緒申鐃緒申鐃緒申必鐃竣わ申鐃緒申鐃銃わ申鐃緒申鐃獣てわ申鐃緒申里鐃緒申鐃緒申任鐃緒申鐃�
- CGI鐃夙わ申鐃銃わ申鐃緒申鐃叔はなわ申鐃緒申mod_perl鐃緒申registry鐃叔もき鐃緒申鐃緒申鐃銃逸申鐃緒申鐃緒申鐃�
鐃緒申鐃緒申鐃緒申鐃緒申
__DATA__鐃緒申鐃夙わ申鐃淑わ申鐃塾わ申鐃緒申鐃緒申鐃叔￥申鐃緒申両鐃緒申鐃緒申箸濆鐃緒せ鐃緒申箸鐃緒申鐃緒申辰鴇鐃緒申圓曚匹鐃緒申弔鐃緒申鐃緒申任呂鐃緒申鐃殉わ申鐃緒申鐃緒申鐃緒申鐃緒申肋鐃緒申蠅�鐃緒申鐃緒申鐃緒申 - Taint Mode鐃叔わ申動鐃緒申鐃緒申鐃緒申
mod_perl鐃叔もそ鐃塾まわ申動鐃緒申鐃緒申鐃緒申鐃夙わ申鐃塾醐申鐃緒申董鐃�
#!鐃緒申-T鐃緒申鐃淑わ申鐃緒申鐃瞬わ申Release鐃緒申鐃緒申鐃緒申鐃銃わ申鐃殉わ申鐃緒申鐃緒申鐃縦わ申鐃銃もき鐃緒申鐃緒申鐃銃逸申鐃緒申里鐃緒申鐃叔わ申鐃緒申 - 鐃緒申鐃緒申鐃叔わ申鐃暑こ鐃緒申
鐃緒申両鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申造蝓�鐃淑わ申戮鐃緒申鐃�
鐃緒申鐃緒申埜鐃緒申鐃緒申函鐃緒申岼鐃緒申澆鐃緒申屬鐃緒申鐃緒申鐃緒申鐃緒申媛澆鐃淳わ申覆任鐃緒申鐃緒申鐃緒申茲�鐃竣￥申鐃夙わ申鐃緒申鐃緒申鐃夙でわ申鐃緒申
Perl鐃緒申足鐃緒申覆鐃緒申隼廚鐃緒申鐃緒申 - Perl鐃緒申鐃緒申鐃緒申鐃緒申鐃竣ルコ鐃緒申鐃宿にわ申鐃�Perl鐃緒申鐃緒申鐃�Perl鐃夙わ申鐃緒申鐃緒申鐃曙が鐃書しわ申鐃塾ではなわ申鐃銃￥申Perl鐃緒申惱鐃緒申鐃緒申鐃塾わ申鐃書しわ申鐃緒申
鐃夙わ申鐃緒申鐃春醐申鐃緒申鐃塾わ申里忙鐃熟誌申鐃緒申鐃叔はわ申鐃緒申泙鐃緒申鵑�￥申鐃緒申鐃緒申任鐃薯今のはてブを見わ申函鐃緒申鐃叔わ申鐃緒申鐃瞬ワ申鐃緒申鐃緒申佑任覆鐃緒申隼箸鐃緒申鐃緒申覆鐃緒申覆鐃緒申里鐃�Perl鐃熟」とわ申鐃緒申鐃緒申鐃出にわ申鐃緒申鐃緒申鐃所そ鐃緒申鐃祝なわ申泙鐃緒申鐃緒申鐃緒申離廛鐃緒申鐃緒申鐃緒申鐃緒申箸呂鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申發鰹申鐃銃わ申鐃殉わ申鐃緒申
鐃緒申直鐃緒申鐃緒申鐃夙￥申CGI鐃夙わ申鐃緒申鐃塾は初心鐃峻には器申鐃緒申鐃緒申泙鐃緒申鵝�「とりあ鐃緒申鐃緒申動鐃緒申鐃竣わ申里牢鐃獣縁申忘鐃緒申討癲�鐃瞬わ申鐃緒申鐃緒申鐃銃逸申鐃緒申廚鐃塾となわ申箸鐃緒申覆鐃緒申颪靴鐃緒申鐃緒申鐃緒申鐃緒申蕕鰹申鐃緒申鐃緒申鐃緒申鐃夙わ申鐃緒申鐃緒申鐃純が鐃緒申辰鐃緒申澆鐃緒申鐃緒申里任鐃緒申鐃�
So join us and help us!
Dan the Starter
http://svn.coderepos.org/share/lang/perl/tnek-cgi/trunk/upload.cgi
#!/usr/bin/perl
use strict;
use warnings;
=encoding utf8
=head1 NAME
upload.cgi - 鐃春ワ申鐃緒申鐃緒申離鐃緒申奪廛鐃緒申鐃緒申鐃�
=head1 VERSION
$Id: upload.cgi,v 0.2 2009/04/03 01:07:17 dankogai Exp dankogai $
=head1 INSTALL
鐃緒申鐃緒申鐃緒申名: your.example.org
CGI鐃緒申URI: http://your.example.org/cgi-bin/upload.cgi
CGI鐃緒申鐃緒申鐃瞬パワ申: /home/www/cgi-bin/upload.cgi
鐃緒申鐃獣プワ申鐃緒申鐃宿フワ申鐃緒申鐃緒申鐃術のデワ申鐃曙ク鐃夙ワ申: /home/www/htdocs/uploads
鐃緒申鐃獣プワ申鐃緒申鐃宿フワ申鐃緒申鐃緒申鐃�URI: http://your.example.org/uploads/file.txt
鐃緒申鐃緒申鐃所し鐃緒申鐃緒申隋�鐃淑駕申鐃塾とわ申鐃緒申任鐃緒申鐃�
=over 2
=item 1.
鐃旬フワ申鐃緒申鐃緒申鐃�
/home/www/cgi-bin/upload.cgi
鐃緒申鐃緒申存鐃緒申文鐃緒申鐃緒申鐃緒申鐃宿わ申UTF-8鐃叔￥申
=item 2.
鐃淑駕申鐃緒申$Dir 鐃緒申 $URI_Dir 鐃薯カワ申鐃緒申鐃殉ワ申鐃緒申
=cut
our $Dir = '/home/www/htdocs/uploads'; # 鐃渋際のデワ申鐃曙ク鐃夙ワ申
our $URI_Dir = '/uploads'; # uri鐃緒申表鐃緒申鐃緒申鐃緒申鐃叔ワ申鐃曙ク鐃夙ワ申
=pod
=item 3.
鐃旬フワ申鐃緒申鐃緒申鐃渋行駕申能鐃祝￥申
% chmod 0755 /home/www/cgi-bin/upload.cgi
=item 4.
鐃緒申鐃獣プワ申鐃緒申鐃宿デワ申鐃曙ク鐃夙ワ申虜鐃緒申鐃�
% mkdir /home/www/htdocs/uploads
% chdir 1777 /home/www/htdocs/uploads
=item 5.
鐃淑わ申戮鐃叔э申擇鬚�わ申鐃緒申
# .htaccess 鐃緒申鐃緒申; 鐃緒申鐃緒申肇鐃粛ットのみ居申鐃緒申
<Limit GET POST>
Order allow,deny
Allow from 127.0.0.1 10.0.0/8 172.16.0.0/12 192.168.0.0/16
Deny from all
</Limit>
<LimitExcept GET POST>
Order deny,allow
Deny from all
</LimitExcept>
鐃緒申鐃縮醐申鐃緒申鐃緒申鐃緒申噺鐃緒申鐃緒申鐃暑羽鐃旬になわ申任鐃緒申腓�鐃緒申
=back
=cut
our $VERSION = 0.01;
use CGI;
# use CGI::Carp qw/fatalsToBrowser warningsToBrowser/;
=head2 $Regexp_Fn
鐃春ワ申鐃緒申鐃緒申名鐃薯検証わ申鐃緒申鐃緒申鐃緒申表鐃緒申鐃叔わ申鐃緒申
=cut
our $Regexp_Fn = qr/\A([0-9A-Za-z_][0-9A-Za-z_\-\+\.]+)\z/;
{ # main
my $q = CGI->new;
check_sanity($q);
if ( $q->param('del') ) { # 鐃春ワ申鐃緒申鐃緒申探鐃盾ー鐃緒申
for my $fn ( $q->param('fn') ) {
$fn =~ $Regexp_Fn or next;
unlink "$Dir/$1";
}
redirect_self($q);
}
elsif ( my $fn = $q->param('fn') )
{ # 鐃春ワ申鐃緒申鐃暑ア鐃獣プワ申鐃緒申鐃宿モー鐃緒申
$fn =~ $Regexp_Fn or filename_error( $q, $fn );
$fn = $1; # untaint
# 鐃緒申鐃獣プワ申鐃緒申鐃宿緒申鐃緒申
open my $wfh, '>', "$Dir/$fn" or die "$Dir/$fn:$!";
my $rfh = $q->upload('fn');
my $content = do { local $/; <$rfh> };
print $wfh $content;
close $wfh;
redirect_self($q);
}
else {
show_form($q);
}
}
sub check_sanity {
return if -d $Dir and -w $Dir;
my $q = shift;
print $q->header( -charset => 'UTF-8', -status => 500 ), error_html(
qq{
鐃叔ワ申鐃曙ク鐃夙ワ申 "$Dir" 鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃所さ鐃緒申討泙鐃緒申鐃�
鐃淑駕申鐃塾ワ申鐃殉ワ申匹鬚�使わ申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
mkdir $Dir; chmod 1777 $Dir
鐃緒申 }
);
exit;
}
sub redirect_self {
my $q = shift;
print $q->redirect( -uri => $ENV{SCRIPT_NAME} );
exit;
}
sub filename_error {
my ( $q, $fn ) = @_;
print $q->header( -charset => 'UTF-8', -status => 500 ),
error_html(qq{鐃春ワ申鐃緒申鐃緒申名"$fn"鐃緒申鐃緒申鐃緒申鐃叔わ申鐃緒申});
exit;
}
sub show_form {
my $q = shift;
my %mtime;
opendir my $dh, $Dir or die "$Dir:$!";
for my $fn ( grep !/\A\./, sort readdir($dh) ) {
-f "$Dir/$fn" or next;
$mtime{$fn} = ( stat(_) )[9];
}
closedir $dh;
my @tr;
for my $fn ( sort { $mtime{$b} <=> $mtime{$a} } keys %mtime ) {
my $link = "$URI_Dir/$fn";
push @tr,
qq(<td>)
. qq(<input type="checkbox" name="fn" value="$fn">)
. qq(</td>)
. qq(<td><a href="$link">$fn</a></td>)
. qq(<td>)
. localtime( $mtime{$fn} )
. qq(</td>);
}
my $dirlist = join "\n", map { qq(<tr>$_</tr>) } @tr;
print $q->header( -charset => 'UTF-8' ), form_html($dirlist);
exit;
}
=head2 form_html
return <<"END_OF_HTML";
...
END_OF_HTML
鐃塾間わ申HTML鐃緒申
=cut
sub form_html {
my $title = $ENV{SCRIPT_NAME};
my $action = $ENV{SCRIPT_NAME};
my $dirlist = shift;
return <<"END_OF_HTML";
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
<form method="post" action="$action" enctype="multipart/form-data">
鐃緒申鐃獣プワ申鐃緒申鐃宿わ申鐃緒申侫鐃緒申鐃緒申鐃�:<input type="file" name="fn">
<input type="submit">
<h2>鐃緒申鐃獣プワ申鐃緒申鐃宿済みのフワ申鐃緒申鐃緒申:</h2>
<table border="1">
<thead>
<tr>
<td><input type="submit" name="del" value="鐃獣居申"></td>
<td>鐃春ワ申鐃緒申鐃緒申名:</td>
<td>鐃緒申鐃緒申:</td>
</tr>
</thead>
<tbody>$dirlist</tbody>
</table>
</form>
</body>
</html>
END_OF_HTML
}
=head2 error_html
return <<"END_OF_HTML";
...
END_OF_HTML
鐃塾間わ申HTML鐃緒申
=cut
sub error_html {
my $msg = shift;
my $title = $ENV{SCRIPT_NAME} . ":error";
return <<"END_OF_HTML";
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
$msg
<table border="1">
</body>
</html>
END_OF_HTML
}
鐃緒申鐃塾ブワ申鐃緒申鐃祝ワ申鐃緒申鐃夙わ申鐃緒申砲鐃�鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申必鐃竣でわ申鐃緒申
鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
鐃緒申鐃塾居申鐃緒申鐃祝は居申鐃縦ユー鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃夙わ申鐃叔わ申鐃殉わ申鐃緒申