Perlのスクリプト

PerlでHTTPサーバー

HTTPプロトコールを理解するためにPerlでHTTPサーバーをつくる

HTTP::Daemonモジュールのインストール

perldoc HTTPとやってもそんな文書はないといわれてしまったので、CPANからダウンロードしてインストールします。途中でてくるperl Makefile.PLとするとでてくる質問には最初のみyと答え、残りはnとしました。
```
$ lynx -source 'http://www.cpan.org/authors/id/GAAS/libwww-perl-5.65.tar.gz' > libwww-perl-5.65.tar.gz
$ tar xzf libwww-perl-5.65.tar.gz
$ cd libwww-perl-5.65
$ perl Makefile.PL
$ make
$ su -c 'make install'
```

サンプルプログラムを動かす

perldoc HTTP::Daemonとしてでてくる文書のプログラムをちょっといじって動かしてみます。

$ cat http01.pl
#!/usr/bin/perl -w
use HTTP::Daemon;
use HTTP::Status;

my $d = new HTTP::Daemon LocalPort => 10000;
        
  print "Please contact me at: <URL:", $d->url, ">\n";
  while (my $c = $d->accept) {
      while (my $r = $c->get_request) {
          if ($r->method eq 'GET' and $r->url->path eq "/httpd_test.txt") {
              $c->send_file_response("/home/takamasa/httpd_test.txt");
          } else {
              $c->send_error(RC_FORBIDDEN)
          }
      }
      $c->close;
      undef($c);
  }

$ ./httpd01.pl
Please contact me at:<URL:http://myhost:10000/>

別のパソコンからthaliana.myhome.cx/httpd_test.txtへIEなどでつないでみるとちゃんとhttpd_test.txtの内容が表示されました。プログラムの終了はCtrl+cです。

サンプルプログラムを調べる

ちょっと改良します。ところどころメッセージを入れ、どんな状態にあるか表示させます。

$ cat http02.pl
#!/usr/bin/perl -w
use HTTP::Daemon;
use HTTP::Status;

my $d = new HTTP::Daemon LocalPort => 10000;
        
print "Please contact me at: <URL:", $d->url, ">\n";
while (my $c = $d->accept) {
	print "Get access.\n";
	while (my $r = $c->get_request) {
		print "Reading request.\n";
		print $r->as_string();
		if ($r->method eq 'GET' and $r->url->path eq "/httpd_test.txt") {
				$c->send_file_response("/home/takamasa/httpd_test.txt");
			} else {
				$c->send_error(RC_FORBIDDEN)
		}
	}
	$c->close;
	undef($c);
}

$ ./httpd02.pl
Please contact me at:<URL:http://myhost:10000/>
Get access                     IEから接続を開始と同時に現われる
Reading request.               IEでF5(再読み込み)をするとここからもう一度現われる
GET /httpd_test.txt HTTP/1.1
Connection: Keep-Alive
Accept: */*
Accept:-Encoding: gzip, deflate
Accept-Language: ja
Host: myhost:10000
If-Modifies-Since: Fri, 15 Mar 2002 13:13:46 GMT
User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; Win 9x 4.90; T312461)

INPUTタグのTYPEによって送信されるデータが異なることを調べる

もともとperlでHTTPサーバーをつくるのを考えたのは、あるサイトへのショートカットを作っていたときに、INPUTタグのtype="image"をtype="submit"に変えたら目的とは違うページが表示されたのに疑問を持ったからです。次のフォームではデータの送信ボタンをtype="submit"とtype="image"で作ってあります。それぞれをクリックしたときに得られるサーバー側のデータを示します。

Please contact me at: <URL:http://myhost:10000/>      プログラム起動
Get access.                                           submitボタンを押した
Reading request.
GET /httpd_test.txt?Sname=Submit HTTP/1.1
Connection: Keep-Alive
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, */*
Accept-Encoding: gzip, deflate
Accept-Language: ja
Host: myhost:10000
Referer: http://thaliana.myhome.cx/systemhack/perl_http_daemon.php
User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; Win 9x 4.90; T312461)


