#! /usr/bin/perl
#
# 履歴記録ＣＧＩ
#
# 1.010 : 8/14/07 : タグ処理を修正
# 1.009 : 5/10/07 : 0から始まる日付を修正。時刻を修正。
# 1.008 : 5/5/07 : 1970年以前を指定できないように修正。
# 1.007 : 6/13/06 : タグの処理を修正
# 1.006 : 11/27/05 : 削除方法を修正
# 1.005 : 11/26/05 : 管理人パスワードで削除できないバグを修正
# 1.004 : 10/2/05 : methodをpostに修正
# 1.003 : 10/1/05 : 更新時間表示を修正
# 1.002 : 9/4/05 : 表示に日、月の表示非表示オプションを追加
# 1.001 : 8/28/05 : ロックを修正
# 1.0 : 8/26/05 : Created
#
# $Id: historys.cgi,v 1.21 2007/08/14 06:34:50 Hideki Kanayama Exp $
# Copyright(c) 2005-2007, Hideki Kanayama, All rights reserved.

use strict;
use CGI qw(:cgi-lib);
use CGI::Carp qw(fatalsToBrowser);
use File::Basename;
use Time::Local;

our ($datafile, $title, $bgimage_en, $bgimage_file, $bgcolor,
     $order,
     $body_width, $body_head, $body_tail,
     $user_mode,
     $style_sheet_en, $style_sheet, $head_insert_en, $head_insert,
     $offset, $backlink_en, $backlink, $backlink_name,
     $deltitle, $date_disp,
     );

my $adminpwd = "adminpwd.dat";
my $setupfile = "hist_setup.pl";

my $version = "1.010";
my $lastupdatedyear = "2007";
my $script = basename($0);

my $charset = "Shift_JIS";

# Language 0:Japanese 1:English
my $lang = 0;

### デフォルト設定 ###

# data file
$datafile = 'history.dat';

# Title
$title = 'ヒストリー';

# Delete page title
$deltitle = 'ヒストリー削除';

# Background
$bgimage_en = 0;
$bgimage_file = '';
$bgcolor = "#ffffff";

# Back link
$backlink_en = 1;
$backlink = '..';
$backlink_name = '戻る';

# Body width
$body_width = '80';

# Display order 0:From new, 1:From old
$order = 0;

# Date display 0:年月日 1:年月のみ 2:年のみ
$date_disp = 0;

# body_head
$body_head = "
<center><h1>$title</h1></center><p>
";

# body_tail
$body_tail = '
';

# mode 0:admin only, 1:user mode
$user_mode = 0;

# Style Sheet
$style_sheet_en = 0;
$style_sheet = '
';

# Head insert
$head_insert_en = 0;
$head_insert = '
';

# Offset from GMT, Japan:+9
$offset = 9;

#######################

require $setupfile if (-e "$setupfile");

my $LOCK_EX = 2;

my $now = time + $offset*3600;
my $q = new CGI;
my $cgierror = $q->cgi_error;
&error($cgierror) if ($cgierror);

my $mode = $q->param('mode');

if (! -e "$adminpwd"){
    if ($mode eq 'wradminpwd'){
	&wradminpwd;
    } else {
	&setadminpwd;
    }
}

if ($mode eq 'write'){
    &histwrite;
} elsif ($mode eq 'delpage'){
    &delpage;
} elsif ($mode eq 'delete'){
    &histdelete;
} elsif ($mode eq 'setup'){
    &setup;
} elsif ($mode eq 'setupwrite'){
    &setupwrite;
} else {
    &display;
}

