$title

#! /usr/bin/perl # # sdn.cgi # # 1.0 : 4/7/08 : Created # # Need Archive::Zip, File::Copy::Recursive # # http://www.hidekik.com # # Copyright(c) 2005-2008, 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; use File::Copy::Recursive qw(rmove); use Time::Local; my $script= basename($0); my $version = "1.0"; my $updatedyear = "2008"; my $adminpwd = "adminpwd.dat"; my $lang = 0; my $charset = ('Shift_JIS', 'ISO-8859-1')[$lang]; my $prefix = 'flist'; my $zipfile = "$prefix$$.zip"; my $setupfile = "sdn_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:移動する 0:移動しない our $move_expired_files = 0; our $expired_dir = 'expired'; #スタイルシート 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; } } if (! -d $zipdir){ mkdir "$zipdir"; } my $now = time; # $filelist[number][0] = title # $filelist[number][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,$starttime,$endtime) = split /,/; $filedir =~ s/^ *(.+?) *$/$1/; my ($startok,$endok) = &check_file_time("$starttime","$endtime"); if ($startok == 0 or $endok == 0) { rmove("$filedir","$expired_dir/$filedir") if ($move_expired_files and $endok == 0); next; } 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++; # Skip if no file or directory # } 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 check_file_time { my ($start,$end) = @_; my $startepoc; my $endepoc; my $startok = 0; my $endok = 0; my @starttime = split /:/, "$start"; if ($starttime[0] == 0){ $startok = 1; } else { if ($starttime[1] < 1){ $starttime[1] = 1; } if ($starttime[2] < 1){ $starttime[2] = 1; } @starttime = &fix_date(@starttime); $startepoc = timelocal(0,$starttime[4],$starttime[3],$starttime[2],$starttime[1]-1,$starttime[0]); } my @endtime = split /:/, "$end"; if ($endtime[0] == 0){ $endok = 1; } else { @endtime = &fix_date(@endtime); $endepoc = timelocal(0,$endtime[4],$endtime[3],$endtime[2],$endtime[1]-1,$endtime[0]); } return (($startepoc <= $now or $startok),($endepoc >= $now or $endok)); } sub fix_date { my ($year,$month,$day,$hour,$min) = @_; if ($month < 1 and $month ne ''){ $month = 1; } if ($day < 1 and $day ne ''){ $day = 1; } if ($year < 1971 and ($year ne '' and $year != 0)){ $year = 1971; } elsif ($year > 2037 and ($year ne '' and $year != 0)){ $year = 2037; } if ($hour < 0 and $hour ne ''){ $hour = 0; } elsif ($hour > 23 and $hour ne ''){ $hour = 23; } if ($min < 0 and $min ne ''){ $min = 0; } elsif ($min > 59 and $min ne ''){ $min = 59; } if ($year == 0){ $year = ''; $month = ''; $day = ''; $hour = ''; $min = ''; } else { my @monthdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); my $md = $monthdays[$month-1]; ++$md if ($month == 2 and $year % 4 == 0 and ($year % 100 != 0 or $year % 400 == 0)); $day = $md if ($day > $md and $day ne ''); } return ($year,$month,$day,$hour,$min); } 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 { &cleanzip; 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]"; 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 ($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|

sdn.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; my @move_expired_files_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"; $move_expired_files_check[$move_expired_files] = "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"; print "\n"; print "\n"; my $i = 0; if (open(LISTFILE, "< $listfile")){ while (){ chomp; my @line = split /,/; &drawlistform($i,@line); $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 " 時間は0時0分から23時59分を指定できます。 \n"; print " 時間指定を無効にする場合は年の項目をブランクにしてください。それで年月日時分全て削除され、期限無しの常に表\示となります。 \n"; print " 指定可能\時刻は1971年1月1日0時0分から2037年12月31日23時59分の範囲内です。 \n"; print "

\n"; print "\n"; &ending; } sub drawlistform { my ($i, $title, $pathnfile,$start,$end) = @_; my $title_name = "title_$i"; my ($syear,$smonth,$sday,$shour,$sminutes) = &fix_date(split /:/, $start); my ($eyear,$emonth,$eday,$ehour,$eminutes) = &fix_date(split /:/, $end); my $pathnfile_name = "pathnfile_$i"; my ($syear_name,$smonth_name,$sday_name,$shour_name,$sminutes_name) = ("syear_$i","smonth_$i","sday_$i","shour_$i","sminutes_$i"); my ($eyear_name,$emonth_name,$eday_name,$ehour_name,$eminutes_name) = ("eyear_$i","emonth_$i","eday_$i","ehour_$i","eminutes_$i"); print "\n"; print ""; print ""; print "\n"; print ""; print ""; print "\n"; print ""; print "年"; print "月"; print "日"; print "時"; print "分"; print "\n"; print ""; print "年"; print "月"; print "日"; 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_$_"; my $start_time = $in{"syear_$_"} ? sprintf("%d:%d:%d:%d:%d",$in{"syear_$_"},$in{"smonth_$_"}, $in{"sday_$_"},$in{"shour_$_"},$in{"sminutes_$_"}) : ''; my $end_time = $in{"eyear_$_"} ? sprintf("%d:%d:%d:%d:%d",$in{"eyear_$_"},$in{"emonth_$_"}, $in{"eday_$_"},$in{"ehour_$_"},$in{"eminutes_$_"}) : ''; next unless ($in{$title_name}); print FILE "$in{$title_name},$in{$pathnfile_name},$start_time,$end_time\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; } sub cleanzip { opendir(ZIPDIR, "$zipdir") or &error(("ディレクトリ$zipdirが開けません","Cannot open $zipdir")[$lang]); my @ziplist = grep /^$prefix.*\.zip$/, readdir ZIPDIR; closedir(ZIPDIR); my $zipfile; 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"); } } }