#! /usr/bin/perl
#
# crpedit.cgi
# Edit a text or html on a browser and save with encription.
# No one can read the text without the key to decript.
#
# 1.002 : 2/6/07 : タイトルの空白を禁止するように修正
# 1.001 : 7/9/06 : IEでPOSTから来るテキストデータを正しく表示するよう修正
# 1.0 : 12/12/05 : Created
#
# $Id: crpedit.cgi,v 1.6 2007/02/06 03:14:34 Hideki Kanayama Exp $

use strict;
use CGI qw(:cgi-lib);
use CGI::Carp qw(fatalsToBrowser);
use File::Basename;
use Crypt::CBC;

my $version = "1.002";
my $lastupdatedyear = "2007";

my $admindat = "adminpwd.dat";
my $setupfile = "crpedit_setup.pl";

my $script = basename($0);

# English:1, Japanese:0
my $lang = 0;
my $charset = ("Shift_JIS","ISO-8859-1")[$lang];

#######################3

# datadir
our $datadir = ".";

# datafile
our $datafile = "$datadir/crpedit.dat";

# datafile
our $basefile = "cryp.doc";

# lockfile
our $lockfile = "lockfile.dat";

# Title
our $pagetitle = ('クリプト編集','Crypt Edit')[$lang];

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

# Back link
our $backlink_en = 1;
our $backlink = '..';
our $backlink_name = ('戻る','Back')[$lang];

# Body width
our $body_width = '100';

# table layout
our $number_en = 0;
our $head_bgcolor = 'white';
our $title_head = 'Title';
our $title_width = 60;
our $title_color = 'black';
our $date_head = 'Date';
our $date_width = 5;
our $key_head = 'Key';
our $key_width = 5;
our $option_width = 5;
our $button_width = 5;
our $button_name = 'Action';

# Admin link
our $setup_en = 1;
our $setup_name = ('管理用','Admin setup')[$lang];

# Admin only mode
our $adminonly_en = 1;

# body insertion
our $body_insert1_en = 1;
our $body_insert1 = "
<center><h1>Crypt Edit</h1></center><p>
";
our $body_insert2_en = 0;
our $body_insert2 = '
';
our $body_insert3_en = 0;
our $body_insert3 = '
';

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

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

# Time 1:localtime, 0:offset from GMT
our $localtime_en = 1;
our $offset_from_gmt = 9;

#######################3

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

my $q = CGI->new;
my $cgierror = $q->cgi_error;
&error($cgierror) if ($cgierror);
my %in = $q->Vars;

if (! -e "$admindat"){
    if ($in{mode} ne 'wradminpwd'){
	&setadminpwd;
    } else {
	&wradminpwd($in{pwd});
    }
}

if ($in{mode} eq 'crwrite'){
    &crwrite;
} elsif ($in{mode} eq 'action'){
    &action;
} elsif ($in{mode} eq 'deldoc2'){
    &deldoc2;
} elsif ($in{mode} eq 'setup'){
    &setup;
} elsif ($in{mode} eq 'wrsetup'){
    &wrsetup;
} else {
    &display;
}