sub display {
    my $histdata = &getdata;
    my @regtime = keys %{$histdata};
    @regtime = sort {$a <=> $b} @regtime;
    @regtime = reverse @regtime if ($order == 0);
    
    &htmlhead($title);
    print "$body_head\n";

    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("$datafile");
    my ($ssec,$smin,$shour,$sday,$smon,$syear,$swday,$syday,$sisdst)=gmtime($d_mtime+$offset*3600);
    $syear += 1900 if ($syear < 1900);
    $smon++;
    print "<center>\n";
    print "<a href=\"$backlink\">$backlink_name</a><br>\n" if ($backlink_en);
    print "${syear}年${smon}月${sday}日更新\n";
    print "</center><p>\n";

    print "<table cols=2 width=\"100%\" border=1 align=center>\n";
    # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
    foreach (@regtime){
	print "<tr>\n";

	print "<td nowrap width=\"10%\">";
	print "$histdata->{$_}[1]年";
	print "$histdata->{$_}[2]月" if ($date_disp == 0 or $date_disp == 1);
	print "$histdata->{$_}[3]日" if ($date_disp == 0);
	print "</td>\n";

	print "<td>";
	print "$histdata->{$_}[11]";
	print "</td>\n";

	print "</tr>\n";
    }
    print "</table><p>\n";

    my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst)=gmtime($now);
    $mon++;
    $year += 1900 if ($year < 1900);

    print "<table cols=1 width=\"100%\" border=0 style=\"border:0px\" align=center>\n";
    print "<tr><td>";
    print "<form name=histwrite action=\"$script\" method=post>\n";
    print "<input type=text size=5 name=year value=\"$year\">年";
    print "<input type=text size=3 name=month value=\"$mon\">月";
    print "<input type=text size=3 name=day value=\"$day\">日<br>\n";
    print "内容<br><textarea cols=30 rows=3 name=comment wrap=soft>\n";
    print "</textarea><br>\n";
    print "パスワード<input type=password size=10 name=pwd><br>\n";
    print "<input type=submit name=\"submit\" value=\"書きこみ\">\n";
    print "<input type=hidden name=mode value=\"write\">\n";
    print "</form>\n";
    print "</td></tr>\n";
    print "</table>\n";

    print "<table cols=2 border=0 width=\"100%\" style=\"border:0px\">\n";
    print "<tr><td align=left>";
    print "<a href=\"$script?mode=delpage\">削除ページ</a></td>\n";
    print "<td align=right>";
    print "<a href=\"$script?mode=setup\">管理用</a></td></tr>\n";
    print "</table>\n";

    print "$body_tail\n";
    &htmltail;
}

sub delpage {
    my $histdata = &getdeldata;
    my @regtime = @{$histdata};
    @regtime = sort {$a->[6] <=> $b->[6] or $a->[0] <=> $b->[0]} @regtime;
    @regtime = reverse @regtime if ($order == 0);
    
    &htmlhead($deltitle);
    print "<center><h3>$deltitle</h3></center>\n";

    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("$datafile");
    my ($ssec,$smin,$shour,$sday,$smon,$syear,$swday,$syday,$sisdst)=gmtime($d_mtime+$offset*3600);
    $syear += 1900 if ($syear < 1900);
    $smon++;
    print "<center>\n";
    print "<a href=\"$script\">${title}へ</a><br>\n";
    print "</center><p>\n";

    print "<form name=delform action=$script method=post>\n";
    print "<table cols=4 width=\"100%\" border=1 align=center>\n";
    # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
    foreach my $refkey (@regtime){
	print "<tr>\n";

	print "<td nowrap width=\"10%\">";
	print "$refkey->[1]年";
	print "$refkey->[2]月";
	print "$refkey->[3]日";
	print "</td>\n";

	print "<td>";
	print "$refkey->[11]";
	print "</td>\n";

	print "<td width=\"5%\" align=center>";
	print "<input type=password name=pwd_$refkey->[0] size=10>\n";
	print "</td>";

	print "<td width=\"5%\" nowrap align=center>";
	print "<input type=submit name=sub_$refkey->[0] value=\"削除\">\n";
	print "</td>";

	print "</tr>\n";
    }
    print "</table><p>\n";
    print "削除したい行のテキストボックスににパスワードを入れて削除ボタンをクリックしてください。";
    print "<input type=hidden name=mode value=delete>\n";
    print "</form>\n";

    &htmltail;
}

sub histdelete {

    my ($fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$fnow,$fpwd,$fhost,$fip,$fcomment);
    my @tmparray = ();
    open (DATAFILE, "+< $datafile") or &error("${datafile}が開けません。");
    flock DATAFILE, $LOCK_EX;
    while (<DATAFILE>){
	chomp;
	($fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$fnow,$fpwd,$fhost,$fip,$fcomment) = split /,/;
	my $subname = 'sub_' . $fid;
	my $pwdname = 'pwd_' . $fid;
	my $inpwd = $q->param($pwdname);
	if (!$q->param($subname)) {
	    push @tmparray, "$fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$now,$fpwd,$fhost,$fip,$fcomment\n";
	} elsif (! &checkcrypt($inpwd,$fpwd)) {
	    close(DATAFILE);
	    &error('パスワードが違います。');
	}
    }

    truncate DATAFILE, 0;
    seek DATAFILE, 0, 0;
    print DATAFILE @tmparray;
    close(DATAFILE);

    print "Location: $script\n\n";

}

