#! c:/perl/bin/perl # # lstdn.cgi # # 1.002 : 10/26/06 : zipファイル格納ディレクトリを指定できるように修正 # 1.001 : 10/25/06 : zipダウンロードページへ移動するオプションを追加 # 1.0 : 7/27/06 : Created # # Need Archive::Zip # # http://www.hidekik.com # # $Id: lstdn.cgi,v 1.6 2006/10/26 02:21:25 Hideki Kanayama Exp $ # Copyright(c) 2005-2006, Hideki Kanayama, All rights reserved. use Archive::Zip; use CGI::Carp qw(fatalsToBrowser); use Cwd; use File::Basename; use CGI qw(:cgi-lib); use strict; my $script= basename($0); my $version = "1.002"; my $updatedyear = "2006"; my $adminpwd = "adminpwd.dat"; my $lang = 0; my $charset = ('Shift_JIS', 'ISO-8859-1')[$lang]; my $prefix = 'flist'; my $zipfile = "$prefix$$.zip"; my $setupfile = "lstdn_setup.pl"; #### Environment setup from here #################### # リストファイル our $listfile = "listfile.lst"; # zipファイル格納ディレクトリ。CGIから見た相対パス。 our $zipdir = "."; # $zipdirにあるテンポラリ.zipファイルを削除するまでの時間（分） # Expiratoin time to delete zip files in the temporary file our $expire = 60; # タイトル # title our $title_en = 1; our $title = 'リストダウン'; our $title_color=""; our $title_size='+1'; our $title_face=''; # 1ページ表示行数 # number to be displayed in one page our $num_in_a_page = 20; # 戻るリンク # back link our $back_en = 1; our $back = ('戻る','Back')[$lang]; our $backlink = ".."; # 管理人リンク 0:off 1:on our $adminlink_en = 1; # background our $bgimage_en = 0; our $bgcolor = "#ffffff"; our $bgimagefile = ""; # 表\示幅 our $body_width = 100; # zipダウンロードページへ移動 1:有効 0:無効 our $goto_zippage = 0; #スタイルシート 1:on 0:off our $style_sheet_en = 0; our $style_sheet = 'A:link {text-decoration: none} A:visited {text-decoration: none} A:active {text-decoration: none} '; #〜内に挿入できる構\文 1:on, 0:off our $head_insert_en = 0; our $head_insert = ''; #### Environment setup till here #################### require "$setupfile" if (-e "$setupfile"); my $q = new CGI; my $cgierror = $q->cgi_error; &error($cgierror) if ($cgierror); my %in = $q->Vars; if (! -e "$adminpwd"){ if ($in{mode} eq 'wradminpwd'){ &wradminpwd; } else { &setadminpwd; } } &error(("ディレクトリ$zipdirが存在しません","Cannot open directory:$zipdir")[$lang]) if (! -d $zipdir); # dir = 0, file = 1 # $filelist[number][dir][0] = title # $filelist[number][dir][1] = dir list # $filelist[number][file][0] = title # $filelist[number][file][1] = filename my @filelist; my @file_or_dir; my $i = 1; my $maxnum; if ($in{mode} eq '' or $in{mode} eq 'download'){ if (open (LIST, "< $listfile")) { while (){ chomp; my ($filetitle, $filedir) = split /,/; $filedir =~ s/^ *(.+?) *$/$1/; if (-d "$filedir") { opendir(DLDIR, "$filedir") or &error(("ディレクトリ$filedirが存在しません。

管理人設定","Cannot open directory:$filedir")[$lang]); my @tmp = sort grep !/^\./, readdir DLDIR; closedir(DLDIR); foreach my $thisfile (@tmp) { next if (-d "$filedir/$thisfile"); $filelist[$i][0] = "$filetitle/$thisfile"; $filelist[$i][1] = "$filedir/$thisfile"; $i++; } } elsif (-f "$filedir"){ $filelist[$i][0] = "$filetitle"; $filelist[$i][1] = "$filedir"; $i++; } else { &error(("ディレクトリ、またはファイル$filedirが存在しません。リストファイルを修正してください。