sub display {
    &htmlhead($pagetitle);

    print "$body_insert1\n" if ($body_insert1_en);
    print "<center><a href=\"$script?mode=action&option=new\">";
    print (('新規登録','New post')[$lang]);
    print "</a></center>\n";
    print "$body_insert2\n" if ($body_insert2_en);

    print "<FORM name=\"master\" method=post action=\"$script\">\n";

    if ($backlink_en or $setup_en){
	print "<table cols=2 border=0 style=\"border:0px\" width=\"100%\">\n";
	print "<tr><td align=left>\n";
	print "<a href=\"$backlink\">$backlink_name</a>\n" if ($backlink_en);
	print "</td>\n";
	print "<td><td align=right>\n";
	print "<a href=\"$script?mode=setup\">$setup_name<a/>\n" if ($setup_en == 1);
	print "</td></tr></table>\n";
    }

    my $cols = 5 + $number_en;

    print "<table border cols=$cols width=\"100%\">";
    print "<tr bgcolor=\"$head_bgcolor\">\n";
    print "<th width=\"1%\" nowrap>&nbsp;</th>\n" if ($number_en);
    print "<th nowrap width=\"$title_width%\">";
    print "<font color=\"$title_color\">$title_head</font>";
    print "</th>\n";
    print "<th width=\"$date_width%\">";
    print "<font color=\"$title_color\">$date_head</font>";
    print "</th>\n";
    print "<th width=\"$key_width%\" nowrap>";
    print "<font color=\"$title_color\">$key_head</font>";
    print "</th>\n";
    print "<th width=\"$option_width%\" nowrap>&nbsp</th>\n";
    print "<th width=\"$button_width%\" nowrap>&nbsp;</th></tr>\n";

    if (open(DAT,"< $datafile")){
	my $i=1;
	while(<DAT>){
	    chomp;
	    my ($num,$date,$title,$file,$type,$pwd)=split(/,/);
	    my ($y,$m,$d,$h,$mm,$s) = split /-/, $date;
	    my $dispdate;
	    if ($lang) {
		$dispdate = sprintf("%2d/%2d/%4d",$m,$d,$y+1900);
	    } else {
		$dispdate = sprintf("%4d年%2d月%2d日",$y+1900,$m,$d);
	    }
	    
	    print "<tr>";
	    print "<td width=1 nowrap>&nbsp;$i&nbsp;</td>\n" if ($number_en);
	    print "<td width=\"$title_width%\">$title</td>\n";
	    print "<td width=\"$date_width%\" nowrap>$dispdate</td>\n";
	    print "<td width=\"$key_width%\">";
	    print "<input type=password name=key_$num size=8>";
	    print "</td>\n";
	    print "<td width=\"$option_width%\">\n";
	    print "<select name=\"option_$num\">\n";
	    print "<option value=browse select>";
	    print (('閲覧','browse')[$lang]);
	    print "\n";
	    print "<option value=edit>";
	    print (('編集','edit')[$lang]);
	    print "\n";
	    print "<option value=delete>";
	    print (('削除','delete')[$lang]);
	    print "\n";
	    print "</select>\n";
	    print "</td>\n";
	    print "<td width=\"$button_width%\"><input type=\"submit\" name=\"action_$num\" value=\"$button_name\"></a></td>\n";
	    print "</tr>\n";
	    $i++;
	}
	close(DAT);
    }
	
    print "<input type=hidden name=mode value=action>";
    print "</form>\n";
    print "</table>\n";
    print "$body_insert3\n" if ($body_insert3_en);

    &htmltail;
}

sub getdata {
    my ($num,$date,$title,$file,$type,$pwd);
    my $act;
    if (open(LIST, "< $datadir/$datafile")) {
	while (<LIST>){
	    chomp;
	    ($num,$date,$title,$file,$type,$pwd)=split /,/;
	    $act = 'action_' . $num;
	    if ($in{$act} ne '') {
		last;
	    }
	}
	close(LIST);
    }
    return ($num,$date,$title,$file,$type,$pwd);
}

sub action {
    my ($num,$date,$title,$file,$type,$pwd) = &getdata;
    if ($in{"option_$num"} eq 'edit' or $in{option} eq 'new'){
	&crform($num);
    } elsif ($in{"option_$num"} eq 'delete'){
	&deldoc;
    } elsif ($in{"option_$num"} eq 'browse'){
	&showdoc;
    } else {
	&error(('サポートされていない選択がされました。','Wrong option is specified.')[$lang]);
    }
}

