#! c:/perl/bin/perl # # updown.cgi # # Ver. 2.071 : 1/25/06 : ローカルタイムモードを追加 # Ver. 2.070 : 11/14/05 : アップファイル名の処理を修正 # Ver. 2.069 : 10/6/05 : メンバー専用パスワードを追加 # Ver. 2.068 : 10/1/05 : Copyrightにリンクを追加 # Ver. 2.067 : 9/24/05 : 拡張子を省略した場合元の拡張子を使うように修正 # Ver. 2.066 : 9/22/05 : Headerにcharsetを追加 # Ver. 2.065 : 9/10/05 : アップロード禁止モードを追加 # Ver. 2.064 : 8/28/05 : アップロード方法を変更 # Ver. 2.063 : 8/25/05 : アップ後のファイル名にハイフンを許可するように変更 # jcode.pl, cgi-lib.plを削除。cryptを変更。 # Ver. 2.062 : 2/19/05 : リンククリック時のオプションを追加 # Ver. 2.061 : 2/6/05 : Locationを修正 # Ver. 2.06 : 1/14/05 : リストファイルにホスト名を記録するように修正 # Ver. 2.05 : 4/14/03 : セットアップ画面追加 # ソースの構造を変更 # コピーライトの年数表示を修正 # Ver. 2.04 : 3/31/03 : アップファイル最大サイズ設定追加 # 削除したときリストファイルから改行が抜けるバグを修正 # トップへのリンクを追加 # Ver. 2.03 : 3/25/03 : 著作権表記を追加 # セットアップファイルを使えるように変更 # Ver. 2.02 : 3/24/03 : パスワード作成失敗エラー処理を追加 # Ver. 2.01 : 1/28/03 : ＩＥで正しくアップロードできなかったのを修正 # Ver. 2.0 : 11/24/02 : パスワード機能を追加 # showdllst.plとwrdllst.plをupdown.cgiの一つに統合 # # $Id: updown.cgi,v 1.26 2006/01/25 04:13:08 Hideki Kanayama Exp $ # Copyright(c) 2002-2005 Hideki Kanayama All rights reserved use strict; use CGI qw(:cgi-lib); use CGI::Carp qw(fatalsToBrowser); use File::Copy; use File::Basename; my $version = "2.071"; my $lastmodifiedyear = "2006"; my$admindat = "adminpwd.dat"; my $setupfile = "updown_setup.pl"; my $script = basename($0); my $charset = "Shift_JIS"; my $lang = 1; ############# 環境設定ここから ######################## our $dldir = "../updown"; our $dllistfile = "$dldir/updown.lst"; # バックグラウンド設定 our $bgimage_en = 1; our $bgimagefile="$dldir/sample.jpg"; our $bgcolor="ffffff"; #タイトル our $title = 'アップダウン'; #トップへのリンク our $toplink_en = 1; our $toplink_link = "../updown.html"; our $toplink_title = 'トップへ'; # リンククリック時 0:同じウィンドウ、1:別ウィンドウ、2:指定拡張子のみ別ウィンドウ our $link_target = 0; our $link_extention = "jpg gif png"; # 半角スペースで区切る # アップロード禁止な拡張子 our $prohibit_en = 1; our $prohibit_extention = "cgi pl csh sh"; # 半角スペースで区切る #アップファイル最大サイズ(ＭＢ) our $maxsize2 = 10; #メンバー専用パスワード 1:on 0:off our $member_only = 0; our $member_pwd = '12345'; #スタイルシート our $style_sheet_en = 1; our $style_sheet = ' '; #挿入文 our $head_insert_en = 0; our $head_insert = ''; # 時間設定 our $localtime_en = 1; our $offset_from_gmt = 9; ############# 環境設定ここまで ######################## if (-e "$setupfile"){ require "$setupfile"; } my $bgset; if ($bgimage_en == 1){ $bgset = "background=\"$bgimagefile\""; } else { $bgset = "bgcolor=\"$bgcolor\""; } $CGI::POST_MAX = $maxsize2 * 1048576; my $maxsize = $CGI::POST_MAX; if ($maxsize > 1048576){ $maxsize = sprintf("%.1fMB",$maxsize/1048576); } elsif ($maxsize > 1024){ $maxsize = sprintf("%.1fkB",$maxsize/1024); } else { $maxsize = sprintf("%dB",$maxsize); } my $q = new CGI; my $cgierror = $q->cgi_error; &error($cgierror) if ($cgierror); my %in = $q->Vars; while (my ($key,$value)=each %in){ if ($key ne 'upfile'){ $value =~ s//>/g; my $br; if ($key eq 'style_sheet' || $key eq 'head_insert'){ $br = "
"; } else { $br = ""; } if ($value =~ /\r\n/) { $value =~ s/\r\n/$br/g; } if ($value =~ /\n/) { $value =~ s/\n/$br/g; } if ($value =~ /\r/) { $value =~ s/\r/$br/g; } if ($value =~ /,/) { $value =~ s/,/&\#44;/g; } $in{"$key"}=$value; } } if (! -e "$admindat"){ if ($in{mode} ne 'adminpwd'){ &setadminpwd; } else { &wradminpwd; } } if ($in{mode} eq 'register'){ ®ister; } elsif ($in{mode} eq 'delete'){ &delete; } elsif ($in{mode} eq 'setup'){ &setup; } elsif ($in{mode} eq 'wrsetup'){ &wrsetup; } else { &display; } ################## 登録 ########################### sub register { if ($in{'sub'} eq "" || $in{'upfile'} eq "") { &error("$in{sub}:$in{upfile}:タイトル、またはファイル名を正しく入れてください。"); } if ($in{'pwd'} eq "") { &error("削除用パスワードを正しく入れてください。"); } &error("メンバー用パスワードが違います。") if ($in{member_pwd} ne $member_pwd and $member_only == 1); my $fname; my $upfile = $q->param('upfile'); my ($tmp1, $tmp2, $orgext) = fileparse($upfile,'\.[^\.]*?$'); if ($in{'fname'} eq ""){ $fname = basename($upfile); } else { $fname=$in{'fname'}; } $fname =~ s/^.+[\/\\]([^\/\\]+)$/$1/; #just in case $fname .= "$orgext" if ($fname !~ /\.[^\.]*?$/); if ($fname !~ /^[\w\.\-]+$/) { &error("$fname:アップ後のファイル名は半角英数、ドット、ハイフン、アンダースコアで。"); } my @suffix_list = split /\s+/, $prohibit_extention; my ($body_name, $path_name, $suf_name) = fileparse($fname,@suffix_list); if ($suf_name and $prohibit_en){ &error("$suf_nameの拡張子ではアップロードが禁止されています。"); } my $outfile = "$dldir/$fname"; if (-e "$outfile") { &error("同じファイル名がサーバー上に存在します。
アップ後のファイル名を変更してやり直してください。"); } my $fh = $q->upload('upfile'); my $cgierror = $q->cgi_error; &error($cgierror) if (!$fh && $cgierror); copy ($fh, $outfile) or &error('アップロードに失敗しました'); close($fh); chmod (0666,$outfile); my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$outfile"); my $size; if ($d_size > 1048576){ $size = sprintf("%.1fMB",$d_size/1048576); } elsif ($d_size > 1024){ $size = sprintf("%.1fkB",$d_size/1024); } else { $size = sprintf("%dB",$d_size); } open(DLFILE,"< $dllistfile"); my $count; my @dummy; while(){ ($count,@dummy)=split(/,/); } close(DLFILE); $count++; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= $localtime_en ? localtime($d_mtime) : gmtime($d_mtime+$offset_from_gmt*3600); my $update = sprintf("%s年%s月%s日%02s時%02s分",$year+1900,$mon+1,$mday,$hour,$min); my $remote_host=$ENV{'REMOTE_HOST'}; my $remote_addr=$ENV{'REMOTE_ADDR'}; my $encpwd = &makecrypt($in{pwd}); open(DAT,">> $dllistfile"); print DAT "$count,$fname,$in{sub},$size,$update,$encpwd,$remote_host,$remote_addr\n"; close(DAT); chmod(0666,"$dllistfile"); print "Location: $script\n\n"; } ######################　削除　######################### sub delete { if ($in{'deletefile'} == 0) { &error("削除するタイトルを選んでください。"); } my $delnumber = $in{deletefile}; if ($in{'pwd'} eq "") { &error("削除用パスワードを正しく入れてください。"); } my @newlist=(); open(DLFILE,"< $dllistfile"); while(){ chomp; my ($count,$file,$title,$size,$update,$pwd,$host,$addr)=split(/,/); if ($count == $delnumber){ if ((&checkcrypt($in{pwd},"$pwd") && ($pwd ne '')) || &checkcrypt($in{pwd},&adminpwd)){ unlink("$dldir/$file"); } else { &error("パスワードが違います。"); } } else { push(@newlist,"$_\n"); } } close(DLFILE); open(DAT,"> $dllistfile"); print DAT @newlist; close(DAT); print "Location: $script\n\n"; } ##############################　セットアップ　################################ sub setup { if ($in{'pwd'} eq "") { &error("管理用パスワードを正しく入れてください。"); } if (!&checkcrypt($in{pwd},&adminpwd)){ &error("パスワードが違います。"); } &beginning; my @bgimage_check; my @toplink_check; my @head_insert_check; my @style_sheet_check; my @link_target_check; my @prohibit_check; my @member_only_check; my @localtime_check; $bgimage_check[$bgimage_en] = "checked"; $toplink_check[$toplink_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; $style_sheet_check[$style_sheet_en] = "checked"; $link_target_check[$link_target] = "checked"; $prohibit_check[$prohibit_en] = "checked"; $member_only_check[$member_only] = "checked"; $localtime_check[$localtime_en] = "checked"; print <
  • ディレクトリ、ファイルの設定は、$scriptから見た相対パス、又は絶対パスで指定してください。ＣＧＩと同じディレクトリの場合、.（半角ドット）でＯＫです。バックグランドファイルやロゴファイルはhttp://からのリンクの指定も可能\です。
  • 管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。
  • これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。
  • $scriptがバージョンアップされた場合、単純に$scriptだけを置き換えるだけで設定はそのまま使えます。
  • $admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。
  • 管理人パスワードで他人の登録ファイルを削除することができます。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
