use lib 'inc'; use Test::More; # skip_all => 'CAS is in rebuild'; use strict; use IO::String; use LWP::UserAgent; use LWP::Protocol::PSGI; use MIME::Base64; BEGIN { require 't/test-lib.pm'; } my $userdb = tempdb(); my $maintests = 12; my $debug = 'error'; my ( $issuer, $sp, $res ); eval { require XML::Simple }; plan skip_all => "Missing dependencies: $@" if ($@); # Redefine LWP methods for tests LWP::Protocol::PSGI->register( sub { my $req = Plack::Request->new(@_); ok( $req->uri =~ m#http://auth.((?:id|s)p).com([^\?]*)(?:\?(.*))?$#, 'SOAP request' ); my $host = $1; my $url = $2; my $query = $3; my $res; my $client = ( $host eq 'idp' ? $issuer : $sp ); if ( $req->method eq 'POST' ) { my $s = $req->content; ok( $res = $client->_post( $url, IO::String->new($s), length => length($s), query => $query, type => 'application/xml', ), "Execute POST request to $url" ); } else { ok( $res = $client->_get( $url, type => 'application/xml', query => $query, ), "Execute request to $url" ); } expectOK($res); ok( getHeader( $res, 'Content-Type' ) =~ m#xml#, 'Content is XML' ) or explain( $res->[1], 'Content-Type => application/xml' ); count(3); return $res; } ); SKIP: { eval { require DBI; require DBD::SQLite; }; if ($@) { skip 'DBD::SQLite not found', $maintests; } # Build SQL DB my $dbh = DBI->connect("dbi:SQLite:dbname=$userdb"); $dbh->do( 'CREATE TABLE users (user text,password text,name text,uid text,cn text,mail text)' ); $dbh->do( "INSERT INTO users VALUES ('dwho','dwho','Doctor who','dwho','Doctor who','dwho\@badwolf.org')" ); # Build CAS server $issuer = register('issuer', \&issuer); # Build CAS App $sp = register('sp', \&sp); # Simple SP access # Connect to CAS app ok( $res = $sp->_get( '/', accept => 'text/html', ), 'Unauth SP request' ); ok( $res->[2]->[0] =~ s#^.*(
).*$#$1#s, 'Found CAS entry' ); my ( $host, $url, $query ) = expectForm($res); ok( $res = $sp->_get( '/', accept => 'text/html', query => $query, ), 'Unauth SP request' ); # CAS idp must be sorted my @idp = map /idploop py-3" val="(.+?)">/g, $res->[2]->[0]; ok( $idp[0] eq 'idp', '1st = idp' ) or print STDERR Dumper( \@idp ); ok( $idp[1] eq 'idp3', '2nd = idp3' ) or print STDERR Dumper( \@idp ); ok( $idp[2] eq 'idp4', '3rd = idp4' ) or print STDERR Dumper( \@idp ); ok( $idp[3] eq 'idp2', '4th= idp2' ) or print STDERR Dumper( \@idp ); # Found Cancel button ok( $res->[2]->[0] =~ qr%%, 'Found Cancel button' ) or print STDERR Dumper( $res->[2]->[0] ); # Found CAS idp logo and display name ok( $res->[2]->[0] =~ qr%