CGI

出典: フリー教科書『ウィキブックス(Wikibooks)』
ナビゲーションに移動 検索に移動

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

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

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

概要[編集]

実は、webサーバのApacheは、(世間一般でサーバ向けプログラム言語と言われている)PHPやPerlのコードだけでなく、C言語をコンパイルしたバイナリファイルも実行できます。(ただし、バイナリなので、そのパソコンごとにコンパイルしなおす必要があるので、取り回しが悪いので、用途は例外的に処理速度が極端に必要な場合以外には、めったにC言語バイナリの読み取りは用いられない。)

CGIとは、主にwebサーバが、PerlやPHPやコンパイル済みC言語バイナリなど、なんらかのプログラミング言語の内容を実行する事です。

ですが、2010年以降の現代では、webサーバでPerlを実行することだけを「CGI」という場合もあり、用語の定義が人によって異なり、不統一です。

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

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

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

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

慣習的な狭い意味では「CGI」とは、webサーバでPerlスクリプトを実行する事です。


C言語でCGI[編集]

たしか初期設定ではApacheはCGIの実行を禁じているので、まずは設定書き換えの必要があり、そのため設定ファイル httpd.conf ファイルを書き換えることになる。

場所は、\xampp\apache\conf の中に設定ファイル

「http.conf」

があるので、探して httpd.conf のファイルの中身の下記のような部分を、下記のようになるように書き換える。

linuxの(LAMPではなく)素のApacheの場合、 /etc/httpd/conf に httpd.conf があります。なお、Linuxの場合、初期設定では所有者がroot所有者に設定されているために読み取り専用になってるので、書き込み編集できるように設定を変えておいてください。

sudo chown ログインユーザ名 /etc/httpd/conf/httpd.conf

で設定を書き込み可能にできます。

CGI使用設定の方法[編集]

設定の方法は2種類あります。

<Directory /> タグの内容を書き換える方法[編集]

書き換え前
<Directory />
    AllowOverride none
    Require all denied
</Directory>
書き換え後
AllowOverride のあとを none から ALL に書き換える。
Optionsのあとを「ExecCGI」に書き換える。
<Directory "C:/xampp/cgi-bin">
    AllowOverride All
    Options ExecCGI
    Require all granted
</Directory>

ScriptAlias を書き換える方法[編集]

ScriptAlias という行を、下記のようになるように、書き換えます。

ScriptAlias /cgi-bin/ "/var/www/cgi-bin/"


どちらの方法で編集するにしても、もしApacheをすでに立ち上げていたら、いったんApacheを終了してから、再度、立ち上げ癒し手下さい。

Apacheの起動時に設定ファイルを読み込む方式のようなので、立ち上げ直さないと、設定が反映されない場合があります。

Apacheを終了させるには、コマンド

sudo service httpd stop

でApacheが終了します。

右上のXボタンを押してコマンドラインなどのウィンドウを閉じるだけでは、Apacheが終了しない場合が普通なので、終了させるためにはコマンド入力で確実に、いったんApacheを終了させてください。

Apacheを立ち上げるには、コマンド

sudo service httpd start 

で立ち上がります。

次の作業[編集]

今後の作業の暗黙の前提として、Apacheサーバーを立ち上げるのを忘れないように(よく忘れてエラーになる)。さっさと先にApacheサーバを立ち上げよう。


さて、たとえば、下記のようなC言語ファイルをテキストファイル(『メモ帳』で良い)に書いて、コンパイル(gccでも良い)して、実行ファイル(windowsならexeファイル)にしよう。

コード例
#include <stdio.h>

int main(void) {
  printf("Content-Type: Text/html\r\n\r\n");

  int a = 3, b = 4;
  int c = a + b;
  printf("sum %d\n", c);

  return 0;
}


Content-Type: Text/html というのは、Apache側が解釈のために必要な情報であり、これから送られてくるprintf文の内容が、テキストファイルまたはHTMLファイルであることを宣言しているテキスト文です。「HTMLヘッダ」などと言われる、webでの情報のやりとりをする際の、送受信メッセージ文の一種です。

