diff --git a/perl/Net/IMAP/Server.pm b/perl/Net/IMAP/Server.pm
index e582557..80450c8 100644
--- a/perl/Net/IMAP/Server.pm
+++ b/perl/Net/IMAP/Server.pm
@@ -38,7 +38,8 @@ Note that, following RFC suggestions, login is not allowed except
under a either SSL or TLS. Thus, you are required to have a F
directory under the current working directory, containing files
F and C. Failure to do so will cause
-the server to fail to start.
+the server to fail to start. Note that if the default paths suit your
+needs, you can specify different ones.
=head1 INTERFACE
@@ -61,6 +62,7 @@ __PACKAGE__->mk_accessors(
user group
poll_every
unauth_idle auth_idle unauth_commands
+ server_cert server_key
/
);
@@ -132,16 +134,22 @@ How long, in seconds, to wait before disconnecting authenticated
connections. By RFC specification, this B be longer than 30
minutes. The default is an hour; set to zero to disable.
+=item server_cert
+
+Path to the SSL certificate that the server should use. This can be
+either relative or absolute path.
+
+=item server_key
+
+Path to the SSL certificate key that the server should use. This can be
+either relative or absolute path.
+
=back
=cut
sub new {
my $class = shift;
- unless ( -r "certs/server-cert.pem" and -r "certs/server-key.pem" ) {
- die
- "Can't read certs (certs/server-cert.pem and certs/server-key.pem)\n";
- }
my $self = Class::Accessor::new(
$class,
@@ -154,11 +162,20 @@ sub new {
unauth_idle => 5*60,
auth_idle => 60*60,
unauth_commands => 10,
+ server_cert => "certs/server-cert.pem",
+ server_key => "certs/server-key.pem",
@_,
command_class => {},
connection => {},
}
);
+ unless ( -r $self->server_key and -r $self->server_cert ) {
+ my $server_cert = $self->server_cert;
+ my $server_key = $self->server_key;
+ die
+ "Can't read certificates ($server_cert and $server_key)\n";
+ }
+
UNIVERSAL::require( $self->auth_class )
or die "Can't require auth class: $@\n";
$self->auth_class->isa("Net::IMAP::Server::DefaultAuth")
diff --git a/perl/Net/IMAP/Server/Command/Starttls.pm b/perl/Net/IMAP/Server/Command/Starttls.pm
index 0200834..4378ad5 100644
--- a/perl/Net/IMAP/Server/Command/Starttls.pm
+++ b/perl/Net/IMAP/Server/Command/Starttls.pm
@@ -23,13 +23,13 @@ sub validate {
sub run {
my $self = shift;
- unless (-r "certs/server-cert.pem" and -r "certs/server-key.pem") {
+ unless (-r $self->server->server_cert and -r $self->server->server_key) {
return $self->bad_command("Server error");
}
$self->ok_completed;
- $self->connection->io_handle->start_SSL;
+ $self->connection->io_handle->start_SSL();
}
1;