#!/usr/local/bin/perl5
#
# osl.cgi
#
# Copyright (C) 1998-2000 がま <gama@mvg.biglobe.ne.jp>
#
# 1998/12/10 Ver.0.00
# 1999/01/12 Ver.0.05
# 1999/01/30 Ver.0.06
# 1999/02/17 Ver.0.07 gzip & gunzip 化
# 1999/02/21 Ver.0.09
# 1999/02/22 Ver.0.10 error 時に 戻るボタンを追加
# 1999/02/26 Ver.0.12
# 1999/02/27 Ver.0.13
# 1999/11/06 Ver.0.14
# 2000/05/26 Ver.0.15
# $readonly を追加 $ownname を自動設定
# ファイル名のチェックを追加
#
# ---------------------------------------------------------------------
$copyright ='osl.cgi Ver.0.15 Copyright (C) 1998-2000 gama';
# ---------------------------------------------------------------------
$readonly = 0; # readonly flag
require 'osl.env';
# ---------------------------------------------------------------------
$sep ='>';
$LOCK_SH = 1; # 共有ロック
$LOCK_EX = 2; # 排他的にロック
# ---------------------------------------------------------------------
$ownname="http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";
# YY/MM/DD ------------------------------------------------------------
my($sec,$min,$hour,$mday,$mon,$year)=localtime;
$date = sprintf("%2.2d\/%2d\/%2d",$year%100,$mon+1,$mday);
# ---------------------------------------------------------------------
{
$|=1;
&html_head;
if ($ENV{'CONTENT_LENGTH'} > $maxsize ) {
&err_html("ファイルサイズが制限値(約 $maxsize byte)を超えました。");
exit;
}
# -----------------------------------------------------------------
# CONTENT_TYPE から boudary 文字列を取出す ----------------------------
# CONTENT_TYPE の例.
# multipart/form-data; boundary=---------------------------123456789012345
# ---------------------------------------------------------------------
($type, $boundary) = split(';',$ENV{'CONTENT_TYPE'},2);
if ( $type eq 'multipart/form-data' ) {
&upload unless $readonly;
} else {
&osllist;
}
exit;
}
# -------------------------------------------------------------------------
sub upload {
(undef,$boundary) = split('=',$boundary,2); #
binmode(STDIN); # for DOS
read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
# mail addr -----------------------------------------------------------
(undef,@up) = split('--'.$boundary,$in);
(undef,@line) = split("\n",$up[0]);
chomp($line[2]);
$mailadr = &str_conv_for_html($line[2]);
unless ($mailadr) { # email addr がないとき Error
&err_html("E-Mail アドレスが入力されていません。");
exit;
}
unless ($mailadr =~ /^[\w\-\_\.]+@[\w\-\_]+(\.[\w\-\_]+)+$/ ) {
&err_html("E-Mail アドレスの形式がエラーになりました。");
exit;
}
# ファイル名 と ファイル本体 --b---------------------------------------
(undef,$line[0],$line[1],undef,$output) =split("\n",$up[1],5);
$filename = $line[0].$line[1];
$filename =~ s/^.*filename=\"(.*)\".*$/$1/;
if ( $filename =~ /.*\\(.*)/ ) {
$filename = $1;
}
unless ($filename=~ /^[\w\.-_]*$/ ) {
&err_html("ファイル名に使えない文字が含まれています。($filename)");
exit;
}
$filename ="\L$filename\E"; # ファイル名を小文字化
$fileexp = $filename; # 拡張子を取り出す
while ( $fileexp =~ /.*\.(.*)/ ) {
$fileexp = $1; # . が２つ以上ある場合のために loop
}
if (-e "$datadir$filename$gz" ) {
&err_html("ファイル名が登録済のものと重複しています。($filename)");
exit;
}
# ファイル本体 を書き出す ---------------------------------------------
unless (open(OUTFILE, "|$gzip > $datadir$filename$gz")) { # open
&err_html("Can't open outfile.");
exit;
}
binmode(OUTFILE); # for DOS
print OUTFILE $output;
close OUTFILE; # close
$filesize = length($output);
# コメント ------------------------------------------------------------
(undef,@line) =split("\n",$up[2]);
chomp($line[2]);
$comment = &str_conv_for_html($line[2]);
# fileno. -------------------------------------------------------------
unless (open(FCTR,"+<$ctrfile")) { # open
&err_html("Can't open ctrfile($ctrfile).");
exit;
}
flock(FCTR,$LOCK_EX) if $useflock; # 排他ロック
$fileno=<FCTR>+1;
seek(FCTR, 0, 0);
printf(FCTR "%d", $fileno);
# 情報ファイルへ書き出す ----------------------------------------------
unless (open(INFO,"+<$infofile")) { # open
&err_html("Can't open infofile($infofile).");
exit;
}
flock(INFO,$LOCK_EX) if $useflock; # 排他ロック
@infobuf = <INFO>; # 丸ごと入力
if ( @infobuf > $filemax ) {
my($rec) = pop(@infobuf);
my($delno,$delfile) = split($sep,$rec,2);
unlink($datadir.$delfile.$gz); # 削除
unlink($infodir.'dl'.$delno.'.dat'); # 削除
}
seek(INFO, 0, 0); # ファイルの先頭へ移動
truncate(INFO, 0); # ファイルの長さを 0 へ
$rec = join($sep, $fileno, $filename, $mailadr, $date, $filesize, $comment);
print INFO $rec,"\n";
print INFO @infobuf;
# DownLoad Counter を新設 ---------------------------------------------
my($dlctrfile)=$infodir.'dl'.$fileno.'.dat';
open(DLCTR,">$dlctrfile"); # open
flock(DLCTR,$LOCK_EX) if $useflock; # 排他ロック
print DLCTR 0;
#----------------------------------------------------------------------
close(DLCTR); # close
close(INFO); # close
close(FCTR); # close
# 結果を表示する (gif,jpg) --------------------------------------------
print "<BLOCKQUOTE>\n<PRE>\n";
&disp_head;
&disp_rec;
print "</PRE>\n</BLOCKQUOTE>\n<BR>\n";
if ($fileexp =~ /^(gif|jpg|jpeg)$/ ) { # 画像は結果を表示する｡
print '<IMG SRC="', $dl_cgi, '?n&', $fileno, '&', $filename, '">';
}
print <<END;
<HR>
<CENTER><A HREF="$ownname">| 戻る |</A></CENTER>
END
&html_tail;
}
# ---------------------------------------------------------------------
sub osllist {
# -----------------------------------------------------------------
print <<END;
<CENTER><A HREF="$backurl">| 終了 |</A></CENTER>
<HR>
<BLOCKQUOTE>
<PRE>
END
&disp_head;
open(INFO,"+<$infofile");
flock(INFO,$LOCK_SH) if $useflock; # 共有ロック
while (<INFO>) {
$filenum++;
chomp;
($fileno, $filename, $mailadr, $date, $filesize, $comment )
= split('>');
my($dlctrfile)=$infodir."dl".$fileno.".dat";
open(DLCTR,"+<$dlctrfile");
flock(INFO,$LOCK_SH) if $useflock; # 共有ロック
$dlctr=<DLCTR>;
close(DLCTR);
&disp_rec;
}
close INFO;
# -----------------------------------------------------------------
print <<END;
</PRE>
</BLOCKQUOTE>
<HR>
<CENTER><A HREF="$backurl">| 終了 |</A></CENTER>
END
&upload_form;
&html_tail;
}
# ----------------------------------------------------------------------------
sub upload_form {
return if $readonly;
&get_cookie;
if ($maxsize > 100000) {
$maxsizestr = $maxsize/1000000 . 'MByte';
$maxsizemsg=
'・アップロードのファイルの大きさの上限は 約 '
. $maxsizestr
. ' に設定されています。<BR>';
} else {
$maxsizestr = $maxsize/1000 . 'KByte';
$maxsizemsg=
'・大きなファイルはアップロードできません。（現在の上限は 約 '
. $maxsizestr
.' に設定されています。）<BR>';
}
print <<END;
<HR>
<BLOCKQUOTE>
<B>登録</B><BR>
<BR>
・ファイル名は、英数字などの ASCII 文字に限ります。日本語などの 2byte 文字を使わないで下さい。<BR>
$maxsizemsg
<FORM METHOD="POST" ACTION="$ownname" ENCTYPE="multipart/form-data">
登録者ＩＤ（メールアドレスを入力してください。）<BR>
<INPUT NAME="e-mail" TYPE="text" SIZE=30 VALUE="$email"><P>
ファイル<BR>
<INPUT NAME="filename" TYPE="file" SIZE=70><P>
コメント<BR>
<INPUT NAME="comm" TYPE="text" SIZE=70 MAXLENGTH=70><P>
<INPUT TYPE="submit" VALUE="UpLoad"><P>
</FORM>
</BLOCKQUOTE>
END
}
# ----------------------------------------------------------------------------
sub disp_head {
print '<B>',$oslname,'</B>',"\n\n";
print " ファイル名 ",
"登録者ＩＤ 登録日 サイズ アクセス\n\n";
}
# ----------------------------------------------------------------------------
sub disp_rec {
my($name);
($name,undef) = split('@',$mailadr,2);
printf "%5d.<A HREF=\"$dl_cgi?c&%d&%s\">%-19.19s<\/A> "
."<A HREF=\"mailto:%s\">%-9.9s<\/A> %s %07d %07d\n",
$fileno,
$fileno,
$filename, # link 用
"\U$filename\E", # 表示用 filename 大文字化
$mailadr,
"\U$name\E", # 表示用 name 大文字化
$date,
$filesize,
$dlctr;
print " ($comment)\n\n";
}
# ----------------------------------------------------------------------------
sub html_head {
print "Content-type: text/html\n\n";
print '<HTML><HEAD><TITLE>',$oslname,'</TITLE></HEAD>',"\n";
print '<BODY BGCOLOR="#FFFFFF"><HR>',"\n";
print $head;
}
# ----------------------------------------------------------------------------
sub html_tail {
print '<HR>',"\n";
print $tail;
print '<A HREF="http://www2d.biglobe.ne.jp/~gama/cgi/index.cgi">';
print $copyright;
print '</A>';
print '<BR>mode:readonly' if $readonly;
print '</BODY></HTML>';
}
# ----------------------------------------------------------------------------
sub err_html {
my($errmsg)=$_[0]; # サブルーチンの引数
print <<END;
<PRE><BLOCKQUOTE>$errmsg</BLOCKQUOTE></PRE>
<HR>
<CENTER><A HREF="$ownname">| 戻る |</A></CENTER>
<HR>
END
}
# ---------------------------------------------------------------------
sub get_cookie {
my(@cookie) = split("; ", $ENV{'HTTP_COOKIE'});
my($cname, $value);
foreach (@cookie) {
($cname, $value) = split("=", $_);
if ($cname eq "NickName") {
($name,$email,$hp) = split("&",$value); # フィールド毎に分割
}
}
$name = &str_decode_cookie($name);
$email = &str_decode_cookie($email);
$hp = &str_decode_cookie($hp);
}
# ---------------------------------------------------------------------
sub str_conv_for_html {
local($str)=$_[0]; # サブルーチンの引数を
$str=~ s/&/&/g; # &
$str=~ s/</</g; # <
$str=~ s/>/>/g; # >
$str=~ s/\r//g; # \r
$str=~ s/\n//g; # \n
return($str);
}
# ---------------------------------------------------------------------
sub str_decode_cookie {
local($str)=$_[0]; # サブルーチンの引数を
$str=~ s/^\w+=//; # = までを削除・・・
$str=~ s/%(..)/pack("c",hex($1))/ge; # decode
return($str);
}