#! c:/perl/bin/perl # # cryppage.cgi # HTMLファイルをキーでエンコードしてサーバーにアップします。 # サーバー上にテキストでファイルが残らないのでキーを破られない限り # 誰にも(サーバー管理者にさえ)内容を見られることがありません。 # また、キーを知っていればそのページを閲覧することができます。 # 仲間内の住所録など限定された人のみに公開するのに向いてます。 # # 5.017 : 10/2/05 : Copyrightにリンクを追加 # 5.016 : 8/28/05 : jcode.plとcgi-lib.plを削除 # 5.015 : 7/23/06 : イニシャルキーをランダムに変更 # 5.014 : 3/22/05 : イニシャルキーを管理設定に追加。 # 5.013 : 2/24/05 : バックグランド、リンクアイコン、スタイルシート、挿入文、 # エントリーでの表示画面の設定を追加 # 5.012 : 2/21/05 : 管理用セットアップのパスワード認証でまれにミスするバグを修正 # 5.011 : 2/8/05 : CGI::Carpをコメントアウト # 5.01 : 2/7/05 : Location:の後にスペースを追加。AnHTTPD対応。 # CGI::Carpを追加。 # 5.0 : 1/9/05 : CryptをPerlのpackage, Crypt::CBCに変更。 # # $Id: cryppage.cgi,v 1.15 2005/10/01 16:04:17 Hideki Kanayama Exp $ # Copyright(c) 1997-2005 Hideki Kanayama Allright reserved use POSIX; use CGI::Carp qw(fatalsToBrowser); use Crypt::CBC; use CGI qw(:cgi-lib); #管理人パスワードファイル $admindat = "adminpwd.dat"; #セットアップファイル $setupfile = "cryppage_setup.pl"; $version = "5.017"; $last_updated_year = "2005"; $program = $0; $program =~ s/^.+[\/\\]([^\/\\]+)$/$1/; $script = "$program"; $lang = 0; #### 環境設定 ###### ここから ############ #クリプトファイルのディレクトリ $crdir = "."; #クリプト後のデフォルトファイル名 $crfile = "$crdir/cryptfile.doc"; #リストファイル名 $listfile = "$crdir/cryplist.dat"; # バックグラウンド設定 # Background設定 # 1:画像を使う 0:カラー番号を使う $bgimage_en = 1; $bgimagefile = ""; $bgcolor="#ffffff"; #タイトル $title_logo_en = 0; $title_logo = ''; $title = 'クリプトページ'; $title_color='blue'; #トップへのリンク 1: on 0:off $toplink_en = 1; $toplink_logo_en = 0; $toplink_logo = ''; $toplink_title = 'トップへ'; $toplink_link = "../cryppage.html"; #管理人セットアップ表示 1: on, 0: off $setup_en = 1; $setup_icon_en = 0; $setup_icon = ''; $setup_title = '管理用'; #管理ページタイトル $admin_title_logo_en = 0; $admin_title_logo = ''; $admin_title = '管理ページ'; $admin_title_color='black'; #アクセスログ 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 = '

'; $explain2 = '

キーを入力して下さい。

'; $explain3 = '

'; $explain4 = '

キーをご存知ない方は、管理人までメールをください。


'; #〜内に挿入できる構文 1:on, 0:off $head_insert_en = 0; $head_insert = ''; #スタイルシート 1:on 0:off $style_sheet_en = 1; $style_sheet = ' A:link {text-decoration: none} A:visited {text-decoration: none} A:active {text-decoration: none} '; #時間設定 $offset = 9; #### 環境設定 ###### ここまで ############ if (-e "$setupfile"){ require "$setupfile"; } if ($bgimage_en == 1){ $bgset = "background=\"$bgimagefile\""; } else { $bgset = "bgcolor=\"$bgcolor\""; } $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 = ; 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; } elsif ($in{mode} eq 'delete'){ &delete; } 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("$listfile"); @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 "
"; if ($title_logo_en == 1){ print "\"$title\""; } else { print "

$title

"; } print "

\n"; print "

\n"; if ($lastupdate_en == 1){ print "$lastupdate $date_str

\n"; } if ($toplink_en == 1){ if ($toplink_logo_en == 1){ print "\"$toplink_title\"\n"; } else { print "$toplink_title"; } } print " "; if ($setup_en == 1){ if ($setup_icon_en == 1){ print "\"$setup_title\"\n"; } else { print "$setup_title"; } } print "

