Net-OpenID-Common-1.17000755001750000167 012132077574 13442 5ustar00rfcfuse000000000000INSTALL000644001750000167 44612132077574 14537 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17If you downloaded this package off of CPAN, it should build and install in the standard way: perl Makefile.PL make make test make install If you are building this package directly from a git repository, you will need to install Dist::Zilla first. See http://dzil.org/ Changes000644001750000167 406712132077574 15024 0ustar00rfcfuse000000000000Net-OpenID-Common-1.171.17 Apr 12 2013 1.16 Apr 01 2013 * better fix for #78218 from vlyon 1.15 Apr 01 2013 * URIFetch->fetch now returns decoded_content (closes #78218) 1.14 Nov 09 2011 1.13 Nov 06 2011 * Use/cache Last-modified: as a number, not a raw header string (closes #47349) * Pay attention to charset on application/xrds+xml content-type (closes #41310) 1.12 Oct 25 2011 * API change: IndirectMessage->new(CODEREF) CODEREF now needs to be able to also take 0 arguments and then return a list of all URI parameter names in the request (core protocol as of OpenID 2.0 needs this functionality) Added IndirectMessage->all_parameters * Use HTML::Parser for parsing HTML Added OpenID::util::html_extract_linkmetas * Fix YADIS discovery so that (1) HTML parsing is not done on YADIS documents and (2) meta/http-equiv tags are checked when there's no YADIS document or x-xrds-location header 1.11 Oct 22 2011 * Allow Plack::Request parameter objects for IndirectMessage 1.030099_004 Oct 20 2011 * Improved HTML head extraction to skip CDATA and comments * Fixed warning behavior of timing_indep_eq * new comaintainer (Roger Crew) 1.030099_003 Jan 01 2011 * Replace URL escaper with calls to URI::Escape (Robert Norris) * Removed JSON encoder in favour of using JSON::encode_json directly in N::O::Server and N::O::Consumer (Robert Norris) 1.030099_002 Dec 07 2010 * Documentation tweaks (Robert Norris) * Remove use of $& (Jess Robinson RT#63684) 1.030099_001 Nov 06 2010 * Support for Apache2::Request (mod_perl 2) (Yitzchak Scott-Thoennes) * Fix potential timing attack when checking signatures (Adam Sjøgren) (see http://lists.openid.net/pipermail/openid-security/2010-July/001156.html) * In Net::OpenID::Yadis, use the single-constant form of "use constant" so we work under Perl 5.6 where the multi constant form was not available. * Initial version with stuff moved out of Net::OpenID::Consumer. t000755001750000167 012132077574 13626 5ustar00rfcfuse000000000000Net-OpenID-Common-1.1703-use-common.t000644001750000167 13512132077574 16433 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use strict; use Test::More tests => 1; use Net::OpenID::Common; ok(1); 1; 01-use-urifetch.t000644001750000167 13712132077574 16754 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use strict; use Test::More tests => 1; use Net::OpenID::URIFetch; ok(1); 1; 04-messages.t000644001750000167 777712132077574 16224 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use strict; use Test::More tests => 40; use Net::OpenID::IndirectMessage; my $openid2_ns = 'http://specs.openid.net/auth/2.0'; my $sreg_ns = 'http://openid.net/extensions/sreg/1.1'; my %basic_v2_args = ( 'openid.mode' => 'id_res', 'openid.ns' => $openid2_ns, 'openid.test' => 'success', ); my %basic_v1_args = ( 'openid.mode' => 'id_res', 'openid.test' => 'success', ); my %sreg_args = ( 'openid.sreg.nickname' => 'Frank', 'openid.sreg.fullname' => 'Frank the Goat', ); my $good_v2_args = args({ %basic_v2_args, }); my $good_v1_args = args({ %basic_v1_args, }); my $sreg_v1_args = args({ %basic_v1_args, %sreg_args, }); my $sreg_v2_args = args({ %basic_v2_args, %sreg_args, 'openid.ns.sreg' => $sreg_ns, }); my $sreg_v1_in_openid_v2 = args ({ %basic_v2_args, %sreg_args, }); my $nonsense_args = args({ 'kumquats' => 'yes', 'madprops' => 'no', 'language' => 'spranglish', }); my $missing_mode_v2 = args({ 'openid.ns' => 'http://specs.openid.net/auth/2.0', }); my $unsupported_version_args = args({ %basic_v2_args, 'openid.ns' => 'http://example.com/openid/some-future-version', }); my $empty_args = args({}); my $basic_test = sub { my $args = shift; my $version = shift; is($args->protocol_version, $version, "detected version $version"); is($args->mode, 'id_res', "v$version mode correct"); is($args->get('test'), 'success', "v$version test correct"); is($args->get('missing'), undef, "v$version missing correctly"); should_die(sub { $args->get('sreg.fullname'); }, "v$version access invalid keyname croaks"); should_die(sub { $args->get(); }, "v$version missing keyname croaks"); }; # A valid OpenID 2.0 message $basic_test->($good_v2_args, 2); # A valid OpenID 1.1 message $basic_test->($good_v1_args, 1); # OpenID 1.1 message to consumer when we only support 2.0 or above is(args(\%basic_v1_args, minimum_version => 2), undef, "2.0-only doesn't understand 1.1"); my $sreg_test = sub { my $args = shift; my $version = shift; ok($args->has_ext($sreg_ns), "v$version has sreg namespace"); ok($args->get_ext($sreg_ns, 'nickname'), "v$version has sreg nickname"); is($args->get_ext($sreg_ns, 'nonsense'), undef, "v$version has no sreg nonsense"); my $sreg = $args->get_ext($sreg_ns); is(keys(%$sreg), 2, "v$version two sreg args"); ok(defined $sreg->{nickname}, "v$version has sreg nickname in hash"); ok(defined $sreg->{fullname}, "v$version has sreg fullname in hash"); should_die(sub { $args->get_ext(); }, "v$version missing namespace croaks"); }; # SREG in a valid 2.0 message $sreg_test->($sreg_v2_args, 2); # SREG in a valid 1.1 message $sreg_test->($sreg_v1_args, 1); my $missing_extension_test = sub { my $args = shift; my $version = shift; is($args->has_ext('nonsense'), 0, "v$version no nonsense extension"); is($args->get_ext('nonsense', 'nonsense'), undef, "v$version no nonsense extension argument"); is(keys(%{$args->get_ext('nonsense')}), 0, "v$version nonsense extension empty hash"); }; # A namespace that doesn't exist in a 2.0 message $missing_extension_test->($good_v2_args, 2); # A namespace that doesn't exist in a 1.1 message $missing_extension_test->($good_v1_args, 1); # V1 SREG in V2 Message is($sreg_v1_in_openid_v2->has_ext($sreg_ns), 0, "no v1 sreg in v2 message"); # Some args that aren't an OpenID message at all is($nonsense_args, undef, "nonsense args give undef"); is($missing_mode_v2, undef, "v2 with missing mode gives undef"); is($unsupported_version_args, undef, "unsupported version gives undef"); is($empty_args, undef, "empty hash gives undef"); # Passing in garbage into the constructor should_die(sub { args("HELLO WORLD!"); }, "passing string into constructor croaks"); should_die(sub { args(); }, "passing nothing into constructor croaks"); sub args { return Net::OpenID::IndirectMessage->new(@_); } sub should_die { my ($coderef, $message) = @_; eval { $coderef->(); }; $@ ? pass($message) : fail($message); } 1; 00-use-indirectmessage.t000644001750000167 14612132077574 20310 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use strict; use Test::More tests => 1; use Net::OpenID::IndirectMessage; ok(1); 1; 07-htmlparse.t000644001750000167 1557512132077574 16432 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use warnings; use strict; use Test::More; use Net::OpenID::Common; sub html_is { is_deeply(OpenID::util::html_extract_linkmetas(shift),@_) } html_is('plain text hello world',{},'plain') ; html_is('',{},'body'); html_is('',{link =>[{rel=>'boo',href=>'real'}]},'nohead'); my $p1 = 'https://api.screenname.aol.com/auth/openidServer'; my $doc1 = <AOL OpenIdIf not redirected automatically, please click here to continue END my $r1 = { link => [ {rel=>"openid.server", href=>"$p1",'/'=>'/'}, {rel=>"openid2.provider", href=>"$p1",'/'=>'/'}, ], meta => [ {'http-equiv'=>"Content-Type", content=>"text/html; charset=UTF-8"}, {'http-equiv'=>"refresh", content=>"0;url=https://api.screenname.aol.com/auth/openid/name/test"}, ] }; my $r0; html_is($doc1,$r1,'basic') ; done_testing(); __END__ my $uri2 = 'http://openid.example.com/everything_in_comments'; addf_uri($uri2,content => < Bite me END is_deeply($csr->_find_semantic_info($uri2), {'openid.server'=>'http://www.livejournal.com/misc/openid.bml', 'openid.delegate'=>'http://openid1.net/delegate', 'openid2.provider'=>'http://www.livejournal.com/misc/openid.bml', 'openid2.local_id'=>'http://openid2.net/delegate', 'foaf.maker'=> "foaf:mbox_sha1sum '4caa1d6f6203d21705a00a7aca86203e82a9cf7a'", 'foaf'=>"http://brad.livejournal.com/data/foaf", 'rss'=>"http://www.livejournal.com/~brad/data/rss", 'atom'=>"http://www.livejournal.com/~brad/data/atom", },'everything from consumer.pm comments' ); my $uri3 = 'http://openid.example.com/cdata_crap'; addf_uri($uri3,content => < bitez moi END is_deeply($csr->_find_semantic_info($uri3), {'openid.server'=>'http://www.livejournal.com/misc/openid.bml', 'openid.delegate'=>'http://openid1.net/delegate', 'rss'=>"http://www.livejournal.com/~brad/data/rss", 'atom'=>"http://www.livejournal.com/~brad/data/atom", },'CDATA/comment silliness' ); my $uri4 = 'http://openid.aol.com/oldstyle'; addf_uri($uri4,content => < END is_deeply($csr->_find_semantic_info($uri4), {'openid.delegate'=>'http://openid1.net/delegate'},'HTML 4.0- test'); my $uri4a = 'http://openid.aol.com/oldstyle2'; addf_uri($uri4a,content => < END is_deeply($csr->_find_semantic_info($uri4a), {'openid.delegate'=>'http://openid1.net/delegate?x=1&y=2&z=3'},'HTML 4.0- test'); my $uri5 = 'http://google.com/somewhere'; addf_uri($uri5,content => < OpenID for Google Accounts bye END my $answer5 = {'openid2.provider'=>'http://openid-provider.appspot.com/joey%40kitenet.net', 'openid.server'=>'http://openid-provider.appspot.com/joey%40kitenet.net' }; is_deeply($csr->_find_semantic_info($uri5), $answer5,'link with two refs in it'); is_deeply($csr->_find_semantic_info($uri5), $answer5,'link with two refs in it(again)'); addf_uri($uri5,content => 'randomness'); is_deeply($csr->_find_semantic_info($uri5), $answer5,'link with two refs in it(yet again)'); my $uri4b = 'http://openid.aol.com/oldstyle4b'; addf_uri($uri4b,content => < END is_deeply($csr->_find_semantic_info($uri4b), {'openid.delegate'=>'http://openid1.net/delegate?x=1&y=2&z=3'},'numerical entities'); my $uri6 = 'http://google.com/somewhere6'; addf_uri($uri6,content => < Nice test