管理人設定","Cannot open directory or file:$filedir")[$lang]); } } # unshift(@filelist,'dummy'); close(LIST); } $maxnum = $i - 1; } if ($in{mode} eq 'setup'){ &setupform; } elsif ($in{mode} eq 'makesetup'){ &makesetup; } elsif ($in{mode} eq 'listfileform'){ &listfileform; } elsif ($in{mode} eq 'makelistfile'){ &makelistfile; } elsif ($in{mode} eq 'download'){ &makezip; } else { &display; } exit; sub makezip { my $zip = Archive::Zip->new(); my $member; my $i=0; my $eachfile; my $newfile; foreach (keys(%in)){ if ($in{$_} eq 'on'){ next if ($_ eq 'allon' || $_ eq 'alloff'); /check_(\d\d*)/; $eachfile = $filelist[$1][1]; $newfile = basename($eachfile); $member = $zip->addFile("$eachfile","$newfile"); } } my $status = $zip->writeToFileNamed("$zipfile"); if ($status != 'AZ_OK') { unlink("$zipfile") if (-e "$zipfile"); &error(("$zipfileが作成されません","Cannot create $zipfile")[$lang]) } rename "$zipfile", "$zipdir/$zipfile"; if ($goto_zippage){ &zippage($zipfile); } else { print "Location: $zipdir/$zipfile\n\n"; } } sub display { opendir(ZIPDIR, "$zipdir") or &error(("ディレクトリ$zipdirが開けません","Cannot open $zipdir")[$lang]); my @ziplist = grep /^$prefix.*\.zip$/, readdir ZIPDIR; closedir(ZIPDIR); my $zipfile; my $now = time; 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); foreach $zipfile (@ziplist){ ($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("$zipdir/$zipfile"); if ($now > $d_mtime + $expire * 60){ unlink("$zipdir/$zipfile"); } } my $from; if (! exists $in{from}) { $from = 1; } else { $from = $in{from}; } my $to; if (! exists $in{to}){ $to = $num_in_a_page; } else { $to = $in{to}; } &beginning($from,$to); print qq(

\n); print qq(); print qq($title) if ($title_en); print qq(\n); print qq(
\n); print qq($back\n) if ($back_en); print "
\n"; print qq|
\n|; print qq|\n|; my $alldownload_name = ('チェックした分をまとめてダウンロード','Download all')[$lang]; my $allon_name = ('全部オン','All on')[$lang]; my $alloff_name = ('全部オフ','All off')[$lang]; print qq|

\n|; &listlink($from,$to); print "

\n"; print qq|$allon_name\n|; print qq|$alloff_name
\n|; for ($i=1;$i<=$maxnum;$i++){ if ($i < $from or $i > $to) { next; } my $dlfile = "$filelist[$i][0]"; my $dllistfile = "$filelist[$i][1]"; ($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 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($d_mtime); my $update; if ($lang) { $update = sprintf("%02s:%02s %s/%s/%s",$hour,$min,$mon+1,$mday,$year+1900); } else { $update = sprintf("%s年%s月%s日%02s時%02s分",$year+1900,$mon+1,$mday,$hour,$min); } 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); } my $checkname = "check_$i"; print qq||; print "$i, $dlfile ($size)"; print " .......... $update
\n"; } print "

\n"; &listlink($from,$to); print qq|

\n|; print "

\n"; print "
\n"; print "管理用\n" if ($adminlink_en); &ending; } sub beginning { my ($from,$to) = @_; print $q->header(-type=>'text/html', -charset=>"$charset"); print ""; print < $title HEADPRINT if ($style_sheet_en) { print qq(\n); } if ($head_insert_en) { print "$head_insert"; } &jsset($from,$to) if ($in{mode} eq ''); print "\n"; my $bg; if ($bgimage_en) { $bg = "background=\"$bgimagefile\""; } else { $bg = "bgcolor=\"$bgcolor\""; } print "\n"; print "
\n"; } sub ending { my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print qq|
lstdn.cgi Ver. $version
Copyright(c) 2005-$updatedyear, hidekik.com
\n|; print "
\n"; print ""; print ""; exit; } sub error { &beginning; print "
$_[0]
\n"; &ending; exit; } sub jsset { my ($from,$to) = @_; my (@locallist) = @filelist; shift(@locallist); print qq( JSDISP3 } sub listlink { my ($from, $to) = @_; my $i; for ($i=1;$i<=$#filelist;$i+=$num_in_a_page){ my $end = $i + $num_in_a_page - 1; if ($end > $#filelist) { $end = $#filelist; } print qq(); print $i . '-' . $end; print " "; } print "
\n"; } sub setadminpwd { &beginning('管理者用パスワードを入力してください'); print "
\n"; if ($in{mode} eq 'setup'){ print "
管理者用パスワードを入力してください。
\n"; print "\n"; print "
\n"; print "セットアップ\n"; print "リストファイル作成\n"; } else { print "
管理者用パスワードを設定してください。
\n"; print "\n"; print "\n"; print "\n"; } print ""; &ending; } sub wradminpwd { my $plain = $q->param('pwd'); my $passwd = &makecrypt($plain); if (open(FILE,"> $adminpwd")){ print FILE "$passwd"; close(FILE); } else { &error('パスワードファイル作成に失敗しました'); } print "Location: $script\n\n"; } sub setupform { my $inpwd = $q->param('pwd'); &setadminpwd if ($inpwd eq ''); &error('管理用パスワードが違います。') unless &checkadmin($inpwd); my @title_check; my @back_check; my @bgimage_check; my @adminlink_check; my @goto_zippage_check; my @style_sheet_check; my @head_insert_check; $title_check[$title_en] = "checked"; $back_check[$back_en] = "checked"; $bgimage_check[$bgimage_en] = "checked"; $adminlink_check[$adminlink_en] = "checked"; $style_sheet_check[$style_sheet_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; $goto_zippage_check[$goto_zippage] = "checked"; &beginning('管理人セットアップ'); print "
\n"; print "\n"; print "\n"; print <
  • 管理用リンクを非表\示にしている場合は、$script?mode=setupからパスワードを入力してこのページに入ってください。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