\n"; if (open(FILE,"< $listfile")){ @list = ; close(FILE); } print "
\n"; print "$explain1\n"; print "\n"; print "$explain2\n"; print "\n"; print "\n"; print "$explain3\n"; print "\n"; print "
\n"; print "$explain4\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 ($in{page} eq ''){&error("表\\示するページを選んでください。");} $crfile = "$crdir/$in{page}"; if (! -e "$crfile"){&error("$crfileが存在しません。");} open(LISTFILE, "< $listfile"); while(){ chomp; ($number,$filename,$filetitle,$readiv) = split(/,/); if ($filename eq $in{page}){ last; } } close(LISTFILE); $cipher = &init_cipher; print "Content-Type: text/html\n\n"; $success = 0; open(CRFILE, "< $crfile"); @tmp = ; 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\t%s\n",$remote_addr,$date_now,$in{page},$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 (open(FILE,"< $listfile")){ if ($in{regtype} eq 'new'){ while (){ ($number,@tmp)=split(/,/,$_); push(@numlist,$number); } close(FILE); @numlist = sort {$a <=> $b} @numlist; $maxnum = $numlist[$#numlsit]; $i = $maxnum + 1; } else { $i = $in{regtype}; } } else { $i = 1; } $fh = $q->upload('upfile'); $upfiletext = join '', <$fh>; $crfile_body = $crfile; $crfile_body =~ s/.*\/([^\/]+)$/$1/; $crfile_body = "$i" . '-' . "$crfile_body"; $crfile = "$crdir/$crfile_body"; $cipher = &init_cipher; $crypttext = $cipher->encrypt($upfiletext); open(FILE,"> $crfile"); binmode FILE; print FILE "$crypttext"; close(FILE); if ($in{regtype} eq 'new'){ if (open(FILE,">> $listfile")){ print FILE "$i,$crfile_body,$in{filetitle}"; print FILE "\n"; close(FILE); } } else { open(READFILE,"< $listfile"); if (open(WRFILE,"> $crdir/tmp.$$")){ while(){ ($number,$filename,$filetitle,$tmp_iv)=split(/,/); if ($i != $number){ print WRFILE "$_"; } else { print WRFILE "$i,$crfile_body,$in{filetitle}"; print WRFILE "\n"; } } close(WRFILE); } close(READFILE); rename("$crdir/tmp.$$","$listfile"); } print "Location: $script\n\n"; } ################ ページ削除 ####################### sub delete { if (! &checkcrypt($in{pwd},"$adminpwd")){ &error('パスワードが違います。'); } if ($in{delnumber} eq ''){ &error('削除するタイトルを選んでください。'); } if (open(READFILE,"< $listfile")){ if (open(WRFILE,"> $crdir/tmp.$$")){ while(){ ($number,$filename,@tmp)=split(/,/); if ($in{delnumber} != $number){ print WRFILE "$_"; } else { unlink("$crdir/$filename"); } } close(WRFILE); } close(READFILE); rename("$crdir/tmp.$$","$listfile"); } print "Location: $script?mode=setup\n\n"; } ################ 管理用ページ ####################### sub setup { &beginning; if (open(FILE,"< $listfile")){ @list = ; close(FILE); } print "
"; if ($admin_title_logo_en == 1){ print "\"$admin_title\""; } else { print "

$admin_title

"; } print "
"; print <

登録タイプ
アップファイル
ファイルタイトル
エンコードキー
管理人パスワード

END2 print < END2b print <
管理人パスワード
$titleへ END3 &ending; exit; } ################ セットアップフォーム ####################### sub setform { if (! &checkcrypt($in{pwd},"$adminpwd")){ &error('パスワードが違います。'); } &beginning; print "\n"; print "\n"; print "\n"; $bgimage_check[$bgimage_en] = "checked"; $title_logo_check[$title_logo_en] = "checked"; $admin_title_logo_check[$admin_title_logo_en] = "checked"; $toplink_check[$toplink_en] = "checked"; $toplink_logo_check[$toplink_logo_en] = "checked"; $setup_check[$setup_en] = "checked"; $setup_icon_check[$setup_icon_en] = "checked"; $accesslog_check[$accesslog_en] = "checked"; $lastupdate_check[$lastupdate_en] = "checked"; $style_sheet_check[$style_sheet_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; print <
  • ディレクトリ、ファイルの設定は、$scriptから見た相対パス、又は絶対パスで指定してください。CGIと同じディレクトリの場合、.(半角ドット)でOKです。ロゴファイルはhttp://からのリンクの指定も可能\\です。
  • 管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。
  • これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。
  • $scriptがバージョンアップされた場合、単純に$scriptだけを置き換えるだけで設定はそのまま使えます。
  • $admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。
  • 管理用リンクを非表\\示にしている場合にこのページにアクセスするには、$script?mode=setupを実行するとアクセスできます。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとCGIが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
