Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
added experimental TLS certificate authority support to Mojo::UserAgent
  • Loading branch information
kraih committed Feb 5, 2012
1 parent 63b6731 commit 45e05c9
Show file tree
Hide file tree
Showing 8 changed files with 189 additions and 69 deletions.
2 changes: 2 additions & 0 deletions Changes
Expand Up @@ -4,10 +4,12 @@ This file documents the revision history for Perl extension Mojolicious.
- Deprecated Mojo::Server::Daemon->prepare_ioloop in favor of
Mojo::Server::Daemon->start.
- Deprecated Mojo::Headers->x_forwarded_for.
- Added EXPERIMENTAL ca attribute to Mojo::UserAgent.
- Added EXPERIMENTAL drain event to Mojo::Content.
- Added EXPERIMENTAL drain event to Mojo::Transaction::WebSocket.
- Added EXPERIMENTAL support for RSV1-3 flags to
Mojo::Transaction::WebSocket.
- Added EXPERIMENTAL tls_ca option to Mojo::IOLoop::Client->connect.
- Added lock_timeout parameter to Hypnotoad.
- Removed experimental status from JSON Pointer support.
- Removed Cygwin exception from Hypnotoad.
Expand Down
12 changes: 9 additions & 3 deletions lib/Mojo/IOLoop/Client.pm
Expand Up @@ -94,9 +94,11 @@ sub _connect {
close delete $self->{handle};
$self->emit_safe(error => $_[1]);
},
SSL_cert_file => $args->{tls_cert},
SSL_key_file => $args->{tls_key},
SSL_verify_mode => 0x00
SSL_cert_file => $args->{tls_cert},
SSL_key_file => $args->{tls_key},
SSL_ca_file => $args->{tls_ca}
&& -T $args->{tls_ca} ? $args->{tls_ca} : undef,
SSL_verify_mode => $args->{tls_ca} ? 0x01 : 0x00
);
$self->{tls} = 1;
return $self->emit_safe(error => 'TLS upgrade failed.')
Expand Down Expand Up @@ -239,6 +241,10 @@ getting canceled.
Enable TLS.
=item C<tls_ca>
Path to TLS certificate authority file.
=item C<tls_cert>
Path to the TLS certificate file.
Expand Down
10 changes: 5 additions & 5 deletions lib/Mojo/IOLoop/Server.pm
Expand Up @@ -193,7 +193,7 @@ sub _accept {
$self->iowatcher->drop($handle);
close $handle;
};
$handle = IO::Socket::SSL->start_SSL($handle, %$tls);
return unless $handle = IO::Socket::SSL->start_SSL($handle, %$tls);
$self->iowatcher->io($handle => sub { $self->_tls($handle) });
$self->{handles}->{$handle} = $handle;
}
Expand Down Expand Up @@ -342,6 +342,10 @@ Port to listen on.
Enable TLS.
=item C<tls_ca>
Path to TLS certificate authority file.
=item C<tls_cert>
Path to the TLS cert file, defaulting to a built-in test certificate.
Expand All @@ -350,10 +354,6 @@ Path to the TLS cert file, defaulting to a built-in test certificate.
Path to the TLS key file, defaulting to a built-in test key.
=item C<tls_ca>
Path to TLS certificate authority file.
=back
=head2 C<generate_port>
Expand Down
12 changes: 12 additions & 0 deletions lib/Mojo/UserAgent.pm
Expand Up @@ -13,6 +13,7 @@ use Scalar::Util 'weaken';
use constant DEBUG => $ENV{MOJO_USERAGENT_DEBUG} || 0;

