shib_test.pl

#!/usr/bin/env perl
#
# Version: $Id$
#
use strict;
use warnings;
use CGI;
use CGI::Carp qw( fatalsToBrowser);
use URI;

#
# constants
#
my @ATTRIBUTES_REQUIRED = qw(
    eduPersonPrincipalName:eppn
    eduPersonTargetedID:persistent_id
);
my @ATTRIBUTES_OPTIONAL = qw(
    eduPersonScopedAffiliation:affiliation:eduPersonAffiliation
    cn
    displayName
);


# allow override from environment ...
if (exists $ENV{'SHIBTEST_ATTRIBUTES_REQUIRED'}) {
    @ATTRIBUTES_REQUIRED = split('\s+', $ENV{'SHIBTEST_ATTRIBUTES_REQUIRED'});
}
if (exists $ENV{'SHIBTEST_ATTRIBUTES_OPTIONAL'}) {
    @ATTRIBUTES_OPTIONAL = split('\s+', $ENV{'SHIBTEST_ATTRIBUTES_OPTIONAL'});
}


#
# code below ... nothing to change there ...
#
sub xml_escape {
    my $s = shift;

    $s =~ s!&!&!gs;
    $s =~ s!<!&lt;!gs;
    $s =~ s!>!&gt;!gs;
    return $s;
}


sub render_table_rows {
    my $caption = shift;
    my $keys    = shift;
    my $i = 0;
    print '<tr class="header">', '<th colspan="2">',
        $caption, '</th>', '</tr>';
    if (scalar(@{$keys}) > 0) {
	foreach my $key (@{$keys}) {
	    my $value = $ENV{$key};
	    $value =~ s!\n*!!gs;
	    $value =~ s!\s*(;|\$)\s*!\n!gs;
	    $value = xml_escape($value);
	    $value =~ s!\n!<br />!gs;
	    print '<tr class="', ($i++ % 2 == 0 ? 'even' : 'odd'), '">';
	    print '<td>', $key, '</td>', '<td>', $value, '</td>', '</tr>';
	}
    }
    else {
	print '<tr class="even"><td colspan="2">',
            '<span class="error center">[NONE]</span></tr>';
    }
}