データディレクトリ
データファイル
バックグランド 画像を使う カラー設定にする
画像を使う場合の画像ファイル
カラー設定の場合のカラー番号（白：\#ffffff 又は white）
タイトル
トップへのリンク表\示 有り 無し
トップのリンク先
リンク名
アップファイルのリンククリック時 同じウィンドウ 別ウィンドウ 指定の拡張子のみ別ウィンドウ
拡張子半角スペースで区切ってください
アップロード禁止 無効 有効
拡張子半角スペースで区切ってください
アップファイル最大サイズ ＭＢ
メンバー用パスワード 有効 無効
メンバー用パスワード（半角英数で）
<head>内挿入文 有効 無効
ＨＴＭＬ書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。
スタイルシート 有効 無効
時間設定 GMTからのオフセット ローカルタイム
GMTからのオフセットに設定した場合、GMTより時間(日本：+9時間)
 
SETUPWIN &ending; } ##############################　セットアップ作成　############################ sub wrsetup { if ($in{'pwd'} eq "") { &error("管理用パスワードを正しく入れてください。"); } if (!&checkcrypt($in{pwd},&adminpwd)){ &error("パスワードが違います。"); } my @nodecode=('style_sheet','head_insert'); foreach (@nodecode){ $in{$_} =~ s/
/\n/g; $in{$_} =~ s/<//g; $in{$_} =~ s/,/,/g; } open(FILE,"> $setupfile") || error('$セットアップファイルを作成できません。$setupfileのディレクトリのパーミッションを確認してください。'); print FILE <挿入文 \$head_insert_en = $in{head_insert_en}; \$head_insert = '$in{head_insert}'; #時間設定 \$localtime_en = $in{localtime_en}; \$offset_from_gmt = $in{offset_from_gmt}; ############# 環境設定ここまで ######################## 1; END close(FILE); print "Location: $script\n\n"; } ##############################　表示　################################ sub display { open(FILE,"< $dllistfile"); my @alldata=; close(FILE); my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$dllistfile"); my @monarray=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= $localtime_en ? localtime($d_mtime) : gmtime($d_mtime+$offset_from_gmt*3600); my $date_str = sprintf("%s %02d, %s",$monarray[$mon], $mday, $year+1900); &beginning; &header($date_str); my @extlist = split(/\s+/,$link_extention); if ($toplink_en == 1){ print "$toplink_title\n"; } print "
\n"; print "
    \n"; foreach (reverse(@alldata)){ chomp; my ($count,$file,$title,$size,$update,$pwd)=split(/,/); my $target; my $ext; if ($link_target == 0){ $target = ""; } elsif ($link_target == 1){ $target = "target=\"_blank\""; } elsif ($link_target == 2){ my ($body_name, $path_name, $ext) = fileparse($file,@extlist); # $ext =~ s/^.+\.(.+)$/$1/; # if (grep(/^$ext$/i, @extlist)){ if ($ext){ $target = "target=\"_blank\""; } else { $target = ""; } } print "
  • "; print "$title ($size)"; # if ($update eq ''){ ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$dldir/$file"); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= $localtime_en ? localtime($d_mtime) : gmtime($d_mtime+$offset_from_gmt*3600); $update = sprintf("%s年%s月%s日%02s時%02s分",$year+1900,$mon+1,$mday,$hour,$min); # } print " .......... $update"; print "
    • \n"; } print "
