Perl/CGI研究室 'PERL-LABO'

クッキーのpath指定に対応

研究内容

ここまでの研究で作成したクッキー処理ライブラリcookie.plはそこそこ使えるものでしたが、 pathに対応していませんでした。 pathに対応することで、 「クッキーを書き込むCGIプログラムと、そのクッキーを利用するCGIプログラムが異なる ディレクトリにある」ということができるようになります。挑戦してみましょう！

詳細

クッキーのpathって？

クッキーの書式は、次のようなものでした。

Set-Cookie: 名前=値; expires=有効期限; path=パス; domain=ドメイン名;

pathは、そのクッキーを受け取るCGIプログラムの場所を指定するんでしたね。 例えば、/counter/ のような文字列を指定すると、 /counter/以下のディレクトリにあるCGIプログラムでそのクッキーを受け取ることができます。 省略した場合は、そのクッキーを出力したCGIプログラムのパスが入るんでした。

domainは、クッキーを受け取るサイトのドメインを指定するんですが、ここでは扱いません。 省略すると、そのクッキーを出力したCGIプログラムのドメインが入ります。

さて、path、domain は省略できたのでこれまで無視してきましたが、 「クッキーを書き込むCGIプログラムと、そのクッキーを利用するCGIプログラムが異なる ディレクトリにある」というケースでは、pathの指定が必須です。 pathを指定しないと、クッキーを受け取れないですから。

pathを指定する方法とデータ構造

クッキーは複数扱うことができるんでした。 そのうち、特定のクッキーだけ他のCGIプログラムに渡したい場合は、 「このクッキーのpathはコレにしてください」っていうことをクッキーライブラリcookie.plに 伝える必要があります。次のような感じですね。

setcookiepath(クッキー名, パス);

cookie.pl側では、これを連想配列に記憶しておいて、クッキー出力のときに処理すれば良さそうです。

それほど難しくはなさそうですね。

作成したCGIプログラム

# v 1.11

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

package plab;

# 使い方
#   %plab::Cookie でクッキーにアクセス
#   plab::writecookie(); （HTTPヘッダ出力時に必ず呼ぶ）
# 注意
#   readcookie() は自動的に呼ばれます。

%plab::Cookie;  	# plabパッケージグローバルハッシュ
$plab::Cookie_read;	# readcookieが呼ばれたら1
%plab::Cookie_path;	# path設定
readcookie();		# 最初にクッキーの読み込みを行う

# クッキーの読み込み
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)) {

		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::setcookiepath("testvar", "/cookie/8/dir2/");

plab::writecookie();

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

クッキーを書き込みました。<br>
データ：testvar=testval<br>
パス：/cookie/8/dir2/
EOM

#!/usr/bin/perl

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

次のクッキーを受け取りました。<br>
$ENV{"HTTP_COOKIE"}
EOM

実行結果

解説

動作確認

dir1 ディレクトリにある writetest.cgi で、dir2 ディレクトリをpathに指定してクッキーを書き込みます。 次に、dir2 ディレクトリにある readtest.cgi で、クッキーが受け取れるか確認すると･･･成功です！ クッキーを受け取ることができました。

どういうときに使う？

クッキーを書き込んだCGIプログラムとそれを利用するCGIプログラムが違うというケースは あまり無いと思いますが、CGIプログラム間でクッキーを共有したいときはこういうやり方があるということが 分かりました。