# -*- mode: perl; coding: utf-8 -*-
# Keitairc::SessionManager
# $Id: SessionManager.pm,v 1.9 2008-08-02 15:45:05 morimoto Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/SessionManager.pm,v $
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
# This program is covered by the GNU General Public License 2

package Keitairc::SessionManager;
use strict;
use warnings;

################################################################
# my $sm = new Keitairc::SessionManager;
# オプションで ttl を指定可能
# my $sm = new Keitairc::SessionManager({default_ttl => 120});
sub new{
	my $proto = shift;
	my $arg = shift;
	my $me = {};
	srand(time % $$);
	$me->{sessions} = {};
	$me->{default_ttl} = $arg->{default_ttl} || 60 * 30;
        bless $me;
}

################################################################
# $sm->verify({session_id => $session_id, user_agent => $user_agent});
# $sm->verify({serial_key => $serial_key, user_agent => $user_agent});
sub verify{
	my $me = shift;
	my $arg = shift;
	my $user_agent = $me->normalize_user_agent($arg->{user_agent});
	my $s;

	# Keitairc::Log::log_debug("sm->verify: sid [$arg->{session_id}] serial_key [$arg->{serial_key}] user_agent [$arg->{user_agent}]");

	if(defined $arg->{serial_key}){
		if($s = $me->search_by_serial_key($arg->{serial_key}, $user_agent)){
			# アクセスに合致する有効なセッションが見つかったら
			# タイムスタンプを更新して成功を返す
			return $me->refresh($s->{id}, $user_agent);
		}
	}

	if(defined $arg->{session_id}){
		if($s = $me->search_by_session_id($arg->{session_id}, $user_agent)){
			# アクセスに合致する有効なセッションが見つかったら
			# タイムスタンプを更新して成功を返す
			return $me->refresh($s->{id}, $user_agent);
		}
	}

	undef;
}

################################################################
# 指定のセッションID文字列のセッションがあるか調べ、
# セッションオブジェクトを返す
# $sm->search_by_session_id($session_id, $user_agent);
sub search_by_session_id{
	my $me = shift;
	my $session_id = shift;
	my $user_agent = shift;

	$user_agent = $me->normalize_user_agent($user_agent);
	if(my $s = $me->{sessions}->{$session_id}){
		if($s->{user_agent} eq $user_agent){
			if($s->{last_access_time} + $s->{ttl} >= time){
				return $s;
			}
		}
	}
}

################################################################
# 指定のセッションID文字列のセッションがあるか調べ、
# セッションオブジェクトを返す
# $sm->search_by_serial_key($serial_key, $user_agent);
sub search_by_serial_key{
	my $me = shift;
	my $serial_key = shift;
	my $user_agent = shift;

	$user_agent = $me->normalize_user_agent($user_agent);

	for my $id (keys(%{$me->{sessions}})){
		next unless defined $me->{sessions}->{$id}->{serial_key};
		if($me->{sessions}->{$id}->{serial_key} eq $serial_key){
			if($me->{sessions}->{$id}->{user_agent} eq $user_agent){
				return $me->{sessions}->{$id};
			}
		}
	}
}

################################################################
# 指定のセッションID文字列のセッションの最終時刻を更新し、
# セッションオブジェクトを返す
# $sm->refresh($session_id, $user_agent);
sub refresh{
	my $me = shift;
	my $session_id = shift;
	my $user_agent = shift;

	$user_agent = $me->normalize_user_agent($user_agent);

	# good time to gc, huh?
	$me->garbage_collect();

	if(my $s = $me->{sessions}->{$session_id}){
		if($s->{user_agent} eq $user_agent){
			$s->{last_access_time} = time;
			return $s;
		}
	}
}

################################################################
# 新たなセッションを始め、セッションオブジェクトを返す
# 認証が成功した直後など、有意なとき以外にやってはいけない
# $sm->add($user_agent, [$serial_key]);
sub add{
	my $me = shift;
	my $user_agent = shift;
	my $serial_key = shift;

	return unless length $user_agent;

	$user_agent = $me->normalize_user_agent($user_agent);

	my @id_chars = ('a'..'z', 'A'..'Z');
	my $session_id;
	do{
		$session_id = 'S';
		for(1..10){
			$session_id .= $id_chars[rand(@id_chars)];
		}
	}while(defined $me->{sessions}->{$session_id});

	my $s = $me->{sessions}->{$session_id} = {};
	$s->{id} = $session_id;
	$s->{ttl} = $me->{default_ttl};
	$s->{user_agent} = $user_agent;
	if(defined $serial_key){
		$s->{serial_key} = $serial_key;
	}else{
		$s->{serial_key} = undef;
	}
	$s->{last_access_time} = time;
	Keitairc::Log::log_debug(
		dh('new session', $s,
		   qw(id user_agent last_access_time serial_key ttl)));
	$s;
}

################################################################
# dh: dump hash
sub dh{
	my $title = shift;
	my $obj = shift;
	my @args = @_;
	my @buf;
	for my $arg (@args){
		if(defined $obj->{$arg}){
			push @buf, sprintf('%s[%s]', $arg, $obj->{$arg});
		}
	}

	$title . ': ' . join(', ', @buf);
}

################################################################
# TTLが過ぎたセッションを抹消
# $sm->garbage_collect();
sub garbage_collect{
	my $me = shift;
	for my $id (keys(%{$me->{sessions}})){
		if(($me->{sessions}->{$id}->{last_access_time} +
		    $me->{sessions}->{$id}->{ttl}) < time){
			delete $me->{sessions}->{$id};
			Keitairc::Log::log_debug("deleted session: id[$id]");
		}
	}
}

################################################################
sub delete{
	my $me = shift;
	my $session_id = shift;
	delete $me->{sessions}->{$session_id};
}

################################################################
# USER_AGENT文字列から、セッション判定の妨げとなる要素を取る
sub normalize_user_agent{
	my $me = shift;
	my $user_agent = shift;

	# Keitairc::Log::log_debug("normalize_user_agent: user_agent[$user_agent]");

	# NTT DoCoMoのFOMA端末製造番号 (15桁のユニークな英数字) および
	# FOMAカード製造番号 (20桁のユニークな英数字) を除去
	# http://www.nttdocomo.co.jp/service/imode/make/content/html/tag/utn.html
	# DoCoMo/2.0 P703imyu(c100;TB;W30H15)
	# DoCoMo/2.0 P703imyu(c100;TB;W30H15;ser123451234512345;icc12345678901234567890)
	if($user_agent =~ m|^DoCoMo/|){
		$user_agent =~ s/;ser[0-9a-zA-Z]{15}//;
		$user_agent =~ s/;icc[0-9a-zA-Z]{20}//;
	}

	# SoftBank/Vodafone/J-PHONE
	# http://developers.softbankmobile.co.jp/dp/tool_dl/web/useragent.php
	if($user_agent =~ m!^(SoftBank|Vodafone|J-PHONE|MOT-)/!){
		$user_agent =~ s|/SN[0-9A-Z]+|/|;
	}

	# Keitairc::Log::log_debug("normalize_user_agent: user_agent[$user_agent]");
	$user_agent;
}

1;
