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

概略

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

今CGIが再びアツい

miyagawaさんのPSGI/PlackにはCGI::Compileというモジュールが含まれており、過去のCGIスクリプトに手を加えることなくmod_Perl/Apacheをすっ飛ばしていきなりサーバーのいちプロセスとしてアプリケーションを常駐(つまりは単純に高速化！)させることが可能になっていることを発見しましたので、これまた再びアツいんじゃなかろうかと考える次第であります。

で、CGI::Sessionから考えよう

上記については別途記事を作成する予定です。まずはこの辺りの知識が不足してるとモダンでセキュアなWebアプリケーションを書くことができない一方、ちょっとわかりやすいドキュメントが見つかりにくいので自分で書きました。

サンプル

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に関しては別途記事を用意してますのでそちらもあわせてご参照ください。

使い方

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

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

概略

今CGIが再びアツい

で、CGI::Sessionから考えよう

サンプル

使い方

参考文献