[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