File Coverage

blib/lib/Dancer/Plugin/Auth/CAS.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package Dancer::Plugin::Auth::CAS;
{
  $Dancer::Plugin::Auth::CAS::VERSION = '1.128';
}

=head1 NAME

Dancer::Plugin::Auth::CAS - CAS sso authentication for Dancer

=cut

use warnings;
use strict;

use Dancer ':syntax';
use Dancer::Plugin;
use Dancer::Response;
use Dancer::Exception ':all';
use HTTP::Headers;
use Authen::CAS::Client;
use Scalar::Util 'blessed';

our $VERSION;

register_exception('InvalidConfig', message_pattern => "Invalid or missing configuration: %s");
register_exception('CasError', message_pattern => "Unable to auth with CAS backend: %s");

my $settings = plugin_setting;

sub _auth_cas {
    my (%options) = @_;

    my $base_url = $settings->{cas_url} // raise( InvalidConfig => "cas_url is unset" );
    my $cas_version = $settings->{cas_version} ||  raise( InvalidConfig => "cas_version is unset");
    my $cas_user_map = $options{cas_user_map} || $settings->{cas_user_map} || 'cas_user';
    my $cas_denied_url = $options{cas_denied_path} || $settings->{cas_denied_path} || '/denied';

    my $ssl_verify_hostname = $settings->{ssl_verify_hostname};
    $ENV{"PERL_LWP_SSL_VERIFY_HOSTNAME"} = defined( $ssl_verify_hostname ) ? $ssl_verify_hostname : 1;

    # check supported versions
    unless( grep(/$cas_version/, qw( 2.0 1.0 )) ) {
        raise( InvalidConfig => "cas_version '$cas_version' not supported");
    }

    my $mapping = $settings->{cas_attr_map} || {};

    my $ticket = $options{ticket};
    my $params = request->params;
    unless( $ticket ) {
        my $tickets = $params->{ticket};
        # For the case when application also uses 'ticket' parameters
        # we only remove the real cas service ticket
        if( ref($tickets) eq "ARRAY" ) {
            while( my ($index, $value) = each @$tickets ) {
                # The 'ST-' is specified in CAS-protocol
                if( $value =~ m/^ST\-/ ) {
                    $ticket = delete $tickets->[$index];
                }
            }
        } else {
            $ticket = delete $params->{ticket};
        }
    }
    my $service = uri_for( request->path_info, $params );

    my $cas = Authen::CAS::Client->new( $base_url );

    my $user = session($cas_user_map);

    unless( $user ) {

        my $response = Dancer::Response->new( status => 302 );
        my $redirect_url;

        if( $ticket) {
            debug "Trying to validate via CAS '$cas_version' with ticket=$ticket";

            my $r;
            if( $cas_version eq "1.0" ) {
                $r = $cas->validate( $service, $ticket );
            }
            elsif( $cas_version eq "2.0" ) {
                $r = $cas->service_validate( $service, $ticket );
            }
            else {
                raise( InvalidConfig => "cas_version '$cas_version' not supported");
            }

            if( $r->is_success ) {

                # Redirect to given path
                info "Authenticated as: ".$r->user;
                if( $cas_version eq "1.0" ) {
                    session $cas_user_map => $r->user;
                } else {
                    session $cas_user_map => _map_attributes( $r->doc, $mapping );
                }
                $redirect_url = $service;

            } elsif( $r->is_failure ) {

                # Redirect to denied
                debug "Failed to authenticate: ".$r->code." / ".$r->message;
                $redirect_url = uri_for( $cas_denied_url );

            } else {

                # Raise hard error, backend has errors
                error "Unable to authenticate: ".$r->error;
                raise( CasError => $r->error );
            }

        } else {
            # Has no ticket, needs one
            debug "Redirecting to CAS: ".$cas->login_url( $service );
            $redirect_url = $cas->login_url( $service );
        }

        # General redir response
        $response->header( Location => $redirect_url );
        halt( $response );
    }

}

sub _map_attributes {
    my ( $doc, $mapping ) = @_;

    my $attrs = {};

    my $result = $doc->find( '/cas:serviceResponse/cas:authenticationSuccess' );
    if( $result ) {
        my $node = $result->get_node(1);

        # extra all attributes
        my @attributes = $node->findnodes( "./cas:attributes/*" );
        foreach my $a (@attributes) {
            my $name = (split(/:/, $a->nodeName, 2))[1];
            my $val = $a->textContent;

            my $mapped_name = $mapping->{ $name } // $name;
            $attrs->{ $mapped_name } = $val;
        }

    }
    debug "Mapped attributes: ".to_dumper( $attrs );
    return $attrs;
}


register auth_cas => \&_auth_cas;
register_plugin;

1; # End of Dancer::Plugin::Auth::CAS
__END__