メインメニューを開く

Wikibooks β

メインページ > 工学 > 情報技術 > プログラミング > CGI

Wikipedia
ウィキペディアCommon Gateway Interfaceの記事があります。

CGI(シージーアイ、Common Gateway Interface)とは、ウェブサーバ上で動作するプログラムがウェブページを生成できるようにする仕組みです。CGIプログラムの記述にはPerlなどのスクリプト言語がよく用いられますが、基本的に標準入出力を備えているプログラミング言語であれば(たとえばC言語シェルスクリプトでも)CGIプログラムを記述することは可能です。

目次

概要編集

CGIとはウェブページでユーザからの入力に応答したり、動的な出力を行ったりするための機構です。CGIの規格は[1]で定められています。ここで動的とはたとえば、ブラウザからリクエストを受け付けた日時をページとして表示させるものも動的なページの一つです。ウィキブログなども動的なページに含まれます。これに対して静的とはあらかじめ用意してあるHTML等で記述されたドキュメントを動的な変更を行わずに配信することを指しています。

実際にCGIを用いているかどうかは別として、現在インターネット上で大規模、あるいは著名なウェブサイトのほとんどは何らかの動的な仕組みを有していると考えられます。CGIの仕組みを理解することは大規模なデータをインターネット上で出版する技術的な背景を学ぶのと強い関係があると言えます。

CGIが行う動的な作用は主に以下の4要素によって成り立っています。

簡単に言うとWebサーバーをプラットホームにしてHTMLの形でパソコンにHTMLを送り表示させそこからデータをもらいPerl等に処理を受け渡しHTMLの形でパソコンに送り出すインターフェースの一つです。

開発の参考編集

Perl/CGI のページも見てください。 Perl/ライブラリ・モジュールとオブジェクト指向 のページも見てください。

テキストエディタ TeraPad(テラパッド)等のテキスト(拡張子*.txt)を*.cgiに変えた物です。書かれている内容はtextなのでコード指定はテキストエディタのファイルオープンでUTF-8に変えてから日本語が使えます。変えないと文字化けします。

  • パソコンで初期の拡張子の表示を表示するにしないと、*.cgi.txtになってしまいます。名前付けは英字と数字しか使えません。コントロールパネルの検索で「拡張子」で繰ってください。

動作が確認されミスが無いのが確認されたら契約サーバーにアップロードFFFTP等でして皆さんに楽しんでもらいましょう。属性(パーミッション)の変更をお忘れなく。

Perl/制御構造 も見てください。Perl/リファレンス も見てください。Perl/はじめに も見てください。

とほほのWWW入門は、良い情報源になるかも知れません。

本書ではApache HTTP Serverを用いた例を示しますが、ほかにも多くのウェブサーバでCGIが利用可能です。

Apache HTTP Server 2.2の組込み編集

  • ファイル名は、以下指定なき物は「mihon.cgi」ディレクトリ(フォルダー)はサーバーの場合なんでもいいのだけど「test-cgi」が無難かも知れません。
  • ローカルサーバーの場合、アパッチの指定されたフォルダーの中htdocsやcgi-binに「test-cgi」が無難かも知れません。「test-cgi」はウインドーズの場合、プロパティの書き換えなどの指定か互換性の変更が確か必要だったと思います。
  • ローカルサーバーの呼び出し実行は「http://127.0.0.1/test-cgi/mihon.cgi」とか「http://127.0.0.1/cgi-bin/test-cgi/mihon.cgi」をアドレスとして呼び出してください。
  • 127.0.0.1はlocalhostローカルホストに当たるアドレスです。
  • 契約サーバーは場所指定があったり、説明書きを読まないと分りません。『public_html 「test-cgi/mihon.cgi」』 など。
  • アップしたら属性(パーミッション)を実行可能な700または755またはサーバー指定の値に変更します。
  • ローカルの場合32bitと64bitのバージョンがあるので注意してください。また、アパッチの場合、conf の httpd.conf を書き換え、追加など必要だったと思います。これはインストールされたスタート内のプログラムからも出来ると思います。
    • 補足これについてのホームページを見つけました。アドレス http://d.hatena.ne.jp/foussin/20110424/1303589811 分室の分室 443行目以下は、説明が分かってからの追加変更だと思います。最初に動かす時は触らない方がよいと思います。
    • Statを押しても黒い箱が出てくる。チョット待ってください。Rrestatを押して再起動は出来ませんか?動いたのをStopさせた後はRrestatで起動ですよ。
      •  ウインドーズ7では通知領域「USB 抜差し等の▲の中」に入っています。
  • Perl http://www.activestate.com/ の中の アクティブパル http://www.activestate.com/activeperl/downloads 自分のパソコンを選んでね。トップページは見てください。
  • パールはPerl64の場合64を取ってPerlとして覚えて置いてください。パール アパッチ の順でインストールしてください。
  • 過去にウイルス対策ソフト「ノートン」において動作させられなかった経験があります。現在は改善されているかも知れません。
  • Perlリファレンスなど公開されているリファレンスレファレンス(reference)とも言う」を組み合わせて一つのプログラムとして組み上げます。
  • 不勉強の為、ウインドーズしか持って居ないのでそれしか分りません。詳しくは加筆お願いします。

CGIプログラムの例編集

Perlによる単純なCGIプログラムの例です。

#!/usr/local/bin/perl
use strict;
use warnings;

print <<"EOT";
Content-Type: text/html; charset=UTF-8

<!DOCTYPE html>
<html>
<head>
<title>Example Web Page</title>
</head>
<body>
<p>Hello, world!</p>
</body>
</html>
EOT

より高度なCGIプログラムは次のようになります。

#!/usr/local/bin/perl
use strict;
use warnings;
use CGI;
my $q = CGI->new;
print $q->header( -charset => "UTF-8" );
print $q->start_html( -title => "Example Web Page" );
print $q->p("Hello, world!");
print $q->end_html;

上記の書き方は「信じられない植物 ダウンロード」で繰って、参考に見てください。CGIのゲームです。

ちょっと古い見なれた構文 オリジナルです。printは一般的に使われています。

#!C:/Perl/bin/perl
#上は必ず一行目に書いてローカルホスト C:\Perl\bin\perl.exeを使うと言う定義。コメントも書けません。

