#!/usr/bin/perl
# op-discover-test.pl - run OpenID discovery to find provider endpoint URLs
# Copyright 2010 by Ian Kluft
#    Written for use by the TWiki Community for the OpenIdRpContrib
#    Released under the GNU General Public License version 3 or later
#    See license text at http://ian.kluft.com/opensource/GPLv3.txt
#    This attribution info must be retained in any copies

use strict;
use Carp;
use Data::Dumper;
use Cache::FileCache;
use Net::OpenID::Consumer;
use Net::OpenID::Yadis;

# command line processing
my $claimed_id = $ARGV[0];
if ( !defined $claimed_id ) {
	die "usage: $0 openid-url-to-test\n";
}

# initialize
my $required_root = "http://wiki.disneyresearch.com/";
my $nonce_pattern = "GJvxv_%s";
my $consumer_secret = sub { sprintf($nonce_pattern, shift^0xCAFEFEED )};
my $cache = Cache::FileCache->new({ namespace => 'OpenIdRpContrib' });
my $args = {};

# create Net::OpenID::Consumer object for OpenID protocol
my $csr = Net::OpenID::Consumer->new (
	cache => $cache,
	consumer_secret => $consumer_secret,
	required_root => $required_root,
	#args  => $args,
	debug => 1,
);

# create Net::OpenID::Yadis object for OpenID endpoint discovery
my $disc = Net::OpenID::Yadis->new(
	consumer => $csr,
	debug => 1,
);

# status update
print "claimed ID: $claimed_id\n";
print "\n";

# find semantic info from the URL's HTML content if available
my $final_url;
my $semantic = $csr->_find_semantic_info( $claimed_id, \$final_url ) ;
print "Semantic info...\n";
if ( defined $final_url ) {
	print "final URL: $final_url\n";
}
foreach my $key ( keys %$semantic ) {
	my $value = $semantic->{$key};
	if ( defined $value ) {
		print "$key: $value\n";
	}
}

# perform Yadis discovery on the provided URL
my $xrd = $disc->discover($claimed_id);
print "Yadis discovery...\n";
if ( $xrd ) {
	print "identity: ".$disc->identity_url."\n";
	print "XRD URL: ".$disc->xrd_url."\n";
	foreach my $srv ( @$xrd ) {
		print "\n";
		if ( ref $srv->URI eq "HASH" ) {
			print "URI: ".(%{$srv->URI})."\n";
		} elsif ( ref $srv->URI eq "ARRAY" ) {
			print "URI: ".(@{$srv->URI})."\n";
		} elsif ( !ref $srv->URI ) {
			print "URI: ".$srv->URI."\n";
		}
		print "type: ".join( " ", $srv->Type)."\n";
		print "priority: ".$srv->priority."\n";
		print "delegate: ".$srv->extra_field("Delegate","http://openid.net/xmlns/1.0")."\n";
	}
	#print "xrd: ".Dumper( $xrd )."\n";
} else {
	print "   error: ".$disc->err."\n";
}
#print "disc ".Dumper( $disc )."\n";

# get claimed OpenID identity
print "\n";
print "check claimed identity...\n";
my $cident = $csr->claimed_identity( $claimed_id );
if ( $cident ) {
	print "identity server: ".$cident->identity_server."\n";
	print "delegated URL: ".$cident->delegated_url."\n";
	print "protocol version: ".$cident->protocol_version."\n";
	#print "cident: ".Dumper( $cident )."\n";
} else {
	print "   error: ".$csr->err."\n";
}

# check and print possible OpenID endpoints
print "\n";
my $disc_url;
if ( $cident ) {
	$disc_url = $claimed_id;
} elsif ( $disc ) {
	$disc_url = $disc->xrd_url;
}
if ( defined $disc_url ) {
	print "Endpoints ($disc_url)...\n";
	my $possible_endpoints = $csr->_discover_acceptable_endpoints($disc_url, force_version => 2);
	print "possible endpoints: ".Dumper( $possible_endpoints )."\n";
} else {
	print "possible endpoints: none\n";
}