[Bps-public-commit] r10492 - in Net-IMAP-Server: lib/Net/IMAP lib/Net/IMAP/Server lib/Net/IMAP/Server/Command
alexmv at bestpractical.com
alexmv at bestpractical.com
Thu Jan 24 20:20:45 EST 2008
Author: alexmv
Date: Thu Jan 24 20:20:44 2008
New Revision: 10492
Modified:
Net-IMAP-Server/ (props changed)
Net-IMAP-Server/lib/Net/IMAP/Server.pm
Net-IMAP-Server/lib/Net/IMAP/Server/Command/Starttls.pm
Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm
Log:
r27196 at zoq-fot-pik: chmrr | 2008-01-24 20:20:15 -0500
* Fixes for selecing your current mailbox
Modified: Net-IMAP-Server/lib/Net/IMAP/Server.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server.pm (original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server.pm Thu Jan 24 20:20:44 2008
@@ -15,12 +15,98 @@
our $VERSION = '0.001';
+
+=head1 NAME
+
+Net::IMAP::Server - A single-threaded multiplexing IMAP server
+implementation, using L<Net::Server::Coro>.
+
+=head1 SYNOPSIS
+
+ use Net::IMAP::Server;
+ Net::IMAP::Server->new(
+ port => 193,
+ ssl_port => 993,
+ auth_class => "Your::Auth::Class",
+ model_class => "Your::Model::Class",
+ )->run;
+
+=head1 DESCRIPTION
+
+This model provides a complete implementation of the C<RFC 3501>
+specification, along with several IMAP4rev1 extensions. It provides
+separation of the mailbox and message store from the client
+interaction loop.
+
+Note that, following RFC suggestions, login is not allowed except
+under a either SSL or TLS. Thus, you are required to have a F<certs/>
+directory under the current working directory, containing files
+F<server-cert.pem> and C<server-key.pem>. Failure to do so will cause
+the server to fail to start.
+
+=head1 INTERFACE
+
+The primary method of using this module is to supply your own model
+and auth classes, which inherit from
+L<Net::IMAP::Server::DefaultModel> and
+L<Net::IMAP::Server::DefaultAuth>. This allows you to back your
+messages from arbitrary data sources, or provide your own
+authorization backend.
+
+=head1 METHODS
+
+=cut
+
__PACKAGE__->mk_accessors(
qw/connections port ssl_port auth_class model_class user group/);
+=head2 new PARAMHASH
+
+Creates a new IMAP server object. This doesn't even bind to the
+sockets; it merely initializes the object. It will C<die> if it
+cannot find the appropriate certificate files. Valid arguments to
+C<new> include:
+
+=over
+
+=item port
+
+The port to bind to. Defaults to port 4242.
+
+=item ssl_port
+
+The port to open an SSL listener on; by default, this is disabled, and
+any true value enables it.
+
+=item auth_class
+
+The name of the class which implements authentication. This must be a
+subclass of L<Net::IMAP::Server::DefaultAuth>.
+
+=item model_class
+
+The name of the class which implements the model backend. This must
+be a subclass of L<Net::IMAP::Server::DefaultModel>.
+
+=item user
+
+The name or ID of the user that the server should run as; this
+defaults to the current user. Note that privileges are dropped after
+binding to the port and reading the certificates, so escalated
+privileges should not be needed. Running as your C<nobody> user or
+equivilent is suggested.
+
+=back
+
+=cut
+
sub new {
my $class = shift;
- return Class::Accessor::new($class,
+ 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,
{ port => 8080,
ssl_port => 0,
auth_class => "Net::IMAP::Server::DefaultAuth",
@@ -29,6 +115,17 @@
connections => [],
}
);
+ UNIVERSAL::require( $self->auth_class )
+ or die "Can't require auth class: $@\n";
+ $self->auth_class->isa("Net::IMAP::Server::DefaultAuth")
+ or die "Auth class (@{[$self->auth_class]}) doesn't inherit from Net::IMAP::Server::DefaultAuth\n";
+
+ UNIVERSAL::require( $self->model_class )
+ or die "Can't require model class: $@\n";
+ $self->model_class->isa("Net::IMAP::Server::DefaultModel")
+ or die "Auth class (@{[$self->model_class]}) doesn't inherit from Net::IMAP::Server::DefaultModel\n";
+
+ return $self;
}
sub run {
@@ -116,126 +213,31 @@
1; # Magic true value required at end of module
__END__
-=head1 NAME
-
-Net::IMAP::Server - [One line description of module's purpose here]
-
-
-=head1 SYNOPSIS
-
- use Net::IMAP::Server;
-
-=for author to fill in:
- Brief code example(s) here showing commonest usage(s).
- This section will be as far as many users bother reading
- so make it as educational and exeplary as possible.
-
-
-=head1 DESCRIPTION
-
-=for author to fill in:
- Write a full description of the module and its features here.
- Use subsections (=head2, =head3) as appropriate.
-
-
-=head1 INTERFACE
-
-=for author to fill in:
- Write a separate section listing the public components of the modules
- interface. These normally consist of either subroutines that may be
- exported, or methods that may be called on objects belonging to the
- classes provided by the module.
-
-
-=head1 DIAGNOSTICS
-
-=for author to fill in:
- List every single error and warning message that the module can
- generate (even the ones that will "never happen"), with a full
- explanation of each problem, one or more likely causes, and any
- suggested remedies.
-
-=over
-
-=item C<< Error message here, perhaps with %s placeholders >>
-
-[Description of error here]
-
-=item C<< Another error message here >>
-
-[Description of error here]
-
-[Et cetera, et cetera]
-
-=back
-
-
-=head1 CONFIGURATION AND ENVIRONMENT
-
-=for author to fill in:
- A full explanation of any configuration system(s) used by the
- module, including the names and locations of any configuration
- files, and the meaning of any environment variables or properties
- that can be set. These descriptions must also include details of any
- configuration language used.
-
-Net::IMAP::Server requires no configuration files or environment variables.
=head1 DEPENDENCIES
-=for author to fill in:
- A list of all the other modules that this module relies upon,
- including any restrictions on versions, and an indication whether
- the module is part of the standard Perl distribution, part of the
- module's distribution, or must be installed separately. ]
-
-None.
-
-
-=head1 INCOMPATIBILITIES
-
-=for author to fill in:
- A list of any modules that this module cannot be used in conjunction
- with. This may be due to name conflicts in the interface, or
- competition for system or program resources, or due to internal
- limitations of Perl (for example, many modules that use source code
- filters are mutually incompatible).
-
-None reported.
-
+L<Coro>, L<Net::Server::Coro>
=head1 BUGS AND LIMITATIONS
-=for author to fill in:
- A list of known problems with the module, together with some
- indication Whether they are likely to be fixed in an upcoming
- release. Also a list of restrictions on the features the module
- does provide: data types that cannot be handled, performance issues
- and the circumstances in which they may arise, practical
- limitations on the size of data sets, special cases that are not
- (yet) handled, etc.
-
No bugs have been reported.
Please report any bugs or feature requests to
C<bug-net-imap-server at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.
-
=head1 AUTHOR
-Jesse Vincent C<< <jesse at bestpractical.com> >>
-
+Alex Vandiver C<< <alexmv at bestpractical.com> >>
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2006, Best Practical Solutions, LLC. All rights reserved.
+Copyright (c) 2008, Best Practical Solutions, LLC. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
-
=head1 DISCLAIMER OF WARRANTY
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Command/Starttls.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Command/Starttls.pm (original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Command/Starttls.pm Thu Jan 24 20:20:44 2008
@@ -25,7 +25,13 @@
sub run {
my $self = shift;
+ unless (-r "certs/server-cert.pem" and -r "certs/server-key.pem") {
+ return $self->bad_command("Server error");
+ }
+
$self->ok_completed;
+
+ require Net::Server::Proto::SSL;
my $handle = $self->connection->io_handle;
$handle = tied(${$handle})->[0];
IO::Socket::SSL->start_SSL( $handle,
Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm (original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm Thu Jan 24 20:20:44 2008
@@ -29,7 +29,7 @@
cede;
}
- $self->log("Connection closed by remote host");
+ $self->log("-(@{[$self]},@{[$self->auth ? $self->auth->user : '???']},@{[$self->is_selected ? $self->selected->full_path : 'unselected']}): Connection closed by remote host");
$self->close;
}
@@ -143,8 +143,10 @@
sub selected {
my $self = shift;
if (@_ and $self->selected) {
- $self->send_untagged;
- $self->selected->close;
+ unless ($self->selected eq $_[0]) {
+ $self->send_untagged;
+ $self->selected->close;
+ }
$self->selected_read_only(0);
}
return $self->_selected(@_);
More information about the Bps-public-commit
mailing list