さて、Windows版ApacheであるXAMPPの場合、上記コード例をコンパイルして出来上がった実行ファイル(ファイル名を指定しなければWindows版gccなら「 a.exe 」という名前になる)を、 フォルダ

\xampp\cgi-bin

に入れればいい。

Linux版の素のApacheの場合、フォルダ cgi-bin の場所は

/var/www

ですので、そこにa.outなどの実行ファイルをいれればすみます。ですが、初期設定では、root所有になってますので、chownコマンドで所有者を変えてください。

sudo chown ログインユーザ名 /var/www/cgi-bin


※ なお、英語で「sum」(合計)と書いている理由は、文字コードの理由。標準設定では、Windows日本語版の文字コードの Shift-JIS にApacheが設定していないので、Windows版Apacheで日本語を表示するには、設定が多く必要で、難しい。
もし仕事で本格的にApacheを使いたい場合、こういった国際化対応の理由などから、なるべくOSはLinuxが良いだろう。サーバ業界ではLinuxが標準である。


とにかく、cgi-bin フォルダにバイナリファイルを入れたら、のあと単にwebブラウザで

http://localhost/cgi-bin/a.exe

にアクセスすればいい。

または実行ファイル名がa.exe以外の別のファイル名なら、

http://localhost/cgi-bin/実行ファイル名

にアクセスすればいい。

すると、

上記コードの場合

sum 7

というふうに、webページでprintf文の内容が表示される。(Linux版Apacheでも同様の結果です。Fedora 32 で2020年7月14日に確認。)


C言語バイナリだろうが、Apache側がHTMLファイルを解釈してくれるので、なので、下記のようにprintf文中にHTMLタグを書いてバイナリ化しておけば、自動的にApacheがうまく変換して、ブラウザにHTMLタグの指示通りに表示できるようにしてくれる。

コード例
#include <stdio.h>

int main(void) {
  printf("Content-Type: Text/html\r\n\r\n");

  int a = 3, b = 4;
  int c = a + b;
  printf("<h1>sum %d</h1>\n", c);

  return 0;
}

上記コードをコンパイルしたバイナリファイルをフォルダ cgi-bin に入れたあと、webブラウザでアクセスすると、大きな文字で、

sum 7

と表示される。 (Linuxでも同様の結果です。Fedora 32 で2020年7月14日に確認。)

CGIそのものの実装方法[編集]

もし、興味あるのがCGIを使ったサーバ公開ではなく、CGIそのものの機能を作りたい場合、そのためのCGIの原理の知識は色々と考えられますが、OSのコマンドラインに搭載されている

標準出力のリダイレクト機能を使う方法

が、原理的と思われる方法です。(なお、理解のために方法を紹介しているだけであり、通常のサーバ構築ではCGI機能自体の新規の実装は不要な作業です。すでにApacheなどの既存のサーバソフトにCGI機能が搭載されているからです。)

また、OSのコマンドラインへの命令をプログラム化する方法については、Windowsならバッチファイル、Linuxならシェルスクリプトを用いて自動化できます。

本科目では、リダイレクトについて説明します。バッチファイルの解説は別の科目にゆだねます。

Windowsの場合[編集]

リダイレクトについては、Windowsの場合、DOSプロンプトで

 実行ファイル名 1> リダイレクト先のファイル名

と入力すれば、標準出力に出される文字列がそのまま、リダイレクト先のファイルに書き込まれて保存されます。


たとえば実行ファイル名「hello.exe」で、リダイレクト先ファイル名「ridtest.txt」なら

 hello.exe 1> ridtest.txt 

というコマンドになります。


間の演算子の機能は、

1> だと実行ファイル成功時のリダイレクト、
2> だと実行ファイル失敗時のエラーメッセージのリダイレクト、

になります。

