まだ重たいCMSをお使いですか？
毎秒1000リクエスト を捌く超高速CMS「adiary」

2019/02/11(月)Linux/Windowsで動く本格的なWebServerをPerlで作る

はてブ数 プログラム::Perl

adiary Ver3.20から adiary.httpd.pl というスタンドアローンサーバが付属するようになりました。これを作成した際の知見メモ。

ネットワークサーバとマルチプロセス/マルチスレッドの基本

  • Socketをオープンして、bindして、listenする。
  • whileループでacceptすることで接続を受け付ける。
  • 同時接続に対応するため、マルチプロセスorスレッドで処理する。

Perlではスレッドを実現するための threads と、マルチプロセスを実現するための fork があります。それぞれの特徴を整理します。

  • threads
  • fork()
    • 命令実行時点でのプロセスの複製（子プロセス）を作成する。
    • Linux等ではOSネイティブであるので高速である。
    • プロセスなのでメモリを圧迫しやすい。
    • Windowsではforkできないため、内部的にithreadsにより実現されている。
    • Windows + pp（exe化）では、fork() したいずれかの疑似プロセスから exit() するとプログラム全体（親プロセスごと）が落ちるというクソバグがあるため、事実上Windowsでは使用不可。

以上の点から、Windowsでの動作も考えると threads により作成するのが無難となります。Linux等ではfork()のほうが高速であるので、条件やオプションによりfork()とthreadsを使い分ける実装を取りました。

fork()よるマルチプロセスサーバの実装

以下は、fork()したプロセスでのサーバの実装例です。

use Socket;
use POSIX;	# for waitpid(<pid>, WNOHANG);

my $srv;
my $PORT=8888;
{
	socket($srv, PF_INET, SOCK_STREAM, 0)			|| die "socket failed: $!";
	setsockopt($srv, SOL_SOCKET, SO_REUSEADDR, pack("l",1))	|| die "setsockopt failed: $!";
	bind($srv, sockaddr_in($PORT, INADDR_ANY))		|| die "bind port failed: $!";
	listen($srv, SOMAXCONN)					|| die "listen failed: $!";
}
{
	local $SIG{CHLD};
	# clear defunct process
	$SIG{CHLD} = sub {
		while(waitpid(-1, WNOHANG) > 0) {};
	};

	while(1) {
		my $addr = accept(my $sock, $srv);
		if (!$addr) { next; }

		my $pid = fork();
		if (!defined $pid) {
			die "fork() fail!";
		}
		if (!$pid) {
			&accept_client($sock, $addr);
			exit();
		}
	}
}

$SIG{CHLD}は子プロセスのいずれかの状態が変化（例えば終了した）ときに呼ばれるシグナルです*1。「waitpid(-1, WNOHANG) > 0」によって終了した子プロセスを回収します。こうしないと、大量のゾンビプロセスを抱えてシステムリソースを圧迫します。

 7512 pts/0    S      0:00 /usr/bin/perl ./adiary.httpd.pl
 7513 pts/0    S      0:00 /usr/bin/perl ./adiary.httpd.pl
 7514 pts/0    S      0:00 /usr/bin/perl ./adiary.httpd.pl
 7515 pts/0    S      0:00 /usr/bin/perl ./adiary.httpd.pl
 7518 pts/0    Z      0:00 [adiary.httpd.pl] <defunct>
 7519 pts/0    Z      0:00 [adiary.httpd.pl] <defunct>
 7520 pts/0    Z      0:00 [adiary.httpd.pl] <defunct>
		（22行略）
 7643 pts/0    Z      0:00 [adiary.httpd.pl] <defunct>
 7644 pts/0    Z      0:00 [adiary.httpd.pl] <defunct>
 7645 pts/0    S      0:00 /usr/bin/perl ./adiary.httpd.pl
 7646 pts/0    S      0:00 /usr/bin/perl ./adiary.httpd.pl

複製プロセスから抜けるときは、exit() します。