Send me your comment:

END is_deeply($csr->_find_semantic_info($uri6), { 'openid2.provider' => 'http://openid.example.com/~user', },'headless injection example'); 1; 06-int2bytes.t000644001750000167 51512132077574 16301 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use strict; use Test::More tests => 2048; use Net::OpenID::Common; use Math::BigInt; for my $num (1..2048) { my $bi = Math::BigInt->new("2")->bpow($num); my $bstr = $bi->bstr; my $bytes = OpenID::util::int2bytes($bstr); my $bstr2 = OpenID::util::bytes2int($bytes); is($bstr,$bstr2); } 02-use-yadis.t000644001750000167 13412132077574 16252 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use strict; use Test::More tests => 1; use Net::OpenID::Yadis; ok(1); 1; 05-eq.t000644001750000167 246112132077574 15004 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!/usr/bin/perl use warnings; use strict; use utf8; use Test::More tests=>14; use Net::OpenID::Common; compare_comparisons('x', 'x', 'same, 1 char'); compare_comparisons('x', 'y', 'different, 1 char'); compare_comparisons('xx', 'xx', 'same, 2 chars'); compare_comparisons('xx', 'xy', 'different, 2 chars'); compare_comparisons('Frække frølår', 'Frække frølår', 'same, utf-8'); compare_comparisons('Frøkke frålær', 'Frække frølår', 'different, utf-8'); my $x='x' x 1000000; my $y='y' . 'x' x 999999; compare_comparisons($x, $x, 'same, 1M chars'); compare_comparisons($x, $y, 'different, 1M chars'); my $z='x' x 999999; compare_comparisons( $x, $z, 'different lengths, long'); compare_comparisons('a', 'aa', 'different lengths, short'); compare_comparisons( '', 'a', 'different lengths, shortest'); compare_comparisons( '', '', 'same length, shortest'); compare_comparisons(undef, '', 'undef, empty string'); compare_comparisons(undef, undef, 'both undef'); 1; sub compare_comparisons { my ($first, $second, $description)=@_; # XXX may still want to test that the circumstances under # which eq and timing_indep_eq produce warnings are the same no warnings 'uninitialized'; is( ($first eq $second), OpenID::util::timing_indep_eq($first, $second), $description); } OpenID000755001750000167 012132077574 15775 5ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/NetIndirectMessage.pm000644001750000167 2342012132077574 21561 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenID package Net::OpenID::IndirectMessage; BEGIN { $Net::OpenID::IndirectMessage::VERSION = '1.17'; } use strict; use Carp; use Net::OpenID::Common; sub new { my $class = shift; my $what = shift; my %opts = @_; my $self = bless {}, $class; $self->{minimum_version} = delete $opts{minimum_version}; Carp::croak("Unknown options: " . join(", ", keys %opts)) if %opts; my $getter; my $enumer; if (ref $what eq "HASH") { # In this case it's the caller's responsibility to determine # whether the method is GET or POST. $getter = sub { $what->{$_[0]}; }; $enumer = sub { keys(%$what); }; } elsif (ref $what eq "Apache") { my %get; if ($what->method eq 'POST') { %get = $what->content; } else { %get = $what->args; } $getter = sub { $get{$_[0]}; }; $enumer = sub { keys(%get); }; } elsif (ref $what eq "Plack::Request") { my $p = $what->method eq 'POST' ? $what->body_parameters : $what->query_parameters; $getter = sub { $p->get($_[0]); }; $enumer = sub { keys %{$p}; }; } elsif (ref $what ne "CODE") { # assume an object that follows the CGI interface and has a param() method # CGI does the right thing and omits query parameters if this is a POST # others (Apache::Request, Apache2::Request) mix query and body params. $getter = sub { scalar $what->param($_[0]); }; $enumer = sub { $what->param; }; } else { # CODE reference my @keys = (); my $enumerated; $getter = $what; $enumer = sub { unless ($enumerated) { $enumerated = 1; # In Consumer/Common 1.03 and predecessors, coderefs # did not have to be able to enumerate all keys. # Therefore, we must cope with legacy coderefs being # passed in which don't expect to be called with no # arguments, and then, most likely, fail in one of # three ways: # (1) return empty list # (2) retrieve undef/'' value for undef/'' key. # (3) raise an error # We normalize these all to empty list, which our # caller can then recognize as obviously wrong # and do something about it. eval { @keys = $what->() }; @keys = () if (@keys == 1 && !(defined($keys[0]) && length($keys[0]))); } return @keys; } } $self->{getter} = $getter; $self->{enumer} = $enumer; # Now some quick pre-configuration of a few bits # Is this an OpenID message at all? # All OpenID messages have an openid.mode value... return undef unless $self->get('mode'); # Is this an OpenID 2.0 message? my $ns = $self->get('ns'); # The 2.0 spec section 4.1.2 requires that we support these namespace values # but act like it's a normal 1.1 request. # We do this by just pretending that ns wasn't set at all. if ($ns && ($ns eq 'http://openid.net/signon/1.1' || $ns eq 'http://openid.net/signon/1.0')) { $ns = undef; } if (defined($ns) && $ns eq OpenID::util::version_2_namespace()) { $self->{protocol_version} = 2; } elsif (! defined($ns)) { # No namespace at all means a 1.1 message if (($self->{minimum_version}||0) <= 1) { $self->{protocol_version} = 1; } else { # Pretend we don't understand the message. return undef; } } else { # Unknown version is the same as not being an OpenID message at all return undef; } # This will be populated in on demand $self->{extension_prefixes} = undef; return $self; } sub protocol_version { return $_[0]->{protocol_version}; } sub mode { my $self = shift; return $self->get('mode'); } sub get { my $self = shift; my $key = shift or Carp::croak("No argument name supplied to get method"); # Arguments can only contain letters, numbers, underscores and dashes Carp::croak("Invalid argument key $key") unless $key =~ /^[\w\-]+$/; Carp::croak("Too many arguments") if scalar(@_); return $self->{getter}->("openid.$key"); } sub raw_get { my $self = shift; my $key = shift or Carp::croak("No argument name supplied to raw_get method"); return $self->{getter}->($key); } sub getter { my $self = shift; return $self->{getter}; } # NOTE RE all_parameters(): # # It was originally thought that enumeration of URL parameters was # unnecessary except to support extensions, i.e., that support of the # core protocol did not need it. While this is true in OpenID 1.1, it # is not the case in OpenID 2.0 where check_authentication requires # sending back a complete copy of the positive assertion message # that was received indirectly. # # In cases where legacy client code is not supplying a real enumerator, # this routine will return an empty list and callers will need to # check for this. Recall that actual messages in all versions of the # Openid protocol (thus far) are guaranteed to have at least an # 'openid.mode' parameter. sub all_parameters { my $self = shift; return $self->{enumer}->(); } sub get_ext { my $self = shift; my $namespace = shift or Carp::croak("No namespace URI supplied to get_ext method"); my $key = shift; Carp::croak("Too many arguments") if scalar(@_); $self->_compute_extension_prefixes() unless defined($self->{extension_prefixes}); my $alias = $self->{extension_prefixes}{$namespace}; return $key ? undef : {} unless $alias; if ($key) { return $self->{getter}->("openid.$alias.$key"); } else { my $prefix = "openid.$alias."; my $prefixlen = length($prefix); my $ret = {}; foreach my $key ($self->all_parameters) { next unless substr($key, 0, $prefixlen) eq $prefix; $ret->{substr($key, $prefixlen)} = $self->{getter}->($key); } return $ret; } } sub has_ext { my $self = shift; my $namespace = shift or Carp::croak("No namespace URI supplied to get_ext method"); Carp::croak("Too many arguments") if scalar(@_); $self->_compute_extension_prefixes() unless defined($self->{extension_prefixes}); return defined($self->{extension_prefixes}{$namespace}) ? 1 : 0; } sub _compute_extension_prefixes { my ($self) = @_; # return unless $self->{enumer}; $self->{extension_prefixes} = {}; if ($self->protocol_version != 1) { foreach my $key ($self->all_parameters) { next unless $key =~ /^openid\.ns\.(\w+)$/; my $alias = $1; my $uri = $self->{getter}->($key); $self->{extension_prefixes}{$uri} = $alias; } } else { # Synthesize the SREG namespace as it was used in OpenID 1.1 $self->{extension_prefixes}{"http://openid.net/extensions/sreg/1.1"} = "sreg"; } } 1; =head1 NAME Net::OpenID::IndirectMessage - Class representing a collection of namespaced arguments =head1 VERSION version 1.17 =head1 DESCRIPTION This class acts as an abstraction layer over a collection of flat URL arguments which supports namespaces as defined by the OpenID Auth 2.0 specification. It also recognises when it is given OpenID 1.1 non-namespaced arguments and acts as if the relevant namespaces were present. In this case, it only supports the basic OpenID 1.1 arguments and the extension arguments for Simple Registration. This class can operate on a normal hashref, a L object or any object with a C method that behaves similarly (L, L, L,...), an L object, a L object, or an arbitrary C ref that when given a key name as its first parameter and returns a value and if given no arguments returns a list of all keys present. If you pass in a hashref or a coderef it is your responsibility as the caller to check the HTTP request method and pass in the correct set of arguments. For the other kinds of objects, this module will do the right thing automatically. =head1 SYNOPSIS use Net::OpenID::IndirectMessage; # Pass in something suitable for the underlying flat dictionary. # Will return an instance if the request arguments can be understood # as a supported OpenID Message format. # Will return undef if this doesn't seem to be an OpenID Auth message. # Will croak if the $argumenty_thing is not of a suitable type. my $args = Net::OpenID::IndirectMessage->new($argumenty_thing); # Determine which protocol version the message is using. # Currently this can be either 1 for 1.1 or 2 for 2.0. # Expect larger numbers for other versions in future. # Most callers don't really need to care about this. my $version = $args->protocol_version(); # Get a core argument value ("openid.mode") my $mode = $args->get("mode"); # Get an extension argument value my $nickname = $args->get_ext("http://openid.net/extensions/sreg/1.1", "nickname"); # Get hashref of all arguments in a given namespace my $sreg = $args->get_ext("http://openid.net/extensions/sreg/1.1"); Most of the time callers won't need to use this class directly, but will instead access it through a L instance. =head1 METHODS =over 4 =item B Currently returns 1 or 2, according as this is an OpenID 1.0/1.1 or an OpenID 2.0 message. =item B Takes an extension namespace and returns true if the named extension is used in this message. =item B Takes an extension namespace and an optional parameter name, returns the parameter value, or if no parameter given, the parameter value. =backExtension.pm000644001750000167 465512132077574 20460 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenID package Net::OpenID::Extension; BEGIN { $Net::OpenID::Extension::VERSION = '1.17'; } use strict; =head1 NAME Net::OpenID::Extension - Base class for OpenID extensions =head1 VERSION version 1.17 =head1 METHODS =head2 CLASS->namespace_uris Return a hashref mapping namespace URIs to the aliases you will use to refer to them in the other methods. For example: return { 'http://example.com/some-extension' => 'someext', }; =head2 CLASS->new_request(@parameters) When your extension is added to the L object in consumer-land, this method will be called to create a request object. Any additional arguments passed when adding the extension will be passed through verbatim in C<@parameters>. The object you return here should at minimum provide the interface defined in L. You can return C here if you have nothing useful to return. =head2 CLASS->received_request(\%args) In server-land, when a caller asks for the request object for your extension this method will be called to create a request object. C<%args> maps the aliases you returned from the C method to a hashref of the key-value pairs provided in that namespace. The object you return here should at minimum provide the interface defined in L, and should behave identically to the corresponding object returned from C. You can return C here if you have nothing useful to return. =head2 CLASS->new_response(@parameters) When your extension is added to the response in server-land, this method will be called to create a response object. Any additional arguments passed when adding the extension will be passed through verbatim in C<@parameters>. You can return C here if you have nothing useful to return. =head2 CLASS->received_response(\%args) In consumer-land, when a caller asks for the request object for your extension in L this method will be called to create a response object. C<%args> maps the aliases you returned from the C method to a hashref of the key-value pairs provided in that namespace. You can return C here if you have nothing useful to return. =cut sub namespace_uris { return {}; } sub new_request { return undef; } sub new_response { return undef; } sub received_request { return undef; } sub received_response { return undef; } 1;ExtensionMessage.pm000644001750000167 126612132077574 21760 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenID package Net::OpenID::ExtensionMessage; BEGIN { $Net::OpenID::ExtensionMessage::VERSION = '1.17'; } use strict; =head1 NAME Net::OpenID::ExtensionMessage - Base class for extension messages =head1 VERSION version 1.17 =head1 DESCRIPTION Instances of implementations of the interface provided by this package are returned from various methods in L implementations. =head1 METHODS =head2 $emsg->extension_arguments Return a hashref that maps extension namespace aliases as defined in the corresponding L to hashrefs of key-value pairs for the arguments to include in that namespace. =cut sub extension_arguments { return {}; } 1;Common.pm000644001750000167 2074112132077574 17746 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenID package Net::OpenID::Common; BEGIN { $Net::OpenID::Common::VERSION = '1.17'; } =head1 NAME Net::OpenID::Common - Libraries shared between Net::OpenID::Consumer and Net::OpenID::Server =head1 VERSION version 1.17 =head1 DESCRIPTION The Consumer and Server implementations share a few libraries which live with this module. This module is here largely to hold the version number and this documentation, though it also incorporates some utility functions inherited from previous versions of L. =head1 COPYRIGHT This package is Copyright (c) 2005 Brad Fitzpatrick, and (c) 2008 Martin Atkins. All rights reserved. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. If you need more liberal licensing terms, please contact the maintainer. =head1 AUTHORS Brad Fitzpatrick Tatsuhiko Miyagawa Martin Atkins Robert Norris Roger Crew =head1 MAINTAINER Maintained by Roger Crew =cut # This package should totally be called Net::OpenID::util, but # it was historically named wrong so we're just leaving it # like this to avoid confusion. package OpenID::util; BEGIN { $OpenID::util::VERSION = '1.17'; } use Crypt::DH::GMP; use Math::BigInt; use Time::Local (); use MIME::Base64 (); use URI::Escape (); use HTML::Parser (); use constant VERSION_1_NAMESPACE => "http://openid.net/signon/1.1"; use constant VERSION_2_NAMESPACE => "http://specs.openid.net/auth/2.0"; # I guess this is a bit daft since constants are subs anyway, # but whatever. sub version_1_namespace { return VERSION_1_NAMESPACE; } sub version_2_namespace { return VERSION_2_NAMESPACE; } sub version_1_xrds_service_url { return VERSION_1_NAMESPACE; } sub version_2_xrds_service_url { return "http://specs.openid.net/auth/2.0/signon"; } sub version_2_xrds_directed_service_url { return "http://specs.openid.net/auth/2.0/server"; } sub version_2_identifier_select_url { return "http://specs.openid.net/auth/2.0/identifier_select"; } sub parse_keyvalue { my $reply = shift; my %ret; $reply =~ s/\r//g; foreach (split /\n/, $reply) { next unless /^(\S+?):(.*)/; $ret{$1} = $2; } return %ret; } sub eurl { my $a = $_[0]; $a =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg; $a =~ tr/ /+/; return $a; } sub push_url_arg { my $uref = shift; $$uref =~ s/[&?]$//; my $got_qmark = ($$uref =~ /\?/); while (@_) { my $key = shift; my $value = shift; $$uref .= $got_qmark ? "&" : ($got_qmark = 1, "?"); $$uref .= URI::Escape::uri_escape($key) . "=" . URI::Escape::uri_escape($value); } } sub push_openid2_url_arg { my $uref = shift; my %args = @_; push_url_arg($uref, 'openid.ns' => VERSION_2_NAMESPACE, map { 'openid.'.$_ => $args{$_} } keys %args, ); } sub time_to_w3c { my $time = shift || time(); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time); $mon++; $year += 1900; return sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", $year, $mon, $mday, $hour, $min, $sec); } sub w3c_to_time { my $hms = shift; return 0 unless $hms =~ /^(\d{4,4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)Z$/; my $time; eval { $time = Time::Local::timegm($6, $5, $4, $3, $2 - 1, $1); }; return 0 if $@; return $time; } sub int2bytes { my ($int) = @_; my $bigint = Math::BigInt->new($int); die "Can't deal with negative numbers" if $bigint->is_negative; my $bits = $bigint->as_bin; die unless $bits =~ s/^0b//; # prepend zeros to round to byte boundary, or to unset high bit my $prepend = (8 - length($bits) % 8) || ($bits =~ /^1/ ? 8 : 0); $bits = ("0" x $prepend) . $bits if $prepend; return pack("B*", $bits); } sub int2arg { return b64(int2bytes($_[0])); } sub b64 { my $val = MIME::Base64::encode_base64($_[0]); $val =~ s/\s+//g; return $val; } sub d64 { return MIME::Base64::decode_base64($_[0]); } sub bytes2int { return Math::BigInt->new("0b" . unpack("B*", $_[0]))->bstr; } sub arg2int { my ($arg) = @_; return undef unless defined $arg and $arg ne ""; # don't acccept base-64 encoded numbers over 700 bytes. which means # those over 4200 bits. return 0 if length($arg) > 700; return bytes2int(MIME::Base64::decode_base64($arg)); } sub timing_indep_eq { no warnings 'uninitialized'; my ($x, $y)=@_; warnings::warn('uninitialized','Use of uninitialized value in timing_indep_eq') if (warnings::enabled('uninitialized') && !(defined($x) && defined($y))); return '' if length($x)!=length($y); my $n=length($x); my $result=0; for (my $i=0; $i<$n; $i++) { $result |= ord(substr($x, $i, 1)) ^ ord(substr($y, $i, 1)); } return !$result; } sub get_dh { my ($p, $g) = @_; $p ||= "155172898181473697471232257763715539915724801966915404479707795314057629378541917580651227423698188993727816152646631438561595825688188889951272158842675419950341258706556549803580104870537681476726513255747040765857479291291572334510643245094715007229621094194349783925984760375594985848253359305585439638443"; $g ||= "2"; return if $p <= 10 or $g <= 1; my $dh = Crypt::DH::GMP->new(p => $p, g => $g); $dh->generate_keys; return $dh; } ################################################################ # HTML parsing # # This is a stripped-down version of HTML::HeadParser # that only recognizes and tags our @_linkmeta_parser_options = ( api_version => 3, ignore_elements => [qw(script style base isindex command noscript title object)], start_document_h => [sub { my($p) = @_; $p->{first_chunk} = 0; $p->{found} = {}; }, "self"], end_h => [sub { my($p,$tag) = @_; $p->eof if $tag eq 'head' }, "self,tagname"], start_h => [sub { my($p, $tag, $attr) = @_; if ($tag eq 'meta' || $tag eq 'link') { if ($tag eq 'link' && ($attr->{rel}||'') =~ m/\s/) { # split # into multiple s push @{$p->{found}->{$tag}}, map { +{%{$attr}, rel => $_} } split /\s+/,$attr->{rel}; } else { push @{$p->{found}->{$tag}}, $attr; } } elsif ($tag ne 'head' && $tag ne 'html') { # stop parsing $p->eof; } }, "self,tagname,attr"], text_h => [sub { my($p, $text) = @_; unless ($p->{first_chunk}) { # drop Unicode BOM if found if ($p->utf8_mode) { $text =~ s/^\xEF\xBB\xBF//; } else { $text =~ s/^\x{FEFF}//; } $p->{first_chunk}++; } # Normal text outside of an allowed tag # means start of body $p->eof if ($text =~ /\S/); }, "self,text"], ); # XXX this line is also in HTML::HeadParser; do we need it? # current theory is we don't because we're requiring at # least version 3.40 which is already pretty ancient. # # *utf8_mode = sub { 1 } unless HTML::Entities::UNICODE_SUPPORT; our $_linkmeta_parser; # return { link => [links...], meta => [metas...] } # where each link/meta is a hash of the attribute values sub html_extract_linkmetas { my $doc = shift; $_linkmeta_parser ||= HTML::Parser->new(@_linkmeta_parser_options); $_linkmeta_parser->parse($doc); $_linkmeta_parser->eof; return delete $_linkmeta_parser->{found}; } ### DEPRECATED, do not use, will be removed Real Soon Now sub _extract_head_markup_only { my $htmlref = shift; # kill all CDATA sections $$htmlref =~ s///sg; # kill all comments $$htmlref =~ s///sg; # ***FIX?*** Strictly speaking, SGML comments must have matched # pairs of '--'s but almost nobody checks for this or even knows # trim everything past the body. this is in case the user doesn't # have a head document and somebody was able to inject their own # head. -- brad choate $$htmlref =~ s/ 1; use constant YR_XRDS => 2; use fields ( 'last_errcode', # last error code we got 'last_errtext', # last error code we got 'debug', # debug flag or codeblock 'consumer', # consumer object 'identity_url', # URL to be identified 'xrd_url', # URL of XRD file 'xrd_objects', # Yadis XRD decoded objects ); sub new { my $self = shift; $self = fields::new( $self ) unless ref $self; my %opts = @_; $self->consumer(delete($opts{consumer})); $self->{debug} = delete $opts{debug}; Carp::croak("Unknown options: " . join(", ", keys %opts)) if %opts; return $self; } sub consumer { &_getset; } sub identity_url { &_getset; } sub xrd_url { &_getset; } sub xrd_objects { _pack_array(&_getset); } sub _getset { my $self = shift; my $param = (caller(1))[3]; $param =~ s/.+:://; if (@_) { my $val = shift; Carp::croak("Too many parameters") if @_; $self->{$param} = $val; } return $self->{$param}; } sub _debug { my $self = shift; return unless $self->{debug}; if (ref $self->{debug} eq "CODE") { $self->{debug}->($_[0]); } else { print STDERR "[DEBUG Net::OpenID::Yadis] $_[0]\n"; } } sub _fail { my $self = shift; my ($code, $text) = @_; $text ||= { 'xrd_parse_error' => "Error occured since parsing yadis document.", 'xrd_format_error' => "This is not yadis document (not xrds format).", 'too_many_hops' => 'Too many hops by X-XRDS-Location.', 'empty_url' => 'Empty URL', 'no_yadis_document' => 'Cannot find yadis Document', 'url_gone' => 'URL is no longer available', }->{$code}; $self->{last_errcode} = $code; $self->{last_errtext} = $text; $self->_debug("fail($code) $text"); wantarray ? () : undef; } sub err { my $self = shift; $self->{last_errcode} . ": " . $self->{last_errtext}; } sub errcode { my $self = shift; $self->{last_errcode}; } sub errtext { my $self = shift; $self->{last_errtext}; } sub _clear_err { my $self = shift; $self->{last_errtext} = ''; $self->{last_errcode} = ''; } sub _get_contents { my $self = shift; my ($url, $final_url_ref, $content_ref, $headers_ref) = @_; # we do NOT do elimination here because # if it's an HTML document, we are only ever looking at the headers, and # if it's a YADIS document, elimination is not appropriate # (YADIS is not HTML; film at 11) my $res = Net::OpenID::URIFetch->fetch($url, $self->consumer); if ($res) { $$final_url_ref = $res->final_uri; my $headers = $res->headers; foreach my $k (keys %$headers) { $headers_ref->{$k} ||= $headers->{$k}; } $$content_ref = $res->content; return 1; } else { return undef; } } sub parse_content_type { # stolen from HTTP::Headers but returns lc charset my $h = shift; $h = $h->[0] if ref($h); $h = "" unless defined $h; my ($v) = (split_header_words($h), []); my($ct, undef, %ct_param) = @$v; $ct ||= ''; $ct = lc($ct); $ct =~ s/\s+//; my $charset = lc($ct_param{charset} || ''); $charset =~ s/^\s+//; $charset =~ s/\s+\z//; return ($ct, $charset); } sub discover { my $self = shift; my $url = shift or return $self->_fail("empty_url"); my $count = shift || YR_GET; Carp::croak("Too many parameters") if @_; # trim whitespace $url =~ s/^\s+//; $url =~ s/\s+$//; return $self->_fail("empty_url") unless $url; my $final_url; my %headers; my $xrd; $self->_get_contents($url, \$final_url, \$xrd, \%headers) or return; $self->identity_url($final_url) if ($count < YR_XRDS); # (1) found YADIS/XRDS-Location headers if ($count < YR_XRDS and my $doc_url = $headers{'x-yadis-location'} || $headers{'x-xrds-location'} ) { return $self->discover($doc_url, YR_XRDS); } # (2) is content type YADIS document? my ($ctype, $charset) = parse_content_type($headers{'content-type'}); if ($ctype eq 'application/xrds+xml') { #survey says Yes! $self->xrd_url($final_url); return $self->parse_xrd($xrd); } # (3) YADIS/XRDS-location might be in a tag. if ( $ctype eq 'text/html' and my ($meta) = grep { my $heqv = lc($_->{'http-equiv'}||''); $heqv eq 'x-yadis-location' || $heqv eq 'x-xrds-location' } @{OpenID::util::html_extract_linkmetas($xrd)->{meta}||[]} ) { return $self->discover($meta->{content}, YR_XRDS); } return $self->_fail($count == YR_GET ? "no_yadis_document" : "too_many_hops"); } sub parse_xrd { my $self = shift; my $xrd = shift; Carp::croak("Too many parameters") if @_; my $xs_hash = XMLin($xrd) or return $self->_fail("xrd_parse_error"); ($xs_hash->{'xmlns'} and $xs_hash->{'xmlns'} eq 'xri://$xrd*($v*2.0)') or $self->_fail("xrd_format_error"); my %xmlns; foreach (map { /^(xmlns:(.+))$/ and [$1,$2] } keys %$xs_hash) { next unless ($_); $xmlns{$_->[1]} = $xs_hash->{$_->[0]}; } my @priority; my @nopriority; foreach my $service (_pack_array($xs_hash->{'XRD'}{'Service'})) { bless $service, "Net::OpenID::Yadis::Service"; $service->{'Type'} or next; $service->{'URI'} ||= $self->identity_url; foreach my $sname (keys %$service) { foreach my $ns (keys %xmlns) { $service->{"{$xmlns{$ns}}$1"} = delete $service->{$sname} if ($sname =~ /^${ns}:(.+)$/); } } defined($service->{'priority'}) ? push(@priority,$service) : push(@nopriority,$service); # Services without priority fields are lowest priority } my @service = sort {$a->{'priority'} <=> $b->{'priority'}} @priority; push (@service,@nopriority); foreach (grep {/^_protocol/} keys %$self) { delete $self->{$_} } $self->xrd_objects(\@service); } sub _pack_array { wantarray ? ref($_[0]) eq 'ARRAY' ? @{$_[0]} : ($_[0]) : $_[0] } sub services { my $self = shift; my %protocols; my @protocols; my $code_ref; my $protocol = undef; Carp::croak("You haven't called the discover method yet") unless $self->xrd_objects; foreach my $option (@_) { Carp::croak("No further arguments allowed after code reference argument") if $code_ref; my $ref = ref($option); if ($ref eq 'CODE') { $code_ref = $option; } else { my $default = {versionarray => []}; $protocols{$option} = $default; $protocol = $option; push @protocols, $option; } } my @servers; @servers = $self->xrd_objects if (keys %protocols == 0); foreach my $key (@protocols) { my $regex = $protocols{$key}->{urlregex} || $key; my @ver = @{$protocols{$key}->{versionarray}}; my $ver_regex = @ver ? '('.join('|',map { $_ =~ s/\./\\./g; $_ } @ver).')' : '.+' ; $regex =~ s/\\ver/$ver_regex/; push (@servers,map { $protocols{$key}->{objectclass} ? bless($_ , $protocols{$key}->{objectclass}) : $_ } grep {join(",",$_->Type) =~ /$regex/} $self->xrd_objects); } @servers = $code_ref->(@servers) if ($code_ref); wantarray ? @servers : \@servers; } 1; __END__ =head1 NAME Net::OpenID::Yadis - Perform Yadis discovery on URLs =head1 VERSION version 1.17 =head1 SYNOPSIS use Net::OpenID::Yadis; my $disc = Net::OpenID::Yadis->new( consumer => $consumer, # Net::OpenID::Consumer object ); my $xrd = $disc->discover("http://id.example.com/") or Carp::croak($disc->err); print $disc->identity_url; # Yadis URL (Final URL if redirected) print $disc->xrd_url; # Yadis Resourse Descriptor URL foreach my $srv (@$xrd) { # Loop for Each Service in Yadis Resourse Descriptor print $srv->priority; # Service priority (sorted) print $srv->Type; # Identifier of some version of some service (scalar, array or array ref) print $srv->URI; # URI that resolves to a resource providing the service (scalar, array or array ref) print $srv->extra_field("Delegate","http://openid.net/xmlns/1.0"); # Extra field of some service } # If you are interested only in OpenID. (either 1.1 or 2.0) my $xrd = $self->services( 'http://specs.openid.net/auth/2.0/signon', 'http://specs.openid.net/auth/2.0/server', 'http://openid.net/signon/1.1', ); # If you want to choose random server by code-ref. my $xrd = $self->services(sub{($_[int(rand(@_))])}); =head1 DESCRIPTION This module provides an implementation of the Yadis protocol, which does XRDS-based service discovery on URLs. This module was originally developed by OHTSUKA Ko-hei as L, but was forked and simplified for inclusion in the core OpenID Consumer package. This simplified version is tailored for the needs of Net::OpenID::Consumer; for other uses, L is probably a better choice. =head1 CONSTRUCTOR =over 4 =item C my $disc = Net::OpenID::Yadis->new([ %opts ]); You can set the C in the constructor. See the corresponding method description below. =back =head1 EXPORT This module exports three constant values to use with discover method. =over 4 =item C If you set this, module check Yadis URL start from HTTP GET request. This is the default. =item C If you set this, this module consider Yadis URL as Yadis Resource Descriptor URL. If not so, an error is returned. =back =head1 METHODS =over 4 =item $disc->B($consumer) =item $disc->B Get or set the Net::OpenID::Consumer object that this object is associated with. =item $disc->B($url,[$request_method]) Given a user-entered $url (which could be missing http://, or have extra whitespace, etc), returns either array/array ref of Net::OpenID::Yadis::Service objects, or undef on failure. $request_method is optional, and if set this, you can change the HTTP request method of fetching Yadis URL. See EXPORT to know the value you can set, and default is YR_HEAD. If this method returns undef, you can rely on the following errors codes (from $csr->B) to decide what to present to the user: =over 8 =item xrd_parse_error =item xrd_format_error =item too_many_hops =item no_yadis_document =item url_fetch_err =item empty_url =item url_gone =back =item $disc->B Returns array/array ref of Net::OpenID::Yadis objects. It is same what could be got by discover method. =item $disc->B Returns Yadis URL. If not redirected, it is same with the argument of discover method. =item $disc->B Returns Yadis Resource Descriptor URL. =item $disc->B($protocol,$protocol,...) =item $disc->B($protocol=>[$version1,$version2],...) =item $disc->B($protocol,....,$code_ref); Filter method of xrd_objects. If no opton is defined, returns same result with xrd_objects method. protocol names or Type URLs are given, filter only given protocol. Two or more protocols are given, return and results of filtering. Sample: $disc->servers("openid","http://lid.netmesh.org/sso/1.0"); If reference of version numbers array is given after protocol names, filter only given version of protocol. Sample: $disc->servers("openid"=>['1.0','1.1'],"lid"=>['1.0']); If you want to use version numbers limitation with type URL, you can use \ver as place holder of version number. Sample: $disc->servers("http://lid.netmesh.org/sso/\ver"=>['1.0','2.0']); If code reference is given as argument , you can make your own filter rule. code reference is executed at the last of filtering logic, like this: @results = $code_ref->(@temporary_results) Sample: If you want to filter OpenID server and get only first one: ($openid_server) = $disc->servers("openid",sub{$_[0]}); =item $disc->B Returns the last error, in form "errcode: errtext" =item $disc->B Returns the last error code. =item $disc->B Returns the last error text. =back =head1 COPYRIGHT This module is Copyright (c) 2006 OHTSUKA Ko-hei. All rights reserved. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. =head1 WARRANTY This is free software. IT COMES WITHOUT WARRANTY OF ANY KIND. =head1 SEE ALSO Yadis website: L L L =head1 AUTHORS Based on L by OHTSUKA Ko-hei Martin Atkins =cutURIFetch.pm000644001750000167 1247412132077574 20133 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenID#!/usr/bin/perl =head1 NAME Net::OpenID::URIFetch - fetch and cache content from HTTP URLs =head1 VERSION version 1.17 =head1 DESCRIPTION This is roughly based on Ben Trott's URI::Fetch module, but URI::Fetch doesn't cache enough headers that Yadis can be implemented with it, so this is a lame copy altered to allow Yadis support. Hopefully one day URI::Fetch can be modified to do what we need and this can go away. This module is tailored to the needs of Net::OpenID::Consumer and probably isn't much use outside of it. See URI::Fetch for a more general module. =cut package Net::OpenID::URIFetch; BEGIN { $Net::OpenID::URIFetch::VERSION = '1.17'; } use HTTP::Request; use HTTP::Status; use strict; use warnings; use Carp(); use constant URI_OK => 200; use constant URI_MOVED_PERMANENTLY => 301; use constant URI_NOT_MODIFIED => 304; use constant URI_GONE => 410; # Fetch a document, either from cache or from a server # URI -- location of document # CONSUMER -- where to find user-agent and cache # CONTENT_HOOK -- applied to freshly-retrieved document # to normalize it into some particular format/structure # PREFIX -- used as part of the cache key, distinguishes # different content formats and must change whenever # CONTENT_HOOK is switched to a new format; this way, # cache entries from a previous run of this server that # are using a different content format will not kill us. sub fetch { my ($class, $uri, $consumer, $content_hook, $prefix) = @_; $prefix ||= ''; if ($uri eq 'x-xrds-location') { Carp::confess("Buh?"); } my $ua = $consumer->ua; my $cache = $consumer->cache; my $ref; my $cache_key = "URIFetch:${prefix}:${uri}"; if ($cache) { if (my $blob = $cache->get($cache_key)) { $ref = Storable::thaw($blob); } } my $cached_response = sub { return Net::OpenID::URIFetch::Response->new( status => 200, content => $ref->{Content}, last_modified => $ref->{LastModified}, headers => $ref->{Headers}, final_uri => $ref->{FinalURI}, ); }; # We just serve anything from the last 60 seconds right out of the cache, # thus avoiding doing several requests to the same URL when we do # Yadis, then HTML discovery. # TODO: Make this tunable? if ($ref && $ref->{CacheTime} > (time() - 60)) { $consumer->_debug("Cache HIT for $uri"); return $cached_response->(); } else { $consumer->_debug("Cache MISS for $uri"); } my $req = HTTP::Request->new(GET => $uri); $req->header('Accept-Encoding', scalar HTTP::Message::decodable()); if ($ref) { if (my $etag = ($ref->{Headers}->{etag})) { $req->header('If-None-Match', $etag); } if (my $ts = $ref->{LastModified}) { $req->if_modified_since($ts); } } my $res = $ua->request($req); # There are only a few headers that OpenID/Yadis care about my @useful_headers = qw(last-modified etag content-type x-yadis-location x-xrds-location); my %response_fields; if ($res->code == HTTP::Status::RC_NOT_MODIFIED()) { $consumer->_debug("Server says it's not modified. Serving from cache."); return $cached_response->(); } else { my $final_uri = $res->request->uri->as_string(); my $final_cache_key = "URIFetch:${prefix}:${final_uri}"; my $content = $res->decoded_content # Decode content-encoding and charset || $res->decoded_content(charset => 'none') # Decode content-encoding || $res->content; # Undecoded content if ($content_hook) { $content_hook->(\$content); } my $headers = {}; foreach my $k (@useful_headers) { $headers->{$k} = $res->header($k); } my $ret = Net::OpenID::URIFetch::Response->new( status => $res->code, last_modified => $res->last_modified, content => $content, headers => $headers, final_uri => $final_uri, ); if ($cache && $res->code == 200) { my $cache_data = { LastModified => $ret->last_modified, Headers => $ret->headers, Content => $ret->content, CacheTime => time(), FinalURI => $final_uri, }; my $cache_blob = Storable::freeze($cache_data); $cache->set($final_cache_key, $cache_blob); $cache->set($cache_key, $cache_blob); } return $ret; } } package Net::OpenID::URIFetch::Response; BEGIN { $Net::OpenID::URIFetch::Response::VERSION = '1.17'; } use strict; use constant FIELDS => [qw(final_uri status content headers last_modified)]; use fields @{FIELDS()}; use Carp(); sub new { my ($class, %opts) = @_; my $self = fields::new($class); @{$self}{@{FIELDS()}} = delete @opts{@{FIELDS()}}; Carp::croak("Unknown option(s): " . join(", ", keys %opts)) if %opts; return $self; } BEGIN { foreach my $field_name (@{FIELDS()}) { no strict 'refs'; *{__PACKAGE__ . '::' . $field_name} = sub { return $_[0]->{$field_name}; }; } } sub header { return $_[0]->{headers}{lc($_[1])}; } 1;Yadis000755001750000167 012132077574 17046 5ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenIDService.pm000644001750000167 375012132077574 21150 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenID/Yadis package Net::OpenID::Yadis::Service; BEGIN { $Net::OpenID::Yadis::Service::VERSION = '1.17'; } use strict; use warnings; sub URI { Net::OpenID::Yadis::_pack_array(shift->{'URI'}) } sub Type { Net::OpenID::Yadis::_pack_array(shift->{'Type'}) } sub priority { shift->{'priority'} } sub extra_field { my $self = shift; my ($field,$xmlns) = @_; $xmlns and $field = "\{$xmlns\}$field"; $self->{$field}; } 1; __END__ =head1 NAME Net::OpenID::Yadis::Service - Class representing an XRDS Service element =head1 VERSION version 1.17 =head1 SYNOPSIS use Net::OpenID::Yadis; my $disc = Net::OpenID::Yadis->new(); my @xrd = $disc->discover("http://id.example.com/") or Carp::croak($disc->err); foreach my $srv (@xrd) { # Loop for Each Service in Yadis Resourse Descriptor print $srv->priority; # Service priority (sorted) print $srv->Type; # Identifier of some version of some service (scalar, array or array ref) print $srv->URI; # URI that resolves to a resource providing the service (scalar, array or array ref) print $srv->extra_field("Delegate","http://openid.net/xmlns/1.0"); # Extra field of some service } =head1 DESCRIPTION After L performs discovery, the result is a list of instances of this class. =head1 METHODS =over 4 =item $srv->B The priority value for the service. =item $srv->B The URI representing the kind of service provided at the endpoint for this record. =item $srv->B The URI of the service endpoint. =item $srv->B( $fieldname , $namespace ) Fetch the value of extension fields not provided directly by this class. If C<$namespace> is not specified, the default is the namespace whose name is the empty string. =back =head1 COPYRIGHT, WARRANTY, AUTHOR See L for author, copyright and licensing information. =head1 SEE ALSO L Yadis website: LExtension000755001750000167 012132077574 17751 5ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenIDSimpleRegistration.pm000644001750000167 1372612132077574 24323 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/lib/Net/OpenID/Extension package Net::OpenID::Extension::SimpleRegistration; BEGIN { $Net::OpenID::Extension::SimpleRegistration::VERSION = '1.17'; } use base qw(Net::OpenID::Extension); use strict; use Carp; use constant namespace_uris => { 'http://openid.net/extensions/sreg/1.1' => 'sreg', }; sub new_request { my ($class, %opts) = @_; return Net::OpenID::Extension::SimpleRegistration::Request->new(%opts); } sub received_request { my ($class, $args) = @_; return Net::OpenID::Extension::SimpleRegistration::Request->received($args); } sub new_response { my ($class, %opts) = @_; return Net::OpenID::Extension::SimpleRegistration::Request->new(%opts); } sub received_response { my ($class, $args) = @_; return Net::OpenID::Extension::SimpleRegistration::Request->received($args); } package Net::OpenID::Extension::SimpleRegistration::Request; BEGIN { $Net::OpenID::Extension::SimpleRegistration::Request::VERSION = '1.17'; } use base qw(Net::OpenID::ExtensionMessage); use strict; sub new { my ($class, %opts) = @_; my $self = bless {}, $class; $self->required_fields(delete $opts{required_fields}); $self->optional_fields(delete $opts{optional_fields}); $self->policy_url(delete $opts{policy_url}); $self->{required_fields} = [ split(',', $self->{required_fields}) ] unless ref $self->{required_fields}; $self->{optional_fields} = [ split(',', $self->{optional_fields}) ] unless ref $self->{optional_fields}; Carp::croak("Unsupported options: ".join(',', keys %opts)) if %opts; return $self; } sub received { my ($class, $args) = @_; my $self = $class->new(); $args = $args->{sreg} || {}; $self->required_fields($args->{required}); $self->optional_fields($args->{optional}); return $self; } sub extension_arguments { my ($self) = @_; my $ret = {}; $ret->{required} = join(',', @{$self->required_fields}) if @{$self->required_fields}; $ret->{optional} = join(',', @{$self->optional_fields}) if @{$self->optional_fields}; $ret->{policy_url} = $self->policy_url if $self->policy_url; return { sreg => $ret, }; } sub required_fields { my ($self, $value) = @_; if (defined $value) { $value = [] unless $value; $value = [ split(',', $value) ] unless ref $value; $self->{required_fields} = $value; } else { return $self->{required_fields}; } } sub optional_fields { my ($self, $value) = @_; if (defined $value) { $value = [] unless $value; $value = [ split(',', $value) ] unless ref $value; $self->{optional_fields} = $value; } else { return $self->{optional_fields}; } } sub add_required_field { my ($self, $value) = @_; push @{$self->{required_fields}}, $value; } sub add_optional_field { my ($self, $value) = @_; push @{$self->{optional_fields}}, $value; } sub policy_url { my ($self, $value) = @_; if (defined $value) { $self->{policy_url} = $value; } else { return $self->{optional_fields}; } } package Net::OpenID::Extension::SimpleRegistration::Response; BEGIN { $Net::OpenID::Extension::SimpleRegistration::Response::VERSION = '1.17'; } use base qw(Net::OpenID::ExtensionMessage); use strict; use constant FIELDS => [qw(nickname email fullname dob gender postcode country language timezone)]; use fields FIELDS(); BEGIN { # Create an accessor for each of the fields foreach my $field_name (@{FIELDS()}) { no strict qw(refs); *{'Net::OpenID::Extension::SimpleRegistration::Response::'.$field_name} = sub { my ($self, $value) = @_; if (defined $value) { $self->{$field_name} = $value; } else { return $self->{$field_name}; } }; } } sub new { my ($class, %opts) = @_; my $self = fields::new($class); foreach my $field_name (@{FIELDS()}) { $self->{$field_name} = delete $opts{$field_name}; } Carp::croak("Unrecognised options: ".join(',', %opts)) if %opts; return $self; } sub received { my ($class, $args) = @_; $args = $args->{sreg} || {}; my %opts = (); foreach my $field_name (@{FIELDS()}) { $opts{$field_name} = $args->{$field_name} if $args->{$field_name}; } return $class->new(%opts); } sub extension_arguments { my ($self) = @_; # De-reference and then re-reference the hash to shake off the blessedness my $ret = { %$self }; return { sreg => $ret, }; } =pod =head1 NAME Net::OpenID::Extension::SimpleRegistration - Support for the Simple Registration extension (SREG) =head1 VERSION version 1.17 =head1 SYNOPSIS In Consumer... my $sreg_req = $claimed_identity->add_extension_request('Net::OpenID::Extension::SimpleRegistration', ( required_fields => [qw(nickname email)], optional_fields => [qw(country language timezone)], policy_url => "http://example.com/policy.html", )); Then, in Server, when handling the authentication request... # FIXME: What object do we have in ::Server that can hold this method? my $sreg_req = $something->get_extension_request('Net::OpenID::Extension::SimpleRegistration'); my $required_fields = $sreg_req->required_fields; my $optional_fields = $sreg_req->optional_fields; my $policy_url = $sreg_req->policy_url; When Server sends back its response... # FIXME: Again, what object do we have to hold this method? my $sreg_res = $something->add_extension_response('Net::OpenID::Extension::SimpleRegistration', ( nickname => $nickname, email => $email, )); And finally, when back in Consumer recieving the response: my $sreg_res = $verified_identity->get_extension_response('Net::OpenID::Extension::SimpleRegistration'); my $nickname = $sreg_res->nickname; my $email = $sreg_res->email; my $country = $sreg_res->country; my $language = $sreg_res->language; my $timezone = $sreg_res->timezone; =cut 1;META.yml000644001750000167 157612132077574 15004 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17--- abstract: 'Libraries shared between Net::OpenID::Consumer and Net::OpenID::Server' author: - 'Robert Norris ' - 'Roger Crew ' build_requires: Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.31 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.101900, CPAN::Meta::Converter version 2.101670' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-OpenID-Common requires: Crypt::DH::GMP: 0 Encode: 0 HTML::Parser: 3.40 HTTP::Headers::Util: 0 HTTP::Request: 0 HTTP::Status: 0 MIME::Base64: 0 Math::BigInt: 0 Time::Local: 0 XML::Simple: 0 resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-OpenID-Common homepage: http://groups.google.com/group/openid-perl repository: git://github.com/wrog/Net-OpenID-Common.git version: 1.17 LICENSE000644001750000167 4353012132077574 14554 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17This software is copyright (c) 2005 by Brad Fitzpatrick. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2005 by Brad Fitzpatrick. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2005 by Brad Fitzpatrick. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End README000644001750000167 53012132077574 14360 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17 This archive contains the distribution Net-OpenID-Common, version 1.17: Libraries shared between Net::OpenID::Consumer and Net::OpenID::Server This software is copyright (c) 2005 by Brad Fitzpatrick. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. MANIFEST000644001750000167 75012132077574 14635 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README lib/Net/OpenID/Common.pm lib/Net/OpenID/Extension.pm lib/Net/OpenID/Extension/SimpleRegistration.pm lib/Net/OpenID/ExtensionMessage.pm lib/Net/OpenID/IndirectMessage.pm lib/Net/OpenID/URIFetch.pm lib/Net/OpenID/Yadis.pm lib/Net/OpenID/Yadis/Service.pm t/00-use-indirectmessage.t t/01-use-urifetch.t t/02-use-yadis.t t/03-use-common.t t/04-messages.t t/05-eq.t t/06-int2bytes.t t/07-htmlparse.t t/release-pod-syntax.t META.json000644001750000167 310712132077574 15144 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17{ "abstract" : "Libraries shared between Net::OpenID::Consumer and Net::OpenID::Server", "author" : [ "Robert Norris ", "Roger Crew " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.101900, CPAN::Meta::Converter version 2.101670", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-OpenID-Common", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.31" } }, "runtime" : { "requires" : { "Crypt::DH::GMP" : 0, "Encode" : 0, "HTML::Parser" : "3.40", "HTTP::Headers::Util" : 0, "HTTP::Request" : 0, "HTTP::Status" : 0, "MIME::Base64" : 0, "Math::BigInt" : 0, "Time::Local" : 0, "XML::Simple" : 0 } }, "test" : { "requires" : { "Test::More" : 0 } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-net-openid-common@rt.cpan.org", "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-OpenID-Common" }, "homepage" : "http://groups.google.com/group/openid-perl", "repository" : { "type" : "git", "url" : "git://github.com/wrog/Net-OpenID-Common.git", "web" : "http://github.com/wrog/Net-OpenID-Common" } }, "version" : "1.17" } release-pod-syntax.t000644001750000167 45012132077574 17655 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Makefile.PL000644001750000167 251012132077574 15472 0ustar00rfcfuse000000000000Net-OpenID-Common-1.17 use strict; use warnings; use ExtUtils::MakeMaker 6.31; my %WriteMakefileArgs = ( 'ABSTRACT' => 'Libraries shared between Net::OpenID::Consumer and Net::OpenID::Server', 'AUTHOR' => 'Robert Norris , Roger Crew ', 'BUILD_REQUIRES' => { 'Test::More' => '0' }, 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => '6.31' }, 'DISTNAME' => 'Net-OpenID-Common', 'EXE_FILES' => [], 'LICENSE' => 'perl', 'NAME' => 'Net::OpenID::Common', 'PREREQ_PM' => { 'Crypt::DH::GMP' => '0', 'Encode' => '0', 'HTML::Parser' => '3.40', 'HTTP::Headers::Util' => '0', 'HTTP::Request' => '0', 'HTTP::Status' => '0', 'MIME::Base64' => '0', 'Math::BigInt' => '0', 'Time::Local' => '0', 'XML::Simple' => '0' }, 'VERSION' => '1.17', 'test' => { 'TESTS' => 't/*.t' } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs);