Perl・CGI入門/ファイルアップローダ/ログファイル作成
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
単語検索
|
最終更新
|
ヘルプ
|
ログイン
]
開始行:
''[[FrontPage]]''
* 自作ファイルアップローダのログファイル生成部 [#ea58f06a]
実際に作成したソースコードを公開します。~
掲示板と同様、機能の観点でファイルを2つに分けています。~
それぞれ、表(HTML出力部: dfh.cgi)と裏(ログファイル作成部:...
ここではログの生成に特化したwrite.cgiを、コメント中にて解...
~
~
ファイル名: write_f_r2.cgi
#!/usr/bin/perl
use warnings; ...
use strict; ...
use CGI; ...
...
require './jcode.pl'; ...
require './idroll.pl'; ...
...
# URL Decode *******************************************...
my $cgi = CGI::new(); ...
...
my $name = ""; ...
my $comment = ""; ...
my $infile = ""; ...
my $pwd = ""; ...
my $url = ""; ...
my $curl = ""; ...
my $mssid = ""; ...
...
$name = $cgi->param('name'); ...
$comment = $cgi->param('comment'); ...
$infile = $cgi->param('file'); ...
$pwd = $cgi->param('pwd'); ...
$url = $curl = $cgi->param('url'); ...
$mssid = $cgi->param('mssid'); ...
...
$name =~ s/<br>//g; ...
$comment =~ s/<br>//g; ...
...
jcode::h2z_sjis( \$name ); ...
jcode::h2z_sjis( \$comment ); ...
#/URL Decode *******************************************...
# ERR Check ********************************************...
my $size = 0; ...
my $filename = ""; ...
my @path = (""); ...
...
$size = (-s $infile); ...
...
if( $ENV{'HTTP_USER_AGENT'} =~ /Win/ || ...
$ENV{'HTTP_USER_AGENT'} =~ /win/ ) ...
{ ...
@path = split( /\\/, $infile ); ...
} ...
else ...
{ ...
@path = split( /\//, $infile ); ...
} ...
...
$filename = pop( @path ); ...
$filename = "./attach/" . $filename; ...
...
if( ...
$infile eq "" || ...
$pwd ne "****" || ...
(-e $filename) || ...
(-s $infile > (5 * 1024 * 1024)) || ...
($size == 0) || !(-e $infile) || ...
(($mssid > 1024 || $mssid < 1) && $mssid ne '****') ...
) ...
{ ...
print "Location: http://bj006.com/cgi/error3.htm"."\...
} ...
elsif( !index( $ENV{'HTTP_REFERER'}, "http://bj006.com/c...
!index( $ENV{'HTTP_REFERER'}, "http://www.bj006.com/...
{ ...
print "Location: http://bj006.com/cgi/error9.htm"."\...
} ...
else ...
{ ...
#/ERR Check ********************************************...
# Write Log File then Move *****************************...
# Get Time *********************************************...
my ($sec, $min, $hour) = (0, 0, 0); ...
my ($day, $mon, $year) = (0, 0, 0); ...
my ($weeko, $yday, $isdat) = (0, 0, 0); ...
my $time = ""; ...
my @weeka = ( 'Sun','Mon','Tue','Wed','Thu','Fri','S...
...
($sec,$min,$hour,$day,$mon,$year,$weeko,$yday,$isdat...
$mon++; ...
$year += 1900; ...
$time = sprintf( "%04d-%02d-%02d (%s) %02d:%02d:%02d...
$year,$mon,$day,$weeka[$weeko],$hour,$mi...
#/Get Time *********************************************...
# Get ID ***********************************************...
my $mystr = ""; ...
...
if( $mssid ne '****' ) ...
{ ...
$mystr = idroll::roll( $mssid - 1 ); ...
} ...
else ...
{ ...
$mystr = '<b><font color="#00FF00">Hermit Webmas...
} ...
#/Get ID ***********************************************...
# GET IP and Host **************************************...
my $ipaddr = ""; ...
my $host = ""; ...
...
$ipaddr = $ENV{'REMOTE_ADDR'}; ...
$host = gethostbyaddr( pack("C4", $ipaddr), 2 ) || $...
#/GET IP and Host **************************************...
while($size =~ s/(.*\d)(\d\d\d)/$1,$2/){} ...
...
open( OUTFO, ">$filename" ) ...
or print "Location: http://bj006.com/cgi/error2....
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/error2....
binmode( OUTFO ); ...
...
while( <$infile> ) ...
{ ...
print OUTFO $_; ...
} ...
...
close( OUTFO ); ...
close( $infile ) if ($CGI::OS ne 'UNIX'); ...
# close( $infile ); ...
...
$filename =~ s/.\/attach\///; ...
...
if( index( $url, 'http://' ) < 0 ) ...
{ ...
$url = $curl = 'http://'; ...
} ...
...
if( $url eq 'http://' ) ...
{ ...
$url = 'URL'; ...
} ...
else ...
{ ...
$url = "<a href=\""."$url"."\">URL</a>"; ...
} ...
...
open LOGW, ">>./filelog.txt" ...
or print "Location: http://bj006.com/cgi/error2....
flock( LOGW, 2 ) ...
or print "Location: http://bj006.com/cgi/error2....
print LOGW "$name#@#$comment#@#$filename#@#$size#@#"...
"$url#@#$mystr#@#$time#@#$ipaddr#@#$h...
close( LOGW ); ...
# Set Cookie *******************************************...
my $target = 0; ...
my ($gsec, $gmin, $ghour) = (0, 0, 0); ...
my ($gday, $gmon, $gyear) = (0, 0, 0); ...
my ($gweeko, $gyday, $gisdat) = (0, 0, 0); ...
my @gmona = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun...
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'De...
my $expire = ""; ...
my $cs = ""; ...
...
$target = time() + (60 * 60 * 24 * 90); ...
($gsec,$gmin,$ghour,$gday,$gmon,$gyear,$gweeko,$gyda...
$gyear += 1900; ...
...
$expire = sprintf( "%s, %02d-%s-%04d %02d:%02d:%02d ...
$weeka[$gweeko], $gday, $gmona[$gmon],...
$gyear, $ghour, $gmin, $gsec ); ...
...
$cs = "$name#@#$curl#@#$mssid#@#"; ...
...
print "Set-cookie:$cs; expires=$expire\n"; ...
#/Set Cookie *******************************************...
print "Location: http://bj006.com/cgi/dfh/dfh.cgi"."...
} ...
#/Write Log File then Move *****************************...
exit; ...
** 関連ページ [#o43acf5b]
[[Perl・CGI入門/パッケージを使う/ID Roll]]~
[[Perl・CGI入門/ファイルアップローダ/HTML出力]]
** 修正履歴 [#g98babae]
#attach( [nolist] ,[noform])
*** 参考ページ [#bffcccc6]
http://www.perl-labo.org/~
http://perl.misty.ne.jp/~
[[Perlメモ/CGIモジュール:http://digit.que.ne.jp/work/inde...
終了行:
''[[FrontPage]]''
* 自作ファイルアップローダのログファイル生成部 [#ea58f06a]
実際に作成したソースコードを公開します。~
掲示板と同様、機能の観点でファイルを2つに分けています。~
それぞれ、表(HTML出力部: dfh.cgi)と裏(ログファイル作成部:...
ここではログの生成に特化したwrite.cgiを、コメント中にて解...
~
~
ファイル名: write_f_r2.cgi
#!/usr/bin/perl
use warnings; ...
use strict; ...
use CGI; ...
...
require './jcode.pl'; ...
require './idroll.pl'; ...
...
# URL Decode *******************************************...
my $cgi = CGI::new(); ...
...
my $name = ""; ...
my $comment = ""; ...
my $infile = ""; ...
my $pwd = ""; ...
my $url = ""; ...
my $curl = ""; ...
my $mssid = ""; ...
...
$name = $cgi->param('name'); ...
$comment = $cgi->param('comment'); ...
$infile = $cgi->param('file'); ...
$pwd = $cgi->param('pwd'); ...
$url = $curl = $cgi->param('url'); ...
$mssid = $cgi->param('mssid'); ...
...
$name =~ s/<br>//g; ...
$comment =~ s/<br>//g; ...
...
jcode::h2z_sjis( \$name ); ...
jcode::h2z_sjis( \$comment ); ...
#/URL Decode *******************************************...
# ERR Check ********************************************...
my $size = 0; ...
my $filename = ""; ...
my @path = (""); ...
...
$size = (-s $infile); ...
...
if( $ENV{'HTTP_USER_AGENT'} =~ /Win/ || ...
$ENV{'HTTP_USER_AGENT'} =~ /win/ ) ...
{ ...
@path = split( /\\/, $infile ); ...
} ...
else ...
{ ...
@path = split( /\//, $infile ); ...
} ...
...
$filename = pop( @path ); ...
$filename = "./attach/" . $filename; ...
...
if( ...
$infile eq "" || ...
$pwd ne "****" || ...
(-e $filename) || ...
(-s $infile > (5 * 1024 * 1024)) || ...
($size == 0) || !(-e $infile) || ...
(($mssid > 1024 || $mssid < 1) && $mssid ne '****') ...
) ...
{ ...
print "Location: http://bj006.com/cgi/error3.htm"."\...
} ...
elsif( !index( $ENV{'HTTP_REFERER'}, "http://bj006.com/c...
!index( $ENV{'HTTP_REFERER'}, "http://www.bj006.com/...
{ ...
print "Location: http://bj006.com/cgi/error9.htm"."\...
} ...
else ...
{ ...
#/ERR Check ********************************************...
# Write Log File then Move *****************************...
# Get Time *********************************************...
my ($sec, $min, $hour) = (0, 0, 0); ...
my ($day, $mon, $year) = (0, 0, 0); ...
my ($weeko, $yday, $isdat) = (0, 0, 0); ...
my $time = ""; ...
my @weeka = ( 'Sun','Mon','Tue','Wed','Thu','Fri','S...
...
($sec,$min,$hour,$day,$mon,$year,$weeko,$yday,$isdat...
$mon++; ...
$year += 1900; ...
$time = sprintf( "%04d-%02d-%02d (%s) %02d:%02d:%02d...
$year,$mon,$day,$weeka[$weeko],$hour,$mi...
#/Get Time *********************************************...
# Get ID ***********************************************...
my $mystr = ""; ...
...
if( $mssid ne '****' ) ...
{ ...
$mystr = idroll::roll( $mssid - 1 ); ...
} ...
else ...
{ ...
$mystr = '<b><font color="#00FF00">Hermit Webmas...
} ...
#/Get ID ***********************************************...
# GET IP and Host **************************************...
my $ipaddr = ""; ...
my $host = ""; ...
...
$ipaddr = $ENV{'REMOTE_ADDR'}; ...
$host = gethostbyaddr( pack("C4", $ipaddr), 2 ) || $...
#/GET IP and Host **************************************...
while($size =~ s/(.*\d)(\d\d\d)/$1,$2/){} ...
...
open( OUTFO, ">$filename" ) ...
or print "Location: http://bj006.com/cgi/error2....
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/error2....
binmode( OUTFO ); ...
...
while( <$infile> ) ...
{ ...
print OUTFO $_; ...
} ...
...
close( OUTFO ); ...
close( $infile ) if ($CGI::OS ne 'UNIX'); ...
# close( $infile ); ...
...
$filename =~ s/.\/attach\///; ...
...
if( index( $url, 'http://' ) < 0 ) ...
{ ...
$url = $curl = 'http://'; ...
} ...
...
if( $url eq 'http://' ) ...
{ ...
$url = 'URL'; ...
} ...
else ...
{ ...
$url = "<a href=\""."$url"."\">URL</a>"; ...
} ...
...
open LOGW, ">>./filelog.txt" ...
or print "Location: http://bj006.com/cgi/error2....
flock( LOGW, 2 ) ...
or print "Location: http://bj006.com/cgi/error2....
print LOGW "$name#@#$comment#@#$filename#@#$size#@#"...
"$url#@#$mystr#@#$time#@#$ipaddr#@#$h...
close( LOGW ); ...
# Set Cookie *******************************************...
my $target = 0; ...
my ($gsec, $gmin, $ghour) = (0, 0, 0); ...
my ($gday, $gmon, $gyear) = (0, 0, 0); ...
my ($gweeko, $gyday, $gisdat) = (0, 0, 0); ...
my @gmona = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun...
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'De...
my $expire = ""; ...
my $cs = ""; ...
...
$target = time() + (60 * 60 * 24 * 90); ...
($gsec,$gmin,$ghour,$gday,$gmon,$gyear,$gweeko,$gyda...
$gyear += 1900; ...
...
$expire = sprintf( "%s, %02d-%s-%04d %02d:%02d:%02d ...
$weeka[$gweeko], $gday, $gmona[$gmon],...
$gyear, $ghour, $gmin, $gsec ); ...
...
$cs = "$name#@#$curl#@#$mssid#@#"; ...
...
print "Set-cookie:$cs; expires=$expire\n"; ...
#/Set Cookie *******************************************...
print "Location: http://bj006.com/cgi/dfh/dfh.cgi"."...
} ...
#/Write Log File then Move *****************************...
exit; ...
** 関連ページ [#o43acf5b]
[[Perl・CGI入門/パッケージを使う/ID Roll]]~
[[Perl・CGI入門/ファイルアップローダ/HTML出力]]
** 修正履歴 [#g98babae]
#attach( [nolist] ,[noform])
*** 参考ページ [#bffcccc6]
http://www.perl-labo.org/~
http://perl.misty.ne.jp/~
[[Perlメモ/CGIモジュール:http://digit.que.ne.jp/work/inde...
ページ名: