lib/Keitairc/SessionManager.pm

   1 # -*- mode: perl; coding: utf-8 -*-
   2 # Keitairc::SessionManager
   3 # $Id: SessionManager.pm,v 1.9 2008-08-02 15:45:05 morimoto Exp $
   4 # $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/SessionManager.pm,v $
   5 #
   6 # Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
   7 # This program is covered by the GNU General Public License 2
   8
   9 package Keitairc::SessionManager;
  10 use strict;
  11 use warnings;
  12
  13 ################################################################
  14 # my $sm = new Keitairc::SessionManager;
  15 # オプションで ttl を指定可能
  16 # my $sm = new Keitairc::SessionManager({default_ttl => 120});
  17 sub new{
  18         my $proto = shift;
  19         my $arg = shift;
  20         my $me = {};
  21         srand(time % $$);
  22         $me->{sessions} = {};
  23         $me->{default_ttl} = $arg->{default_ttl} || 60 * 30;
  24         bless $me;
  25 }
  26
  27 ################################################################
  28 # $sm->verify({session_id => $session_id, user_agent => $user_agent});
  29 # $sm->verify({serial_key => $serial_key, user_agent => $user_agent});
  30 sub verify{
  31         my $me = shift;
  32         my $arg = shift;
  33         my $user_agent = $me->normalize_user_agent($arg->{user_agent});
  34         my $s;
  35
  36         # Keitairc::Log::log_debug("sm->verify: sid [$arg->{session_id}] serial_key [$arg->{serial_key}] user_agent [$arg->{user_agent}]");
  37
  38         if(defined $arg->{serial_key}){
  39                 if($s = $me->search_by_serial_key($arg->{serial_key}, $user_agent)){
  40                         # アクセスに合致する有効なセッションが見つかったら
  41                         # タイムスタンプを更新して成功を返す
  42                         return $me->refresh($s->{id}, $user_agent);
  43                 }
  44         }
  45
  46         if(defined $arg->{session_id}){
  47                 if($s = $me->search_by_session_id($arg->{session_id}, $user_agent)){
  48                         # アクセスに合致する有効なセッションが見つかったら
  49                         # タイムスタンプを更新して成功を返す
  50                         return $me->refresh($s->{id}, $user_agent);
  51                 }
  52         }
  53
  54         undef;
  55 }
  56
  57 ################################################################
  58 # 指定のセッションID文字列のセッションがあるか調べ、
  59 # セッションオブジェクトを返す
  60 # $sm->search_by_session_id($session_id, $user_agent);
  61 sub search_by_session_id{
  62         my $me = shift;
  63         my $session_id = shift;
  64         my $user_agent = shift;
  65
  66         $user_agent = $me->normalize_user_agent($user_agent);
  67         if(my $s = $me->{sessions}->{$session_id}){
  68                 if($s->{user_agent} eq $user_agent){
  69                         if($s->{last_access_time} + $s->{ttl} >= time){
  70                                 return $s;
  71                         }
  72                 }
  73         }
  74 }
  75
  76 ################################################################
  77 # 指定のセッションID文字列のセッションがあるか調べ、
  78 # セッションオブジェクトを返す
  79 # $sm->search_by_serial_key($serial_key, $user_agent);
  80 sub search_by_serial_key{
  81         my $me = shift;
  82         my $serial_key = shift;
  83         my $user_agent = shift;
  84
  85         $user_agent = $me->normalize_user_agent($user_agent);
  86
  87         for my $id (keys(%{$me->{sessions}})){
  88                 next unless defined $me->{sessions}->{$id}->{serial_key};
  89                 if($me->{sessions}->{$id}->{serial_key} eq $serial_key){
  90                         if($me->{sessions}->{$id}->{user_agent} eq $user_agent){
  91                                 return $me->{sessions}->{$id};
  92                         }
  93                 }
  94         }
  95 }
  96
  97 ################################################################
  98 # 指定のセッションID文字列のセッションの最終時刻を更新し、
  99 # セッションオブジェクトを返す
 100 # $sm->refresh($session_id, $user_agent);
 101 sub refresh{
 102         my $me = shift;
 103         my $session_id = shift;
 104         my $user_agent = shift;
 105
 106         $user_agent = $me->normalize_user_agent($user_agent);
 107
 108         # good time to gc, huh?
 109         $me->garbage_collect();
 110
 111         if(my $s = $me->{sessions}->{$session_id}){
 112                 if($s->{user_agent} eq $user_agent){
 113                         $s->{last_access_time} = time;
 114                         return $s;
 115                 }
 116         }
 117 }
 118
 119 ################################################################
 120 # 新たなセッションを始め、セッションオブジェクトを返す
 121 # 認証が成功した直後など、有意なとき以外にやってはいけない
 122 # $sm->add($user_agent, [$serial_key]);
 123 sub add{
 124         my $me = shift;
 125         my $user_agent = shift;
 126         my $serial_key = shift;
 127
 128         return unless length $user_agent;
 129
 130         $user_agent = $me->normalize_user_agent($user_agent);
 131
 132         my @id_chars = ('a'..'z', 'A'..'Z');
 133         my $session_id;
 134         do{
 135                 $session_id = 'S';
 136                 for(1..10){
 137                         $session_id .= $id_chars[rand(@id_chars)];
 138                 }
 139         }while(defined $me->{sessions}->{$session_id});
 140
 141         my $s = $me->{sessions}->{$session_id} = {};
 142         $s->{id} = $session_id;
 143         $s->{ttl} = $me->{default_ttl};
 144         $s->{user_agent} = $user_agent;
 145         if(defined $serial_key){
 146                 $s->{serial_key} = $serial_key;
 147         }else{
 148                 $s->{serial_key} = undef;
 149         }
 150         $s->{last_access_time} = time;
 151         Keitairc::Log::log_debug(
 152                 dh('new session', $s,
 153                    qw(id user_agent last_access_time serial_key ttl)));
 154         $s;
 155 }
 156
 157 ################################################################
 158 # dh: dump hash
 159 sub dh{
 160         my $title = shift;
 161         my $obj = shift;
 162         my @args = @_;
 163         my @buf;
 164         for my $arg (@args){
 165                 if(defined $obj->{$arg}){
 166                         push @buf, sprintf('%s[%s]', $arg, $obj->{$arg});
 167                 }
 168         }
 169
 170         $title . ': ' . join(', ', @buf);
 171 }
 172
 173 ################################################################
 174 # TTLが過ぎたセッションを抹消
 175 # $sm->garbage_collect();
 176 sub garbage_collect{
 177         my $me = shift;
 178         for my $id (keys(%{$me->{sessions}})){
 179                 if(($me->{sessions}->{$id}->{last_access_time} +
 180                     $me->{sessions}->{$id}->{ttl}) < time){
 181                         delete $me->{sessions}->{$id};
 182                         Keitairc::Log::log_debug("deleted session: id[$id]");
 183                 }
 184         }
 185 }
 186
 187 ################################################################
 188 sub delete{
 189         my $me = shift;
 190         my $session_id = shift;
 191         delete $me->{sessions}->{$session_id};
 192 }
 193
 194 ################################################################
 195 # USER_AGENT文字列から、セッション判定の妨げとなる要素を取る
 196 sub normalize_user_agent{
 197         my $me = shift;
 198         my $user_agent = shift;
 199
 200         # Keitairc::Log::log_debug("normalize_user_agent: user_agent[$user_agent]");
 201
 202         # NTT DoCoMoのFOMA端末製造番号 (15桁のユニークな英数字) および
 203         # FOMAカード製造番号 (20桁のユニークな英数字) を除去
 204         # http://www.nttdocomo.co.jp/service/imode/make/content/html/tag/utn.html
 205         # DoCoMo/2.0 P703imyu(c100;TB;W30H15)
 206         # DoCoMo/2.0 P703imyu(c100;TB;W30H15;ser123451234512345;icc12345678901234567890)
 207         if($user_agent =~ m|^DoCoMo/|){
 208                 $user_agent =~ s/;ser[0-9a-zA-Z]{15}//;
 209                 $user_agent =~ s/;icc[0-9a-zA-Z]{20}//;
 210         }
 211
 212         # SoftBank/Vodafone/J-PHONE
 213         # http://developers.softbankmobile.co.jp/dp/tool_dl/web/useragent.php
 214         if($user_agent =~ m!^(SoftBank|Vodafone|J-PHONE|MOT-)/!){
 215                 $user_agent =~ s|/SN[0-9A-Z]+|/|;
 216         }
 217
 218         # Keitairc::Log::log_debug("normalize_user_agent: user_agent[$user_agent]");
 219         $user_agent;
 220 }
 221
 222 1;