print "Content-type:text/html\n\n"; #\n改行がふたつ必要ですクッキーは上に書きます。
print <<EOF ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>てすと</title>
</head>
<BODY BGCOLOR="#ffffff">
<h1>test</h1>
EOF
print "動くかな。<br>\n"; #print に続く物がプログラムです。ヘッダーとフッタに分割してサブルーチンとする事も出来ます。
print <<"EOF" ;
</BODY>
</html>
EOF
exit;
__END__
  • 経験の意見が入るかも知れません。自論を押し付ける気はありません。
  • cgi-lib.pl(著作権あり)と言うのが有りデコードさせたり、ヘッダーやフッタを書き出すには便利ですが、融通性が利かない難点があります。
  • 最近、CSS(スタイルシート)を使う事が多くなりましたが、対応状況が判りません。
  • JavaScript(ジャバスクリプト)もあったり、ヘッダーの可視性が不十分です。
  • jcode.pl(著作権あり)もよく見かけますが書いた言語と同じ言語が通常戻ってきます。メール用SendmailJISコードに変換させるには非常に便利ですがcgiからメールを送信しない場合は内部で言語変換させないのならば、あまり必要と思いません。
  • では、デコードをどの様に組むか書いていきます。cgi-lib.pl(著作権あり)を使うと$in{'送られてきたデータ'}と返されますので$In{'送られてきたデータ'}と変えて書きます。
#!C:/Perl/bin/perl
#上記はサーバーで動かす時はサーバーの仕様書を見て変えてください。
#!/usr/local/bin/perl

# このcgiの名前
$this_cgi = "mihon.cgi";

# GETでの取り込みを禁止する。1 または 0
$getin = 0;

# ファイルのサイズ指定
$max_size = 100;

&decode;
&header;
&main;
&footer;
exit;

####### メイン処理 ######
sub main{
	print 'あなたは ';
	print "$In{'kakikomi'}";
	print ' と書き込みしましたね。<br><br>'; # 全角空白は文字化けの為 ''を使って囲む。
	print << "EOF" ;
<br>
<form action="$this_cgi" method="POST">
<input type="text" name="kakikomi" size="40" maxlength="30">
<input type="submit" value="送信する">
</form>
EOF

}

#######ヘッダー出力
sub header {
	print "Content-type:text/html\n\n";
	print <<"EOF" ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>見本1</title>
</head>
<BODY BGCOLOR="#ffffff">
EOF
}

#デコード処理
sub decode {
	my ($query,$pair);
	if($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	} else {
		$query = $ENV{'QUERY_STRING'};
		if ($query ne "" && $getin == 1){&err("GET");}
	}
	my ($saizu)=length $query;
	if ($saizu > $max_size){&err("エラー・サイズオーバー");}
	
	foreach $pair (split(/&/, $query)) {
		my ($key, $value) = split(/=/, $pair);
	
	# 文字のデコード
		$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
		$value =~ s/\0/0/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/\r\n/<br>/g; #追加
		$value =~ s/\r|\n/<br>/g;
		$value =~ tr/+/ /;
		$In{$key} = $value;
	}
}

### フッタ #########
sub footer{
	print "<br><br><table border='1'>";
	print "<tr><th>フォーム要素名</th><th>データ</th></tr>";
	foreach $key (keys %In) {
		print "<tr><th>$key</th><td>$In{$key}</td></tr>\n";
	}
	print "</table><br>";
	print <<"EOF" ;
</BODY>
</html>
EOF
	exit;
}

###### エラー ########
sub err{
	&header;
	print 'エラー'."<br>\n";
	print "$_[0]<br>\n";
	&footer;
	exit;

}

CGIプログラムの例2編集

  • 少し難しくなってきました。HTMLの知識、スタイルシートの組み込み、ジャバスクリプトの書き込みが追加になっています。
  • ロックファイル、フォルダの好ましくない点を上げると、あっちもこっちもロックに来てロックがフル稼働になってしまうことです。
  • つまり、ロックの分散化が必要になります。ファイルハンドルで別名を使うファイルによって付けてやれば、ファイルハンドルの衝突も起きないしファイルの衝突、待ち時間の軽減になると思います。
  • これを踏まえた上で組んで見ました。
  • ランダムもシードを与えなければタイムが自動的になります。
  • ご要望があればもっと詳しく書きますが、とりあえずこんな物かと書き加えて試してみるのを目的に組みました。
#!d:/Perl/bin/perl
#上記はサーバーで動かす時はサーバーの仕様書を見て変えてください。

# このcgiの名前
$this_cgi = "mihon.cgi";

# GETでの取り込みを禁止する。1 または 0
$getin = 0;

# ファイルのサイズ指定
$max_size = 100;

# カウンタファイル
$cntfile = './count.cgi';
# 無い時に自動的に作成する
unless(-e "$cntfile"){
	open (FOUT, "> $cntfile") or &err("エラー・ファイルが作れません。");
	close (FOUT);
	chmod 0600,$cntfile;
}
# 
# カウンタの桁数
$mini_fig = 6;

# 記録ファイルの名前
$datafile = './kiroku.cgi';
# 無い時に自動的に作成する
unless(-e "$datafile"){
	open (FOUT, "> $datafile") or &err("エラー・ファイルが作れません。");
	close (FOUT);
	chmod 0600,$cntfile;
}
# 
####--------------------------------------------------------

&decode;
&header;
&main;
&footer;
exit;


#########  カウンタ処理
sub counter {
	local($count,$cntup);
	# カウントファイルを読みこみ
	open(CUNT,"< $cntfile") || &err("Open Error: cntfile","in");
	eval{flock(CUNT, 1);};
	$count = <CUNT>;
	close(CUNT);

	local($local_time);
	local($cnt,$kiroku_day,$keika_day,$today,$yestaday) = split(/<>/, $count);

	$local_time = time + (9*60*60);#GMT+9:00補正
	if (!$kiroku_day){
		$kiroku_day = $local_time - ($local_time % (24*60*60));
	}
	if ($local_time - $kiroku_day > 24*60*60){
		$keika_day += int(($local_time - $kiroku_day)/(24*60*60));
		if ($local_time - $kiroku_day > 2*24*60*60){
			$yestaday = 0;
		}else{$yestaday = $today;}
		$kiroku_day = $local_time - ($local_time % (24*60*60));
		$today = 0;
	}
	$today++;
	if (!$keika_day){$keika_day = 0; }
	if (!$yestaday){$yestaday = 0; } 

	$cnt++;
	open(CUNT,"> $cntfile") || &err("Write Error: cntfile","in");
	eval{flock(CUNT, 2);};
	print CUNT "$cnt<>$kiroku_day<>$keika_day<>$today<>$yestaday<>\n";
	close(CUNT);
	# 桁数調整
	while(length($cnt) < $mini_fig) { $cnt = '0' . $cnt; }
	#時間の整形
	$date_sec = time;
	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($date_sec);
#	local($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($date_sec); # 日時を使えるように開放
	local @week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	local $m_week = $week[$wday];
	$date = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",$year+1900,$mon+1,$mday,$week[$wday],$hour,$min,$sec);

	print "<table border=\"0\">\n";
	print "<tr><td rowspan=\"3\">\n";
	print "<font size=\"6\"class=\"kazu\">$cnt</font><br>\n";
	print "</td><td><font size=\"2\">経過</font></td><td><font size=\"2\">$keika_day</font></td></tr>\n";
	print "<tr><td><font size=\"2\">今日</font></td><td><font size=\"2\">$today</font></td></tr>\n";
	print "<tr><td><font size=\"2\">昨日</font></td><td><font size=\"2\">$yestaday</font></td></tr>\n";
	print "<tr><td colspan=\"3\"><font size=\"2\"><form name=\"Watch0\"><input type=\"text\" name=\"watch01\" size=\"25\"></form></font></td></tr>\n";
	print "</table><br>\n";

}

