AuthCAS-1.5/000755 024403 047040 00000000000 11550610754 012733 5ustar00salauncru000000 000000 AuthCAS-1.5/Build.PL000444 024403 047040 00000000607 11550610754 014230 0ustar00salauncru000000 000000 use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'AuthCAS', license => 'perl', dist_author => 'Olivier Salaun ', dist_version_from => 'lib/AuthCAS.pm', requires => { 'Test::More' => 0, }, add_to_cleanup => [ 'AuthCAS-*' ], ); $builder->create_build_script(); AuthCAS-1.5/Changes000444 024403 047040 00000010316 11550610754 014225 0ustar00salauncru000000 000000 2009-06-08 13:00 olivier.salaun * trunk/META.yml, trunk/lib/AuthCAS.pm: Renaming 1.3.3 release to 1.4 to match the CPAN versionning style 2009-06-05 15:47 olivier.salaun * trunk/Changes, trunk/META.yml, trunk/lib/AuthCAS.pm: preparing version 1.3.3 2009-05-12 15:48 olivier.salaun * trunk/Changes, trunk/META.yml, trunk/lib/AuthCAS.pm: Updating the version number 2009-05-12 07:31 olivier.salaun * trunk/lib/AuthCAS.pm: Change: now use eval() to check if perl modules are available ; this is required by recent Perl interpreters 2007-10-16 09:26 olivier.salaun * trunk/lib/AuthCAS.pm: Updated release number 2007-10-16 09:20 olivier.salaun * trunk/Changes, trunk/META.yml: Preparing 1.3.1 release 2007-10-16 09:13 olivier.salaun * trunk/lib/AuthCAS.pm: [reported by S.McDonald, bepress.com] Fix: error at "make test" : "Global symbol "$xmlRef" requires explicit package name" The code was still refering to the old $xmlRef variable 2007-08-21 08:43 olivier.salaun * trunk/Changes: Updated 2007-08-21 08:31 olivier.salaun * trunk/lib/AuthCAS.pm: [reported by P.Brusten]Fix: expected an arrayref instead of an array for gethttps2() output. This bug was introduced by S.More's patch. Concel it. 2007-08-21 08:20 olivier.salaun * trunk/README: Refer to the bug tracking system 2007-04-06 16:14 olivier.salaun * trunk/Changes: Updated 2007-04-06 16:10 olivier.salaun * trunk/META.yml, trunk/lib/AuthCAS.pm: preparind 1.2 2007-04-06 16:05 olivier.salaun * trunk/lib/AuthCAS.pm: [Kasper Løvschall] Fix: XML parser now accepts multiple name space tags in CAS xml responses 2007-04-06 15:56 olivier.salaun * trunk/lib/AuthCAS.pm: [#24021] [Stephen More] Fix: error trapping in get_https2 2007-04-06 15:30 olivier.salaun * trunk/debian, trunk/debian/compat, trunk/debian/control, trunk/debian/copyright, trunk/debian/rules: [Lionel Porcheron, Anywhere] Added the required files to allow Debian packaging. 2006-11-13 13:02 olivier.salaun * trunk/Changes: updated 2006-04-11 14:01 olivier.salaun * trunk/lib/AuthCAS.pm: Fix: Added "Host:" HTTP header field to requests 2006-03-14 09:42 olivier.salaun * trunk/META.yml, trunk/lib/AuthCAS.pm, trunk/t/00.load.t: preparing release 1.1 2006-03-14 08:40 olivier.salaun * trunk/t/00.load.t: [reported by L.Porcheron]: incorrect tests referring to old module name 2005-04-21 15:02 olivier.salaun * trunk/lib/AuthCAS.pm, trunk/lib/CAS.pm: enamed module 2005-04-21 14:50 olivier.salaun * trunk/Build.PL, trunk/MANIFEST, trunk/META.yml, trunk/Makefile.PL, trunk/sampleCasClient.pl: enamed project AuthCAS?\024?\024 2005-04-21 14:04 olivier.salaun * trunk/sampleCasClient.pl: restore sample code 2005-04-21 14:04 olivier.salaun * trunk, trunk/.cvsignore, trunk/Build.PL, trunk/CAS.pm, trunk/ChangeLog, trunk/Changes, trunk/MANIFEST, trunk/META.yml, trunk/Makefile.PL, trunk/README, trunk/lib, trunk/lib/CAS.pm, trunk/sampleCasClient.pl, trunk/t, trunk/t/00.load.t, trunk/t/pod-coverage.t, trunk/t/pod.t: A clean CPAN distribution of CAS.pm 2003-11-28 14:19 olivier.salaun * trunk/CAS.pm: Rename sub 2003-11-27 11:12 olivier.salaun * trunk/CAS.pm: Change: allow all service Path to be changed at new() time 2003-11-26 15:55 olivier.salaun * trunk/CAS.pm: Add getServerGatewayURL() for nonblocking login check 2003-11-25 15:41 olivier.salaun * trunk/ChangeLog: Update 2003-11-25 15:40 olivier.salaun * trunk/CAS.pm, trunk/sampleCasClient.pl: Change: Better error management via the $errors variable 2003-11-14 16:09 olivier.salaun * trunk/ChangeLog: Add Changelog 2003-11-14 16:08 olivier.salaun * trunk/CAS.pm: [proposed by V.Mathieu] Change: verify CAS server certificate only if capath or cafile were set 2003-11-14 15:33 olivier.salaun * trunk/CAS.pm, trunk/sampleCasClient.pl: [reported by V.Mathieu] Fix SSL_verify_mode 2003-11-14 15:08 olivier.salaun * trunk/CAS.pm, trunk/sampleCasClient.pl: [reported by V. Mathieu] Fix: capath and cafile were inverted in sample code 2003-11-14 15:00 olivier.salaun * trunk/CAS.pm, trunk/sampleCasClient.pl: Initial revision 2003-11-14 15:00 * branches, tags, trunk: New repository initialized by cvs2svn. AuthCAS-1.5/lib/000755 024403 047040 00000000000 11550610754 013501 5ustar00salauncru000000 000000 AuthCAS-1.5/Makefile.PL000444 024403 047040 00000001004 11550610754 014676 0ustar00salauncru000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'AuthCAS', AUTHOR => 'Olivier Salaun ', VERSION_FROM => 'lib/AuthCAS.pm', ABSTRACT_FROM => 'lib/AuthCAS.pm', PL_FILES => {'sampleCasClient.pl'}, PREREQ_PM => { 'IO::Socket::SSL' => 0, 'LWP::UserAgent' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'AuthCAS-*' }, ); AuthCAS-1.5/MANIFEST000444 024403 047040 00000000213 11550610754 014056 0ustar00salauncru000000 000000 Build.PL Changes MANIFEST META.yml # Will be created by "make dist" Makefile.PL README lib/AuthCAS.pm t/00.load.t t/pod-coverage.t t/pod.t AuthCAS-1.5/META.yml000444 024403 047040 00000000647 11550610754 014211 0ustar00salauncru000000 000000 --- name: AuthCAS version: 1.5 author: - 'Olivier Salaun ' abstract: Client library for CAS 2.0 authentication server license: perl requires: Test::More: 0 generated_by: Module::Build version 0.280801 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 provides: AuthCAS: file: lib/AuthCAS.pm version: 1.5 resources: license: http://dev.perl.org/licenses/ AuthCAS-1.5/README000444 024403 047040 00000002356 11550610754 013617 0ustar00salauncru000000 000000 CAS The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install Alternatively, to install with Module::Build, you can use the following commands: perl Build.PL ./Build ./Build test ./Build install REPORTING BUGS You can report bugs using our bug tracking system : http://sourcesup.cru.fr/tracker/?group_id=76 COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2005,2006,2007 Olivier Salaun - Comité Réseau des Universités This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. AuthCAS-1.5/t/000755 024403 047040 00000000000 11550610754 013176 5ustar00salauncru000000 000000 AuthCAS-1.5/t/00.load.t000444 024403 047040 00000000151 11550610754 014513 0ustar00salauncru000000 000000 use Test::More tests => 1; BEGIN { use_ok( 'AuthCAS' ); } diag( "Testing AuthCAS $AuthCAS::VERSION" ); AuthCAS-1.5/t/pod-coverage.t000444 024403 047040 00000000254 11550610754 015735 0ustar00salauncru000000 000000 #!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); AuthCAS-1.5/t/pod.t000444 024403 047040 00000000214 11550610754 014140 0ustar00salauncru000000 000000 #!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); AuthCAS-1.5/lib/AuthCAS.pm000444 024403 047040 00000030757 11550610754 015301 0ustar00salauncru000000 000000 package AuthCAS; use strict; use vars qw( $VERSION); $VERSION = '1.5'; =head1 NAME AuthCAS - Client library for CAS 2.0 authentication server =head1 VERSION Version 1.5 =head1 DESCRIPTION AuthCAS aims at providing a Perl API to Yale's Central Authentication System (CAS). Only a basic Perl library is provided with CAS whereas AuthCAS is a full object-oriented library. =head1 PREREQUISITES This script requires IO::Socket::SSL and LWP::UserAgent =pod OSNAMES any =pod SCRIPT CATEGORIES Network =head1 SYNOPSIS A simple example with a direct CAS authentication use AuthCAS; my $cas = new AuthCAS(casUrl => 'https://cas.myserver, CAFile => '/etc/httpd/conf/ssl.crt/ca-bundle.crt', ); my $login_url = $cas->getServerLoginURL('http://myserver/app.cgi'); ## The user should be redirected to the $login_url ## When coming back from the CAS server a ticket is provided in the QUERY_STRING ## $ST should contain the receaved Service Ticket my $user = $cas->validateST('http://myserver/app.cgi', $ST); printf "User authenticated as %s\n", $user; In the following example a proxy is requesting a Proxy Ticket for the target application $cas->proxyMode(pgtFile => '/tmp/pgt.txt', pgtCallbackUrl => 'https://myserver/proxy.cgi?callback=1 ); ## Same as before but the URL is the proxy URL my $login_url = $cas->getServerLoginURL('http://myserver/proxy.cgi'); ## Like in the previous example we should receave a $ST my $user = $cas->validateST('http://myserver/proxy.cgi', $ST); ## Process errors printf STDERR "Error: %s\n", &AuthCAS::get_errors() unless (defined $user); ## Now we request a Proxy Ticket for the target application my $PT = $cas->retrievePT('http://myserver/app.cgi'); ## This piece of code is executed by the target application ## It received a Proxy Ticket from the proxy my ($user, @proxies) = $cas->validatePT('http://myserver/app.cgi', $PT); printf "User authenticated as %s via %s proxies\n", $user, join(',',@proxies); =head1 DESCRIPTION CAS is Yale University's web authentication system, heavily inspired by Kerberos. Release 2.0 of CAS provides "proxied credential" feature that allows authentication tickets to be carried by intermediate applications (Portals for instance), they are called proxy. This AuthCAS Perl module provides required subroutines to validate and retrieve CAS tickets. =head1 SEE ALSO Yale Central Authentication Service (http://www.yale.edu/tp/auth/) phpCAS (http://esup-phpcas.sourceforge.net/) =head1 COPYRIGHT Copyright (C) 2003 Comite Reseau des Universites (http://www.cru.fr). All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Olivier Salaun =cut my @ISA = qw(Exporter); my @EXPORT = qw($errors); my $errors; use Carp; sub new { my($pkg, %param) = @_; my $cas_server = {}; $cas_server->{'url'} = $param{'casUrl'}; $cas_server->{'CAFile'} = $param{'CAFile'}; $cas_server->{'CAPath'} = $param{'CAPath'}; $cas_server->{'loginPath'} = $param{'loginPath'} || '/login'; $cas_server->{'logoutPath'} = $param{'logoutPath'} || '/logout'; $cas_server->{'serviceValidatePath'} = $param{'serviceValidatePath'} || '/serviceValidate'; $cas_server->{'proxyPath'} = $param{'proxyPath'} || '/proxy'; $cas_server->{'proxyValidatePath'} = $param{'proxyValidatePath'} || '/proxyValidate'; bless $cas_server, $pkg; return $cas_server; } ## Return module errors sub get_errors { return $errors; } ## Use the CAS object as a proxy sub proxyMode { my $self = shift; my %param = @_; $self->{'pgtFile'} = $param{'pgtFile'}; $self->{'pgtCallbackUrl'} = $param{'pgtCallbackUrl'}; $self->{'proxy'} = 1; return 1; } ## Escape dangerous chars in URLS sub _escape_chars { my $s = shift; ## Escape chars ## !"#$%&'()+,:;<=>?[] AND accented chars ## escape % first # foreach my $i (0x25,0x20..0x24,0x26..0x2c,0x3a..0x3f,0x5b,0x5d,0x80..0x9f,0xa0..0xff) { foreach my $i (0x26) { my $hex_i = sprintf "%lx", $i; $s =~ s/\x$hex_i/%$hex_i/g; } return $s; } sub dump_var { my ($var, $level, $fd) = @_; if (ref($var)) { if (ref($var) eq 'ARRAY') { foreach my $index (0..$#{$var}) { print $fd "\t"x$level.$index."\n"; &dump_var($var->[$index], $level+1, $fd); } }elsif (ref($var) eq 'HASH') { foreach my $key (sort keys %{$var}) { print $fd "\t"x$level.'_'.$key.'_'."\n"; &dump_var($var->{$key}, $level+1, $fd); } } }else { if (defined $var) { print $fd "\t"x$level."'$var'"."\n"; }else { print $fd "\t"x$level."UNDEF\n"; } } } ## Parse an HTTP URL sub _parse_url { my $url = shift; my ($host, $port, $path); if ($url =~ /^(https?):\/\/([^:\/]+)(:(\d+))?(.*)$/) { $host = $2; $path = $5; if ($1 eq 'http') { $port = $4 || 80; }elsif ($1 eq 'https') { $port = $4 || 443; }else { $errors = sprintf "Unknown protocol '%s'\n", $1; return undef; } }else { $errors = sprintf "Unable to parse URL '%s'\n", $url; return undef; } return ($host, $port, $path); } ## Simple XML parser sub _parse_xml { my $data = shift; my %xml_struct; while ($data =~ /^<([^\s>]+)(\s+[^\s>]+)*>([\s\S\n]*)(<\/\1>)/m) { my ($new_tag, $new_data) = ($1,$3); chomp $new_data; $new_data =~ s/^[\s\n]+//m; $data =~ s/^<$new_tag(\s+[^\s>]+)*>([\s\S\n]*)(<\/$new_tag>)//m; $data =~ s/^[\s\n]+//m; ## Check if data still includes XML tags my $struct; if ($new_data =~/^<([^\s>]+)(\s+[^\s>]+)*>([\s\S\n]*)(<\/\1>)/m) { $struct = &_parse_xml($new_data); }else { $struct = $new_data; } push @{$xml_struct{$new_tag}}, $struct; } return \%xml_struct; } sub getServerLoginURL { my $self = shift; my $service = shift; return $self->{'url'}.$self->{'loginPath'}.'?service='.&_escape_chars($service); } ## Returns non-blocking login URL ## ie: if user is logged in, return the ticket, otherwise do not prompt for login sub getServerLoginGatewayURL { my $self = shift; my $service = shift; return $self->{'url'}.$self->{'loginPath'}.'?service='.&_escape_chars($service).'&gateway=1'; } ## Return logout URL ## After logout user is redirected back to the application sub getServerLogoutURL { my $self = shift; my $service = shift; return $self->{'url'}.$self->{'logoutPath'}.'?service='.&_escape_chars($service).'&gateway=1'; } sub getServerServiceValidateURL { my $self = shift; my $service = shift; my $ticket = shift; my $pgtUrl = shift; my $query_string = 'service='.&_escape_chars($service).'&ticket='.$ticket; if (defined $pgtUrl) { $query_string .= '&pgtUrl='.&_escape_chars($pgtUrl); } ## URL was /validate with CAS 1.0 return $self->{'url'}.$self->{'serviceValidatePath'}.'?'.$query_string; } sub getServerProxyURL { my $self = shift; my $targetService = shift; my $pgt = shift; return $self->{'url'}.$self->{'proxyPath'}.'?targetService='.&_escape_chars($targetService).'&pgt='.&_escape_chars($pgt); } sub getServerProxyValidateURL { my $self = shift; my $service = shift; my $ticket = shift; return $self->{'url'}.$self->{'proxyValidatePath'}.'?service='.&_escape_chars($service).'&ticket='.&_escape_chars($ticket); } ## Validate a Service Ticket ## Also used to get a PGT sub validateST { my $self = shift; my $service = shift; my $ticket = shift; my $pgtUrl = $self->{'pgtCallbackUrl'}; my $xml = $self->callCAS($self->getServerServiceValidateURL($service, $ticket, $pgtUrl)); if (defined $xml->{'cas:serviceResponse'}[0]{'cas:authenticationFailure'}) { $errors = sprintf "Failed to validate Service Ticket %s : %s\n", $ticket, $xml->{'cas:serviceResponse'}[0]{'cas:authenticationFailure'}[0]; return undef; } my $user = $xml->{'cas:serviceResponse'}[0]{'cas:authenticationSuccess'}[0]{'cas:user'}[0]; ## If in Proxy mode, also retreave a PGT if ($self->{'proxy'}) { my $pgtIou; if (defined $xml->{'cas:serviceResponse'}[0]{'cas:authenticationSuccess'}[0]{'cas:proxyGrantingTicket'}) { $pgtIou = $xml->{'cas:serviceResponse'}[0]{'cas:authenticationSuccess'}[0]{'cas:proxyGrantingTicket'}[0]; } unless (defined $self->{'pgtFile'}) { $errors = sprintf "pgtFile not defined\n"; return undef; } ## Check stored PGT unless (open STORE, $self->{'pgtFile'}) { $errors = sprintf "Unable to read %s\n", $self->{'pgtFile'}; return undef; } my $pgtId; while () { if (/^$pgtIou\s+(.+)$/) { $pgtId = $1; last; } } $self->{'pgtId'} = $pgtId; } return ($user); } ## Validate a Proxy Ticket sub validatePT { my $self = shift; my $service = shift; my $ticket = shift; my $xml = $self->callCAS($self->getServerProxyValidateURL($service, $ticket)); if (defined $xml->{'cas:serviceResponse'}[0]{'cas:authenticationFailure'}) { $errors = sprintf "Failed to validate Proxy Ticket %s : %s\n", $ticket, $xml->{'cas:serviceResponse'}[0]{'cas:authenticationFailure'}[0]; return undef; } my $user = $xml->{'cas:serviceResponse'}[0]{'cas:authenticationSuccess'}[0]{'cas:user'}[0]; my @proxies; if (defined $xml->{'cas:serviceResponse'}[0]{'cas:authenticationSuccess'}[0]{'cas:proxies'}) { @proxies = @{$xml->{'cas:serviceResponse'}[0]{'cas:authenticationSuccess'}[0]{'cas:proxies'}[0]{'cas:proxy'}}; } return ($user, @proxies); } ## Access a CAS URL and parses received XML sub callCAS { my $self = shift; my $url = shift; my ($host, $port, $path) = &_parse_url($url); my @xml = &get_https2($host, $port, $path,{'cafile' => $self->{'CAFile'}, 'capath' => $self->{'CAPath'}}); unless (@xml) { warn $errors; return undef; } ## Skip HTTP header fields my $line = shift @xml; while ($line !~ /^\s*$/){ $line = shift @xml; } return &_parse_xml(join('', @xml)); } sub storePGT { my $self = shift; my $pgtIou = shift; my $pgtId = shift; unless (open STORE, ">>$self->{'pgtFile'}") { $errors = sprintf "Unable to write to %s\n", $self->{'pgtFile'}; return undef; } printf STORE "%s\t%s\n", $pgtIou, $pgtId; close STORE; return 1; } sub retrievePT { my $self = shift; my $service = shift; my $xml = $self->callCAS($self->getServerProxyURL($service, $self->{'pgtId'})); if (defined $xml->{'cas:serviceResponse'}[0]{'cas:proxyFailure'}) { $errors = sprintf "Failed to get PT : %s\n", $xml->{'cas:serviceResponse'}[0]{'cas:proxyFailure'}[0]; return undef; } if (defined $xml->{'cas:serviceResponse'}[0]{'cas:proxySuccess'}[0]{'cas:proxyTicket'}) { return $xml->{'cas:serviceResponse'}[0]{'cas:proxySuccess'}[0]{'cas:proxyTicket'}[0]; } return undef; } # request a document using https, return status and content sub get_https2{ my $host = shift; my $port = shift; my $path = shift; my $ssl_data= shift; my $trusted_ca_file = $ssl_data->{'cafile'}; my $trusted_ca_path = $ssl_data->{'capath'}; if (($trusted_ca_file && !(-r $trusted_ca_file)) || ($trusted_ca_path && !(-d $trusted_ca_path))) { $errors = sprintf "error : incorrect access to cafile $trusted_ca_file or capath $trusted_ca_path\n"; return undef; } unless (eval "require IO::Socket::SSL") { $errors = sprintf "Unable to use SSL library, IO::Socket::SSL required, install IO-Socket-SSL (CPAN) first\n"; return undef; } require IO::Socket::SSL; unless (eval "require LWP::UserAgent") { $errors = sprintf "Unable to use LWP library, LWP::UserAgent required, install LWP (CPAN) first\n"; return undef; } require LWP::UserAgent; my $ssl_socket; my %ssl_options = (SSL_use_cert => 0, PeerAddr => $host, PeerPort => $port, Proto => 'tcp', Timeout => '5' ); $ssl_options{'SSL_ca_file'} = $trusted_ca_file if ($trusted_ca_file); $ssl_options{'SSL_ca_path'} = $trusted_ca_path if ($trusted_ca_path); ## If SSL_ca_file or SSL_ca_path => verify peer certificate $ssl_options{'SSL_verify_mode'} = 0x01 if ($trusted_ca_file || $trusted_ca_path); $ssl_socket = new IO::Socket::SSL(%ssl_options); unless ($ssl_socket) { $errors = sprintf "error %s unable to connect https://%s:%s/\n",&IO::Socket::SSL::errstr,$host,$port; return undef; } my $request = "GET $path HTTP/1.0\r\nHost: $host\r\n\r\n"; print $ssl_socket "$request"; my @result; while (my $line = $ssl_socket->getline) { push @result, $line; } $ssl_socket->close(SSL_no_shutdown => 1); return (@result); } 1;