sub crform {

    my $number = shift;
    my $c;
    my $plaintext;
    my ($num,$date,$title,$file,$type,$pwd);
    my %type_select = ();
    my %char_select = ();
    my $opt;
    my $action;
    my $pagetitle = ('新規登録','New post')[$lang];
    if ($in{"option_$number"} eq 'edit'){
	$pagetitle = ('編集','Edit')[$lang];
	&lockfile;
	open(LIST, "< $datadir/$datafile") or &error(("$datadir/$datafileが開けません。","Cannot open $datadir/$datafile")[$lang]);
	while (<LIST>){
	    chomp;
	    ($num,$date,$title,$file,$type,$pwd)=split /,/;
	    $action = 'action_' . $num;
	    if ($in{$action} ne ''){
		$opt = 'option_' . $num;
		$type_select{$type} = 'checked';
		last;
	    }
	}
	close(LIST);
	&unlockfile;

	$plaintext = &get_plaintext($file,$in{"key_$num"});
    } else {
	$opt = 'option';
	$type_select{text} = 'checked';
	$char_select{sjis} = 'checked';
    }
    
    &htmlhead($pagetitle);
    
    print "<FORM action=\"$script\" method=\"post\">\n";
    print (('タイトル','Title')[$lang]);
    print "\n<BR><INPUT type=\"text\" size=\"60\" name=\"title\" value=\"$title\">\n";
    print "<BR>\n";
    print "<input type=radio name=type value=text $type_select{text}>\n";
    print (('テキスト','Text')[$lang]);
    print "<input type=radio name=type value=html $type_select{html}>\n";
    print 'HTML';
    print "<br>";
    print (('内容','Contents')[$lang]);
    print "<BR><TEXTAREA rows=\"20\" cols=\"80\" name=\"contents\" wrap=soft>";
    print "$plaintext";
    print "</textarea><br>\n";
    print (('暗号化キー','Encryption key')[$lang]);
    print "\n<input type=password name=key size=15><br>\n";
    print (('パスワード','Password')[$lang]);
    print "\n<input type=password name=pwd size=15><br>\n";
    print "<input type=hidden name=mode value=crwrite>\n";
    print "<input type=hidden name=number value=$num>\n";
    print "<input type=hidden name=option value=$in{$opt}>\n";
    print "<input type=submit name=subbutton value=\"";
    print (("登録","Register")[$lang]) if ($in{option} eq 'new');
    print (("変更","Edit")[$lang]) if ($in{"option_$num"} eq 'edit');
    print "\">\n";
    print "</form>\n";

    &htmltail;
}

sub get_plaintext {
    my $file = shift;
    my $key = shift;
    open(CRFILE, "< $datadir/$file") or &error(("$datadir/$fileが開けません。","Cannot open $datadir/$file.")[$lang]);
    my @tmp = <CRFILE>;
    close(CRFILE);
    my $c = &init_cipher($key);
    my $wholefile = join '', @tmp;
    return $c->decrypt("$wholefile");
}

sub crwrite {

    if (!&checkadmin($in{pwd}) and $adminonly_en) {
	&error(('管理用パスワードが違います。','Wrong admin password.')[$lang]);
    }

    my ($num,$date,$title,$file,$type,$pwd);
    if (open(LIST, "< $datadir/$datafile")) {
	while (<LIST>){
	    chomp;
	    ($num,$date,$title,$file,$type,$pwd)=split /,/;
	    if ($in{number} eq $num) {
		if (! &checkcrypt($in{pwd},"$pwd")){
		    &error(('パスワードが違います。','Wrong password.')[$lang]);
		}
		last;
	    }
	}
	close(LIST);
    } else {
	$num = 0;
    }
    
    if ($in{title} eq ''){
	&error(('タイトルが書き込まれていません。','Title must not be empty.')[$lang]);
    }
    
    if ($in{contents} eq ''){
	&error(('内容が書き込まれていません。','Contents must not be empty.')[$lang]);
    }
    
    if ($in{key} eq ''){
	&error('クリプトキーが指定されていません。');
    }
    
    if (! -e "$datadir/$file" and $in{option} eq 'edit'){
	&error("$datafile/$fileが存在しません。");
    }
    
    my $cipher = &init_cipher($in{key});
    my $crypttext = $cipher->encrypt($in{contents});
    
    $num++ if ($in{option} eq 'new');
    $file = "$num-$basefile";
    open(FILE,"> $datadir/$file");
    binmode FILE;
    print FILE "$crypttext";
    close(FILE);
    chmod(0666, "$datadir/$file");
    
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
	$localtime_en ? localtime(time) : gmtime(time + 3600 * $offset_from_gmt);
    $mon++;
    my $new_date = "$year-$mon-$mday-$hour-$min-$sec";
    $in{title} =~ s/</&lt;/g; 
    $in{title} =~ s/>/&gt;/g;
    $in{title} =~ s/,/&\#44;/g;
    &lockfile;
    if ($in{option} eq 'edit'){
	open(WRITEFILE,"> $datadir/tmp.$$");
	open(READFILE,"< $datadir/$datafile");
	while (<READFILE>){
	    chomp;
	    ($num,$date,$title,$file,$type,$pwd) = split /,/;
	    if ($in{number} == $num) {
		print WRITEFILE "$num,$new_date,$in{title},$file,$in{type}," . &makecrypt($in{pwd}) . "\n";
	    } else {
		print WRITEFILE "$_\n";
	    }
	}
	close WRITEFILE ;
	close READFILE;
	rename "$datadir/tmp.$$", "$datadir/$datafile";
    } elsif ($in{option} eq 'new'){
	open(WRITEFILE,">> $datadir/$datafile");
	print WRITEFILE "$num,$new_date,$in{title},$file,$in{type}," . &makecrypt($in{pwd}) . "\n";
	close(WRITEFILE);
    }
    chmod(0666, "$datadir/$datafile");
    &unlockfile;

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

}