sub histwrite {
    my $year = sprintf("%d",$q->param('year'));
    my $month = sprintf("%d",$q->param('month'));
    my $day = sprintf("%d",$q->param('day'));
    my $hour = 0;
    my $min = 0;
    my $comment = $q->param('comment');
    my $pwd = $q->param('pwd');
    my $id;
    my $regtime;
    my $host;
    my $ip;
    my $encpwd;

#    $comment =~ s/</&lt;/g;
#    $comment =~ s/>/&gt;/g;
    $comment =~ s/,/&#44;/g;
    $comment =~ s/\r\n/<br>/g;
    $comment =~ s/\r/<br>/g;
    $comment =~ s/\n/<br>/g;
    $comment =~ s/<( *\/? *t)/&lt;$1/ig; # Do not allow table tag
    $comment =~ s/<( *plaintext)/&lt;$1/ig;
    $comment =~ s/<( *script)/&lt;$1/ig;
    $comment =~ s/<( *input)/&lt;$1/ig;
    $comment =~ s/<( *pre)/&lt;$1/ig;

    $host = $ENV{'REMOTE_HOST'};
    $ip = $ENV{'REMOTE_ADDR'};
    my $monthn1 = $month-1;
    &monthdaycheck($year,$monthn1,$day);
    $regtime = timegm(0,$min,$hour,$day,$monthn1,$year);
    $encpwd = &makecrypt($pwd);

    &error('管理人オンリーモードなので管理人しか書き込めません。')
	if ($user_mode == 0 and !&checkadmin($pwd));
    &error('パスワードが違います。') 
	if ($user_mode == 1 and !&checkcrypt($pwd,$encpwd));

    if (open DATA, "< $datafile"){
	while (<DATA>){
	    my @dummy;
	    ($id,@dummy) = split /,/;
	}
	close DATA;
	$id++;
    } else {
	$id = 1;
    }

    open (FILE, ">> $datafile") or &error("${datafile}が開けません。");
    # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
    flock FILE, $LOCK_EX;
    print FILE "$id,$year,$month,$day,$hour,$min,$regtime,$now,$encpwd,$host,$ip,$comment\n";
    close(FILE);

    print "Location: $script\n\n";

}

sub getdata {
  my %histdata;
  my @dataarray;
  my $id;
  my $host;
  my $ip;
  my $id;
  if (open DATA, "< $datafile"){
      while (<DATA>){
	  chomp;
	  # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
	  @dataarray = split /,/;
	  next if ($dataarray[11] eq '');
	  my $key = "$dataarray[6]";
	  my @dummy;
	  (@dummy) = gmtime($key) unless ($date_disp == 0);
	  if ($date_disp == 1) {
	      $key = timegm(0,0,0,1,$dummy[4],$dummy[5]);
	  } elsif ($date_disp == 2){
	      $key = timegm(0,0,0,1,0,$dummy[5]);
	  }
	  if (exists $histdata{$key}){
	      $histdata{$key} = [
				 @dataarray[0 .. $#dataarray-1],
				 $histdata{$key}->[$#dataarray] 
				 . "<br>" . $dataarray[11],
				 ];
	  } else {
	      $histdata{$key} = [@dataarray];
	  }
      }
      close DATA;
      return (\%histdata);
  }
}

sub getdeldata {
  my @histdata;
  my @dataarray;

  if (open DATA, "< $datafile"){
      @histdata = ();
      while (<DATA>){
	  chomp;
	  # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
	  @dataarray = split /,/;
	  next if ($dataarray[11] eq '');
	  push(@histdata, [@dataarray]);
      }
      close DATA;
      return (\@histdata);
  }
}

sub htmlhead {
  
  my $title = shift;

  my $bgimage;
  if ($bgimage_en == 1){
    $bgimage = "background=\"$bgimage_file\"";
  } else {
    $bgimage = "bgcolor=\"$bgcolor\"";
  }

#  print "Content-type:text/html\n\n";
  print $q->header(-charset=>"$charset");
  print "<html>\n";
  print "<HEAD>\n";
  print "<TITLE>$title</TITLE>\n";
  if ($head_insert_en == 1){
    print "$head_insert\n";
  }
  
  if ($style_sheet_en == 1){
    print "<STYLE type=\"text/css\">\n";
    print "$style_sheet";
    print "\n</style>\n";
  }
  print "</HEAD>\n";
  print "<BODY TEXT=\"#000000\" $bgimage LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
  print "<table cols=1 border=0 width=\"${body_width}%\" style=\"border:0px\" align=center><tr><td style=\"border:0px;background-color:transparent\" >\n";
  
}

sub htmltail {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
  print "<div align=\"right\"><i>historys.cgi Ver. $version</i></div>\n";
  print "<div align=\"right\"><i>Copyright(C) 2005-$lastupdatedyear, <a href=\"$mysite\" target=\"_blank\">hidekik.com</a></i></div>\n";
  print "</td></tr></table></body></html>\n";
  exit;
}

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 = <FILE>;
    close(FILE);
    my $inpwd = crypt($pwd,$filepwd);
    return ("$inpwd" eq "$filepwd");
  } else {
    &error('パスワードファイルが存在しません');
  }
  
}
sub setadminpwd {
  
  &htmlhead('管理者用パスワードを入力してください');
  
  print "<form name=\"setpwd\" action=\"$script\" method=\"post\">\n";
  
  if ($mode eq 'setup'){
    print "<center>管理者用パスワードを入力してください。<br>\n";
    print "<input type=password name=\"pwd\" size=20>\n";
    print "<input type=submit name=\"sub\" value=\"入力\">\n";
    print "<input type=hidden name=\"mode\" value=\"setup\">\n";
  } else {
    print "<center>管理者用パスワードを設定してください。<br>\n";
    print "<input type=input name=\"pwd\" size=20>\n";
    print "<input type=submit name=\"sub\" value=\"設定\">\n";
    print "<input type=hidden name=\"mode\" value=\"wradminpwd\">\n";
  }
  
  &htmltail;
}

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 error {
  my ($msg) = shift;
  &htmlhead($msg);
  print "<br><center>$msg</center>\n";
  &htmltail;
  exit;
  
}

