#! c:/perl/bin/perl
#
# cryppage.cgi
# ＨＴＭＬファイルをキーでエンコードしてサーバーにアップします。
# サーバー上にテキストでファイルが残らないのでキーを破られない限り
# 誰にも（サーバー管理者にさえ）内容を見られることがありません。
# また、キーを知っていればそのページを閲覧することができます。
# 仲間内の住所録など限定された人のみに公開するのに向いてます。
#
# Crypt::CBC, Crypt::Blowfishを使用しています。
#
# 4.016 : 8/28/05 : jcode.plとcgi-lib.plを削除
# 4.015 : 7/23/06 : イニシャルキーをランダムに変更
# 4.013 : 3/22/05 : イニシャルキーを管理設定に追加。
# 4.012 : 2/21/05 : 管理用セットアップのパスワード認証でまれにミスするバグを修正
# 4.011 : 2/8/05 : CGI::Carpをコメントアウト
# 4.01 : 2/7/05 : Location:の後にスペースを追加。AnHTTPD対応。
#                 CGI::Carpを追加。
# 4.0 : 1/8/03 : CryptをPerlのpackage, Crypt::CBCに変更。
#
# $Id: cryppage.cgi,v 1.11 2005/08/27 22:50:54 Hideki Kanayama Exp $

use POSIX;
use CGI::Carp qw(fatalsToBrowser);
use Crypt::CBC;
use CGI qw(:cgi-lib);

#管理人パスワードファイル
$admindat = "adminpwd.dat";

#セットアップファイル
$setupfile = "cryppage_setup.pl";

$version = "4.016";
$last_updated_year = "2005";

$program = $0;
$program =~ s/^.+[\/\\]([^\/\\]+)$/$1/;
$script = "$program";

#### 環境設定 ###### ここから ############
#クリプトファイルのディレクトリ
$crdir = ".";

#クリプト後のデフォルトファイル名
$crfile = "$crdir/cryptfile.doc";

#タイトル
$title_logo_en = 0;
$title_logo = '';
$title = 'クリプトページ';
$title_color='blue';

#トップへのリンク 1: on 0:off
$toplink_en = 1;
$toplink_title = 'トップへ';
$toplink_link = "../cryppage.html";

#管理人セットアップ表示 1: on, 0: off
$setup_en = 1;
$setup_icon_en = 0;
$setup_icon = '';
$setup_title = '管理用';

#アクセスログ 1: on, 0: off
$accesslog_en = 1;
$accesslog = "$crdir/access.log";

#最終更新表示 1: on, 0: off
$lastupdate_en = 1;
$lastupdate = 'Last Update : ';
$lastupdate_color = '#3333ff';

#エントリーでの説明
$explain1 = '
<center>キーをご存知ない方は、<a href="mailto:yourmailaddress">管理人</a>までメールをください。</center>
';

#時間設定
$offset = 9;

#### 環境設定 ###### ここまで ############

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

$bgset = "bgcolor=\"#ffffff\"";

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

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

open(ADMIN,"< $admindat");
$adminpwd = <ADMIN>;
close(ADMIN);