sub showdoc {
    my ($num,$date,$title,$file,$type,$pwd) = &getdata;
    
    my $plaintext = &get_plaintext($file,$in{"key_$num"});

    my $contenttype;
    # To avoid IE's stupid text/plain handling when it comes from POST.
    # Use <pre> to display text format.
    # It is OK if you use firefox, or pass the data through GET.
#    if ($type eq 'text') {
#	$contenttype = 'text/plain';
#    } elsif ($type eq 'html') {
	$contenttype = 'text/html';
#    }

    print $q->header(-type=>$contenttype, -charset=>$charset);
    print "<pre>\n" if ($type eq 'text');
    print "$plaintext";
    print "</pre>\n" if ($type eq 'text');
    exit;
}

sub deldoc {
    my ($num,$date,$title,$file,$type,$pwd) = &getdata;

    &htmlhead(('削除','Delete')[$lang]);
    print "<p><center>\n";
    if ($lang) {
	print "Deleting<br>$title.<br>Please enter password and click \"Delete\" button.<p>";
    } else {
	print "$title<br>を削除します。<br>パスワードを入力して「削除」をクリックしてください。<p>";
    }
    my $delbutton = ('削除','Delete')[$lang];
    print "<form action=\"$script\" method=post>\n";
    print qq(<input type=password name=pwd size=10>\n);
    print qq(<input type=submit name=action_$num value=$delbutton size=10>\n);
    print qq(<input type=hidden name=mode value=deldoc2>\n);
    print "</form\n";
    print "</center>\n";
    &htmltail;
}

