File Coverage

blib/lib/HTTP/Session/State/MobileAgentID.pm

Criterion	Covered	Total	%
statement	41	42	97.6
branch	16	20	80.0
condition	5	10	50.0
subroutine	9	9	100.0
pod	1	3	33.3
total	72	84	85.7

package HTTP::Session::State::MobileAgentID;
use strict;
use warnings;
use 5.00800;
our $VERSION = '0.46';

use HTTP::Session::State::Base;
use HTTP::MobileAgent 0.28;
use Net::CIDR::MobileJP;

__PACKAGE__->mk_accessors(qw/mobile_agent/);
__PACKAGE__->mk_ro_accessors(qw/check_ip cidr/);

sub new {
    my $class = shift;
    my %args = ref($_[0]) ? %{$_[0]} : @_;
    # set default values
    $args{mobile_agent} = exists($args{mobile_agent}) ? $args{mobile_agent} : undef;
    $args{check_ip} = exists($args{check_ip}) ? $args{check_ip} : 1;
    $args{permissive} = exists($args{permissive}) ? $args{permissive} : 1;
    $args{cidr}       = exists($args{cidr}) ? $args{cidr} : Net::CIDR::MobileJP->new();
    bless {%args}, $class;
}

sub get_session_id {
    my ($self, $req) = @_;
    unless (defined $self->mobile_agent) {
        $self->mobile_agent(HTTP::MobileAgent->new($req->headers));
    }
    my $ma = $self->mobile_agent;
    Carp::croak "this module only supports docomo/softbank/ezweb" unless $ma->is_docomo || $ma->is_softbank || $ma->is_ezweb;

    my $id = $ma->user_id();
    if ($id) {
        if ($self->check_ip) {
            my $ip = $ENV{REMOTE_ADDR} || (Scalar::Util::blessed($req) ? $req->address : $req->{REMOTE_ADDR}) || die "cannot get client ip address";
            if ($self->cidr->get_carrier($ip) ne $ma->carrier) {
                die "SECURITY: invalid ip($ip, $ma, $id)";
            }
        }
        return $id;
    } else {
        my $ip = $ENV{REMOTE_ADDR} || (Scalar::Util::blessed($req) ? $req->address : $req->{REMOTE_ADDR}) || 'UNKNOWN';
        my $ua = $ma->user_agent();
        die "cannot detect mobile id from: ($ua, $ip)";
    }
}

sub response_filter { }


1;
__END__