Apacheなどのwebサーバは、指定されたCGI用のフォルダ内にある実行ファイルについては、すべてリダイレクトして実行すれば、それの出力文字列がテキストファイル(内容はHTMLファイルのこと)になりますので、あとは他のHTMLファイルと同様にリダイレクト先テキストファイルを読み取って表示すればいいだけです。

Linuxなど別OSでも、記法は違いますが、同様のリダイレクト機能があるので、それを使えばCGI機能が簡単に実装できるでしょう。

Linux の場合[編集]

実行ファイルがホームフォルダにある場合、

リダイレクトのためのコマンドの書式は、OSの搭載しているシェルにもよりますが、Fedora32で確認したところ(確認日: 2020年7月25日)、

./実行ファイル名 1> リダイレクト先のファイル名

です。これで、リダイレクト先ファイルに、書き込まれます。(おそらく、シェルがbashなら他Linuxでも同じコマンドかと思われます。)


たとえば実行ファイル名「hello.o」で、リダイレクト先ファイル名「ridtest.txt」なら

./hello.o 1> ridtest.txt 

というコマンドになります。


なお、間の演算子の機能は、

1> だと実行ファイル成功時のリダイレクト、
2> だと実行ファイル失敗時のエラーメッセージのリダイレクト、

になります。


開発の参考[編集]

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

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

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

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

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

w:とほほの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はIPv4において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で起動です。
      •  Windowsでは通知領域「USB 抜差し等の▲の中」に入っています。
  • Perl http://www.activestate.com/ の中の アクティブパル http://www.activestate.com/activeperl/downloads 自分のパソコンを選んでね。トップページは見てください。
  • パールはPerl64の場合64を取ってPerlとして覚えて置いてください。パール → アパッチ の順でインストールしてください。
  • 過去にウイルス対策ソフト「ノートン」において動作させられませんでしたが、現在は改善されているものと思われます。
  • Perlリファレンスなど公開されているリファレンス(レファレンス(reference)とも言う) を組み合わせて一つのプログラムとして組み上げます。
  • 不勉強の為、ウインドウズしか持って居ないのでそれしか分りません。詳しくは加筆お願いします。


PHPやPerlとは関係なく、一般に Apache の起動の方法は、Linux(Fedora32)の場合、ターミナル画面で、コマンド

sudo systemctl start httpd

です。(CentOS 7 以降はこうのようです。)

httpd とはlinuxの場合、Apache のことです。

なお、昔は

sudo service httpd start

というコマンドのようでした。


Apache が正常に動いているか確かめるには、ブラウザを開き、アドレスバーに

http://localhost

と入力します。

Apache ロゴマークの羽

バージョンにもよりますが、Apacheのロゴマークの羽の絵のあるwebページが表示されていれば、たぶんインストール成功しているでしょう。


Apache を終了するには、Linuxならターミナル端末で

systemctl stop httpd

で終了します。

昔は

service httpd stop

で終了でした。

終了後に先程の localhost のリンク先に移動しても、何も読み込みできないハズです。(Apacheを終了したので、読み込みできないのが成功。) そもそもアパッチをどうインストールすればいいかについては、たとえば『PHP/確実に動作させるまで』などに解説がある。(2020年4月21日の時点では、まだ Apache 専用のページはWikibooks日本語版には無い。)


Linux の CentOS系の場合、フォルダ階層 var/www/html に、目的のhtmlファイルを入れる。(なお、このようなフォルダ(そこにhtmlなどを入れるとサーバーが公開してくれる場所)のことをドキュメントルート DocumentRoot という。)

あらかじめ、目的のhtmlファイルを作っておく。

たとえば、serverTest.html というファイルが作ってあり、このhtmlファイルを公開したい場合、

まず、

sudo cp serverTest.html /var/www/html

というコマンドになる。


SELinux がオンだと設定が面倒なので、

sudo setenforce 0

でSELinuxをオフできる。