\n"; print "
\n"; print <<"EOM";
EOM if ($member_only == 1){ print < END3 } print <
タイトル
アップファイル
アップ後のファイル名
メンバー専用パスワード
削除用パスワード
EOM2 print < ※アップ後のファイル名は半角英数、アンダースコア(_)、ドット(.)、ハイフン(-)のみ受け付けます。
※アップ後のファイル名を省略すると元のファイルと同じ名前でアップされます。
※アップできる最大ファイルサイズは$maxsizeです。
※アップロードはファイルサイズ、通信速度によってそれなりに時間がかかりますので、アップロード中はこのページが再表\示されるまで根気よくお待ちください。
※削除用パスワードは半角英数で。
NOTICE print "
"; print "
\n"; print "\n"; print "\n"; print "
\n"; print "削除用パスワード\n"; print "
"; print < ※削除はサーバーから完全にファイルを削除します。復帰はできません。
※削除用パスワードは半角英数で。
NOTICE print <
管理用パスワード
SETUPDISP &ending; } sub beginning { # print "Content-Type: text/html\n\n"; print $q->header(-charset=>"$charset"); print ""; print < $title HEADPRINT if ($head_insert_en == 1){ print "$head_insert"; } if ($style_sheet_en == 1){ print "\n"; } print "\n"; print "\n"; } sub ending { my $year = $lastmodifiedyear; if ($year > 2002){ $year = "2002-$year"; } my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "
$script Ver. $version
Copyright(c) $year, hidekik.com
\n"; print ""; print ""; exit; } sub header { my $date_str = shift; print "

$title

\n"; print "
Last Update : $date_str

\n"; } sub error { &beginning; print "
$_[0]
\n"; &ending; } sub makecrypt { my $plain = shift; my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$'); return $result; } sub setadminpwd { &beginning; print "
"; print "
管理者用パスワードを設定してください。
"; print ""; print ""; print ""; print "
"; &ending; } sub wradminpwd { my $passwd = &makecrypt($in{pwd}); if (open(FILE,"> $admindat")){ print FILE "$passwd"; close(FILE); } else { &error('パスワードファイル作成に失敗しました。'); } print "Location: $script\n\n"; } sub checkcrypt { my ($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd"); } sub adminpwd { open(ADMIN,"< $admindat"); my $adminpwd = ; close(ADMIN); return $adminpwd; }