この2点に注意すると、実装上threadsとさしたる違いはないので、以降はthreadsでの実装でのみ説明します。以降の説明でスレッドと書いた場合、プロセスと読み替えても良いことに注意してください。

*1 : 終了したプロセスの数だけ呼ばれるわけではなく、1つ以上の終了プロセスがあるときでも呼ばれるのは1回です

ithreadsよるマルチスレッドサーバの実装

use Socket;
use POSIX;		# for waitpid(<pid>, WNOHANG);
use threads;		# for ithreads

my $srv;
my $PORT=8888;
{
	socket($srv, PF_INET, SOCK_STREAM, 0)			|| die "socket failed: $!";
	setsockopt($srv, SOL_SOCKET, SO_REUSEADDR, pack("l",1))	|| die "setsockopt failed: $!";
	bind($srv, sockaddr_in($PORT, INADDR_ANY))		|| die "bind port failed: $!";
	listen($srv, SOMAXCONN)					|| die "listen failed: $!";
}
{
	local $SIG{CHLD};
	# clear defunct process
	$SIG{CHLD} = sub {
		while(waitpid(-1, WNOHANG) > 0) {};
	};

	while(1) {
		my $sock;
		my $addr = accept($sock, $srv);
		if (!$addr) { next; }

		my $thr = threads->create(\&accept_client, $sock, $addr);
		if (!defined $thr) {
			die "threads->create fail!";
		}
		$thr->detach();
	}
}
  • 接続を受ける度にスレッドを生成しています。
  • accept() は失敗することがありますので、必ず対策コードを入れておきます。

selectを使用した場合のWindows向けの実装