webブラウザで http://localhost/serverTest.html にアクセスして、作成したhtmlどおりの内容が表示されれば、ここまでは成功。(外部公開するには、まだ作業が続く。)

ファイル名の部分(例では末尾の serverTest.html )は、作成したhtmlファイルのファイル名にする。


webブラウザで確認し終わったら

sudo setenforce 1

でSElinuxの設定をオンに戻す。

Perl/CGIプログラムの例[編集]

PerlでCGIプログラムをする場合、

perlだけでなく perl-CGI もインストールする必要があります。

Linux の Fedoraの場合、

sudo dnf install perl perl-CGI

で両方とも入ります。sudo dnf install perl だけでは、perl-CGI がインストールされません。

Fedoraにインストールする場合、dnf コマンドでの perl-CGIの末尾3文字の「CGI」は大文字でなければなりません。(でないとダウンローダが認識しないです。)

コード例[編集]

下記のコードは、Perlによる単純なCGIプログラムの例です。CGIプログラムは、後述の設定をしたあとにwebブラウザで閲覧して確認できます。(コマンド端末では確認できないか、著しく確認が困難。)

コード例
#!/usr/bin/perl

print "Content-Type: text/html\n\n";
print "Hello World!\n";
(2020年6月2日に Fedora 32 でブラウザ上(Firefox 76)での動作を確認ずみ。ただし後述の追加設定が必要。)

text/htmlのあとのエスケープシーケンスは必ず2つ \n\n としてください。もし1つだけだと、ブラウザで見てもエラーになり、「Hello World!」が表示されません。(もし \n が 1つだけだと「500 Internal Server Error」になります。)


解説
  • シュバング行
#!/usr/bin/perl

というのは何かというと、これはシュバング行という特殊な命令で、インタプリタの実行用バイナリなどの場所をOSやコンパイラなどに伝えています。

書式はコメント文と同様に「#」から始まってますが、しかしコメントではないので、消さないでください。消すと動作しなくなります(インタプリタの実行用バイナリの場所が不明になるので、実行できなくなるので)。

PerlだけでなくUnix系のシェルスクリプトなど他のプログラム言語でも同様にシュバング行を記述する事があります。(詳しくはシェルスクリプトなどの教科書を参照せよ。)


  • HTTPヘッダ
Content-Type: text/html

というのは何かというと、HTTPヘッダというものです。実はwebブラウザなどのwebアプリケーションでは、HTMLの情報とは別に、先に、これから送受信しようとする情報の種類などの打ち合わせのために HTTPヘッダ というものを送受信しあってます。(Perlの場合は「CGIヘッダ」ともいいますが、C言語やPHPなど他の言語では「HTTPヘッダ」というので、本wikiではHTTPヘッダで統一します。)

そのHTTPヘッダで送受信しあう情報のひとつに「Content-Type: 」という種類が存在し、「Content-Type: text/html」という文章によって「これからテキストファイルまたはHTMLファイルを送る」と相手先に伝えています。

HTTPサーバーの仕様などで、そういう風に、先にHTTPヘッダをやりとりするというように、プロトコルなどが決まっているのです。(『ソケットプログラミング』などと言われる分野の書籍に、ここら辺のC言語プログラミング事情が書いてあったのだが、しかし2020年現在の出版市場では、市販のソケットプログラミングの書籍が無い出版状況なので、初心者は気にしなくてイイ。)


Apacheなどのサーバーソフトが気を聞かして、ファイル中に勝手に「print "Content-Type: 」みたいな文章を見つけたら、これはHTTPヘッダであるとして勝手に解釈してくれるという仕組みです。


その証拠に、コマンド端末(Linux の場合なら Terminal など)で上記コードを実行しても、単に

※ コマンド端末での実行例
Content-Type: text/html

Hello World!

とそのままprint以下の文字を表示するだけです。コマンド端末で実行しても、けっして、webブラウザが起動したりはしないです。

なお、コマンド端末で実行するだけなら、シュバング行を消しても、コマンド端末上での実行だけなら可能です。(結果は print以下の文字が表示されるだけ。)


