[Perl] CGI::Session でログイン／ログアウトを管理する簡単なサンプル

##概略
perlといえば一昔前のWebアプリケーション構築環境の代名詞だったわけですが、最近はPHPの台頭やRoRの普及に伴って完全に下火になっちゃってます、と、私もそう思っていましたが、考えが一変しましたので共有します。

##今CGIが再びアツい
[miyagawa](https://twitter.com/miyagawa)さんの[PSGI/Plack](http://plackperl.org/)には[CGI::Compile](http://search.cpan.org/~miyagawa/CGI-Compile-0.19/lib/CGI/Compile.pm)というモジュールが含まれており、過去のCGIスクリプトに手を加えることなく[mod_Perl/Apache](http://perl.apache.org/)をすっ飛ばしていきなり[サーバーのいちプロセスとしてアプリケーションを常駐(**つまりは単純に高速化！**)させることが可能](http://www.omakase.org/perl/cgicompile.html)になっていることを発見しましたので、これまた再びアツいんじゃなかろうかと考える次第であります。

##で、[CGI::Session](http://perldoc.jp/docs/modules/CGI-Session-3.11/Session.pod)から考えよう
上記については別途記事を作成する予定です。**まずはこの辺りの知識が不足してるとモダンでセキュアなWebアプリケーションを書くことができない**一方、ちょっとわかりやすいドキュメントが見つかりにくいので自分で書きました。


##サンプル
![スクリーンショット 2015-05-07 16.06.53.png](https://qiita-image-store.s3.amazonaws.com/0/10766/77b04bb2-e0c8-9a5e-8252-8e905380364b.png)

```session.pl
#! /usr/local/bin/perl

use strict;
use warnings;

# 注）環境依存。この辺は適当に変えてください
use lib "$ENV{DOCUMENT_ROOT}/lib/perl5";	# CPANモジュールを読み込む
use lib "$ENV{DOCUMENT_ROOT}/lib";			# 上位のモジュールを読み込む
use lib "./lib";							# ローカルなモジュールを読み込む
# 環境依存終了

use CGI qw|:standard|;
use CGI::Session;	#qw|-ip_match|; #WiFiとモバイルの切り替えを考えると、IPアドレスが同一とは限らない
use Password;

my $title = "セッションID管理テスト";
my $expire = '+1h';
my $encode = 'UTF-8';

# 本当はデータベースを使うところを省略
my %User = ( 'Qiita' => { pass => q|$1$hEeN3T%+$CRKHRxko1cWGNjE69mTNw.| } );

my $cgi = new CGI;
# GETリクエストによるセッションIDの指定の無効化
print $cgi->redirect( -uri=>'http://'.$ENV{SERVER_NAME}.$ENV{SCRIPT_NAME}, -status=>301 ) and exit if $cgi->param('CGISESSID');

my $sid = $cgi->cookie('CGISESSID') || undef;
# 1.cookieからCGISESSIDを探す
# 2.取得できなかったらundef．
my $session = CGI::Session->load(undef, $sid, {Directory=>'./data'}) or die CGI::Session->errstr();
Error("Your session timed out! Refresh the screen to start new session!") if $session->is_expired;
$session->expire($expire);	# 有効期限の設定
#$session->expire('+1m');	# テスト用

if ( $session->is_empty ) {
    $session = $session->new(undef, $sid, {Directory=>'./data'}) or die $session->errstr;
}# 3.取得したセッションidが有効ならそのまま．無効なら別のidを発番．

my %param = $cgi->Vars();
my @message;

if ($session){
	if (my $action = $param{'action'}){
		push @message, forget() if $action eq 'forget me';	# セッションの削除依頼
		push @message, logout() if $action eq 'logout';	# セッション内のログインステータスを初期化
    }

    $session->save_param($cgi); # 入力値をセッション内に保存
    $session->clear('pass');    # パスワードの平文保存を回避
	push @message, login($session->param('username'), $param{'pass'} ) if $param{'action'} and $param{'action'} eq 'login';
	push @message, $session->param('username')? confirm(): ask();	# 有効なIDを持つセッション
}else{
	push @message, ask();
}

print $session->header( -charset => $encode ),
    start_html( -title => $title, -encoding => $encode, -lang => 'ja'),
	@message,
	a({href=>$ENV{"SCRIPT_NAME"}}, '戻る',),
	end_html(),
;

exit;

sub Error {
    my $msg = shift;
    
    print $session->header( -charset => $encode ),
    start_html( -title => "エラー / " . $title, -encoding => $encode, -lang => 'ja'),
    h1("エラー"),hr(),
	p(strong($msg)),hr(),
	a({href=>$ENV{"SCRIPT_NAME"}}, '戻る',),
	end_html(),
;
exit;
}

sub forget {
    $session->clear(['username', 'firstname', 'lastname', 'like', 'action', 'login']);
    $session->close;
    $session->delete;
    return h2("We've forgotten you!");
}

sub login {
	my ($id, $pass ) = @_;
	Error("存在しないユーザー名でのログインが試行されました: $id\n") if not exists $User{$id};
	Error("$idのパスワードが違います\n") if not Password->verify( $pass, $User{$id}{'pass'} );

	$session->param('login', 1);
    $session->clear('pass');
	$session->expire('login', '+1w');
	return h2("ログイン成功！"),
}

sub logout {
    $session->param('login', 0);
    return h2("ログアウト成功！");
}

sub ask{ #セッションからユーザーデータを取得できない場合の挙動
    return h1("We don't know who you are."),
    start_form(), p(
        'your first name', textfield('firstname', $session->param('firstname'), 16, 16), br(),
        'your last name', textfield('lastname', $session->param('lastname'), 16, 16), br(),
        'your unique ID', textfield('username', $session->param('username'), 16, 16), br(),
        'tell me what you like', textfield('like', $session->param('like'), 16, 16), br(),
        submit('action', 'register'),
    ),end_form();
}

sub confirm {
    $session->expire('+1y');

    my @confirm;
    if ( $session->param('login') != 1) {
		push @confirm,
            password_field('pass',undef,16,20),'password is allowed 4-20 charctors', br(),
            submit('action', 'login'), "or",
		;
	}else{
		push @confirm,
			'your first name is ',$session->param('firstname'),  br(),
			'your last name is ',$session->param('lastname'),  br(),
			'your favorite is ',$session->param('like'),  br(),
			'and your last action is ',$session->param('action'),  br(),
            submit('action', 'logout'), "or",submit('action', 'refresh'), "or",
		;
	}

    return
    h1(a( {href=>"$ENV{'SCRIPT_NAME'}?CGISESSID=".$session->id()}, "We know who you are,", $session->param('username') )),
    start_form(),
        p(@confirm, submit('action', 'forget me'),),
    end_form();
}
```
※依存モジュールである[Password.pmに関しては別途記事を用意](http://qiita.com/worthmine/items/519fb4fd1d7f5117a255)してますのでそちらもあわせてご参照ください。

##使い方
```username``` 以外は任意の値で大丈夫です。
パスワード、ユーザー名とも```Qiita```でログインの確認ができます。

##参考文献
* [CGI::Session - CGIアプリケーションにおける持続的なデータのセッション](http://perldoc.jp/docs/modules/CGI-Session-3.11/Session.pod)
* [CGI::Session.pmでセッション管理](http://www.dab.hi-ho.ne.jp/sasa/biboroku/perl/session.html)
* [CGI::Sessionでファイルを保存してくれない件](http://blog.xaxxi.net/2009/12/04/cgisessionでファイルを保存してくれない件/)

* [既存のCGIスクリプトでより強固なパスワード認証を行う](http://qiita.com/worthmine/items/519fb4fd1d7f5117a255)