sub monthdaycheck {
  my ($year,$month,$day) = @_;
  my @monthdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  my $md = $monthdays[$month];
  ++$md unless $month != 1 or $year % 4 or !($year % 400);
  $month++;
  &error("日付が適切ではありません。${month}月${day}日") if $day  > $md  or $day  < 1;
  &error("1970年以前は指定できません。") if ($year < 1970);
}

sub setup {
    my $inpwd = $q->param('pwd');
    &setadminpwd if ($inpwd eq '');
    &error('管理用パスワードが違います。') unless &checkadmin($inpwd);

    &htmlhead('管理用セットアップ');
  
    my %check;
  
    $check{bgimage}[$bgimage_en] = "checked";
    $check{backlink}[$backlink_en] = "checked";
    $check{order}[$order] = "checked";
    $check{date_disp}[$date_disp] = "checked";
    $check{user_mode}[$user_mode] = "checked";
    $check{style_sheet}[$style_sheet_en] = "checked";
    $check{head_insert}[$head_insert_en] = "checked";
    
    print "<form name=\"setup\" action=\"$script\" method=\"post\">\n";
    print "<input type=hidden name=\"mode\" value=\"setupwrite\">\n";
    print "<input type=hidden name=\"pwd\" value=\"$inpwd\">\n";
    
    print <<END;
<table cols=2 border=1 width="100%">
<tr>
<td colspan=2>
<ul>
<li><font color=red>数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。</font>万一間違って全角で書いてしまった場合は、${setupfile}をエディタで開きその場所を半角に正しく修正してください。それで直ります。</li>
</ul>
</td>
</tr>

<tr>
<td>データファイル</td>
<td><input type=text name="datafile" value="$datafile" size=30></td>
</tr>

<td>タイトル</td>
<td>
<input type=text name="title" value="$title" size=30>
</td>
</tr>

<td>削除ページタイトル</td>
<td>
<input type=text name="deltitle" value="$deltitle" size=30>
</td>
</tr>

<tr>
<td>バックグランド</td>
<td>
<input type=radio name=bgimage_en value=1 $check{bgimage}[1]>画像を使う
<input type=radio name=bgimage_en value=0 $check{bgimage}[0]>カラー設定にする<br>
<input type=text name="bgimage_file" value="$bgimage_file" size=30>画像を使う場合の画像ファイル<br>
<input type=text name="bgcolor" value="$bgcolor" size=10>カラー設定の場合のカラー番号（白：#ffffff 又は white）
</td>
</tr>

<tr>
<td>トップへのリンク</td>
<td>
<input type=radio name=backlink_en value=1 $check{backlink}[1]>表\示
<input type=radio name=backlink_en value=0 $check{backlink}[0]>非表\示<br>
<input type=text name="backlink_name" value="$backlink_name" size=30>リンク名<br>
<input type=text name="backlink" value="$backlink" size=30>ＵＲＬ<br>
</td>
</tr>

<tr>
<td>表\示幅</td>
<td>
ブラウザ全体の<input type=text name="body_width" value="$body_width" size=5>％
</td>
</tr>

<tr>
<td>表\示する順序</td>
<td>
<input type=radio name=order value=0 $check{order}[0]>新しい順
<input type=radio name=order value=1 $check{order}[1]>古い順
</td>
</tr>

<tr>
<td>年月日表\示</td>
<td>
<input type=radio name=date_disp value=0 $check{date_disp}[0]>年月日
<input type=radio name=date_disp value=1 $check{date_disp}[1]>年月のみ
<input type=radio name=date_disp value=2 $check{date_disp}[2]>年のみ
</td>
</tr>

<tr>
<td>管理人モード</td>
<td>
<input type=radio name=user_mode value=0 $check{user_mode}[0]>管理人オンリーモード
<input type=radio name=user_mode value=1 $check{user_mode}[1]>ユーザーモード<br>
管理人オンリーでは管理人しか書き込めません。ユーザーモードでは誰でも書き込めます。
</td>
</tr>

<tr>
<td>ページ上部</td>
<td>
ページ上部に表\示させるものをＨＴＭＬ表\記<br>
<textarea name="body_head" cols=50 rows=3 wrap=soft>$body_head</textarea><br>
</td>
</tr>

<tr>
<td>ページ下部</td>
<td>
ページ下部に表\示させるものをＨＴＭＬ表\記<br>
<textarea name="body_tail" cols=50 rows=3 wrap=soft>$body_tail</textarea><br>
</td>
</tr>

<tr>
<td>スタイルシート</td>
<td>
<input type=radio name=style_sheet_en value=1 $check{style_sheet}[1]>有効
<input type=radio name=style_sheet_en value=0 $check{style_sheet}[0]>無効<br>
<textarea name="style_sheet" cols=50 rows=3>$style_sheet</textarea><br>
</td>
</tr>

<tr>
<td>&lt;head&gt;内挿入文</td>
<td>
<input type=radio name=head_insert_en value=1 $check{head_insert}[1]>有効
<input type=radio name=head_insert_en value=0 $check{head_insert}[0]>無効<br>
ＨＴＭＬ書式<br>
ポップアップ広告やJavascript、&lt;META&gt;を挿入したい場合にここに記述する。<br>
以下の記述が&lt;head&gt;〜&lt;/head&gt;内に挿入される。<br>
<textarea name="head_insert" cols=50 rows=3>$head_insert</textarea><br>
</td>
</tr>

<tr>
<td>時間設定</td>
<td>GMTより<input type=text name=offset value=$offset size=2>時間(日本：+9時間)</td>
</tr>

</table>

END

  print "<input type=submit name=\"sub\" value=\"設定\">";
  print "</form>";

  &htmltail;
}