Reading request.                                        imageボタンを押した
GET /httpd_test.txt?Iname.x=21&Iname.y=23 HTTP/1.1
Connection: Keep-Alive
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, */*
Accept-Encoding: gzip, deflate
Accept-Language: ja
Host: myhost:10000
Referer: http://thaliana.myhome.cx/systemhack/perl_http_daemon.php
User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; Win 9x 4.90; T312461)

で、上の例からわかるとおり、imageのボタンを押すとそのときのマウスの座標が送信されます。imageボタンをsubmitボタンで置き換えるときにはhiddenでimageボタンの名前に.xと.yをつけたものを用意する必要があります。

Perlでメールを受信する

ファイルを送るのに手軽な方法として電子メールの添付書類があります。でもあまり大きいファイルを送ることはネチケットに違反するので他人にはやらないほうがよいでしょう。自分に送るのときもIMAPのサーバーに巨大ファイルができるとメールの受信に時間がかかったりしてよくないことがあります。

そんなときファイル受信専用のアカウントを作成しておくと便利です。ついでに添付書類のデコードもして特定のフォルダに保存するようにすれば便利に使うことができます。

これはメールでプログラムを実行する方法の勉強も兼ねています。このプログラムの作成にあたってはPerlの小技を参考にさせていただきました。

手順

Perlモジュールをインストールする

MIME-Tools、MailTools、IO-StringyをCPANからダウンロードしてインストールしました。MIME-Base64ははじめからインストールされていました。
.qmail-filesaveを用意する

カレントディレクトリに.qmail-filesaveという名前のファイルを用意します。内容は下記のとおりです。.qmail-filesaveのパーミッションは600です。実行属性をつけてはいけません。
```
$ cat .qmail-filesave
|mailsave.pl ./
```

mailsave.plファイルをつくる

qmailにより配送されたメールが標準入力に入ってくることを確認するために下記のスクリプトを書きます。

$ cat mailsave.pl
#!/usr/bin/perl -w
open(OUT, ">result.txt")||die;
while(<STDIN>){
	print OUT $_;
}

動作確認

$ echo "to:takamasa-filesave" | /var/qmail/bin/qmail-inject
cat result.txt
Received: (qmail 17414 invoked by uid 500); 17 Aug 2002 15:10:15 -0000
Date: 17 Aug 2002 15:10:15 -0000
Message-ID: <20020817151015.17413.qmail@thaliana.myhome.cx>
From: takamasa@thaliana.myhome.cx
to: takamasa-filesave@thaliana.myhome.cx

mailsave.plを作成する

本来の目的にあうようにmailsave.plを作り変えます。

$ cat mailsave.pl
#!/usr/bin/perl -w
# 受信したメールから添付ファイルをとりだし、引数で与えられたディレクトリに保存するスクリプト
use MIME::Parser;

# 引数1	添付ファイルを保存するディレクトリ
$directory = $ARGV[0];
(-d $directory) || die "directory is not Directory.";
(-w $directory) || die "Can't add file to $directory.";
chdir($directory) || die "Can't move to $directory.";

# 処理を記録
open(LOG, "$gt;$gt;mailsave.log") || die "Can't add log to mailsave.log";

# メール処理用のオブジェクトを作成
$oParser = new MIME::Parser;
$oParser-$gt;output_under("/tmp");
($sec,$min,$hour,$mday,$mon,$year) = localtime;
$mon++;
print LOG "[$year/$mon/$mday $hour:$min:$sec] ";

# 標準入力を処理
$oEnt = $oParser-$gt;parse(\*STDIN);
$from = $oEnt-$gt;head-$gt;get('From');
print LOG "From:$from";

# 添付書類がある場合保存
if($oEnt-$gt;is_multipart){
	$nCnt = $oEnt-$gt;parts;	#パートの数
	for ($i=1; $i$lt;$nCnt;$i++) {	# 0番目は本文なのでとばす
		$sPath = $oEnt-$gt;parts($i)-$gt;bodyhandle-$gt;path;
		system("mv $sPath ./");
		$file = $sPath;
		$file =~ s/.*\///;	# パスを除く
		print LOG "FILE:$file\n";
	}
}

このスクリプトにはいくつか問題があります。まず日本語のファイル名を受け付けません。全部ファイル名が1になって保存されてしまいます。また同名のファイルが送信されてくると上書きされてしまいます。

Perlのスクリプト

快適個人用Linuxサーバー構築記

ソフトウェアのつかいこなし

開発室

クラスターコンピュータをつくる

雑記帳