最初の実装では select を使用していました。

	my $rbits = '';
	vec($rbits, fileno($srv), 1) = 1
	while(1) {
		select(my $x = $rbits, undef, undef, 0.01);
		if (! vec($x, fileno($srv))) { next; }

		my $addr = accept(my $sock, $srv);

selectから抜けた後に、接続があったのか、単なるタイムアウトなのか判定するという無駄な構成です。

	while(1) {
		select(my $x = $rbits, undef, undef, undef);
		my $addr = accept(my $sock, $srv);

このようにタイムアウトを設定しなければ、接続があったときだけ select から抜けるためスマートです。

しかしWindows上でマルチスレッドでselectすると、selectした接続があるまで他のスレッドをブロックしてしまいます。ひどすぎる仕様ですがどうにもなりません。*2

ですので、適当なtimeoutを設定して、スレッドスイッチを発生させる必要があります。

*2 : 調べたところによると、Windowsではselect待ちはシステムプロセスで行われており、ithreadsはユーザープロセス側でリソースを切り替えることで実現しているため、システムプロセスから返ってこない限りスレッドの切り替えが起こらないようです。acceptやsysreadも似たような問題を抱えそうなのですが、select以外では同様の問題にまだ当たっていません。

pre-thread（pre-fork）よるマルチスレッドサーバの実装

ここまで例示してきたものは、接続があるたびにスレッドを生成（プロセスをフォーク）させるものでした。そのタイプでは以下の問題があります。

  • スレッド生成（プロセス生成）が遅いので、サーバの性能（応答性）が悪い。
  • 悪意を持って、多数の接続をすることで、サーバのメモリを圧迫できる。

この問題を対処するため、予めサーバを複数複製しておく pre-thread（pre-fork）と呼ばれる実装が一般的です。その実装例を示します。

use Socket;
use threads;		# for ithreads

my $srv;
my $PORT=8888;
{
	socket($srv, PF_INET, SOCK_STREAM, 0)			|| die "socket failed: $!";
	setsockopt($srv, SOL_SOCKET, SO_REUSEADDR, pack("l",1))	|| die "setsockopt failed: $!";
	bind($srv, sockaddr_in($PORT, INADDR_ANY))		|| die "bind port failed: $!";
	listen($srv, SOMAXCONN)					|| die "listen failed: $!";
}
{
	# pre-threads
	for(my $i=0; $i<$DEAMONS; $i++) {
		my $thr = threads->create(\&deamon_main, $srv);
		if (!defined $thr) {
			die "threads->create fail!";
		}
		$thr->detach();
	}
	# main thread
	while(1) {
		sleep(1000);
	}
}
sub deamon_main {
	my $srv = shift;
	my %bak = %ENV;
	while(1) {
		my $addr = accept(my $sock, $srv);
		if (!$addr) { next; }		# accept() failed
		&accept_client($sock, $addr);
		%ENV = %bak;
	}
}

pre-thread実装には次の特徴があります。

  • 応答性に優れる（サーバとしての性能が高い）。
  • 事前生成したスレッド数以上のクライアントを同時に処理できない。
    • 悪意を持った人間が簡単にDoS攻撃（サービス不能攻撃）をしかけることができる。

DoS攻撃は非常に厄介な問題です。TCP接続（telnet）だけ（接続したまま放置）を永遠に行うスクリプトを1つ動かすだけで簡単にサービス不能にできます。accept_client()内でのタイムアウトを短くすることである程度は防げますが不十分です*3。考えられる対策としては、

  • 生成したスレッド以上に接続が溢れている時は、スレッドを増やしてあげる。
    • その際、増やしたスレッドは必要がなくなったら終了させる。
  • 悪意ある接続を自動検出して、接続を拒否する。

などがありますが、実装は容易ではありませんし、前者に至っては実装次第でサーバメモリ（リソース）圧迫によりサーバごと落とすことを狙えます。

*3 : しかも短すぎるタイムアウトは回線が不安定なだけの正規の接続を拒否することになりかねません。

接続Accept後の処理

sub accept_client {
	my $sock = shift;
	my $addr = shift;

	my($port, $ip_bin) = sockaddr_in($addr);
	my $ip             = inet_ntoa($ip_bin);
	binmode($sock);

	$ENV{REMOTE_ADDR} = $ip;
	$ENV{REMOTE_PORT} = $port;

	&parse_request($sock);
	close($sock);
}

要求ヘッダの受信

まずクライアントからHTTP要求ヘッダが送られてきますので、それを解析します。

GET / HTTP/1.1
Accept: text/html,application/xhtml+xm…plication/xml;q=0.9,*/*;q=0.8
Accept-Encoding: gzip, deflate
Accept-Language: ja,en-US;q=0.7,en;q=0.3
Connection: keep-alive
Host: localhost
Referer: http://localhost/
User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/69.0.3497.100


sub parse_request {
	my $sock  = shift;
	my $state = { sock => $sock };

	#--------------------------------------------------
	# recieve HTTP Header
	#--------------------------------------------------
	my @header;
	{
		my $break;
		local $SIG{ALRM} = sub { close($sock); $break=1; };
		alarm( $TIMEOUT );

		my $first=1;
		while(1) {
			my $line = &read_sock_1line($sock);	# no buffered <$sock>
			if (!defined $line)  {
				$break = 1;			# disconnect
				last;
			}
			$line =~ s/[\r\n]//g;

			if ($line eq '') { last; }
			push(@header, $line);
		}

		alarm(0);
		if ($break) { return; }
	}
	#
	#（略）
	#
}
sub read_sock_1line {
	my $sock = shift;
	my $line = '';
	my $c;
	while($c ne "\n") {
		if (sysread($sock, $c, 1) != 1) { return; }
		$line .= $c;
	}
	return $line;
}
  • HTTPヘッダは送受信ともに、改行コードが"\r\n"です。
  • 接続切れを検出するため、読み込んだデータが未定義の場合にループを抜ける必要があります。

alarm()関数を使ったタイムアウト処理を行っています。一定時間で接続を切らないと、接続したまま放置することで、簡単にサービス不能攻撃（DoS）が可能になってしまいます。ただし、Windowsでは alarm() を設定しても、タイムアウト割り込み（$SIG{ALRM}）が発生しません。

上のコード中で、

my $line = &read_sock_1line($sock);	# no buffered <$sock>

となっている行は

my $line = <$sock>;

と書いた方が楽だし効率も良くなります。

しかしながら、ヘッダの次にフォームのデータ（POST時のデータ）が送られてくることが問題です。通常CGIのプログラムはフォームデータを STDIN から受け取ります。しかし実際に送られてくるデータはソケット経由です。そのため、Webサーバはソケットから送信されたデータをSTDINにつなぎ替えてやる必要があります。

local *STDIN;
open(STDIN, '<&=', fileno($sock));

ヘッダの解析で <$sock> していると、つなぎ替えてもフォームデータを読むことができません。これには perl の読み出し関数の差を知る必要があります。

  • バッファあり：<$file>, read(), seek(), tell(), eof()
  • バッファなし：sysread(), recv()

例えば、

LINE1
LINE2

というデータを以下のプログラムに送信するとどうなるでしょうか。

my $line1 = <$sock>;
open(STDIN, '<&=', fileno($sock));
my $line2 = <STDIN>;

<$sock>の時点でデータがある程度バッファに入りますので、Perlの中身ではこういう状態になります。

# my $line1 = <$sock>;
client ---("LINE1\nLINE2\n")---> $sock ---> $sock buffer()
client ---(NULL)---> $sock ---> $sock buffer("LINE1\nLINE2\n")
client ---(NULL)---> $sock ---> $sock buffer("LINE2\n") ---> $line = "LINE1\n"

# open(STDIN, '<&=', fileno($sock));
client ---(NULL)---> $sock ---> $sock buffer("LINE2\n")
                        |-----> STDIN

# my $line2 = <STDIN>;
client ---(NULL)---> $sock ---> $sock buffer("LINE2\n")
                        |-----> STDIN ---(NULL)--> $line2 = ????

こんな感じになるので、STDINからいくら続きのデータを受け取ろうとしても、一度$sockのバッファに入ってしまったものは永久に取り出せなくなります。

my $line1 = <$sock>;
my $line2;
recv($sock, $line2, 1000, 0);

として、$line2にソケットからデータを取り出そうとしても、recv()はバッファ通らない関数ですので、データが受け取れなくなります。

この問題を解決するため、効率が悪くてもバッファなし関数sysread()で作成した &read_sock_1line() を使い、1byteずつデータを読み出して処理しています。

スマートな解決方法

CGI側に手を加え、STDINではなく Socket からPOSTデータを受信できるように改造するのが一番スマートです。通常のCGIを動作させることを想定していなければ、この方法で問題ありません。

要求ヘッダの解析

sub parse_request {
	#
	# 略
	#
	if ($timeout) { return; }

	#--------------------------------------------------
	# Analyze Request line
	#--------------------------------------------------
	{
		my $req = shift(@header);
		$state->{request} = $req;

		if ($req !~ m!^(GET|POST|HEAD) ([^\s]+) (?:HTTP/\d\.\d)?!) {
			&_400_bad_request($state);
			return;
		}

		my $method = $1;
		my $path   = $2;
		$state->{method} = $method;
		$state->{path}   = $path;
		if (substr($path,0,1) ne '/') {
			&_400_bad_request($state);
			return;
		}
	}

	#--------------------------------------------------
	# Analyze Header
	#--------------------------------------------------
	foreach(@header) {
		if ($_ !~ /^([\w\-]+):\s*(.*)/) {
			&_400_bad_request($state);
			return $state;
		}
		my $key = $1;
		my $val = $2;
		$key =~ tr/a-z/A-Z/;

		if ($key eq 'IF-MODIFIED-SINCE') {
			$state->{if_modified} = $val;
			next;
		}
		if ($key eq 'CONTENT-LENGTH') {
			$ENV{CONTENT_LENGTH} = int($val);
			next;
		}
		if ($key eq 'CONTENT-TYPE') {
			$ENV{CONTENT_TYPE} = $val;
			next;
		}
		$key =~ s/-/_/g;
		$ENV{"HTTP_$key"} = $val;
	}
	#--------------------------------------------------
	# Host Header check
	#--------------------------------------------------
	if ($ENV{HTTP_HOST} eq '' || $ENV{HTTP_HOST} !~ m/^[\w-]+(\.[\w\-]+)*(:\d+)?$/) {
		&_400_bad_request($state);
		return $state;
	}
	#
	# 略
	#
}

この部分はそんなに難しい処理はしていません。

「If-Modified-Since」「Content-Length」「Content-Type」を特別に処理して、それ以外のヘッダはそのまま「HTTP_XXX」という環境変数に記録します。

Host: localhost
→ $ENV{HTTP_HOST} = 'localhost';

本当はもっと対応すべきヘッダはあるのですが、大変なので HTTP/1.0 レベルでのみの対応としました。

HTTP_HOSTの値チェックは必ず必要です。Hostヘッダインジェクション対策にもなります。

ファイルの読み込み

use Encode;
use Encode::Locale;
my $FS_CODE = $Encode::Locale::ENCODING_LOCALE;

sub parse_request {
	#
	# 略
	#
	#--------------------------------------------------
	# file read
	#--------------------------------------------------
	my $path = $state->{path};
	$state->{file} = $path;
	$state->{file} =~ s/\?.*//;	# cut query
	$state->{file} =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
	my $r = &try_file_read($state);
	if ($r) {
		return;
	}
	#
	# 略
	#
}
#------------------------------------------------------------------------------
# try file read
#------------------------------------------------------------------------------
sub try_file_read {
	my $state = shift;
	my $file  = $state->{file};

	$file =~ s|/+|/|g;
	if ($file =~ m|/\.\./|) { return; }
	if ($INDEX ne '' && substr($file, -1) eq '/') {
		$file .= 'index.html';
	}
	$file = substr($file,1);	# /index.html to index.html

	#--------------------------------------------------
	# file system encode
	#--------------------------------------------------
	my $_file = $file;
	if ($FS_CODE ne 'UTF-8') {
		Encode::from_to($_file, 'UTF-8', $FS_CODE);
	}
	if (!-e $_file) { return; }

	#--------------------------------------------------
	# file request
	#--------------------------------------------------
	if (!-r $_file) {
		&_403_forbidden($state);
		return 403;
	}

	#--------------------------------------------------
	# header
	#--------------------------------------------------
	my $size   = -s $_file;
	my $header = "Content-Length: $size\r\n";

	#--------------------------------------------------
	# read file
	#--------------------------------------------------
	sysopen(my $fh, $_file, O_RDONLY);
	my $r = sysread($fh, my $data, $size);
	if (!$fh || $r != $size) {
		&_403_forbidden($state);
		return 403;
	}
	close($fh);

	&_200_ok($state, $header, $data);
	return 200;
}
  • URIエンコードを戻して、ファイルが存在するか確認し、読み込めればファイルの内容を返して終了します。
  • パスは必ず / で始まります。
    • /で始まらないパスは、analyze_requestでチェックしてerrorにしています。
  • 一部簡略化しました。
    • ファイルの読み込みチェック（拡張子チェック）
    • フィレクトリのアクセス許可チェック
    • Content-Type（MIME-TYPES） や Last-Modified の処理

ファイルシステムエンコーディング

Windowsは内部文字コードとして Unicode を使っています。

昔は、MS-DOS時代を含めcp932（Shift-JIS）を使っていました。その影響で、Windowsの旧APIは cp932（Shift-JIS）で結果を返します。日本語Windowsを使用してPerlなどでファイル名を取得すると、文字コードは（特殊な場合*4を除き）cp932になります。

今どきShift-JISをPerl等で扱うことは問題しかありませんので、普通はUTF-8を使います。ですから、WebサーバURLはUTF-8なのに、それをOSに渡すときはcp932に変換しないとファイルアクセスできないという問題に当たります。

これに対応する処理が $FS_CODE です。

Windowsに限らず、システムのロケールは $Encode::Locale::ENCODING_LOCALE で取得できるので、それを参照して文字コードを変換します。

open や readdir などの関数はオーバーライドしてしまえば透過的に処理できるのですが、ファイルテスト演算子（-e, -r, -d等）がどうにもならないので、もし日本語ファイル名に対応しようと思うなら、プログラムをあちこち書き換える必要があります。

サーバの実装とは直接関係ありませんが、Image::Magickの Read() および Write() メソッドは、ファイル名として cp932 の文字列を渡すと無条件に失敗しますので、日本語を含まないディレクトリにファイルを移動するなどしてから、再度元に戻すという余計な処理が必要になります。

クソWindowsマジで滅びないかなと思うこと間違えなしです。

*4 : Windows 10でシステムロケールをUTF-8に設定した場合

CGIの実行

#------------------------------------------------------------------------------
# parse request
#------------------------------------------------------------------------------
sub parse_request {
	#
	# 略
	#
	#--------------------------------------------------
	# Exec CGI
	#--------------------------------------------------
	$ENV{SERVER_NAME}    = $ENV{HTTP_HOST};
	$ENV{SERVER_NAME}    =~ s/:\d+$//;
	$ENV{REQUEST_METHOD} = $state->{method};
	$ENV{REQUEST_URI}    = $path;
	{
		my $x = index($path, '?');
		if ($x>0) {
			$ENV{QUERY_STRING} = substr($path, $x+1);
			$path = substr($path, 0, $x);
		}
	}
	$ENV{PATH_INFO} = $path;
	&exec_cgi($state);
}

sub exec_cgi {
	my $state = shift;
	my $cache = shift || 0;
	my $sock  = $state->{sock};

	#--------------------------------------------------
	# connect stdin/stdout
	#--------------------------------------------------
	local *STDIN;
	if ($state->{method} eq 'POST') {
		open(STDIN, '<&=', fileno($sock));
	}
	local *STDOUT;
	open(STDOUT, '>&=', fileno($sock));
	binmode(STDOUT);

	#--------------------------------------------------
	# run
	#--------------------------------------------------
	eval {
		# cgi code
	};
}
  • URLからファイルの読み込みでないと判断した場合は、cgiを実行します。もちろん条件は色々ありえると思います。
  • exec_cgiの中身から直接スクリプトを呼び出すことを想定していますが、パイプ等でCGIを別プロセスとして実行すれば、より本物のCGIに近い実行環境となります。
    • pre-thread（pre-fork）実装では「CGI動作部分」が使い回されるため、データやコードがキャッシュされます（メモリに残ります）。SpeedyCGIやFastCGIのような動作環境となります。
local *STDOUT;
open(STDOUT, '>&=', fileno($sock));
binmode(STDOUT);

CGIは出力結果をSTDOUTに出力しますが、それをソケットに接続しています。

CGIの出力結果とHTTPのレスポンスは少しだけ（特に最初の１行）が異なります。

  • CGI 
    Status: 200 OK
Content-Type: text/html; charset=UTF-8
Content-Length: XXXXX
Connection: close

(html data)
  • レスポンス 
    HTTP/1.0 200 OK
Content-Type: text/html; charset=UTF-8
Content-Length: XXXXX
Connection: close

(html data)

これも出力を一度Webサーバ側で受け取って処理すれば、より本物のCGI動作に近づきますが、オーバーヘッドが大きそうなのでプログラム側に細工しました。

まとめ

実際の adiary.httpd.pl はもう少し複雑ですが、Windowsでも動作させる際のポイントやエラー処理の肝は網羅して書きました。

Webサーバやネットワークサーバのテスト的な実装はよく見かけますが、本格的な（実用に耐えうる）実装やエラー処理はあまりみかけなかったので、まとめた次第です。特にWindowsでも動作させるという情報は皆無でした。

この記事の情報は都度アップデートする予定です。

このサーバ解説の元になった、スタンドアローンでもWindowsでも動作する日本製CMSのadiaryをよろしくお願いします。