shib_test.pl CGI::http instead of %ENV

[Ondřej Košarko]

This concerns the CLARIN SPF Interoperability Test Page (ie. shib_test.pl that SPs make available on their service).

After we stopped using shibboleth as an apache module the script basically stopped working. After some inspection we found out it is caused by how the server variables are accessed.

From the CGI point of view, 'mail', 'HTTP_MAIL' and probably case variations of that are still one variable. But it is not so when you try to access them through %ENV. Ie. $ENV{'mail'} and $ENV{'HTTP_MAIL'} may yield different outcomes, but CGI::http('mail') and CGI::http('HTTP_MAIL') should not.

Below is a sketch of a patch, so if someone could review it and/or further modify the file to take what is mentioned above into account... The line numbers will probably be of as we have some other modifications in the file

--- a/secure/shib_test.pl
+++ b/secure/shib_test.pl
@@ -57,7 +57,7 @@ sub render_table_rows {
         $caption, '</th>', '</tr>';
     if (scalar(@{$keys}) > 0) {
        foreach my $key (@{$keys}) {
-           my $value = $ENV{$key};
+           my $value = CGI::http($key);
            $value =~ s!\n*!!gs;
            $value =~ s!\s*(;|\$)\s*!\n!gs;
            $value = xml_escape($value);
@@ -77,7 +77,7 @@ sub dump_shibboleth_attributes {
     my $debug_env = shift;
     
     my @keys = sort(keys(%ENV));
-    my @attrs = grep(!m/^(HTTPS|SERVER_|SCRIPT_|PATH|QUERY_STRING|GATEWAY|DOCUMENT_ROOT|REMOTE|REQUEST|HTTP_|AUTH_TYPE|Shib_)/i, @keys);
+    my @attrs = grep(!m/^(HTTPS|SERVER_|SCRIPT_|PATH|QUERY_STRING|GATEWAY|DOCUMENT_ROOT|REMOTE|REQUEST|HTTP_|AUTH_TYPE|Shib_)/i, @keys) || grep(m/^(HTTP_)/i, CGI::http());
     my @shib = grep(m/Shib_/i, @keys);
 
     render_table_rows('Shibboleth Attributes:', \@attrs);
@@ -107,7 +107,7 @@ sub dump_shibboleth_assertions {
     my $browser = LWP::UserAgent->new;
     ASSERTION:
     for (my $i = 1; $i <= $count; $i++) {
-        my $url = $ENV{sprintf('Shib_Assertion_%02d', $i)};
+        my $url = CGI::http(sprintf('Shib_Assertion_%02d', $i));
         next ASSERTION unless defined ($url);
 
        print '<tr class="', ($j++ % 2 == 0 ? 'even' : 'odd'), '">';
@@ -192,13 +192,11 @@ sub scan_attributes {
        my @attrs = split(':', $aliases);
 
         KEY:
-       foreach my $b (keys(%ENV)) {
-           foreach my $a (@attrs) {
-               if (lc($a) eq lc($b)) {
-                   $found = $b;
+       foreach my $a (@attrs) {
+               if (defined CGI::http($a)) {
+                   $found = $a;
                    last KEY;
                }
-           }
        }
 
        if (defined($found)) {
@@ -226,9 +224,9 @@ sub main {
     my $q = shift;
     print slurp($HEADER_FILE);  
     print '<h1>CLARIN SPF Interoperability Test Page</h1>';
-    if (defined($ENV{'Shib_Session_ID'})) {
+    if (defined(CGI::http('Shib_Session_ID'))) {
        # logout link
-       my $idp = $ENV{'Shib_Identity_Provider'};
+       my $idp = CGI::http('Shib_Identity_Provider');
        if (!defined($idp)) {
            $idp = '<span class="error">[UNKNOWN]</span>';
        }
@@ -256,7 +254,7 @@ sub main {
        }
 
        # remote user
-       my $user = $ENV{'REMOTE_USER'};
+       my $user = CGI::http('REMOTE_USER');
        $warnings++ unless defined($user);
        print '<p class="attr ', (defined($user) ? 'ok' : 'warn'), '">';
        print 'REMOTE_USER: ',
@@ -280,7 +278,7 @@ sub main {
        print '<table class="attr">';
        my $debug_env = (defined($q) && $q->param('debug_env'));
        dump_shibboleth_attributes($debug_env);
-       dump_shibboleth_assertions($ENV{'Shib_Assertion_Count'});
+       dump_shibboleth_assertions(CGI::http('Shib_Assertion_Count'));
        print '</table>';
     }
     else {

[Dieter Van Uytvanck]

Andre, can you have a look at this? Willem can give some hints on how we use this perl cgi-bin script.