sub setupwrite {

    my %in = $q->Vars;

    open (SETUP, "> $setupfile") or &error("${setupfile}が開けません。");
    print SETUP <<END;
### デフォルト設定 ###
    
# data file
\$datafile = '$in{datafile}';

# Title
\$title = '$in{title}';

# Delete page title
\$deltitle = '$in{deltitle}';

# Background
\$bgimage_en = $in{bgimage_en};
\$bgimage_file = '$in{bgimage_file}';
\$bgcolor = "$in{bgcolor}";

# Back link
\$backlink_en = $in{backlink_en};
\$backlink = '$in{backlink}';
\$backlink_name = '$in{backlink_name}';

# Body width
\$body_width = '$in{body_width}';

# Display order 0:From new, 1:From old
\$order = $in{order};

# Date display 0:年月日 1:年月のみ 2:年のみ
\$date_disp = $in{date_disp};

# body_head
\$body_head = '$in{body_head}';

# body_tail
\$body_tail = '$in{body_tail}';

# mode 0:admin only, 1:user mode
\$user_mode = $in{user_mode};

# Style Sheet
\$style_sheet_en = $in{style_sheet_en};
\$style_sheet = '$in{style_sheet}';

# Head insert
\$head_insert_en = $in{head_insert_en};
\$head_insert = '$in{head_insert}';

# Offset from GMT, Japan:+9
\$offset = $in{offset};
END
    close(SETUP);

    print "Location: $script\n\n";
}