view release on metacpan or  search on metacpan

t/lib/Apache2/Controller/Test/OpenIDServer.pm  view on Meta::CPAN

package Apache2::Controller::Test::OpenIDServer;

use strict;
use warnings FATAL => 'all';
use English '-no_match_vars';

use base qw(
    HTTP::Server::Simple::CGI
);

use Net::OpenID::Server;

# try overriding signal handlers
$HTTP::Server::Simple::SIG{ALRM} = sub { 
    my @args = @_;
  # warn "# received timeout alarm, temminating $$\n";
  # warn "# args are (".join(',',@args).")\n";
  # warn "# (caller is ".caller().")\n";
  # die "# terminating on alarm\n";
    exit(0);
};

$HTTP::Server::Simple::SIG{INT} = sub { 
    warn "# caught interrupt, exiting $$ cleanly\n";
    exit(0);
};

use Apache::TestServer;
use Apache::TestRequest;
use Apache2::Controller::Test::Funk qw( diag );
use Apache2::Controller::Test::UnitConf;


use Log::Log4perl qw(:easy);
Log::Log4perl->init(\$L4P_UNIT_CONF);

use YAML::Syck;

# we overload new() so we can auto-detect an available port
sub new {
    my ($class) = @_;

    my $tries = 20;

    my $a2c_test_url = Apache::TestRequest::module2url('');
    diag("a2c_test_url is '$a2c_test_url'");
    my ($port) = $a2c_test_url =~ m{ \A http?://\D*?:(\d+) }mxs;

    my $increment = 0;

    $port += (int(rand(10)) + 1)
        until Apache::TestServer->port_available($port) || !--$tries;

    diag("openid server port is '$port'");
    
    my $server = HTTP::Server::Simple::CGI->new($port);
    bless $server, $class;

    return $server;
}

# we overload run so we can set the appropriate alarm to die
sub run {
    my ($self, @args) = @_;
  # warn "# setting alarm in pid $$ for 45 seconds...\n";
  # warn "# caller is ".caller()."\n";
    alarm(45);
  # warn "# calling super run\n";
    return $self->HTTP::Server::Simple::run(@args);
}

# overload print_banner so it doesn't do anything
sub print_banner {
}

sub handle_request {
    my ($self, $cgi) = @_;
    $self->{cgi} = $cgi;

    my $path = $cgi->path_info();
    DEBUG "handling request for path '$path'";
    return $self->working()  if $path eq '/working';
    return $self->user_url() if $path eq '/a2ctest';

    my $port = $self->port;
    DEBUG "openid server port is '$port'";

    my $nos = Net::OpenID::Server->new(
        get_args        => $cgi,
        post_args       => $cgi,
        get_user        => sub { nos_get_user($cgi, @_)     },
        is_identity     => sub { nos_is_identity($cgi, @_)  },
        is_trusted      => sub { nos_is_trusted($cgi, @_)   },
        setup_url       => "http://localhost:$port/pass-identity",
        server_secret   => q{These blast points, too precise for Sandpeople},
    );

    my ($type, $data);
    eval { ($type, $data) = $nos->handle_page() };
    return $self->die_error($EVAL_ERROR) if $EVAL_ERROR;
    DEBUG "NOS RESULTS: type '$type', data:\n".Dump($data);

    if ($type eq 'redirect') {
        DEBUG "got type redirect, redirecting back to url:\n$data";
        print "HTTP/1.0 302 Found\r\n",
            $cgi->redirect(-uri => $data);
    }
    elsif ($type eq 'setup') {
        $self->die_error("setup unimplemented");
    }
    else {
        print "HTTP/1.0 200 OK\r\n",
        $cgi->header($type),
        $data;
    }
}

sub die_error {
    my ($self, $error_string) = @_;
    DEBUG "dying with error string: '$error_string'";
    my $cgi = $self->{cgi};
    print "HTTP/1.0 500 Internal Server Error\r\n",
        $cgi->header,
        $error_string;
}