$title

#!/usr/local/bin/perl ############################################### # sche24.cgi # V1.0 (2003.4.29) # Copyright(C) CGI-design ############################################### $script = 'sche.cgi'; $base = './scheduledat'; #データ格納ディレクトリ $opfile = "$base/option.txt"; #オプションファイル $lockfile = "$base/lock"; #ロック @fc = ('#000000','#888888','#800000','#c00000','#CC9966','#0000ff','#0099CC','#8E8EFF','#008040','#c100c1','#CC99FF','#ff0000','#FF9900','#ff80c0'); #文字色 @mdays = (31,28,31,30,31,30,31,31,30,31,30,31); @week = ('日','月','火','水','木','金','土'); @wcolor = ("#ff0000","#000000","#000000","#000000","#000000","#000000","#0000ff"); open (IN,"$opfile") || &error("OPEN ERROR"); $opdata = ; close IN; if (!$opdata) { $pass = &crypt('cgi'); chmod(0666,$opfile); open (OUT,">$opfile") || &error("OPEN ERROR"); print OUT "予定表<>$pass<>http://merlion.cool.ne.jp/cgi/<>$base/home.gif<>$base/back.gif<>$base/next.gif<><>$base/style.css<>#800000<>#ffffff"; close OUT; } ##### メイン処理 ##### if ($ENV{'REQUEST_METHOD'} eq "POST") {read(STDIN,$in,$ENV{'CONTENT_LENGTH'});} else {$in = $ENV{'QUERY_STRING'};} @pair = split(/&/,$in); foreach (@pair) { ($n,$val) = split(/=/); $val =~ tr/+/ /; $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $val =~ s/&/&/g; $val =~ s//>/g; $val =~ s/"/"/g; $in{$n} = $val; } $mode = $in{'mode'}; $log = $in{'log'}; open (IN, "$opfile") || &error("OPEN ERROR"); ($title,$pass,$home,$home_icon,$back_icon,$next_icon,$bg_img,$style_file,$title_color,$bg_color) = split(/<>/,); close IN; ($sec,$min,$hour,$nowday,$nowmon,$nowyear) = localtime; $nowyear += 1900; $nowmon++; if ($mode eq 'regin') {®in;} elsif ($mode eq 'regist') {®ist;} elsif ($mode eq 'edtin') {&edtin;} elsif ($mode eq 'edtwrt') {&edtwrt;} elsif ($mode eq 'delwrt') {&delwrt;} elsif ($mode eq 'admin') {&admin;} &header; if ($mode ne 'edtdsp') {$mode = '';} &main; print "\n"; exit; ### sub header { print "Content-type: text/html\n\n"; print "\n"; print "$title\n"; print "\n"; $head = 1; } ### sub main { print "

"; if ($home) { print ""; if ($home_icon) {print "

";} else {print "[HOME]";} print "\n"; } print "

$title

\n"; if (!$log) {$log = "$nowyear$nowmon";} $logyear = substr($log,0,4); $logmon = substr($log,4); $logfile = "$base/d$log.txt"; if (-e $logfile) { open (IN,"$logfile") || &error("OPEN ERROR"); while () { ($no,$day,$name,$com,$color) = split(/<>/); $lognum[$day]++; $dn = "$day-$lognum[$day]"; $logno{$dn} = $no; $logcom{$dn} = "【$name】
$com"; $logcolor{$dn} = $color; } close IN; } $mdays = $mdays[$logmon - 1]; if ($logmon == 2 && $logyear % 4 == 0) {$mdays = 29;} print "\n"; print "

　$logyear年

\n"; $mon = $logmon - 1; if ($mon < 1) {$mon = 12; $year = $logyear - 1;} else {$year = $logyear;} if (2002 < $year) {print "

　";} print "$logmon月\n"; $mon = $logmon + 1; if (12 < $mon) {$mon = 1; $year = $logyear + 1;} else {$year = $logyear;} print "　

[登録]　[変更]