コード例2

HTMLのソースコードを送りたい場合は、下記のように書きます。

#!/usr/bin/perl

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

print "<!DOCTYPE html>\n";
print "<html>\n";
print "<head>\n";
print "<title>Example Web Page</title>\n";
print "</head>\n";
print "<body>\n";
print "<p>Hello, world!</p>\n";
print "</body>\n";
print "</html>\n";
(2020年5月17日に Fedora 32 でブラウザ上(Firefox 76)での動作を確認ずみ。ただし後述の追加設定が必要。)


しかし実用的には、下記のようにプログラムを書いたほうがラクでしょう。

コード例3
#!/usr/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
(2020年5月17日に Fedora 32 でブラウザ上(Firefox 76)での動作を確認ずみ。ただし下記の追加設定が必要。)
解説

use warnings; とは何かというと、これはプログラム中にエラーがあったら警告を出すという意味です。Perlはプログラム言語ですので、エラーも起こりえます。そのエラーの際に警告を出すという意味です。

ですが、これはコマンド端末で実行している場合のハナシです。

webブラウザで見ている場合、そのような気のきいた警告はしてくれないです。


また、use warnings; は警告をするだけですので、そのままプログラムを実行します。けっして、気をきかしてプログラム停止したりはしません。

use strict; は、プログラムの停止なども含めて、より厳格に判定および処置をします。


なので、実は上記プログラムから use warnings; および use strict; を除去しても、webブラウザ上で表示する事は可能です。

必要な追加設定[編集]

このファイルは、拡張子をかならず「.cgi」にしてください。(拡張子「.cgi」または「.pl」にしないと、今後の設定が面倒になります。)

このファイルを、フォルダ階層

/var/www/cgi-bin

の中に配置します。

もし cgi-bin フォルダがまだ作れていない場合、perl-CGIがまだインストールされてないと思われるので、まずperl-CGIをインストールしてください。

所有者がrootになってるなどで、配置できないなら

sudo chown ユーザー名 /var/www/cgi-bin

で所有者を変更できます。


冒頭の

#!/usr/bin/perl

の部分は、環境によっては

#!/usr/local/bin/perl

の場合もあります。

この部分 #!/usr/local/bin/perl は、perlのインタプリタのバイナリを呼び出すための命令です。

これらperlインタプリタのバイナリの存在場所をさがすには、コマンド

which perl

で探せます。

コマンド実行例
$ which perl
/usr/bin/perl


そして、制作したサンプルファイルは、アクセス権の設定で「プログラムとして実行可能」にチェックボックスを入れてください。右クリックで現れるダイアログから設定できると思います。


しかし、サーバがApacheの場合、まだ、これだけでは動きません。

Apacheは初期設定では、cgiスクリプトを動かさない設定になっています。なので、まず、この初期設定を書き換える必要があります。

cgiスクリプトを動かせるように設定を変更するために、設定ファイルの httpd.conf というファイルを書き換えて、

AddHandler cgi-script .cgi

という文章を追加する必要があります。

なお、通常のapacheでは、すでにコメントアウトされた状態で

#AddHandler cgi-script .cgi

とあるので、単に冒頭のコメントアウト記号#をはずせばいいだけです。

この書き換えにより、拡張子 .cgi のある命令を、cgiスクリプトとして処理できるようになります。


なお、perlなどで使われる拡張子 「.pl」のファイルもCGIスクリプトとして実行したいなら、上記の AddHandler に

#AddHandler cgi-script .cgi .pl

と「.pl」を追加するだけで済みます。


ただし、管理者が通常では root になっているので、そのままでは、書き換えできません。なのでLinuxの場合、コマンドで

sudo chown ログインユーザ名 /etc/httpd/conf/httpd.conf

で、管理者を変えてから、管理者設定を書き換えることになります。


書き換えが終わったら、apache を立ち上げ直します。


そして、webブラウザで