if ($in{mode} eq 'setup'){
	&setup;
} elsif ($in{mode} eq 'setform'){
	&setform
} elsif ($in{mode} eq 'wrsetup'){
	&wrsetup
} elsif ($in{mode} eq 'upcrypt'){
	&upcrypt;
} elsif ($in{mode} eq 'display'){
	&display;
} elsif ($in{mode} eq 'bfcrypt'){
	&bfcrypt;
} elsif ($in{mode} eq 'entry'){
	&entry;
} else {
	&entry;
}
################ エントリー #########################################
sub entry {

($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("$crfile");
@monarray=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime($d_mtime + $offset * 3600);

$date_str = POSIX::strftime("%Y年%m月%d日%H時%M分",$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

&beginning;

print "<CENTER>";
if ($title_logo_en == 1){
	print "<img src=\"$title_logo\" alt=\"$title\">";
} else {
	print "<h1><font color=\"$title_color\">$title</font></h1>";
}
print "</CENTER><p>\n";

print "<center>\n";

if ($lastupdate_en == 1){
	print "<FONT COLOR=\"$lastupdate_color\">$lastupdate $date_str</FONT><p>\n";
}

if ($toplink_en == 1){
	if ($toplink_logo_en == 1){
		print "<a href=\"$toplink_link\"><img src=\"$toplink_logo\" alt=\"$toplink_title\"></a>\n";
	} else {
		print "<a href=\"$toplink_link\">$toplink_title</a>";
	}
}

print "　";

if ($setup_en == 1){
	if ($setup_icon_en == 1){
		print "<a href=\"$script?mode=setup\"><img src=\"$setup_icon\" alt=\"$setup_title\"></a>\n";
	} else {
		print "<a href=\"$script?mode=setup\">$setup_title</a>";
	}
}

print "</center>\n";

print "<HR WIDTH=\"100%\"><p>\n";
print "<form method=\"post\" type=\"text\" action=\"$script\">\n";
print "<center>キーを入力して下さい。<p>\n";
print "<input type=hidden name=mode value=display><p>\n";
print "<input type=password name=key size=10><p>\n";
print "<input type=submit value=\"入力\"></center><p>\n";
print "</form>\n";

print "$explain1\n";
print "<p><hr>\n";

&ending;

}

################ ページディスプレイ #######################
sub display {

$remote_host=$ENV{'REMOTE_HOST'};
$remote_addr=$ENV{'REMOTE_ADDR'};

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $offset * 3600);
@wday_array = ('日','月','火','水','木','金','土');
$date_now = sprintf("%04d年%01d月%01d日(%s)%02d時%02d分",$year+1900,$mon +1,$mday,$wday_array[$wday],$hour,$min);

if (! -e "$crfile"){&error("$crfileが存在しません。");}

$cipher = &init_cipher;

print "Content-Type: text/html\n\n";

$success = 0;
open(CRFILE, "< $crfile");
@tmp = <CRFILE>;
close(CRFILE);

$wholefile = join '', @tmp;
$plaintext = $cipher->decrypt($wholefile);
print "$plaintext";

if ($accesslog_en == 1){
	open(LOG,">> $accesslog");
	printf(LOG "%s\t%s\t%s\n",$remote_addr,$date_now,$remote_host);
	close(LOG);
	chmod(0666,"$accesslog");
}

exit;
}

################ アップクリプト #######################
sub upcrypt {

if (! &checkcrypt($in{pwd},"$adminpwd")){
	&error('パスワードが違います。');
}

if ($in{upfile} eq ''){
	&error('アップファイルが指定されていません。');
}


if ($in{key} eq ''){
	&error('クリプトキーが指定されていません。');
}

if (! -e "$crfile"){&error("$crfileが存在しません。");}

$fh = $q->upload('upfile');
$upfiletext = join '', <$fh>;

$cipher = &init_cipher;
$crypttext = $cipher->encrypt($upfiletext);

open(FILE,"> $crfile");
binmode FILE;
print FILE "$crypttext";
close(FILE);

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

}

################ 管理用ページ #######################
sub setup {
&beginning;

print <<END;

<center>
<h1>管理ページ</h1>
<hr>
<p>
<form method=post action=$script name=upform enctype="multipart/form-data">
<table cols=2 border=0 width=80%>
<tr>
<td width=20% nowrap align=right>アップファイル</td>
<td><input type=file name=upfile size=50></td>
</tr>
<tr>
<td align=right>エンコードキー</td>
<td><input type=password name=key size=20></rd>
</tr>
<tr>
<td nowrap align=right>管理人パスワード</td>
<td><input type=password name=pwd size=20>
<input type=hidden name=mode value=upcrypt></td>
</tr>
<tr>
<td></td>
<td>
<input type=submit name=sub1 value="送信">
</td>
</tr>
</table>
</form>
<hr>
<form method=post action=$script name=setform>
管理人パスワード
<input type=hidden name=mode value=setform>
<input type=password name=pwd size=20>
<input type=submit name=sub1 value="セットアップ">

<hr>

</center>
END

&ending;

exit;

}

################ セットアップフォーム #######################
sub setform {

if (! &checkcrypt($in{pwd},"$adminpwd")){
	&error('パスワードが違います。');
}

&beginning;

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

$title_logo_check[$title_logo_en] = "checked";
$toplink_check[$toplink_en] = "checked";
$setup_check[$setup_en] = "checked";
$setup_icon_check[$setup_icon_en] = "checked";
$accesslog_check[$accesslog_en] = "checked";
$lastupdate_check[$lastupdate_en] = "checked";

print <<END;
<table cols=2 border=1>

<tr>
<td colspan=2>
<ul>
<li>ディレクトリ、ファイルの設定は、$scriptから見た相対パス、又は絶対パスで指定してください。ＣＧＩと同じディレクトリの場合、.（半角ドット）でＯＫです。ロゴファイルはhttp://からのリンクの指定も可能\\です。</li>
<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>
</ul>
</td>
</tr>

<tr>
<td width="20%">データディレクトリ</td>
<td width="80%"><input type=text name="crdir" value="$crdir" size=30>CGIと同じでも可</td>
</tr>

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

<tr>
<td>タイトル名</td>
<td>
<input type=radio name=title_logo_en value=1 $title_logo_check[1]>ロゴ使用
<input type=radio name=title_logo_en value=0 $title_logo_check[0]>ロゴ非使用<br>
<input type=text name="title_logo" value="$title_logo" size=30>ロゴ画像ファイル<br>
<input type=text name="title" value="$title" size=30>タイトル名<br>
<input type=text name="title_color" value="$title_color" size=10>その色
</td>
</tr>

<tr>
<td>トップへのリンク表\\示</td>
<td>
<input type=radio name=toplink_en value=1 $toplink_check[1]>有り
<input type=radio name=toplink_en value=0 $toplink_check[0]>無し<br>
<input type=text name="toplink_title" value="$toplink_title" size=30>リンク名<br>
<input type=text name="toplink_link" value="$toplink_link" size=30>トップのリンク先<br>
</td>
</tr>

<tr>
<td>管理用リンク表\\示</td>
<td>
<input type=radio name=setup_en value=1 $setup_check[1]>有り
<input type=radio name=setup_en value=0 $setup_check[0]>無し<br>
<input type=radio name=setup_icon_en value=1 $setup_icon_check[1]>アイコン使用
<input type=radio name=setup_icon_en value=0 $setup_icon_check[0]>アイコン非使用<br>
<input type=text name="setup_icon" value="$setup_icon" size=30>アイコン画像ファイル<br>
<input type=text name="setup_title" value="$setup_title" size=30>リンク名
</td>
</tr>

<tr>
<td>アクセスログ</td>
<td>
<input type=radio name=accesslog_en value=1 $accesslog_check[1]>記録する
<input type=radio name=accesslog_en value=0 $accesslog_logo_check[0]>記録しない<br>
<input type=text name="accesslog" value="$accesslog" size=30>ファイル名
</td>
</tr>

<tr>
<td>最終更新時間表\\示とフォーム</td>
<td>
<input type=radio name=lastupdate_en value=1 $lastupdate_check[1]>有り
<input type=radio name=lastupdate_en value=0 $lastupdate_check[0]>無し<br>
<input type=text name="lastupdate" value="$lastupdate" size=30>最終更新タイトル<br>
<input type=text name="lastupdate_color" value="$lastupdate_color" size=10>その色<br>
</td>
</tr>

<tr>
<td>エントリーでの説明</td>
<td>
ＨＴＭＬ書式<br>
<textarea name="explain1" cols=50 rows=3>$explain1</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>\n";

&ending;
}

################ セットアップファイル作成 #######################
sub wrsetup {

if (open(FILE,"< $admindat")){;
	$filepwd = <FILE>;
	close(FILE);
	$inpwd = crypt($in{pwd},$filepwd);
} else {
	&error('パスワードファイルが存在しません。');
}

if ("$inpwd" ne "$filepwd"){
	&error('パスワードが違います。');
}

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

open(SETUP,"> $setupfile");

print SETUP <<END;
#### 環境設定 ###### ここから ############
#クリプトファイルのディレクトリ
\$crdir = "$in{crdir}";

#クリプト後のデフォルトファイル名
\$crfile = "$in{crfile}";

#タイトル
\$title_logo_en = $in{title_logo_en};
\$title_logo = '$in{title_logo}';
\$title = '$in{title}';
\$title_color='$in{title_color}';

#トップへのリンク 1: on 0:off
\$toplink_en = $in{toplink_en};
\$toplink_title = '$in{toplink_title}';
\$toplink_link = "$in{toplink_link}";

#管理人セットアップ表\\示 1: on, 0: off
\$setup_en = $in{setup_en};
\$setup_icon_en = $in{setup_icon_en};
\$setup_icon = '$in{setup_icon}';
\$setup_title = '$in{setup_title}';

#アクセスログ 1: on, 0: off
\$accesslog_en = $in{accesslog_en};
\$accesslog = "$in{accesslog}";

#最終更新表\\示 1: on, 0: off
\$lastupdate_en = $in{lastupdate_en};
\$lastupdate = '$in{lastupdate}';
\$lastupdate_color = '$in{lastupdate_color}';

#エントリーでの説明
\$explain1 = '$in{explain1}';

#時間設定
\$offset = $in{offset};

#### 環境設定 ###### ここまで ############
END

close(SETUP);

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

}
################ セットアップ用パスワード入力 #######################
sub setadminpwd {

&beginning;
print "<form name=\"setpwd\" action=\"$script\" method=\"post\">";

print "<center>管理者用パスワードを設定してください。<br>";
print "<input type=input name=\"pwd\" size=20>";
print "<input type=submit name=\"sub\" value=\"設定\">";
print "<input type=hidden name=\"mode\" value=\"adminpwd\">";

print "</form></center>";
&ending;
exit;

}

################ セットアップ用パスワード作成 #######################
sub wradminpwd {

$passwd = &makecrypt($in{pwd});

if (open(FILE,"> $admindat")){
	print FILE "$passwd";
	close(FILE);
} else {
	&error('パスワードファイル作成に失敗しました。');

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

}

sub checkcrypt {
    local($pwd,$encpwd)=@_;
    return(crypt($pwd,$encpwd) eq "$encpwd");
}

sub makecrypt {
    my $plain = shift;
    my $salt = &salt;
    my $result = crypt($plain,$salt);
    $result=crypt($plain,'$1$'.$salt.'$') if ($result eq '');
    return $result;
}

sub salt {
    my $length = 2;
    $length = $_[0] if exists $_[0];

    return join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[map {rand 64} (1..$length)];
}

sub beginning {

print "Content-Type: text/html\n\n";

print "<html>\n";
print <<HEADPRINT;
<HEAD>
   <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=Shift_JIS">
   <META NAME="Author" CONTENT="Hideki Kanayama">
   <TITLE>$title</TITLE>
HEADPRINT

print "</HEAD>\n";
print "<BODY TEXT=\"#000000\" $bgset LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
}

sub ending {
print "<div align=\"right\"><i>$script Ver. $version<br>Copyright(C) 1997-$last_updated_year, Hideki</i></div>\n";
print "</body>\n";
print "</html>\n";
}

sub error {
    &beginning;
    print "<br><center>$_[0]</center>\n";
    &ending;
    exit;
}

sub init_cipher {

my $localkey;
my $cipher;
my $cipher_set = '';

$keylength = length($in{key});
if ($keylength < 8){
	$addcount = 8 - $keylength;
	$padding = a x $addcount;
	$localkey = $in{key} . $padding;
} else {
	$localkey = $in{key};
}

%cipher_options = (
	key            => "$localkey",
	cipher         => 'Blowfish',
	salt           => 1,
	regenerate_key => 1,
	padding        => 'standard',
);

$cipher = new Crypt::CBC (\%cipher_options);

return($cipher);

}