sub deldoc2 {
    if (!&checkadmin($in{pwd}) and $adminonly_en) {
	&error(('管理用パスワードが違います。','Wrong admin password.')[$lang]);
    }

    my ($num,$date,$title,$file,$type,$pwd) = &getdata;
    my $delnumber = $num;

    if (!&checkcrypt($in{pwd},$pwd)) {
	&error(('パスワードが違います。','Wrong password.')[$lang]);
    }

    &lockfile;
    open(WRITEFILE,"> $datadir/tmp.$$");
    open(READFILE,"< $datadir/$datafile");
    while (<READFILE>){
	chomp;
	($num,$date,$title,$file,$type,$pwd) = split /,/;
	if ($delnumber == $num) {
	    unlink "$datadir/$file";
	} else {
	    print WRITEFILE "$_\n";
	}
    }
    close WRITEFILE;
    close READFILE;
    rename "$datadir/tmp.$$", "$datadir/$datafile";
    chmod(0666, "$datadir/$datafile");
    &unlockfile;

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

sub setup {

    &setadminpwd if ($in{pwd} eq '');
    &error(('管理用パスワードが違います。','Wrong admin password')[$lang]) unless &checkadmin($in{pwd});
    
    &htmlhead(('管理用セットアップ','Admin setup')[$lang]);

    print "<form name=\"setup\" action=\"$script\" method=\"post\">\n";
    print "<input type=hidden name=\"mode\" value=\"wrsetup\">\n";
    print "<input type=hidden name=\"pwd\" value=\"$in{pwd}\">\n";

    print "<table cols=2 border=1>\n";

    my @setup_check;
    my @localtime_check;
    my @adminonly_check;
    $setup_check[$setup_en] = "checked";
    $localtime_check[$localtime_en] = "checked";
    $adminonly_check[$adminonly_en] = "checked";
    
    my %check;
  
    $check{number}[$number_en] = "checked";
    $check{bgimage}[$bgimage_en] = "checked";
    $check{backlink}[$backlink_en] = "checked";
    $check{style_sheet}[$style_sheet_en] = "checked";
    $check{head_insert}[$head_insert_en] = "checked";
    $check{body_insert1}[$body_insert1_en] = "checked";
    $check{body_insert2}[$body_insert2_en] = "checked";
    $check{body_insert3}[$body_insert3_en] = "checked";

    my $message = ("<li>管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。</li>
<li>これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。</li>
<li>$scriptがバージョンアップされた場合、単純に$scriptだけを置き換えるだけで設定はそのまま使えます。</li>
<li>$admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。</li>
<li>管理用リンクを非表\示にしている場合にこのページにアクセスするには、$script?mode=setupを実行するとアクセスできます。</li>
<li><font color=red>数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。</font>万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。</li>",
"<li>If you want to change your admin password, delete $admindat and open $script on your browser. Then set a new password.</li>
<li>The setup in this page is saved in $setupfile. If you modify $setupfile by an editor, it also reflicted to this page.</li>
<li>If you upgreaded $script, please simply replace $script. These setup will be inheritated.</li>
<li>The file names of $admindat and $setupfile can not be modified in this page. If you want to change them, please do it in this script.</li>
<li>If you want to access this page when you disable \"admin link\" display, please open $script?mode=setup.</li>")[$lang];

    print "
<tr>
<td colspan=2>
<ul>
$message
</ul>
</td>
</tr>";

    print qq(<tr>\n<td>\n);
    print (('データディレクトリ','Data directory')[$lang]);
    print qq(</td>\n);
    print qq(<td><input type=text name="datadir" value="$datadir" size=30></td>\n);
    print qq(</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('データファイル','Data file')[$lang]);
    print qq(</td>\n);
    print qq(<td><input type=text name="datafile" value="$datafile" size=30></td>\n);
    print qq(</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('データファイルの基の名前','Data file base name')[$lang]);
    print qq(</td>\n);
    print qq(<td><input type=text name="basefile" value="$basefile" size=30><br>\n);
    print (('暗号化されたファイルがnumber-basenameのファイル名でdatadirに保存されます。','An encrypted file will be saved as number-basename in datadir.')[$lang]);
    print qq(\n</td>\n);
    print qq(</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('ロックファイル','lock file')[$lang]);
    print qq(</td>\n);
    print qq(<td><input type=text name="lockfile" value="$lockfile" size=30></td>\n);
    print qq(</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('タイトル','Title')[$lang]);
    print qq(</td>\n);
    print qq(<td><input type=text name="pagetitle" value="$pagetitle" size=30><br>\n);
    print (('ブラウザのタイトルバーに表示されるタイトルです。ページのタイトルは「body内挿入部」で自由にタイトル表示させることができます。','This is displayed in the title bar of the browser. The page title can be set in the "body insert" in this page.')[$lang]);
    print qq(</td>\n);
    print qq(</tr>\n);
    
    print qq(<tr>\n<td>\n);
    print (('バックグラウンド','Background')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=bgimage_en value=1 $check{bgimage}[1]>);
    print (('画像を使う','Use image')[$lang]);
    print "\n";
    print qq(<input type=radio name=bgimage_en value=0 $check{bgimage}[0]>);
    print (('カラー設定にする<br>','Use color<br>')[$lang]);
    print "\n";
    print qq(<input type=text name="bgimage_file" value="$bgimage_file" size=30>);
    print (('画像を使う場合の画像ファイル<br>','Image file when to use an image<br>')[$lang]);
    print "\n";
    print qq(<input type=text name="bgcolor" value="$bgcolor" size=10>);
    print (('カラー設定の場合のカラー番号（白：\#ffffff 又は white）','')[$lang]);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('トップへのリンク','Link to top')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=backlink_en value=1 $check{backlink}[1]>);
    print (('表示','Display')[$lang]);
    print "\n";
    print qq(<input type=radio name=backlink_en value=0 $check{backlink}[0]>);
    print (('非表示<br>','Not display<br>')[$lang]);
    print "\n";
    print qq(<input type=text name="backlink_name" value="$backlink_name" size=30>);
    print (('リンク名<br>','Link name<br>')[$lang]);
    print qq(<input type=text name="backlink" value="$backlink" size=30>);
    print (('ＵＲＬ<br>','URL<br>')[$lang]);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('表示幅','Display widthb')[$lang]);
    print qq(<td>);
    print (('ブラウザ全体の','Pacentage out of browser width')[$lang]);
    print qq(<input type=text name="body_width" value="$body_width" size=5>%\n);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('テーブルレイアウト','Table layout')[$lang]);
    print qq(</td>\n<td>\n);
    print (('ヘッダーの背景色','Background color of the header')[$lang]);
    print qq(<input type=text name="head_bgcolor" value="$head_bgcolor" size=10><br>\n);
    print (('タイトル名','Title name')[$lang]);
    print qq(<input type=text name="title_head" value="$title_head" size=20><br>\n);
    print (('タイトルの幅','Title width')[$lang]);
    print qq(<input type=text name="title_width" value="$title_width" size=10>%<br>\n);
    print (('タイトルの色','Title font color')[$lang]);
    print qq(<input type=text name="title_color" value="$title_color" size=10><br>\n);
    print (('日付名','Date name')[$lang]);
    print qq(<input type=text name="date_head" value="$date_head" size=20><br>\n);
    print (('日付の幅','Date width')[$lang]);
    print qq(<input type=text name="date_width" value="$date_width" size=10>%<br>\n);
    print (('キー名','Key name')[$lang]);
    print qq(<input type=text name="key_head" value="$key_head" size=20><br>\n);
    print (('キー欄の幅','Key cell width')[$lang]);
    print qq(<input type=text name="key_width" value="$key_width" size=10>%<br>\n);
    print (('オプション欄の幅','Option cell width')[$lang]);
    print qq(<input type=text name="option_width" value="$option_width" size=10>%<br>\n);
    print (('ボタン欄の幅','Button cell width')[$lang]);
    print qq(<input type=text name="button_width" value="$button_width" size=10>%<br>\n);
    print (('ボタン名','Button name')[$lang]);
    print qq(<input type=text name="button_name" value="$button_name" size=20>%<br>\n);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('番号','Number')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=number_en value=1 $check{number}[1]>);
    print (('表示','Display')[$lang]);
    print "\n";
    print qq(<input type=radio name=number_en value=0 $check{number}[0]>);
    print (('非表示<br>','Not display<br>')[$lang]);
    print "\n";
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('管理用リンク表示','Amin link display')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=setup_en value=1 $setup_check[1]>);
    print (('表示','On')[$lang]);
    print qq(<input type=radio name=setup_en value=0 $setup_check[0]>);
    print (('非表示<br>','Off<br>')[$lang]);
    print (('リンク名','Link name')[$lang]);
    print qq(<input type=text name="setup_name" value="$setup_name" size=20>\n);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('管理人オンリーモード','Admin only mode')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=adminonly_en value=1 $adminonly_check[1]>);
    print (('管理人オンリーモード','Admin only mode')[$lang]);
    print qq(<input type=radio name=adminonly_en value=0 $adminonly_check[0]>);
    print (('ユーザーモード<br>','User mode<br>')[$lang]);
    print qq(</td>\n</tr>\n);

    my $valid = (('有効','valid')[$lang]);
    my $invalid = (('無効','invalid')[$lang]);

    print qq(<tr>\n<td>\n);
    print (('&lt;body&gt;内挿入文','sentense in &lt;body&gt;')[$lang]);
    print "</td><td>\n";

    print (('上部に表示される文をＨＴＭＬで記述。ここにイベントの予定や詳細等を記述することができます。その他リンク、画像なんでもＨＴＭＬで記述できます。タイトルを非表示にして凝ったタイトルをここに記述することもできます。<br>ページ上部','HTML format. You can discrive event detail here.<br>Top of the page')[$lang]);

    print qq(<input type=radio name=body_insert1_en value=1 $check{body_insert1}[1]>$valid);
    print qq(<input type=radio name=body_insert1_en value=0 $check{body_insert1}[0]>$invalid<br>\n);
    print qq(<textarea name="body_insert1" cols=50 rows=3>$body_insert1</textarea><br>\n);
    print (('テーブルの上','above the title')[$lang]);
    print qq(<input type=radio name=body_insert2_en value=1 $check{body_insert2}[1]>$valid);
    print qq(<input type=radio name=body_insert2_en value=0 $check{body_insert2}[0]>$invalid<br>\n);
    print qq(<textarea name="body_insert2" cols=50 rows=3>$body_insert2</textarea><br>\n);
    print (('ページの一番下','bottom of the page')[$lang]);
    print qq(<input type=radio name=body_insert3_en value=1 $check{body_insert3}[1]>$valid);
    print qq(<input type=radio name=body_insert3_en value=0 $check{body_insert3}[0]>$invalid<br>\n);
    print qq(<textarea name="body_insert3" cols=50 rows=3>$body_insert3</textarea><br>\n);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('&lt;head&gt;内挿入文','sentense in &lt;head&gt;')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=head_insert_en value=1 $check{head_insert}[1]>$valid\n);
    print qq(<input type=radio name=head_insert_en value=0 $check{head_insert}[0]>$invalid<br>\n);

    print (('ＨＴＭＬ書式<br>ポップアップ広告やJavascript、&lt;META&gt;を挿入したい場合にここに記述する。<br>以下の記述が&lt;head&gt;〜&lt;/head&gt;内に挿入される。<br>','HTML format. Javascript, popup ads, &lt;META&gt; and so on can be inserted in here.')[$lang]);

    print qq(<textarea name="head_insert" cols=50 rows=3>$head_insert</textarea><br>\n);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('スタイルシート','Style Sheet')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=style_sheet_en value=1 $check{style_sheet}[1]>$valid\n);
    print qq(<input type=radio name=style_sheet_en value=0 $check{style_sheet}[0]>$invalid<br>\n);
    print qq(<textarea name="style_sheet" cols=50 rows=3>$style_sheet</textarea><br>\n);
    print qq(</td>\n</tr>\n);

    print qq(<tr>\n<td>\n);
    print (('時間設定','Time')[$lang]);
    print qq(</td>\n<td>\n);
    print qq(<input type=radio name=localtime_en value=0 $localtime_check[0]>);
    print (('GMTからのオフセット','Offset from GMT')[$lang]);
    print qq(<input type=radio name=localtime_en value=1 $localtime_check[1]>\n);
    print (('ローカルタイム<br>','Localtime<br>')[$lang]);
    print (('GMTからのオフセットに設定した場合、GMTより','When set to GMT, an offset from GMT')[$lang]);
    print qq(<input type=text name=offset_from_gmt value="$offset_from_gmt" size=2>\n);
    print (('時間(日本：+9時間)','hours (Japan : +9)')[$lang]);
    print qq(</td>\n</tr>\n);

    print qq(</table>\n);

    print qq(<p><input type=submit name="update" value=");
    print (('設定','Save')[$lang]);
    print qq(">\n);

    print "</form>\n";
    
    &htmltail;
}

###################### セットアップ作成 ############################
sub wrsetup {

    &error(('パスワードが違います。','Wrong admin password')[$lang]) unless (&checkadmin($in{pwd}));

    open(SETUP,"> $setupfile") || &error(('セットアップファイルが作成できません。<br>ＣＧＩを置いてあるディレクトリが書き込み可能か確認してください。',"Cannot create $setupfile.")[$lang]);

    foreach (keys(%in)){
	$in{$_} =~ s/<br>/\n/g;
	$in{$_} =~ s/&#44;/,/g;
	$in{$_} =~ s/&lt;/</g;
	$in{$_} =~ s/&gt;/>/g;
	$in{$_} =~ s/\s*$//;
    }

print SETUP <<END;
# datadir
\$datadir = "$in{datadir}";

# datafile
\$datafile = "$in{datafile}";

# datafile
\$basefile = "$in{basefile}";

# lockfile
\$lockfile = "$in{lockfile}";

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

# 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}';

# table layout
\$number_en = $in{number_en};
\$head_bgcolor = '$in{head_bgcolor}';
\$title_head = '$in{title_head}';
\$title_width = $in{title_width};
\$title_color = '$in{title_color}';
\$date_head = '$in{date_head}';
\$date_width = $in{date_width};
\$key_head = '$in{key_head}';
\$key_width = $in{key_width};
\$option_width = $in{option_width};
\$button_width = $in{button_width};
\$button_name = $in{button_name};

# Admin link
\$setup_en = $in{setup_en};
\$setup_name = '$in{setup_name}';

# Admin only mode
\$adminonly_en = $in{adminonly_en};

# body insertion
\$body_insert1_en = $in{body_insert1_en};
\$body_insert1 = "$in{body_insert1}";
\$body_insert2_en = $in{body_insert2_en};
\$body_insert2 = '$in{body_insert2}';
\$body_insert3_en = $in{body_insert3_en};
\$body_insert3 = '$in{body_insert3}';

# 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}';

# Time 1:localtime, 0:offset from GMT
\$localtime_en = $in{localtime_en};
\$offset_from_gmt = $in{offset_from_gmt};

1;

END
    close(SETUP);

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

sub checkcrypt {
  my ($pwd,$encpwd)=@_;
  return(crypt($pwd,$encpwd) eq "$encpwd" or &checkadmin($pwd));
}

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

  print $q->header(-charset=>$charset);
  print "<html>\n";
  print "<HEAD>\n";
  print "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=$charset\">\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 copyright {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
    print "<p><div align=\"right\">";
    print "<i><font color=\"gray\">crpedit.cgi Ver. $version</i><br>\n";
    print "<i>Copyright(C) 2005-$lastupdatedyear, </font><a href=\"$mysite\" target=\"_blank\">hidekik.com</a></i>\n";
    print "</div>";
}

sub htmltail {
    &copyright;
    print "</td></tr></table>\n</body></html>\n";
    exit;
}

sub error {
  my ($msg) = shift;
  &unlockfile;
  &htmlhead($msg);
  print "<br><center>$msg</center>\n";
  &htmltail;
  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 setadminpwd {
  
    my $subname = 'setadminpwd';
    &htmlhead(('管理者用パスワードを入力してください','Please set an admin password')[$lang]);
    
    print "<form name=\"setpwd\" action=\"$script\" method=\"post\">\n";
    
    if ($in{mode} eq 'setup'){
	if ($lang){
	    print "<center>Please enter an admin password<br>\n";
	} else {
	    print "<center>管理者用パスワードを入力してください。<br>\n";
	}
	print "<input type=password name=\"pwd\" size=20>\n";
	my $but = ('入力','Enter')[$lang];
	print "<input type=submit name=\"sub\" value=\"$but\">\n";
	print "<input type=hidden name=\"mode\" value=\"setup\">\n";
    } else {
	if ($lang){
	    print "<center>Please set an admin password<br>\n";
	} else {
	    print "<center>管理者用パスワードを設定してください。<br>\n";
	}
	print "<input type=input name=\"pwd\" size=20>\n";
	my $but = ('設定','Enter')[$lang];
	print "<input type=submit name=\"sub\" value=\"$but\">\n";
	print "<input type=hidden name=\"mode\" value=\"wradminpwd\">\n";
    }
    
    &htmltail;
}

sub wradminpwd {

  my $plain = shift;
  my $passwd = &makecrypt($plain);
  
  if (open(FILE,"> $admindat")){
    print FILE "$passwd";
    close(FILE);
  } else {
    &error('パスワードファイル作成に失敗しました');
  }
  
  print "Location: $script\n\n";
  
}

sub checkadmin {
  my $pwd = shift;
  
  if (open(ADMINFILE,"< $admindat")){
    my $filepwd = <ADMINFILE>;
    close(ADMINFILE);
    my $inpwd = crypt($pwd,$filepwd);
    return ("$inpwd" eq "$filepwd");
  } else {
    &error('パスワードファイルが存在しません');
  }
  
}

sub lockfile {
  while(-e "$lockfile"){
    sleep(1);
  }
  open(LOCK,"> $lockfile");
  close(LOCK);
}

sub unlockfile {
    unlink("tmp.$$") if (-e "tmp.$$");
    unlink("$lockfile") if (-e $lockfile);
}

sub init_cipher {

    my $inkey = shift;
    my $localkey;
    my $cipher;
    my $cipher_set = '';
    
    my $keylength = length($inkey);
    if ($keylength < 8){
	my $addcount = 8 - $keylength;
	my $padding = 'a' x $addcount;
	$localkey = $inkey . $padding;
    } else {
	$localkey = $inkey;
    }
    
    my %cipher_options = (
		       key            => "$localkey",
		       cipher         => 'Blowfish',
		       salt           => 1,
		       regenerate_key => 1,
		       padding        => 'standard',
		       );
    
    $cipher = new Crypt::CBC (\%cipher_options);
    
    return($cipher);
}