http://localhost/cgi-bin/ファイル名.cgi

にアクセスしてください。

実行結果

ブラウザ画面上に

Hello, world!

と表示されている。また、そのページのタイトルとして、タブ欄などに「Example Web Page」と書いてある。


HTMLとの連動の例[編集]

では、より実用的なプログラムを見ていきましょう。

下記のプログラムは、入力した文字列を、htmlのフォーム機能を使って別ファイル(例では catchtest.cgi ) に送るプログラムです。

コード例
#!/usr/bin/perl
#!/usr/local/bin/perl

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

<!DOCTYPE html>

<form action="catchTest.cgi" method="post">
ユーザー名を登録: <input type="text" name="username">
<input type="submit" value="登録">
</form>

EOT

※ 『PHP/HTMLフォームからのデータ受け取り』と動作内容は同じです。


このように、パターンとして

#!/usr/bin/perl
#!/usr/local/bin/perl

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

<!DOCTYPE html>

# ここに書きたいHTMLのソースコードを書く
# 中略

EOT

というような書式で、単に <!DOCTYPE html> と EOT のあいだに、お決まりのパターンのコードを書くだけで、入出力機能のあるファームも簡単に作れます。




上記のコードの遷移先のページは、下記のようにつくります

コード例
#!/usr/bin/perl
#!/usr/local/bin/perl

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

if ($ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN, $hensu, $ENV{'CONTENT_LENGTH'});
}
else {
    $hensu = $ENV{'QUERY_STRING'};
}

print " $hensu と入力されました。";
実行結果

たとえば ggggggg とブラウザに表示された入力ボックスにしてボタン「登録」を押すと、

username=ggggggg と入力されました。

と表示される。

(以上、実行結果)
解説

まず、遷移先のページにも、シュバング行やHTTPヘッダを忘れないようにしましょう(無いとエラーになります(Internal Server Error など) )。

上記コードの if文 と else文 は、決まり文句です。 $hensu以外はすべて、Perlでの決まり文句です。STDINは標準入力のことです。


Perlでは、formタグからのPOSTの受け取りは、標準入力 STDIN を通して受け取りが行われる仕様です。

環境変数として REQUEST_METHOD や CONTENT_LENGTH や QUERY_STRING という環境変数があらかじめ用意されています。なので上記コードでは、この変数はこのまま使う必要があります(勝手に名前を変えてはイケナイ)。

なお、環境変数を英語で environmental variable と言います。

if ($ENV{'REQUEST_METHOD'} eq "POST") 

というのは、おおむね「もし環境変数 REQUEST_METHOD が POST なら」 のような意味です。

環境変数 REQUEST_METHOD には、フォームを呼び出した時のリクエストの結果がPOSTまたはGETのどちらかとして入っています。


等価演算子
数値として評価 文字として評価 意味
== eq 等しい場合に真
!= ne 等しくない場合に真 

eq 演算子は、「eqの左右の両辺をもし文字列とした場合に、両辺が等しいか?」を調べる演算子です。

いっぽう、== 演算子は、両辺を数値とした場合に等しいかを調べる演算子です。(C言語と違って、Perlでは変数の宣言時に型指定が無いので、条件分岐if文では、こういった演算子の区別が必要になる。)


なので、けっして eq演算子の部分を == 演算子に変えてはダメです。


なお、両辺が等しくない場合については、文字として評価する場合には ne 演算子、数値として評価する場合には != 演算子 です。


さて、表示結果の username というのは単に、勝手につけたオブジェクト名であり、呼び出し元のファイルのHTMLタグで勝手に命名したオブジェクト名ですので、もしそのオブジェクト名が変われば、表示結果の左辺のこの部分は名前になります。

結局

オブジェクト名 = 受け取った内容

のように、オブジェクト名と一緒に、Perlでは POST で受け取った内容を管理する仕組みです。

高度な例[編集]

より高度な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;

}

Perl/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;
}

関連書籍[編集]