リストファイル zipファイルの格納ディレクトリ CGIから見た相対パス。
テンポラリ.zipファイルを削除するまでの時間 分
CGIのディレクトリに作成されるテンポラリ.zipファイルはこの時間後に$scriptが起動されたときに自動的に削除されます。 タイトル 表\示 非表\示
タイトル：
色：color= サイズ：size= フォント：face= １ページ表\示行数 「戻る」リンク 表\示 非表\示
戻り先のリンク
リンク名 管理人リンク あり なし 壁紙 画像 カラー
画像ファイル
カラー
表\示幅 ブラウザ全体の％
zipダウンロードページへ移動 「まとめてダウンロード」ボタンをクリックした際にエラーが出る場合はこのスイッチを「有効」にしてください。別ページに移動しそこからzipファイルをダウンロードできるようになります。
有効 無効
スタイルシート 有効 無効

<head>内挿入文 有効 無効
ＨＴＭＬ書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。

END print "\n"; print ""; &ending; } ########################################################################### # Setup files write ####################################################### ########################################################################### sub makesetup { my $inpwd = $q->param('pwd'); &setadminpwd if ($inpwd eq ''); &error('管理用パスワードが違います。') unless &checkadmin($inpwd); foreach (keys(%in)){ $in{$_} =~ s/
/\n/g; $in{$_} =~ s/,/,/g; $in{$_} =~ s/<//g; } open(SETUP,"> $setupfile"); print SETUP <〜内に挿入できる構\文 1:on, 0:off \$head_insert_en = $in{head_insert_en}; \$head_insert = '$in{head_insert}'; #### 環境設定　ここまで ############## 1; END close(SETUP); print "Location: $script\n\n"; } sub listfileform { my $inpwd = $q->param('pwd'); &setadminpwd if ($inpwd eq ''); &error('管理用パスワードが違います。') unless &checkadmin($inpwd); &beginning('リストファイル作成'); print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; my $i = 0; if (open(LISTFILE, "< $listfile")){ while (){ chomp; my ($title,$pathnfile) = split /,/; &drawlistform($i,$title,$pathnfile); $i++; } close(LISTFILE); } my $j; for ($j=$i;$j<=$i+9;$j++){ &drawlistform($j); } $j--; print "\n"; print "
\n"; print "
  • 管理用リンクを非表\示にしている場合は、$script?mode=setupからパスワードを入力してこのページに入ってください。
    • \n"; print "
  • リストファイルはこの画面で必ずしも設定する必要はありません。別にエディタで作成し、ＦＴＰ等でサーバーにアップしてもかまいません。
    • \n"; print "
  • 既にリストファイルがある場合はこのページにそれが反映されます。
    • \n"; print "
  • リストを記入するフィールドが足りない場合は一度「作成」ボタンをクリックしてください。次にこのページを開いた時に追加のフィールドが表\示されます。
    • \n"; print "
  • リストファイルのタイトル名をブランクにするとその行は登録されません。
    • \n"; print "
  • ファイル名、ディレクトリ名に全角文字が含まれている場合の動作の保障はできません。半角英数で記述することをお勧めします。
    • \n"; print "
    タイトルファイル／ディレクトリ名
    \n"; print "\n"; &ending; } sub drawlistform { my ($i, $title, $pathnfile) = @_; my $title_name = "title_$i"; my $pathnfile_name = "pathnfile_$i"; print "\n"; print ""; print ""; print "\n"; print ""; print ""; print "\n"; print "\n"; } sub makelistfile { my $inpwd = $q->param('pwd'); &setadminpwd if ($inpwd eq ''); &error('管理用パスワードが違います。') unless &checkadmin($inpwd); my $max_line = $q->param('max_line'); open (FILE, "+< $listfile") or open(FILE, "> $listfile") or &error("$listfileが開けません。"); flock FILE, 2; truncate FILE, 0; seek FILE, 0, 0; foreach (0 .. $max_line) { my $title_name = "title_$_"; my $pathnfile_name = "pathnfile_$_"; next unless ($in{$title_name}); print FILE "$in{$title_name},$in{$pathnfile_name}\n"; } close(FILE); unlink($listfile) if (-z $listfile); print "Location: $script\n\n"; } 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 checkcrypt { my ($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd" or &checkadmin($pwd)); } sub checkadmin { my $pwd = shift; if (open(FILE,"< $adminpwd")){ my $filepwd = ; close(FILE); my $inpwd = crypt($pwd,$filepwd); return ("$inpwd" eq "$filepwd"); } else { &error('パスワードファイルが存在しません'); } } sub zippage { my $zipfile = shift; &beginning; print qq(

    \n); print qq(zipファイルをダウンロードする

    \n); print qq($titleへ戻る\n); print qq(

    \n); &ending; }