\n"; $def = 0.242194*($logyear-1980)-int(($logyear-1980)/4); $spr = int(20.8431+$def); $aut = int(23.2488+$def); %holi_d = ('0101','元日','0211','建国記念の日',"03$spr",'春分の日','0429','みどりの日','0503','憲法記念日','0505','こどもの日',"09$aut",'秋分の日','1103','文化の日','1123','勤労感謝の日','1223','天皇誕生日'); %holi_w = ('012','成人の日','073','海の日','093','敬老の日','102','体育の日'); print "\n"; &get_date($logyear,$logmon,1); $w = $wday; $n = 0; for ($k=1; $k<=$mdays; $k++) { if ($w == 1) {$n++;} $wcolor = $wcolor[$w]; if (!$w) {$bc = "#fef0ef";} elsif ($w == 6) {$bc = "#eeffff";} else {$bc = "#ffffff";} $holiday_dsp = ''; &get_holiday($logmon,$k); if ($holiday) { $bc = "#fef0ef"; $wcolor = $wcolor[0]; $holiday_dsp = " [$holiday]
"; } if ($logyear == $nowyear && $logmon == $nowmon && $k == $nowday) {$bcday = ' bgcolor="#ffff00"';} else {$bcday = '';} print "$holiday_dsp\n"; if ($lognum[$k]) { foreach (1 .. $lognum[$k]) { $dn = "$k-$_"; $com = $logcom{$dn}; $com =~ s/([^=^\"]|^)(http\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%]+)/$1$2<\/a>/g; print "

$week[$w]

\n"; if ($mode eq 'edtdsp') {print "";} print "

$com

修

\n"; } } print "\n"; $w++; if (6 < $w) {$w = 0;} } print "

[管理]

\n"; # 次の行は著作権表示ですので削除しないで下さい。# print "CGI-design\n"; } ### sub get_date { $y = $_[0]; $m = $_[1]; if( $m < 3 ){$y--; $m+=12;} $wday = ($y+int($y/4)-int($y/100)+int($y/400)+int((13*$m+8)/5)+$_[2])%7; } ### sub get_holiday { $sm = sprintf("%02d%02d",$_[0],$_[1]); $holiday = $holi_d{$sm}; if ($sm eq '0504' && 1<$w) {$holiday = '国民の休日';} if ($holiday && !$w) {$hflag = 1;} if (!$holiday && $w == 1) { $smw = sprintf("%02d$n",$_[0]); $holiday = $holi_w{$smw}; if ($hflag) {$holiday = '振替休日'; $hflag = 0;} } } ### sub regin { &header; print "

[Return]

\n"; print "
*****　新規登録　*****

\n"; &getcook; &in_form('reg',$in{'year'},$in{'mon'},1); print "\n"; exit; } ### sub in_form { ($type,$year,$mon,$day) = @_; print "

\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

日付

\n"; if ($type eq 'reg') { print "\n"; print "年\n"; print " 月\n"; print " 日"; $com = ''; $submit = '書込む'; } else { print "\n"; print "\n"; print "\n"; print "$year年$mon月$day日"; $pwd = ''; $submit = '修正する'; } print "

タイトル

内容

文字色

\n"; if (!$color) {$color = $fc[0];} foreach (@fc) { if ($color eq $_) {$chk = ' checked';} else {$chk = '';} print "\n"; } print "

修正キー

（英数8文字以内）

\n"; if ($type ne 'reg') { print "\n"; } print "

\n"; print "

登録後は[変更]をクリックし、自分の登録の[修]をクリックすれば修正及び削除が可能\です。
\n"; print "但し、「修正キー」が必要な場合もありますので入力しておいて下さい。

\n"; } ### sub regist { &in_chk; $logfile = "$base/d$in{'year'}$in{'mon'}.txt"; if ($in{'pwd'} ne '') {$pwd = &crypt($in{'pwd'});} else {$pwd = '';} $newdata = "$in{'day'}<>$in{'name'}<>$in{'com'}<>$in{'color'}<>$pwd<>$ENV{'REMOTE_ADDR'}<>\n"; &lock; if (-e $logfile) { open (IN,"$logfile") || &error("OPEN ERROR"); @data = ; close IN; ($no) = split(/<>/, $data[$#data]); $no++; open (OUT,">>$logfile") || &error("OPEN ERROR"); print OUT "$no<>$newdata"; close OUT; } else { open (OUT,">$logfile") || &error("OPEN ERROR"); print OUT "1<>$newdata"; close OUT; chmod(0666,$logfile); } &unlock; &setcook; } ### sub in_chk { if (!$in{'name'}) {&error("タイトルを入力して下さい。");} if (!$in{'com'}) {&error("内容を入力して下さい。");} $in{'com'} =~ s/\r\n|\n|\r/
/g; } ### sub edtin { &header; print "

[Return]

\n"; $logfile = "$base/d$log.txt"; open (IN,"$logfile") || &error("OPEN ERROR"); while () { ($no,$day,$name,$com,$color,$pwd,$regaddr) = split(/<>/); if ($in{'no'} eq $no) {last;} } close IN; if ($regaddr ne $ENV{'REMOTE_ADDR'}) { if ($in{'pwd'} eq '') { print "

修正キーを入力して下さい