# "You can't let a single bad experience scare you away from drugs."
has ca => sub { $ENV{MOJO_CA_FILE} };
has cert => sub { $ENV{MOJO_CERT_FILE} };
has connect_timeout => 3;
has cookie_jar => sub { Mojo::CookieJar->new };
Expand Down Expand Up @@ -218,6 +219,7 @@ sub _connect {
local_address => $self->local_address,
timeout => $self->connect_timeout,
tls => $scheme eq 'https' ? 1 : 0,
tls_ca => $self->ca,
tls_cert => $self->cert,
tls_key => $self->key,
sub {
Expand Down Expand Up @@ -260,6 +262,7 @@ sub _connect_proxy {
handle => $handle,
id => $id,
tls => 1,
tls_ca => $self->ca,
tls_cert => $self->cert,
tls_key => $self->key,
sub {
Expand Down Expand Up @@ -667,6 +670,15 @@ automatically prepared proxy C<CONNECT> requests and followed redirects.
L<Mojo::UserAgent> implements the following attributes.
=head2 C<ca>
my $ca = $ua->ca;
$ua = $ua->ca('ca.crt');
Path to TLS certificate authority file, defaults to the value of the
C<MOJO_CA_FILE> environment variable. Note that this attribute is
EXPERIMENTAL and might change without warning!
=head2 C<cert>
my $cert = $ua->cert;
Expand Down
12 changes: 10 additions & 2 deletions lib/Mojolicious/Guides/Cheatsheet.pod
Expand Up @@ -139,9 +139,17 @@ L<Mojo::HelloWorld>.

MOJO_APP=MyApp

=head2 C<MOJO_CA_FILE>

The path to the TLS certificate authority file, should always contain a path
like C</etc/tls/ca.crt>. Note that L<IO::Socket::SSL> must be installed for
TLS support.

MOJO_CA_FILE=/etc/tls/ca.crt

=head2 C<MOJO_CERT_FILE>

The path to the TLS certificate, should always contain a path like
The path to the TLS certificate file, should always contain a path like
C</etc/tls/client.crt>. Note that L<IO::Socket::SSL> must be installed for
TLS support.

Expand Down Expand Up @@ -176,7 +184,7 @@ Alternative L<Mojo::IOWatcher> implementation to try.

=head2 C<MOJO_KEY_FILE>

The path to the TLS key, should always contain a path like
The path to the TLS key file, should always contain a path like
C</etc/tls/client.key>. Note that L<IO::Socket::SSL> must be installed for
TLS support.

Expand Down
109 changes: 99 additions & 10 deletions t/mojo/ioloop_tls.t
Expand Up @@ -32,7 +32,7 @@ plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.37 required for this test!'
unless Mojo::IOLoop::Server::TLS;
plan tests => 16;
plan tests => 27;

# "To the panic room!
# We don't have a panic room.
Expand Down Expand Up @@ -71,9 +71,9 @@ Mojo::IOLoop->drop(Mojo::IOLoop->recurring(0 => sub { $drop++ }));
$loop->server(
port => $port,
tls => 1,
tls_ca => 't/mojo/certs/ca.crt',
tls_cert => 't/mojo/certs/server.crt',
tls_key => 't/mojo/certs/server.key',
tls_ca => 't/mojo/certs/ca.crt',
sub {
my ($loop, $stream) = @_;
$stream->write('test', sub { shift->write('321') });
Expand All @@ -85,7 +85,7 @@ $loop->server(
$stream->timeout('0.5');
}
);
my $id = $loop->client(
$loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/client.crt',
Expand All @@ -110,11 +110,11 @@ ok !$server_error, 'no error';

# Invalid client certificate
my $client_error;
$id = $loop->client(
$loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/badcert.key',
tls_key => 't/mojo/certs/badcert.crt',
tls_cert => 't/mojo/certs/badclient.crt',
tls_key => 't/mojo/certs/badclient.key',
sub { shift; $client_error = shift }
);
$loop->timer(1 => sub { shift->stop });
Expand All @@ -123,30 +123,119 @@ ok $client_error, 'has error';

# Missing client certificate
$server_error = $client_error = '';
$id = $loop->client(
$loop->client(
{port => $port, tls => 1} => sub { shift; $client_error = shift });
$loop->timer(1 => sub { shift->stop });
$loop->start;
ok !$server_error, 'no error';
ok $client_error, 'has error';

# Invalid certificate authority
# Invalid certificate authority (server)
$loop = Mojo::IOLoop->new;
$port = Mojo::IOLoop->generate_port;
$server_error = $client_error = '';
$loop->server(
port => $port,
tls => 1,
tls_ca => 'no cert',
tls_cert => 't/mojo/certs/server.crt',
tls_key => 't/mojo/certs/server.key',
tls_ca => 'no cert',
sub { $server_error = 'connected!' }
);
$id = $loop->client(
$loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/client.crt',
tls_key => 't/mojo/certs/client.key',
sub { shift; $client_error = shift }
);
$loop->timer(1 => sub { shift->stop });
$loop->start;
ok !$server_error, 'no error';
ok $client_error, 'has error';

# Valid client and server certificates
$loop = Mojo::IOLoop->singleton;
$port = Mojo::IOLoop->generate_port;
$server = $client = '';
($running, $timeout, $server_error, $server_close, $client_close) = undef;
$loop->server(
port => $port,
tls => 1,
tls_ca => 't/mojo/certs/ca.crt',
tls_cert => 't/mojo/certs/server.crt',
tls_key => 't/mojo/certs/server.key',
sub {
my ($loop, $stream) = @_;
$stream->write('test', sub { shift->write('321') });
$running = Mojo::IOLoop->is_running;
$stream->on(timeout => sub { $timeout++ });
$stream->on(close => sub { $server_close++ });
$stream->on(error => sub { $server_error = pop });
$stream->on(read => sub { $server .= pop });
$stream->timeout('0.5');
}
);
$loop->client(
port => $port,
tls => 1,
tls_ca => 't/mojo/certs/ca.crt',
tls_cert => 't/mojo/certs/client.crt',
tls_key => 't/mojo/certs/client.key',
sub {
my ($loop, $err, $stream) = @_;
$stream->write('tset', sub { shift->write('123') });
$stream->on(close => sub { $client_close++ });
$stream->on(read => sub { $client .= pop });
}
);
$loop->timer(1 => sub { shift->stop });
$loop->start;
is $server, 'tset123', 'right content';
is $client, 'test321', 'right content';
is $timeout, 1, 'server emitted timeout event once';
is $server_close, 1, 'server emitted close event once';
is $client_close, 1, 'client emitted close event once';
ok $running, 'loop was running';
ok !$server_error, 'no error';

# Invalid server certificate
$loop = Mojo::IOLoop->new;
$port = Mojo::IOLoop->generate_port;
$server_error = $client_error = '';
$loop->server(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/badclient.crt',
tls_key => 't/mojo/certs/badclient.key',
sub { $server_error = 'connected!' }
);
$loop->client(
port => $port,
tls => 1,
tls_ca => 't/mojo/certs/ca.crt',
sub { shift; $client_error = shift }
);
$loop->timer(1 => sub { shift->stop });
$loop->start;
ok !$server_error, 'no error';
ok $client_error, 'has error';

# Invalid certificate authority (client)
$loop = Mojo::IOLoop->new;
$port = Mojo::IOLoop->generate_port;
$server_error = $client_error = '';
$loop->server(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/badclient.crt',
tls_key => 't/mojo/certs/badclient.key',
sub { $server_error = 'connected!' }
);
$loop->client(
port => $port,
tls => 1,
tls_ca => 'no cert',
sub { shift; $client_error = shift }
);
$loop->timer(1 => sub { shift->stop });
Expand Down

2 comments on commit 45e05c9

@tempire
Copy link
Contributor

@tempire tempire commented on 45e05c9 Feb 5, 2012

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Relatively straightforward.

Given that system CAs are used by default, what do you think about providing the peer certificate info in MOJO_USERAGENT_DEBUG output?

@kraih
Copy link
Member Author

@kraih kraih commented on 45e05c9 Feb 5, 2012

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There's now an example in the documentation, lets see how it goes. 5dc2d5f

Please sign in to comment.