#!/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; # . が2つ以上ある場合のために 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"> 登録者ID(メールアドレスを入力してください。)<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 " ファイル名 ", "登録者ID 登録日 サイズ アクセス\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); }