From df3923706db0a920e652f8f16b00372a225e7f35 Mon Sep 17 00:00:00 2001
From: Jozef Kutej <jozef@kutej.net>
Date: Mon, 1 Dec 2008 23:38:13 +0100
Subject: server certificate validation

---
 lib/PAUSE/OpenID/Controller/Root.pm | 11 ++++++++++-
 pause_openid.pl                     |  4 ++++
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/lib/PAUSE/OpenID/Controller/Root.pm b/lib/PAUSE/OpenID/Controller/Root.pm
index 566a0a1..275bff8 100644
--- a/lib/PAUSE/OpenID/Controller/Root.pm
+++ b/lib/PAUSE/OpenID/Controller/Root.pm
@@ -71,8 +71,14 @@ sub login :Local {
     $c->log->debug('username "'.$username.'" login attempt');
     
     my $ua = LWP::UserAgent->new;
+    my $req = HTTP::Request->new(GET => 'https://pause.perl.org/pause/authenquery');
+    $req->header('If-SSL-Cert-Subject' => '/CN=pause.perl.org');
+    local $ENV{HTTPS_CA_DIR} = $c->config->{'ssl'}->{'ca_dir'};
     $ua->credentials('pause.perl.org:443', 'PAUSE', $username, $password);
-    my $res = $ua->get('https://pause.perl.org/pause/authenquery');
+    my $res = $ua->request($req);
+    
+    die 'pause server certificate validation failed'
+        if exists $res->headers->{'client-ssl-warning'};
     
     if ($res->code == 200) {
         $c->log->info('login pass');
@@ -80,6 +86,9 @@ sub login :Local {
     }
     else {
         $c->log->warn('login failed');
+        use Data::Dumper;
+        die Dumper($res);
+        
         $c->res->redirect($c->uri_for('/login_failed'));
     }
 }
diff --git a/pause_openid.pl b/pause_openid.pl
index f480b77..7fae2ea 100644
--- a/pause_openid.pl
+++ b/pause_openid.pl
@@ -25,5 +25,9 @@ return {
     'PAUSE::OpenID'=>{
         hostname=>'id.pause.org',
     },
+    
+    'ssl' => {
+        'ca_dir' => '/etc/ssl/certs/',
+    }
 
 };
-- 
cgit v1.2.3