データディレクトリ CGIと同じでも可 データファイル <dir>/<number>-<filename>に変換されて保存されます リストファイル バックグランド 画像を使う カラー設定にする
画像を使う場合の画像ファイル
カラー設定の場合のカラー番号(白:#ffffff 又は white) タイトル名 ロゴ使用 ロゴ非使用
ロゴ画像ファイル
タイトル名
その色 トップへのリンク表\\示 有り 無し
アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名
トップのリンク先
管理用リンク表\\示 有り 無し
アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名 管理ページタイトル名 ロゴ使用 ロゴ非使用
ロゴ画像ファイル
タイトル名
その色 アクセスログ 記録する 記録しない
ファイル名 最終更新時間表\\示とフォーム 有り 無し
最終更新タイトル
その色
エントリーでの表\\示画面 HTML書式でエントリー画面のデザインを自由に設定できます。







<head>内挿入文 有効 無効
HTML書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。

スタイルシート 有効 無効

時間設定 GMTより時間(日本:+9時間) END print ""; print "\n"; &ending; } ################ セットアップファイル作成 ####################### sub wrsetup { if (open(FILE,"< $admindat")){; $filepwd = ; close(FILE); $inpwd = crypt($in{pwd},$filepwd); } else { &error('パスワードファイルが存在しません。'); } if ("$inpwd" ne "$filepwd"){ &error('パスワードが違います。'); } foreach (keys(%in)){ $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:on 0:off \$style_sheet_en = $in{style_sheet_en}; \$style_sheet = '$in{style_sheet}'; #時間設定 \$offset = $in{offset}; #### 環境設定 ###### ここまで ############ END close(SETUP); print "Location: $script\n\n"; } ################ セットアップ用パスワード入力 ####################### sub setadminpwd { &beginning; print "
"; print "
管理者用パスワードを設定してください。
"; print ""; print ""; print ""; print "
"; &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 "\n"; print < $title HEADPRINT if ($head_insert_en == 1){ print "$head_insert\n"; } if ($style_sheet_en == 1){ print "\n"; } print "\n"; print "\n"; } sub ending { my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "
$script Ver. $version
Copyright(C) 1997-$last_updated_year, hidekik.com
\n"; print "\n"; print "\n"; } sub error { &beginning; print "
$_[0]
\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); }