##### 記録遊び
sub asobkiroku {
	$detskazu = int(rand(10))+1;
	if(6 <= $detskazu){$asobimese = 'あなたの勝ち';}else{$asobimese = 'あなたの負け';}

	open(DATS,"< $datafile") || &err("Open Error: datafile","in");
	eval{flock(DATS, 1);};
	@datas = <DATS>;
	close(DATS);

	unshift @datas,"$detskazu<>$asobimese<>$In{'kakikomi'}<>$date<>\n";
	if(@datas > 10){$#datas = 9;}

	open(DATS,"> $datafile") || &err("Write Error: datafile","in");
	eval{flock(DATS, 2);};
	print DATS @datas;
	close(DATS);

	foreach (@datas){
		($b_detskazu,$b_asobimese,$b_kakikomi,$b_date) = split(/<>/);
		if($b_detskazu >=6){
			print "<font class=\"kachi\">$b_detskazu $b_asobimese コメント:$b_kakikomi $b_date</font><br>\n";
		}else{
			print "$b_detskazu $b_asobimese コメント:$b_kakikomi $b_date<br>\n";
		}
	}

}

####### メイン処理 ######
sub main{
	&counter;
	print 'あなたは ';
	print "$In{'kakikomi'}";
	print ' と書き込みしましたね。<br><br>'; # 全角空白は文字化けの為 ''を使って囲む。
	&asobkiroku;
	print << "EOF" ;
<br>
<form action="$this_cgi" method="POST">
<input type="text" name="kakikomi" size="40" maxlength="30">
<input type="submit" value="送信する">
</form>
EOF

}

#######ヘッダー出力
sub header {
	print "Content-type:text/html\n\n";
	print <<"EOF" ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=Shift_JIS">
<meta tttp-equiv="Content-Script-Type" content="taxt/javascript">
<meta http-equiv="Content-Style-Type" content="text/css">
<title>見本2</title>
<script language="JavaScript">
<!--
function DayWatch() {
    var day = new Date();

    if ( day.getYear() >= 2000 ){ var year = day.getYear() }
    else {  var year = day.getYear() +1900 }
    var month = day.getMonth()+1;
    var date = day.getDate();
        if (month < 10) {    //.日が一桁の時頭に0を付ける処理
            month = "0" + month;
                         }
        if (date < 10) {
            date = "0" + date;
                        }
    var time = new Date();
    var hour = time.getHours();
    var min = time.getMinutes();
    var sec = time.getSeconds();
        if (hour < 10) { //時・分・秒が1桁の時頭に0を付ける処理
            hour = "0" + hour;
                        }
        if (min < 10) {
            min = "0" + min;
                       }
        if (sec < 10) {
            sec = "0" + sec;
                       }
    document.Watch0.watch01.value = year +"/"+month+"/"+date+" "+hour+':'+min+':'+sec;
    setTimeout("DayWatch()", 1000);
}
//-->
</script>

<style type="text/css">
<!--
.kazu{
	color: #ff0000;
}
.kachi{
	color: #0000ff;
}

-->
</style>
</head>
<BODY BGCOLOR="#ffffff" onLoad="DayWatch()">
EOF
}

#デコード処理
sub decode {
	my ($query,$pair);
	if($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	} else {
		$query = $ENV{'QUERY_STRING'};
		if ($query ne "" && $getin == 1){&err("GET");}
	}
	my ($saizu)=length $query;
	if ($saizu > $max_size){&err("エラー・サイズオーバー");}
	
	foreach $pair (split(/&/, $query)) {
		my ($key, $value) = split(/=/, $pair);
	
	# 文字のデコード
		$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
		$value =~ s/\0/0/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/\r\n/<br>/g; #追加
		$value =~ s/\r|\n/<br>/g;
		$value =~ tr/+/ /;
		$In{$key} = $value;
	}
}

### フッタ #########
sub footer{
	print "<br><br><table border='1'>";
	print "<tr><th>フォーム要素名</th><th>データ</th></tr>";
	foreach $key (keys %In) {
		print "<tr><th>$key</th><td>$In{$key}</td></tr>\n";
	}
	print "</table><br>";
	print <<"EOF" ;
</BODY>
</html>
EOF
	exit;
}

###### エラー ########
sub err{
	if($_[1] ne "in"){
		&header;
	}
	print 'エラー'."<br>\n";
	print "$_[0]<br>\n";
	&footer;
	exit;

}
  • 下記のプログラムは一般的では無いかも知れませんがprint文で一気に書き出すのが楽ですし分りやすいです。 なので、モジュールは使用したくないのです。Perlでは、モジュール化して組み込む事も出来ます。
  • 下記のプログラムは動的に動かすにはクッキーとソート「配列の中の第一変数を参照して」並び替えを行っています。
  • 分らない単語はここではプログラミングについての記述になるのでここでは触れません。リファレンスや事典を参照してください。
#!d:/Perl/bin/perl
#上記はサーバーで動かす時はサーバーの仕様書を見て変えてください。

# このcgiの名前
$this_cgi = "mihon.cgi";

# GETでの取り込みを禁止する。1 または 0
$getin = 0;

# ファイルのサイズ指定
$max_size = 100;

# カウンタファイル
$cntfile = './count.cgi';
# 無い時に自動的に作成する
unless(-e "$cntfile"){
	open (FOUT, "> $cntfile") or &err("エラー・ファイルが作れません。");
	close (FOUT);
	chmod 0600,$cntfile;
}
# 
# カウンタの桁数
$mini_fig = 6;

# 記録ファイルの名前
$datafile = './kiroku.cgi';
# 無い時に自動的に作成する
unless(-e "$datafile"){
	open (FOUT, "> $datafile") or &err("エラー・ファイルが作れません。");
	close (FOUT);
	chmod 0600,$cntfile;
}
#
# 登録するクッキーの名前
$COOKIE_NAME = 'mihon';
# クッキーの有効期間
$COOKIE_LIFE = 7;

#取り込みファイルの下準備通常は別ファイルとして作ります。
$require_txt = "errgo.cgi";
# 無い時に自動的に作成する
unless(-e "$require_txt"){
	open (FOUT, "> $require_txt") or &err("エラー・ファイルが作れません。");
	print FOUT  "sub err_go { &err(\"エラークエストがありました。\");}\n1;\n"; #ファイルの終わりには「1;」が必要。出来たファイルを見てください。
	close (FOUT);
	chmod 0600,$require_txt;
}

####--------------------------------------------------------
require './errgo.cgi';
#sub err_go { &err("エラークエストがありました。");}
&decode;
&cookie_in;
if($In{'kakikomi'} eq "エラーゴー"){&err_go;} #エラーゴーと書かれた時エラーに行く。
&decode;
&cookie_in;
&header;
&main;
&footer;
exit;

#########  カウンタ処理
sub counter {
	local($count,$cntup);
	# カウントファイルを読みこみ
	open(CUNT,"< $cntfile") || &err("Open Error: cntfile","in");
	eval{flock(CUNT, 1);};
	$count = <CUNT>;
	close(CUNT);

	local($local_time);
	local($cnt,$kiroku_day,$keika_day,$today,$yestaday) = split(/<>/, $count);

	$local_time = time + (9*60*60);#GMT+9:00補正
	if (!$kiroku_day){
		$kiroku_day = $local_time - ($local_time % (24*60*60));
	}
	if ($local_time - $kiroku_day > 24*60*60){
		$keika_day += int(($local_time - $kiroku_day)/(24*60*60));
		if ($local_time - $kiroku_day > 2*24*60*60){
			$yestaday = 0;
		}else{$yestaday = $today;}
		$kiroku_day = $local_time - ($local_time % (24*60*60));
		$today = 0;
	}
	$today++;
	if (!$keika_day){$keika_day = 0; }
	if (!$yestaday){$yestaday = 0; } 

	$cnt++;
	open(CUNT,"> $cntfile") || &err("Write Error: cntfile","in");
	eval{flock(CUNT, 2);};
	print CUNT "$cnt<>$kiroku_day<>$keika_day<>$today<>$yestaday<>\n";
	close(CUNT);
	# 桁数調整
	while(length($cnt) < $mini_fig) { $cnt = '0' . $cnt; }
	&dates;
	print qq|<table border="0">\n|;
	print qq|<tr><td rowspan="3">\n|;
	print qq|<font size="6"class="kazu">$cnt</font><br>\n|;
	print qq|</td><td><font size="2">経過</font></td><td><font size="2">$keika_day</font></td></tr>\n|;
	print qq|<tr><td><font size="2">今日</font></td><td><font size="2">$today</font></td></tr>\n|;
	print qq|<tr><td><font size="2">昨日</font></td><td><font size="2">$yestaday</font></td></tr>\n|;
	print qq|<tr><td colspan="3"><font size="2"><form name="Watch0"><input type="text" name="watch01" size="25"></form></font></td></tr>\n|;
	print qq|</table><br>\n|;

}

###### 日付と時間
sub dates {
	#時間の整形
	$date_sec = time;
	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($date_sec);
#	local($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($date_sec); # 日時を使えるように開放
	local @week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	local $m_week = $week[$wday];
	$date = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",$year+1900,$mon+1,$mday,$week[$wday],$hour,$min,$sec);
}

##### 記録遊び
sub asobkiroku {
	$detskazu = int(rand(10))+1;
	if(6 <= $detskazu){$asobimese = 'あなたの勝ち';}else{$asobimese = 'あなたの負け';}

	open(DATS,"< $datafile") || &err("Open Error: datafile","in");
	eval{flock(DATS, 1);};
	@datas = <DATS>;
	close(DATS);

	unshift @datas,"$detskazu<>$asobimese<>$In{'kakikomi'}<>$date<>\n";
	if(@datas > 10){$#datas = 9;}

	open(DATS,"> $datafile") || &err("Write Error: datafile","in");
	eval{flock(DATS, 2);};
	print DATS @datas;
	close(DATS);

	foreach (@datas){
		($b_detskazu,$b_asobimese,$b_kakikomi,$b_date) = split(/<>/);
		if($b_detskazu >=6){
			print "<font class=\"kachi\">$b_detskazu $b_asobimese コメント:$b_kakikomi $b_date</font><br>\n";
		}else{
			print "$b_detskazu $b_asobimese コメント:$b_kakikomi $b_date<br>\n";
		}
	}
	# 先頭の要素による並び替え
	@keys1 = map {(split /<>/)[0]} @datas;
	@new_datas = @datas[sort {$keys1[$b] <=> $keys1[$a]} 0 .. $#keys1];

	print "<br><br>\n";
	foreach (@new_datas){
		($b_detskazu,$b_asobimese,$b_kakikomi,$b_date) = split(/<>/);
		if($b_detskazu >=6){
			print "<font class=\"kachi\">$b_detskazu $b_asobimese コメント:$b_kakikomi $b_date</font><br>\n";
		}else{
			print "$b_detskazu $b_asobimese コメント:$b_kakikomi $b_date<br>\n";
		}
	}

	print "<br><br>クッキーは $COOKIE{'kakikomi'} と $COOKIE{'date'} が表\示されます。<br><br>\n"; # 表は文字化けを起こすので\を入れます。

}

####### メイン処理 ######
sub main{
	&counter;
	print 'あなたは ';
	print "$In{'kakikomi'}";
	print ' と書き込みしましたね。<br><br>'."\n"; # 全角空白は文字化けの為 ''を使って囲む。
	&asobkiroku;
	print << "EOF" ;
<br>
<form action="$this_cgi" method="POST">
<input type="text" name="kakikomi" size="40" maxlength="30">
<input type="submit" value="送信する">
</form>
EOF

}

### クッキーに値をセット ####
sub set_cookie{
	if ($In{'kakikomi'}){	#書込の時限定。
#		if (!$In{'coodel'}){
			&dates; # 日付と時間のサブルーチン
			$COOKIE{'kakikomi'} = $In{'kakikomi'};
			$COOKIE{'date'}  = $date;
#		}
	}
}

### クッキー読み出し ######
sub cookie_in{
	my ($pair, $cpair);
	
	foreach $pair (split(/;\s*/, $ENV{'HTTP_COOKIE'})) {
		my ($name, $value) = split(/=/, $pair);
		
		# 単一のクッキー値から%COOKIEにデコード
		if($name eq $COOKIE_NAME) {
			foreach $cpair (split(/&/, $value)) {
				my ($cname, $cvalue) = split(/#/, $cpair);
				
				$cvalue =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
				$COOKIE{$cname} = $cvalue;
			}
			last;
		}
	}
}

### クッキー発行 ####
sub cooki_hakkou{
	&set_cookie; # クッキーのセット
	my	(@cpairs, $cname, $cvalue, $value);
	if ($In{'coodel'}){$COOKIE_LIFE = -1;} # クッキー消去
	# %COOKIEを単一のクッキー値にエンコード
	foreach $cname (keys %COOKIE) {
		$cvalue = $COOKIE{$cname};
		$cvalue =~ s/(\W)/sprintf("%%%02X", ord $1)/eg;
		push @cpairs, "$cname#$cvalue";
	}
	$value = join('&', @cpairs);
	
	# グリニッジ標準時の文字列
	my	@mon_str = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	my	@wdy_str = qw(Sun Mon Tue Wed Thu Fri Sat);
	my	$life = $COOKIE_LIFE * 24 * 60 * 60;
	my	($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime(time + $life);
	my	$date = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
			$wdy_str[$wday], $mday, $mon_str[$mon], $year + 1900, $hour, $min, $sec);

	return ("Set-Cookie: $COOKIE_NAME=$value; expires=$date\n");
}


#######ヘッダー出力
sub header {
	($my_cookie) = &cooki_hakkou;
	print "$my_cookie";
	print "Content-type:text/html\n\n";
	print <<"EOF" ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=Shift_JIS">
<meta tttp-equiv="Content-Script-Type" content="taxt/javascript">
<meta http-equiv="Content-Style-Type" content="text/css">
<title>見本2</title>
<script language="JavaScript">
<!--
function DayWatch() {
    var day = new Date();

    if ( day.getYear() >= 2000 ){ var year = day.getYear() }
    else {  var year = day.getYear() +1900 }
    var month = day.getMonth()+1;
    var date = day.getDate();
        if (month < 10) {    //.日が一桁の時頭に0を付ける処理
            month = "0" + month;
                         }
        if (date < 10) {
            date = "0" + date;
                        }
    var time = new Date();
    var hour = time.getHours();
    var min = time.getMinutes();
    var sec = time.getSeconds();
        if (hour < 10) { //時・分・秒が1桁の時頭に0を付ける処理
            hour = "0" + hour;
                        }
        if (min < 10) {
            min = "0" + min;
                       }
        if (sec < 10) {
            sec = "0" + sec;
                       }
    document.Watch0.watch01.value = year +"/"+month+"/"+date+" "+hour+':'+min+':'+sec;
    setTimeout("DayWatch()", 1000);
}
//-->
</script>

<style type="text/css">
<!--
.kazu{
	color: #ff0000;
}
.kachi{
	color: #0000ff;
}

-->
</style>
</head>
<BODY BGCOLOR="#ffffff" onLoad="DayWatch()">
EOF
}

#デコード処理
sub decode {
	my ($query,$pair);
	if($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	} else {
		$query = $ENV{'QUERY_STRING'};
		if ($query ne "" && $getin == 1){&err("GET");}
	}
	my ($saizu)=length $query;
	if ($saizu > $max_size){&err("エラー・サイズオーバー");}
	
	foreach $pair (split(/&/, $query)) {
		my ($key, $value) = split(/=/, $pair);
	
	# 文字のデコード
		$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
		$value =~ s/\0/0/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/\r\n/<br>/g; #追加
		$value =~ s/\r|\n/<br>/g;
		$value =~ tr/+/ /;
		$In{$key} = $value;
	}
}

### フッタ #########
sub footer{
	print "<br><br><table border='1'>";
	print "<tr><th>フォーム要素名</th><th>データ</th></tr>";
	foreach $key (keys %In) {
		print "<tr><th>$key</th><td>$In{$key}</td></tr>\n";
	}
	print "</table><br>";
#------- クッキー要素名 ---------
	my ($name, $value);
	print "<table border='1'>";
	print "<tr><th>クッキー要素名</th><th>データ</th></tr>";
	while (($name, $value) = each(%COOKIE)) {
		print "<tr><td>$name</td><td>$value</td></tr>\n";#\\n
	}
	print "</table><br>";
	print <<"EOF" ;
</BODY>
</html>
EOF
	exit;
}

###### エラー ########
sub err{
	if($_[1] ne "in"){
		&header;
	}
	print 'エラー'."<br>\n";
	print "$_[0]<br>\n";
	&footer;
	exit;

}

サーバー攻撃の防御編集

  • アクセスポイントの環境変数を用いてプログラムを守るものです。
  • 設置は出来るだけ上の方に書いた方が良いと思います。
#!D:/Perl/bin/perl

#!/usr/local/bin/perl
#このプログラム名
# in_atakka.cgi
#作成されるファイル atakka.cgi
&in_atakka;
sub in_atakka {
	local($c_tim,@tem_atakku,$i,$ma_aru,@tem_atakku_new,$ma_addr,$ma_host,$ma_tim,$ma_kaisu,@new_atakku_new,$count11);
	my $get_host = $ENV{'REMOTE_HOST'};
	my $get_addr = $ENV{'REMOTE_ADDR'};
	if ($get_host eq "" || $get_host eq $get_addr) {
		$get_host = gethostbyaddr(pack("C4", split(/\./, $get_addr)), 2) || $get_addr;
	}
	$c_tim = time;

	if(!(-e "atakka.cgi")){
		open(AT,"> atakka.cgi") || &disp;
		close(AT);
	}
	
	open(AT,"< atakka.cgi") || &disp;
	eval{ flock (AT, 1); };
	@tem_atakku = <AT>;
	close(AT);
	$i=0;
	$ma_aru =0;
	@tem_atakku_new = (@tem_atakku);
	foreach (@tem_atakku){
		($ma_addr,$ma_host,$ma_tim,$ma_kaisu) = split(/<>/);
		if($ma_addr eq $get_addr && $get_host eq $ma_host && $ma_kaisu > 5){
			if($ma_tim + 600 < $c_tim){$ma_kaisu = 0;}else{&disp;}
		}
		if(!($ma_addr eq $get_addr && $get_host eq $ma_host) && $ma_kaisu > 5){ #5
			$i++;
			next;
		}
		if($get_addr eq $ma_addr && $get_host eq $ma_host && $c_tim < $ma_tim + 2){
			$ma_kaisu++;
			$tem_atakku_new[$i] = "$get_addr<>$get_host<>$c_tim<>$ma_kaisu<>\n";
			$ma_aru =1;
			last;
		}else{
			$ma_aru =0;
			$ma_kaisu = 0;
			unless($#tem_atakku_new < 0 && $ma_kaisu > 5){splice(@tem_atakku_new,$i,1);}
			last;
		}
		$i++;
	}
	foreach (@tem_atakku_new){
		($ma_addr,$ma_host,$ma_tim,$ma_kaisu) = split(/<>/);
		if($c_tim > $ma_tim + 600){next;} #経過済みのタイムアウト者を消す。10分
		if(@tem_atakku_new > 3 && $c_tim > $ma_tim + 3 && $ma_kaisu <= 2){ #30以上の参加者で3秒以上経過して2回以下なら消すtest 3
			next;
		}
		push @new_atakku_new,"$_";
	}
	@tem_atakku_new = (@new_atakku_new);
	if(!$ma_aru){
		if(@tem_atakku_new > 5){&disp("アクセスが多いのでお待ちください。");} #50以上の参加者の時は新規に入るのを待ってもらう。test 5
		push @tem_atakku_new,"$get_addr<>$get_host<>$c_tim<>1<>\n";
	}
	if(@tem_atakku_new == 0){&disp("exit");}
	open(AT,"> atakka.cgi") || &disp("Fail");
	eval{ flock (AT, 2); };
	$count11 = 0;
	foreach (@tem_atakku_new){
		if(m/$get_host+/){$count11 = 1;}
	}
	if(!$count11){close(AT);&disp("exit2");}
	print AT @tem_atakku_new;
	close(AT);
	if(-z "atakka.cgi"){&disp("Fail=0");}
}

sub disp{
	print "Content-type:text/html; charset=Shift_JIS\n\n";
print <<"EOF";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<HTML>
<HEAD>
<TITLE>エラー</TITLE>
</HEAD>
<BODY>
<h1>過負荷によるエラーが起こりました。</h1>
$_[0]<br>
<h2>10分ほど経ったらもう一度試してみてください。</h2>
<Script Language="JavaScript">
<!--
alert("10分ほど経ったらもう一度試してみてください。");
// End -->
</Script>
<br><br>
</BODY>
</html>
EOF
	exit;
}

####本文
	local(@tem_atakku_new,$prit_out,$ma_addr,$ma_host,$ma_tim,$ma_kaisu);
	open(AT,"< atakka.cgi") || &disp;
	eval{ flock (AT, 1); };
	@tem_atakku_new = <AT>;
	close(AT);

	foreach (@tem_atakku_new){
		($ma_addr,$ma_host,$ma_tim,$ma_kaisu) = split(/<>/);
		$prit_out .= "($ma_addr,$ma_host,$ma_tim,$ma_kaisu)<br>\n";
	}
	print "Content-type:text/html; charset=Shift_JIS\n\n";
print <<"EOF";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<HTML>
<HEAD>
<TITLE>アタックチェック</TITLE>
</HEAD>
<BODY>
<h1>ファイル内容確認</h1>
$prit_out
<br><br><br><br><br><br><br><br><br><br><br><br>
</BODY>
</html>
EOF
	exit;

IPで管理者識別編集

  • 自分の今のIPを登録識別する事で不正アクセスをしにくくする。
  • ディレクトリと2つのプログラムによる共有データを使う。
main.cgi 実行ファイル
フォルダー host3 を作ってください。
  host.cgi 実行ファイル
  in_host.cgi 空ファイル
  host_koushin_ari.txt 空ファイル
##################### main.cgi #####################
#!D:/Perl/bin/perl

# サーバーに合わせて下さい
#!/usr/local/bin/perl

#!C:/Perl/bin/perl
# このファイルの名前
$this_cgi = "main.cgi";
# データー量
$max_size = 500;
# get禁止 1
$getin =1;
# 入口で強化するか
$host_kyuka = 'yes';
# 許可管理者名
$ohna_name = 'ウィキブックス';
# オーナーパスの設定(変更してください)
$ohna_pas = '0000';
# 管理者IPの簡易登録の合言葉
$aikotoba = 'wikibooks';
# ホスト管理用専用cgi
$host_cgi = "./host3/host.cgi";
# ホストのファイル
$in_host = "./host3/in_host.cgi";
# ホスト変更・追加などの報告
$koshin_fail = './host3/host_koushin_ari.txt';
# 記録しておくIPの数  1個多くなります。0の時1個
$ip_kazu = 5;
##########################
&decode;
if($In{'mode'} eq 'nyuryoku'){&nyuryoku;}
if($In{'mode'} eq 'admin'){&admin;}
&syoki;
exit;

######
sub syoki {
	&acsesu;
	print "Content-type:text/html\n\n";
	print <<"EOF" ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>メイン</title>
</head>
<BODY BGCOLOR="#ffffff">
<br>
<form action="$this_cgi" method="POST">
<input type="hidden" name="mode" value="nyuryoku">
<input type="submit" value="管理室入り口へ"><br>
</form>
<form action="$host_cgi" method="POST">
<input type="submit" value="ホスト管理明細"><br>
</form>
<br><br>
$host_mes
<br><br>
EOF

	if ($ohna_name eq $In{'kanrisya_name'} && $ohna_pas && $ohna_pas eq $In{'kanrisya_pas'}){ #管理者のみ表示
		if(-e "$koshin_fail"){
			open (FIN, "$koshin_fail") or &err("エラー・ファイルが開けません..koshin_fail");
			eval{ flock (FIN, 1); };
			$tem_atakku = <FIN>;
			close(FIN);
			($henkou_time,$mese1,$mese2) = split(/ /, $tem_atakku);
			$now_time = time;
			if($now_time > $henkou_time + 2*24*60*60){$mese1 = "";$mese2 = "";}else{print "$mese1 $mese2<br>\n";}
		}
	}else{
		print "管理者不一致<br>\n";
	}
	print "<br><br><table border='1'>";
	print "<tr><th>フォーム要素名</th><th>データ</th></tr>";
	foreach $key (keys %In) {
		print "<tr><th>$key</th><td>$In{$key}</td></tr>\n";
	}
	print "</table><br>";

	print <<"EOF" ;
</BODY>
</html>
EOF
	exit;
}

### アクセス管理 ##############
sub acsesu {
	$host = $ENV{'REMOTE_HOST'};
	$addr = $ENV{'REMOTE_ADDR'};

	(@in_addr) = split(/\s/, $addr);
	$addr = $in_addr[0];
	$addr_in = $addr;

	if ($host eq "" || $host eq $addr) {
		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr;
	}
	if ($host eq "") {$host = $addr;}
	$host_in = $host;
	if ($host_kyuka eq 'yes' && (-e "$in_host")){
		if(!(-z "$in_host")){
			open(IN,"< $in_host") || &err2("Open Error : in_host");
			eval{ flock (IN, 1); };
			$kanri_ip = <IN>;
			close(IN);
			chomp $kanri_ip;
			(@m_ip) = split(/<>/,$kanri_ip);
			$ok = 0;
			foreach (@m_ip){
				if($_ eq "$host_in $addr_in"){$ok = 1;last;}
			}
			if($_[0]){return ($ok);}
			if(!$ok){
				$ohna_pas = "";
				$host_mes = "ホスト一致がありません。";
			}else{
				$host_mes = "ホスト一致があります。";
			}
		}
	}
}
#デコード処理
sub decode {
	my ($query,$pair);
	if($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	} else {
		$query = $ENV{'QUERY_STRING'};
		if ($query ne "" && $getin == 1){&err("GET");}
	}
	my ($saizu)=length $query;
	if ($saizu > $max_size){&err("エラー・サイズオーバー");}
	
	foreach $pair (split(/&/, $query)) {
		my ($key, $value) = split(/=/, $pair);
	
	# 文字のデコード
		$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
		$value =~ s/\0/0/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/\r\n/<br>/g; #追加
		$value =~ s/\r|\n/<br>/g;
		$value =~ tr/+/ /;
		$In{$key} = $value;
	}
}

sub nyuryoku{
	print "Content-type:text/html\n\n";
	print <<"EOF" ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>管理室入り口</title>
</head>
<BODY BGCOLOR="#ffff00">
<br>
<form action="$this_cgi" method="POST">
<input type="hidden" name="mode" value="admin">
<input type="text" name="kanrisya_name" value="" maxlength="30">名前<br>
<input type="text" name="kanrisya_pas" value="" maxlength="30">パスワード<br>
<input type="text" name="aikotoba" value="" maxlength="30">IP合言葉ホストが変更なしの場合書かなくてよい<br>
<input type="submit" value="送信">
</form>
</BODY>
</html>
EOF
	exit;
}

##### 
sub admin{
	($okok) = &acsesu(1);
	if(!($ohna_name eq $In{'kanrisya_name'} && $ohna_pas eq $In{'kanrisya_pas'})){return;}
	if($aikotoba eq $In{'aikotoba'} && !$okok){
		$host = $ENV{'REMOTE_HOST'};
		($addr) = split(/ /, $ENV{'REMOTE_ADDR'});
		if ($host eq "" || $host eq $addr) {
			$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr;
		}
		if ($host eq "") { $host = $addr; }
		open (IN, "< $in_host") or &err("エラー・ファイルが開けません in_host");
		eval{ flock (IN, 1); };
		$f_host = <IN>;
		@host_kiroku = <IN>;
		close (IN);
		chomp $f_host;
		(@f_in_host) = split(/<>/, $f_host);
		$purasu = 0;
		foreach $deta(@f_in_host){
			if("$host $addr" eq $deta){$purasu = 1;}
			push @new_f_in_host,$deta;
		}
		if(!$purasu){unshift @new_f_in_host,"$host $addr";}
		if($#new_f_in_host > $ip_kazu){$#new_f_in_host = $ip_kazu;}
		$new_f_host = join ("<>",@new_f_in_host);
		$new_f_host .= "<>\n";
		($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time) ;	#一括取り入れ
		$year += 1900;	# $year = $year + 1900 と同じ
		++$mon ;
		@youbi=('日','月','火','水','木','金','土');
		$mond = sprintf("%02d",$mon);
		$mdayd = sprintf("%02d",$mday);
		$hourd = sprintf("%02d",$hour);
		$mind = sprintf("%02d",$min);
		$secd = sprintf("%02d",$sec);
		$jikan = "$year年$mond月$mdayd日$youbi[$wday]曜日$hourd時$mind分$secd秒";
		if($#host_kiroku >= 24){$#host_kiroku = 24;}
		unshift @host_kiroku,"$host $addr<>$jikan<>$host<>$ENV{'REMOTE_HOST'}<>$addr<>$ENV{'REMOTE_ADDR'}<>\n";
		open (OUT, "> $in_host") or &err("エラー・ファイルが開けません in_host");
		eval{ flock (OUT, 2); };
		print OUT $new_f_host;
		print OUT @host_kiroku ;
		close (OUT);
		$ima_time = time;
		open (FOUT, "> $koshin_fail") or &err("エラー・ファイルが開けません koshin_fail");
		eval{ flock (FOUT, 2); };
		print FOUT "$ima_time $host 許可ホストの変更がありました。";
		close (FOUT);
	}elsif(!$okok){return;}
	print "Content-type:text/html\n\n";
	print <<"EOF" ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>管理室</title>
</head>
<BODY BGCOLOR="#00ffff">
<br>
<form action="$this_cgi" method="POST">
<input type="text" name="kanrisya_name" value="$In{'kanrisya_name'}" maxlength="30"><br>
<input type="text" name="kanrisya_pas" value="$In{'kanrisya_pas'}" maxlength="30"><br>
<input type="submit" value="トップページに値を持って帰る">
</form><br>
管理者の処理を行う場所です。
EOF
	exit;
}

###### エラー ########
sub err{
	if($_[1] ne "in"){
		print "Content-type:text/html\n\n";
		print <<"EOF" ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>エラー</title>
</head>
<BODY BGCOLOR="#ffffff">
EOF
	}
	print 'エラー'."<br>\n";
	print "$_[0]<br>\n";
	print <<"EOF" ;
</BODY>
</html>
EOF
	exit;
}
####################### host3/host.cgi #########################
#!D:/Perl/bin/perl

# サーバーに合わせて下さい
#!/usr/local/bin/perl

#!C:/Perl64/bin/perl

##### 開発記録など ############
# ver1.01
#
# host.cgi  700(パーミッション)
##### 設定 ####################
# このcgiのファイルの名前
$this_cgi = 'host.cgi';

# オーナーパスの設定(変更してください)
$ona_pas = 'wiki';

# 許可管理者名
$kanre_name = 'ウィキブックス';

$ona_id = 'うぃきぺでぃあ';

$hozon_fail = 'in_host.cgi';

unless(-e $hozon_fail){
	open (FIN, "> $hozon_fail") or &err2("エラー・ファイルが開けません.0");
	close (FIN);
}

# 更新案内ファイル名
$koshin_fail = 'host_koushin_ari.txt';
# 記録しておくIPの数  1個多くなります。0の時1個
$ip_kazu = 5;
# get = 1 GET受け入れ禁止
$get_no = 1;
#=====================
&loadformdata;	#フォーム入力
&getoin;

sub getoin{
	print "Content-type:text/html;\n\n";
	print <<EOF ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=Shift_JIS">
<title>許可ホスト変更</title>
</head>
<body>
EOF

	$host = $ENV{'REMOTE_HOST'};
	($addr) = split(/ /, $ENV{'REMOTE_ADDR'});
	if ($host eq "" || $host eq $addr) {
		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr;
	}
	if ($host eq "") { $host = $addr; }
	$disp_ok = 0;
	if($FORM{'name'} eq $kanre_name && $FORM{'id'} eq $ona_id && $FORM{'pas'} eq $ona_pas && $FORM{'kanri'} eq $FORM{'kensa'}){
		open (IN, "< $hozon_fail") or die;
		eval{ flock (IN, 1); };
		$f_host = <IN>;
		@host_kiroku = <IN>;
		close (IN);
		chomp $f_host;
		(@f_in_host) = split(/<>/, $f_host);
		$purasu = 0;
		foreach $deta(@f_in_host){
			$i = 0;$loop = 0;
			foreach (0..$#f_in_host){
				$d_no = "d_no$i";
				if($FORM{$d_no} eq $deta){$loop = 1;}
				$i++;
			}
			if(!$loop){
				if("$FORM{'host_in'}" eq $deta){$purasu = 1;}
				push @new_f_in_host,$deta;
			}
		}
		if(!$purasu){unshift @new_f_in_host,"$FORM{'host_in'}";}
		if($#new_f_in_host > $ip_kazu){$#new_f_in_host = $ip_kazu;}
		$new_f_host = join ("<>",@new_f_in_host);
		$new_f_host .= "<>\n";
		&get_time;
		if($#host_kiroku >= 24){$#host_kiroku = 24;}
		unshift @host_kiroku,"$FORM{'host_in'}<>$jikan<>$host<>$ENV{'REMOTE_HOST'}<>$addr<>$ENV{'REMOTE_ADDR'}<>\n";
		$host_in = $FORM{'host_in'};
		open (OUT, "> $hozon_fail") or die;
		eval{ flock (OUT, 2); };
		print OUT $new_f_host;
		print OUT @host_kiroku ;
		close (OUT);
		$ima_time = time;
		open (FOUT, "> $koshin_fail") or die;
		eval{ flock (FOUT, 2); };
		print FOUT "$ima_time $host 許可ホストの変更がありました。";
		close (FOUT);
		$disp_ok = 1;
	}
	$kensa = sprintf("%04d",int(rand(10000)));
	print <<EOF ;
<h2 align="center">許可ホスト変更</h2><br>
<div align="center">
host = $host<br>
addr = $ENV{'REMOTE_ADDR'}<br><br>
<form action="$this_cgi" method="post">
名前:<input type="text" name="name"><br>
ID:<input type="text" name="id"><br>
パスワード:<input type="password" name="pas"><br>
確認:<input type=text name="kensa"> <font color=#ff0000>$kensa</font>を左に入れてください
<input type=hidden name=kanri value=$kensa><br>
現在のホスト $host $addr<br>
設定ホスト:<input type=text name="host_in" value="$host $addr" size="50"><br>
<input type=submit value=" 送 信 "><br>
EOF
	if($disp_ok == 1){
		$i = 0;
		foreach (@new_f_in_host){
			print "<input type=\"checkbox\" name=\"d_no$i\" value=\"$_\">$_<br>\n";
			$i++;
		}
	}
	print <<EOF ;
</form>
EOF

	foreach (@host_kiroku){
		($host_disp0,$time_disp,$raitu_host,$addr_disp,$host_disp,$addr0_disp) = split(/<>/);
		chomp $addr0_disp;
		print "$host_disp0 , $time_disp : $raitu_host , $addr_disp , $host_disp , $addr0_disp<br>\n";
	}
	print "</div></body></html>\n";
	exit;
}

### フォーム受信 ##########
sub loadformdata {
	$max_size = 200;
	my ($query,$pair);
	if($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	} else {
		$query = $ENV{'QUERY_STRING'};
		if ($get_no ==1 && $query ne ""){&err2("エラー・GET 禁止");}
	}
	my ($saizu)=length $query;
	if ($saizu > $max_size){&err2("エラー・サイズオーバー");}
	foreach $pair (split(/&/, $query)) {
		my ($key, $value) = split(/=/, $pair);
		# 文字のデコード
		$value =~ tr/+/ /;
		$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
		$value =~ s/\0/0/g;
		$value =~ s/&/&amp;/g;
		if($value =~ m/</ ){&err2("禁止コード < があります。");}
		if($value =~ m/>/ ){&err2("禁止コード > があります。");}
		$value =~ s/"/&quot;/g;
		$value =~ s/\x0D\x0A/<br>/g;
		$value =~ s/\r|\n/<br>/g; #追加
		$value =~ tr/\t//;
		$FORM{$key} = $value;
	}
	(@kennsa) = split(/ /, $FORM{'host_in'});
	if($kennsa[2]){&err2("コードの書き込み違反");}
}

### 現在の時間出し ###############
sub get_time{
	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time) ;	#一括取り入れ
	$year += 1900;	# $year = $year + 1900 と同じ
	++$mon ;
	@youbi=('日','月','火','水','木','金','土');
	$mond = sprintf("%02d",$mon);
	$mdayd = sprintf("%02d",$mday);
	$hourd = sprintf("%02d",$hour);
	$mind = sprintf("%02d",$min);
	$secd = sprintf("%02d",$sec);
	$jikan = "$year年$mond月$mdayd日$youbi[$wday]曜日$hourd時$mind分$secd秒";
}
sub err2{
	print "Content-type:text/html;\n\n";
	print <<EOF ;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=Shift_JIS">
<title>エラー</title>
</head>
<body>
<h2 align="center">$_[0]</h2><br>
</body></html>
EOF
	exit;
}

関連書籍編集

このページ「CGI」は、書きかけです。加筆・訂正など、協力いただける皆様の編集を心からお待ちしております。また、ご意見などがありましたら、お気軽にノートへどうぞ。