#!/usr/bin/perl -w use warnings; use strict; use CGI; my $cgi = CGI->new(); my @services = ( # priority type uri [ 10, 'http://lid.netmesh.org/minimum-lid/2.0b8', 'http://mylid.net/example' ], [ 20, 'http://lid.netmesh.org/sso/2.0b8', 'http://mylid.net/example' ], [ 30, 'http://lid.netmesh.org/sso/1.0', 'http://mylid.net/example' ], ); sub PrintXMLResponse($$$$) { my ($fh, $services, $xrdsns, $xrdns) = @_; my $xrdsnspre = ''; my $xrdsnspost = ''; my $xrdnspre = ''; my $xrdnspost = ''; if (defined($xrdsns) && $xrdsns ne '') { $xrdsnspre = "$xrdsns:"; $xrdsnspost = ":$xrdsns"; } if (defined($xrdns) && $xrdns ne '') { $xrdnspre = "$xrdns:"; $xrdnspost = ":$xrdns"; } print $fh ''; print $fh "\n<${xrdsnspre}XRDS xmlns$xrdsnspost=\"xri://\$xrds\" xmlns$xrdnspost=\"xri://\$xrd*(\$v*2.0)\">\n"; print $fh "\n <${xrdnspre}XRD>\n"; foreach (@$services) { print " <${xrdnspre}Service priority=\"$_->[0]\">\n"; print " <${xrdnspre}Type>$_->[1]\n"; print " <${xrdnspre}URI>$_->[2]\n"; print " \n"; } print $fh " \n"; print $fh "\n"; } # * SCRIPT_NAME: /~danlyke/yadisserve.cgi # * SERVER_NAME: localhost my $thisURL = 'http://example/script.cgi'; $thisURL = "http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}" if (defined($ENV{'SERVER_NAME'}) && defined($ENV{'SCRIPT_NAME'})); my $yadisURL = "$thisURL?forcexml=1"; $yadisURL .= '&xrdsns='.$cgi->param('xrdsns') if (defined($cgi->param('xrdsns'))); $yadisURL .= '&xrdsns='.$cgi->param('xrdns') if (defined($cgi->param('xrdns'))); my $htmlResponse = < Yadis Test Server

Yadis Test Server

 [Yadis logo]

This is a test server application for the Yadis digital identity discovery system. By passing this script various different options, you can exercise all of the various code paths that your application uses to discover Yadis resources.

You can alter the various responses that this application will give you by appending parameters to the URL of this script, $thisURL.

omitheader
Force a response which does not include the X-XRDS-Location response header, and requires you to either parse the resulting HTML (in the case of an HTTP "GET" command), or re-issue a different request (in the case of an HTTP "HEAD" command).
forcexml
Respond with an example Yadis XRDS document, of type application/xrds+xml.
xrdsns
Use the supplied value for the namespace of the 'xri://\$xrds' namespace portions of the Yadis XRDS document. Defaults to 'xrds'.
xrdns
Use the supplied value for the namespace of the 'xri://\$xrd*(\$v*2.0)' portions of the Yadis XRDS document. Defaults to '', or no prefix.

So, for example, the Yadis spec version 1.0, section 6.2.5 lays out the possible responses.

  1. An HTML document with a <head> element that includes an <meta> element..., just use the HTTP "GET" method to $thisURL?omitheader=1
  2. HTTP response-headers that include an X-XRDS-Location with a document, use an HTTP "GET" method and append nothing.
  3. HTTP response headers only, use an HTTP "HEAD" method with combinations of
    1. X-XRDS-Location header: $thisURL
    2. X-XRDS-Location header and an application/xrds+xml document type: $thisURL?forcexml=1
    3. No X-XRDS-Location header and an application/xrds+xml document type: $thisURL?forcexml=1&omitheader=1
  4. A document of MIME media type, application/xrds+xml, use an HTTP "GET" method on $thisURL?forcexml=1

In all cases right now, the Yadis XRDS document returned is from version 1 of the specification, section 7.2 "A simple Yadis document"

EOF # $cgi->request_method() - GET HEAD # Force response: # 1. An HTML document with appropriate fields # 2. HTTP response-headers with X-XRDS-Location # 3. HTTP response headers only # a. X-XRDS-Location response-header # b. content-type => application/xrds+xml, # 4. content-type => application/rds+xml my $requestMethod = $cgi->request_method; $requestMethod = 'GET' unless defined($requestMethod); my %headerArgs; $headerArgs{-X_XRDS_Location} = $yadisURL unless $cgi->param('omitheader'); if ($requestMethod eq 'HEAD') { if ($cgi->param('forcexml')) { $headerArgs{-type} = 'application/xrds+xml'; print $cgi->header( \%headerArgs ); } else { $headerArgs{-type} = 'text/html'; print $cgi->header( \%headerArgs ); } } elsif ($requestMethod eq 'GET') { if ($cgi->param('forcexml')) { $headerArgs{-type} = 'application/xrds+xml'; print $cgi->header( \%headerArgs ); my $xrdsns = 'xrds'; my $xrdns = ''; $xrdsns = $cgi->param('xrdsns') if defined($cgi->param('xrdsns')); $xrdns = $cgi->param('xrdns') if defined($cgi->param('xrdns')); PrintXMLResponse( \*STDOUT, \@services, $xrdsns, $xrdns ); } else { $headerArgs{-type} = 'text/html'; print $cgi->header( \%headerArgs ); print $htmlResponse; } } else { print $cgi->header('text/plain'); print "Illegal request method $requestMethod\n"; }