Added:
trunk/tester/lib/OpenID/Tester/Test/Canonicalize.pm
Modified:
trunk/tester/run-tests
Log:
The start of a test of URL canonicalization rules.
Added: trunk/tester/lib/OpenID/Tester/Test/Canonicalize.pm
==============================================================================
--- (empty file)
+++ trunk/tester/lib/OpenID/Tester/Test/Canonicalize.pm Sat May 17
13:22:46 2008
@@ -0,0 +1,83 @@
+package OpenID::Tester::Test::Canonicalize;
+use strict;
+use base 'OpenID::Tester::Test';
+
+sub needs_op { 1 }
+sub needs_rp { 1 }
+
+sub needed_op_caps {
+ return ("openid1.1");
+}
+*needed_rp_caps = \&needed_op_caps;
+
+sub tests {
+ my ($class, $tester) = @_;
+ my $op_base = $tester->op_base;
+ my $op_base_bare = $op_base;
+ $op_base_bare =~ s!^http://!!;
+
+ my @tests;
+
+ my $mt = sub {
+ my ($in, $out) = @_;
+ return $class->new($tester, url_in => $in, url_out => $out);
+ };
+
+ push @tests, $mt->($op_base."/1.1/identity/will-sign", $op_base."/1.1/identity/will-sign");
+ push @tests, $mt->($op_base_bare."/1.1/identity/will-sign", $op_base."/1.1/identity/will-sign");
+ push @tests, $mt->($op_base."/1.1/identity/will-sign/", $op_base."/1.1/identity/will-sign/");
+ push @tests, $mt->($op_base_bare."/1.1/identity/will-sign/", $op_base."/1.1/identity/will-sign/");
+ push @tests, $mt->($op_base."/1.1/identity/will-sign/redirect", $op_base."/1.1/identity/will-sign");
+ push @tests,
$mt->($op_base_bare."/1.1/identity/will-sign/redirect", $op_base."/1.1/identity/will-sign");
+
+ # FIXME: How can we test just a bare hostname here?
+
+ return @tests;
+}
+
+sub init {
+ my ($self, %args) = @_;
+ $self->{url_in} = $args{url_in};
+ $self->{url_out} = $args{url_out};
+}
+
+sub des {
+ "Tests the consumer's URL canonicalization";
+}
+
+sub summary {
+ my $self = shift;
+ return $self->{url_in};
+}
+
+sub run {
+ my $self = shift;
+
+ my $rp_base = $self->tester->rp_base;
+
+ my $check_url = $self->gen_url(
+ $rp_base . "/1.1/rp",
+ openid_identifier => $self->{url_in},
+ op => 'disco',
+ );
+ $self->status("Fetching URL: $check_url");
+ my $ua = $self->tester->ua;
+ my $res = $ua->get($check_url);
+ die "Response not successful: " . $res->status_line unless $res->is_success;
+
+ my $content = $res->content;
+ my %result = ();
+ foreach my $l (split(/\n/, $content)) {
+ $l =~ s/#.*$//g;
+ $l =~ s/\s*$//g;
+ my ($k, $v) = split(/\s*:\s*/, $l, 2);
+ $result{$k} = $v;
+ }
+
+ my $result_url = $result{user_specified_url};
+
+ return $result_url eq $self->{url_out} ? 1 : die "Got $result_url
while expecting $self->{url_out}";
+
+}
+
+1;
Modified: trunk/tester/run-tests
==============================================================================
--- trunk/tester/run-tests (original)
+++ trunk/tester/run-tests Sat May 17 13:22:46 2008
@@ -42,6 +42,7 @@
my @test_classes = qw(OPCaps
RPCaps
+ Canonicalize
Discovery
CheckID
);