Perl/CGI研究室 'PERL-LABO'

クッキー重複出力の不具合修正

研究内容

ここまでの研究で作成したクッキー処理ライブラリcookie.plはそこそこ使えるものでしたが、 クッキーを出力する際に、上のディレクトリが出力したクッキーを再出力してしまうという 不具合がありました。修正にトライしてみます。

詳細

受け取ったクッキーをそのまま出力していはいけない

クッキーは、自分（CGIプログラム）が置かれているディレクトリよりも上のディレクトリのものも 受け取ることができるんでした。 例えば、http://hoge.jp/ がクッキー key1=val1 を出力すると、その下の階層の http://hoge.jp/shita/ でも、クッキー key1=val1 を受け取ることができます。

さてこれまでに作ったクッキー処理ライブラリでは、httpヘッダで、受け取ったクッキーを全て再出力していました。 すると、http://hoge.jp/shita/ では、受け取った上の階層の クッキー key1=val1 が再出力されてしまいます。 そうすると、本来 http://hoge.jp/ のクッキーだったものが、 http://hoge.jp/shita/ にも保存されてしまいます。 同じ名前のクッキーが、下の階層にコピーされてしまうわけです。

この現象は、上の階層に記録されているクッキーを下の階層でも利用したいようなケースで問題になります。 同じ名前のクッキーが上の階層と下の階層でそれぞれ保存されてしまうので、本来オリジナルのデータである 上の階層のデータを使いたいのに、特別な処理をしないと、古いコピーの方を使ってしまうということが起きます。

これは要するに、クッキー処理ライブラリのバグです。 これまでは、そのようなクッキーの使い方をしていなかったので、気がつきませんでした･･･（＾＾；

どうやって直そう？

私のcookie.plでは、%plab::Cookieというハッシュでクッキーを読み書きしていました。 出力するときは%plab::Cookieの全部を出力していましたが、 一部のみを出力するように修正しなければいけません。 どのクッキーを出力するのかということを、どうやって指定するか。

既にcookie.plはあちこちのプログラムで使用しているので、 互換を保ったまま仕様変更したいです。

解決策として、次のような仕様にしました。

最初にミスをすると、互換性を保ちつつ修正しなければならないので、面倒ですね。

作成したCGIプログラム

# v 1.11

# (c) PERL-LABO
# http://www.perl-labo.org/

package plab;

# 使い方
#   %plab::Cookie でクッキーを読み込む
#   %plab::Cookie_new にクッキーを書き込む
#   plab::writecookie(); （HTTPヘッダ出力時に必ず呼ぶ）
# 注意
#   readcookie() は自動的に呼ばれます。

%plab::Cookie = ();  				# 読み込んだクッキー
$plab::Cookie_new = ();		# 書き込むクッキー
$plab::Cookie_read = 0;				# readcookieが呼ばれたら1
%plab::Cookie_path = ();			# path設定
readcookie();						# 最初にクッキーの読み込みを行う
%plab::Cookie_org = %plab::Cookie;	# 変化を検出するため、コピーしておく

# クッキーの読み込み
sub readcookie
{
	# 念のため上書き読み込みを禁止する
	if ($plab::Cookie_read == 1) { return; }
	$plab::Cookie_read = 1;

	# 生のクッキーデータ。
	# var1=val1; var2=val2; var3=val3
	# という形。最後の ; が無いことに注意。
	my $cookiestring = $ENV{"HTTP_COOKIE"};

	# ; で区切る
	my @pairs = split('; ', $cookiestring);

	# = で区切って連想配列に入れる
	foreach (@pairs) {
		my ($var, $val) = split('=', $_);
		# 名無しの値は処理しません。
		if ($val ne "") {
			$var = urldecode($var);
			$val = urldecode($val);
			$plab::Cookie{$var} = $val;
		}
	}
}

# クッキーHTTPヘッダ出力
# 引数 (有効時間)
# 有効期限は経過時間で与えます。
# 0のときは有効期限設定無し。（ブラウザが閉じられるまで）
# -1または引数無しのときは10年。
# HTTPヘッダを出力するのでHTTPヘッダ出力の最初などに呼びます。
sub writecookie
{
	my $expire_delta_hour = $_[0];
	
	# 有効期限（時）
	if ($expire_delta_hour eq "" || $expire_delta_hour == -1) {
		$expire_delta_hour = 24*365*10;  # 10 years
	}

	# 有効期限文字列の作成
	my $expires;
	if ($expire_delta_hour != 0) {
		my @t = gmtime(time() + $expire_delta_hour*60*60);
		my @m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
		my @w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
		$expires = sprintf(" expires=%s, %02d-%s-%04d %02d:%02d:%02d GMT;",
				$w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);
	}
	
	# クッキーを出力します
	while (my($var, $val) = each(%plab::Cookie_new)) { # 出力明示指定
		writecookie1($var, $val, $expires);
	}
	while (my($var, $val) = each(%plab::Cookie)) { # 変化したもの。互換
		if ($plab::Cookie_org{$var} ne $val) {
			writecookie1($var, $val, $expires);
		}
	}
}
sub writecookie1
{
	my ($var, $val, $expires) = @_;
	
	my $var2 = urlencode($var);
	my $val2 = urlencode($val);
	my $path;
	if (exists($plab::Cookie_path{$var})) {
		$path = " path=$plab::Cookie_path{$var};";
	}
	print "Set-Cookie: $var2=$val2;$expires$path\n";
}

# URLエンコード
sub urlencode
{
	my $s = $_[0];
	$s =~ s/([^a-zA-Z0-9*\-.\@_ ])/sprintf("%%%02X",ord($1))/eg;
	$s =~ tr/ /+/;
	return $s;
}

# URLデコード
sub urldecode
{
	my $s = $_[0];
	$s =~ tr/+/ /;
	$s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
	return $s;
}

# pathの設定
sub setcookiepath
{
	my ($var, $path) = @_;
	$plab::Cookie_path{$var} = $path;
}

1;

#!/usr/bin/perl

require '../cookie.pl';

$plab::Cookie{testvar} = "testval";

plab::writecookie();

print << "EOM";
Content-type: text/html

クッキーを書き込みました。<br>
データ：testvar=testval<br>
EOM

#!/usr/bin/perl

require '../../cookie.pl';

print "Content-type: text/html\n\n";
print "クッキーの内容：<br>\n";
foreach (keys(%plab::Cookie)) {
	print "$_ = $plab::Cookie{$_}<br>\n";
}

print "<br>";
print "plab::writecookie() の出力内容：（何も出力されなければＯＫ）<pre>\n";
plab::writecookie();

実行結果

解説

動作確認

動きました！互換は保っているので、これまでcookie.plを使っていたプログラムも動作します。 互換を保つ必要が無かったとしたら、もっと良いクッキー処理ライブラリが作れたかも知れませんね。 他のクッキー処理ライブラリはどんなやり方をしているのかなぁ？