\n"; print "\n"; print "\n"; exit; } $mat = &decrypt($in{'pwd'},$pass); if (!$mat) { if ($pwd eq "") {&error("該当の登録データに修正キーが設定されていません");} $mat = &decrypt($in{'pwd'},$pwd); if (!$mat) {&error("修正キーが違います");} } } print "
***** 修正・削除　*****

\n"; $com =~ s/
/\r/g; $year = substr($log,0,4); $mon = substr($log,4); &in_form('edt',$year,$mon,$day); print "

\n"; exit; } ### sub in_pwchk { $logfile = "$base/d$log.txt"; open (IN,"$logfile") || &error("OPEN ERROR"); while () { ($no,$day,$name,$com,$color,$pwd,$regaddr) = split(/<>/); if ($in{'no'} eq $no) {last;} } close IN; if ($regaddr eq $ENV{'REMOTE_ADDR'}) {return;} if ($in{'edtpw'} eq '') {&error;} $mat = &decrypt($in{'edtpw'},$pass); if ($mat) {return;} if ($pwd eq '') {&error;} $mat = &decrypt($in{'edtpw'},$pwd); if (!$mat) {&error;} } ### sub edtwrt { &in_pwchk; &in_chk; $logfile = "$base/d$log.txt"; &lock; open (IN,"$logfile") || &error("OPEN ERROR"); while () { ($no,$day,$name,$com,$color,$pwd,$regaddr) = split(/<>/); if ($in{'no'} eq $no) { if ($in{'pwd'} ne '') {$pwd = &crypt($in{'pwd'});} push(@new,"$no<>$day<>$in{'name'}<>$in{'com'}<>$in{'color'}<>$pwd<>$regaddr<>\n"); } else {push(@new,$_);} } close IN; open (OUT,">$logfile") || &error("OPEN ERROR"); print OUT @new; close OUT; &unlock; } ### sub delwrt { &in_pwchk; $logfile = "$base/d$log.txt"; &lock; open (IN,"$logfile") || &error("OPEN ERROR"); while () { ($no) = split(/<>/); if ($in{'no'} ne $no) {push(@new,$_);} } close IN; open (OUT,">$logfile") || &error("OPEN ERROR"); print OUT @new; close OUT; &unlock; } ### sub admin { &header; print "

[Return]

\n"; if ($in{'pass'} eq '') { print "

パスワードを入力して下さい

\n"; print "\n"; print "\n"; exit; } $mat = &decrypt($in{'pass'},$pass); if (!$mat) {&error("パスワードが違います");} if ($in{'wrt'} eq 'on') { if ($in{'newpass'} ne '') {$pass = &crypt($in{'newpass'});} $title = $in{'title'}; $home = $in{'home'}; $home_icon = $in{'home_icon'}; $back_icon = $in{'back_icon'}; $next_icon = $in{'next_icon'}; $bg_img = $in{'bg_img'}; $style_file = $in{'style_file'}; $title_color = $in{'color0'}; $bg_color = $in{'color1'}; open (OUT, ">$opfile") || &error("OPEN ERROR"); print OUT "$title<>$pass<>$home<>$home_icon<>$back_icon<>$next_icon<>$bg_img<>$style_file<>$title_color<>$bg_color"; close OUT; } print "\n"; exit; } ### sub setcook { my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+60*24*60*60); $ww = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday]; $month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon]; $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$ww,$mday,$month,$year+1900,$hour,$min,$sec); $cook = "$in{'name'}<>$in{'color'}<>$in{'pwd'}<>"; print "Set-Cookie: sche24=$cook; expires=$gmt;\n"; } ### sub getcook { my($n, $val, @pair); @pair = split(/;\s*/, $ENV{'HTTP_COOKIE'}); foreach (@pair) { ($n,$val) = split(/=/); $cook{$n} = $val; } ($name,$color,$pwd) = split(/<>/, $cook{'sche24'}); } ### sub lock { $retry = 3; if (-e $lockfile) { $locktime = (stat($lockfile))[9]; if ($locktime < time - 60) {&unlock;} } while (!mkdir($lockfile,0755)) { if (--$retry < 0) {&error("busy!");} sleep(1); } } ### sub unlock {rmdir($lockfile);} ### sub crypt { @salt = ('a' .. 'z','A' .. 'Z','0' .. '9'); srand; $salt = "$salt[int(rand($#salt))]$salt[int(rand($#salt))]"; return crypt($_[0],$salt); } ### sub decrypt { $salt = $_[1] =~ /^\$1\$(.*)\$/ && $1 || substr($_[1],0,2); if (crypt($_[0],$salt) eq $_[1] || crypt($_[0],'$1$' . $salt) eq $_[1]) {return 1;} return 0; } ### sub error { if (!$head) {&header;} print "

ERROR !!

$_[0]\n"; print "\n"; exit; }