File Coverage

blib/lib/Authen/CAS/Client.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Authen::CAS::Client;

require 5.006_001;

use strict;
use warnings;

use Authen::CAS::Client::Response;
use LWP::UserAgent;
use URI;
use URI::QueryParam;
use XML::LibXML;

our $VERSION = '0.08';


#======================================================================
# constructor
#

sub new {
  my ( $class, $cas, %args ) = @_;

  my $self = {
    _cas   => URI->new( $cas ),
    _ua    => LWP::UserAgent->new( agent => "Authen-CAS-Client/$VERSION" ),
    _fatal => $args{fatal} ? 1 : 0,
  };

  bless $self, $class;
}


#======================================================================
# private methods
#

sub _error {
  my ( $self, $error, $doc ) = @_;

  die $error
    if $self->{_fatal};

  Authen::CAS::Client::Response::Error->new( error => $error, doc => $doc );
}

sub _parse_auth_response {
  my ( $self, $xml ) = @_;

  my $doc = eval { XML::LibXML->new->parse_string( $xml ) };
  return $self->_error( 'Failed to parse XML', $xml )
    if $@;

  my ( $node, $response );

  eval {
    if( $node = $doc->find( '/cas:serviceResponse/cas:authenticationSuccess' )->get_node( 1 ) ) {
      $response = eval {
        my $user = $node->find( './cas:user' )->get_node( 1 )->textContent;

        my $iou = $node->find( './cas:proxyGrantingTicket' )->get_node( 1 );
        $iou = $iou->textContent
          if( defined $iou );

        my $proxies = $node->findnodes( './cas:proxies/cas:proxy' );
        $proxies = [ map $_->textContent, @$proxies ]
          if defined $proxies;

        Authen::CAS::Client::Response::AuthSuccess->new(
          user    => $user,
          iou     => $iou,
          proxies => $proxies,
          doc     => $doc,
        );
      };

      $response = $self->_error( 'Failed to parse authentication success response', $doc )
        if $@;
    }
    elsif( $node = $doc->find( '/cas:serviceResponse/cas:authenticationFailure' )->get_node( 1 ) ) {
      $response = eval {
        die
          unless $node->hasAttribute( 'code' );
        my $code = $node->getAttribute( 'code' );

        my $message = $node->textContent;
        s/^\s+//, s/\s+\z//
          for $message;

        Authen::CAS::Client::Response::AuthFailure->new(
          code    => $code,
          message => $message,
          doc     => $doc,
        );
      };

      $response = $self->_error( 'Failed to parse authentication failure response', $doc )
        if $@;
    }
    else {
      die;
    }
  };

  $response = $self->_error( 'Invalid CAS response', $doc )
    if $@;

  return $response;
}

sub _parse_proxy_response {
  my ( $self, $xml ) = @_;

  my $doc = eval { XML::LibXML->new->parse_string( $xml ) };
  return $self->_error( 'Failed to parse XML', $xml )
    if $@;

  my ( $node, $response );

  eval {
    if( $node = $doc->find( '/cas:serviceResponse/cas:proxySuccess' )->get_node( 1 ) ) {
      $response = eval {
        my $proxy_ticket = $node->find( './cas:proxyTicket' )->get_node( 1 )->textContent;

        Authen::CAS::Client::Response::ProxySuccess->new(
          proxy_ticket => $proxy_ticket,
          doc          => $doc,
        );
      };
      $response = $self->_error( 'Failed to parse proxy success response', $doc )
        if $@;
      }
    elsif( $node = $doc->find( '/cas:serviceResponse/cas:proxyFailure' )->get_node( 1 ) ) {
      $response = eval {
        die
          unless $node->hasAttribute( 'code' );
        my $code = $node->getAttribute( 'code' );

        my $message = $node->textContent;
        s/^\s+//, s/\s+\z//
          for $message;

        Authen::CAS::Client::Response::ProxyFailure->new(
          code    => $code,
          message => $message,
          doc     => $doc,
        );
      };
      $response = $self->_error( 'Failed to parse proxy failure response', $doc )
        if $@;
    }
    else {
      die;
    }
  };

  $response = $self->_error( 'Invalid CAS response', $doc )
    if $@;

  return $response;
}

sub _server_request {
  my ( $self, $path, $params ) = @_;

  my $url      = $self->_url( $path, $params )->canonical;
  my $response = $self->{_ua}->get( $url );

  unless( $response->is_success ) {
    return $self->_error(
      'HTTP request failed: ' . $response->code . ': ' . $response->message,
      $response->content
    );
  }

  return $response->content;
}

sub _url {
  my ( $self, $path, $params ) = @_;

  my $url = $self->{_cas}->clone;

  $url->path( $url->path . $path );
  $url->query_param_append( $_ => $params->{$_} )
    for keys %$params;

  return $url;
}

sub _v20_validate {
  my ( $self, $path, $service, $ticket, %args ) = @_;

  my %params = ( service => $service, ticket  => $ticket );

  $params{renew} = 'true'
    if $args{renew};
  $params{pgtUrl} = URI->new( $args{pgtUrl} )->canonical
    if defined $args{pgtUrl};

  my $content = $self->_server_request( $path, \%params );
  return $content
    if ref $content;

  return $self->_parse_auth_response( $content );
}


#======================================================================
# public methods
#

sub login_url {
  my ( $self, $service, %args ) = @_;

  my %params = ( service => $service );

  for ( qw/ renew gateway / ) {
    $params{$_} = 'true', last
      if $args{$_};
  }

  return $self->_url( '/login', \%params )->canonical;
}

sub logout_url {
  my ( $self, %args ) = @_;

  my %params;

  $params{url} = $args{url}
    if defined $args{url};

  return $self->_url( '/logout', \%params )->canonical;
}

sub validate {
  my ( $self, $service, $ticket, %args ) = @_;

  my %params = ( service => $service, ticket  => $ticket );

  $params{renew} = 'true'
    if $args{renew};

  my $content = $self->_server_request( '/validate', \%params );
  return $content
    if ref $content;

  my $response;

  if( $content =~ /^no\n\n\z/ ) {
    $response = Authen::CAS::Client::Response::AuthFailure->new( code => 'V10_AUTH_FAILURE', doc => $content );
  }
  elsif( $content =~ /^yes\n([^\n]+)\n\z/ ) {
    $response = Authen::CAS::Client::Response::AuthSuccess->new( user => $1, doc => $content );
  }
  else {
    $response = $self->_error( 'Invalid CAS response', $content );
  }

  return $response;
}

sub service_validate {
  my ( $self, $service, $ticket, %args ) = @_;
  return $self->_v20_validate( '/serviceValidate', $service, $ticket, %args );
}

sub proxy_validate {
  my ( $self, $service, $ticket, %args ) = @_;
  return $self->_v20_validate( '/proxyValidate', $service, $ticket, %args );
}

sub proxy {
  my ( $self, $pgt, $target ) = @_;

  my %params = ( pgt => $pgt, targetService => URI->new( $target ) );

  my $content = $self->_server_request( '/proxy', \%params );
  return $content
    if ref $content;

  return $self->_parse_proxy_response( $content );
}


1
__END__