Net-IMAP-Server

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

 - Add missing Net::SSLeay dep

0.5 2008-04-25T12:18:17Z
 - Add 'use Coro's for the places I added 'cede's
 - Module::Install version bump

0.4 2008-04-23T15:24:22Z
 - Weaken the timeout callback, so we don't leak connection objects
 - Don't double-store refs to connections
 - Actually clean out old keys in the connection hash
 - Try to print from the right coro, so EV doesn't complain about recursive
   entry, and then wedge the next time it happens.
 - Drop some more 'cede's in for commands which do many things

0.3 2008-03-11T12:33:14Z
 - Connections weren't being fully closed on timeout

0.2 2008-03-10T16:47:52Z
 - Initial release to CPAN

README  view on Meta::CPAN

  DESTROY
    On destruction, ensure that we close all client connections and
    listening sockets.

  connections
    Returns an arrayref of Net::IMAP::Server::Connection objects which are
    currently connected to the server.

  connection
    Returns the currently active Net::IMAP::Server::Connection object, if
    there is one. This is determined by examining the current coroutine.

  concurrent_mailbox_connections [MAILBOX]
    This can be called as either a class method or an instance method; it
    returns the set of connections which are concurrently connected to the
    given mailbox object (which defaults to the current connection's
    selected mailbox)

  concurrent_user_connections [USER]
    This can be called as either a class method or an instance method; it
    returns the set of connections whose "user" in

lib/Net/IMAP/Server.pm  view on Meta::CPAN

sub connections {
    my $self = shift;
    return [ values %{$self->{connection}} ];
}

=head2 connection

Returns the currently active L<Net::IMAP::Server::Connection> object,
if there is one.  This is determined by examining the current
coroutine.

=cut

sub connection {
    my $class = shift;
    my $self  = ref $class ? $class : $Net::IMAP::Server::Server;
    if (@_) {
        if (defined $_[0]) {
            $self->{connection}{$Coro::current . ""} = shift;
        } else {

lib/Net/IMAP/Server/Connection.pm  view on Meta::CPAN

use base 'Class::Accessor';

use Coro;
use AnyEvent;
use Scalar::Util qw/weaken/;

use Net::IMAP::Server::Error;
use Net::IMAP::Server::Command;

__PACKAGE__->mk_accessors(
    qw(server coro io_handle model auth
       timer commands pending
       selected_read_only
       _selected

       temporary_messages temporary_sequence_map
       ignore_flags
       _session_flags

       last_poll previous_exists in_poll
       _unsent_expunge _unsent_fetch

lib/Net/IMAP/Server/Connection.pm  view on Meta::CPAN

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(
        {   @_,
            state           => "unauth",
            _unsent_expunge => [],
            _unsent_fetch   => {},
            last_poll       => time,
            commands        => 0,
            coro            => $Coro::current,
            _session_flags  => {},
        }
    );
    $self->update_timer;
    return $self;
}

=head2 server

Returns the L<Net::IMAP::Server> that this connection is on.

=head2 coro

Returns the L<Coro> process associated with this connection.  For
things interacting with this connection, it will probably be the
current coroutine, except for interactions coming from event loops.

=head2 io_handle

Returns the IO handle that can be used to read from or write to the
client.

=head2 model

Gets or sets the L<Net::IMAP::Server::DefaultModel> or descendant
associated with this connection.  Note that connections which have not

lib/Net/IMAP/Server/Connection.pm  view on Meta::CPAN

=cut

sub greeting {
    my $self = shift;
    $self->untagged_response('OK IMAP4rev1 Server');
}

=head2 handle_lines

The main line handling loop.  Since we are using L<Coro>, this cedes
to other coroutines whenever we block, given them a chance to run.  We
additionally cede after handling every command.

=cut

sub handle_lines {
    my $self = shift;
    $self->coro->prio(-4);

    eval {
        $self->greeting;
        while ( $self->io_handle and $_ = $self->io_handle->getline() ) {
            $self->handle_command($_);
            $self->commands( $self->commands + 1 );
            if (    $self->is_unauth
                and $self->server->unauth_commands
                and $self->commands >= $self->server->unauth_commands )
            {

lib/Net/IMAP/Server/Connection.pm  view on Meta::CPAN

Updates the inactivity timer.

=cut

sub update_timer {
    my $self = shift;
    $self->timer(undef);
    my $weakself = $self;
    weaken($weakself);
    my $timeout = sub {
        $weakself->coro->throw("Timeout\n");
        $weakself->coro->ready;
    };
    if ( $self->is_unauth and $self->server->unauth_idle ) {
        $self->timer( AnyEvent->timer( after => $self->server->unauth_idle, cb => $timeout ) );
    } elsif ( $self->server->auth_idle ) {
        $self->timer( AnyEvent->timer( after => $self->server->auth_idle, cb => $timeout ) );
    }
}

=head2 timer [AnyEvent watcher]

lib/Net/IMAP/Server/Connection.pm  view on Meta::CPAN

sub close {
    my $self = shift;
    if ( $self->io_handle ) {
        $self->io_handle->close;
        $self->io_handle(undef);
    }
    $self->timer( undef )  if $self->timer;
    $self->selected->close if $self->selected;
    $self->model->close    if $self->model;
    $self->server->connection(undef) if $self->server;
    $self->coro(undef);
}

=head2 parse_command LINE

Parses the line into the C<tag>, C<command>, and C<options>.  Returns
undef if parsing fails for some reason.

=cut

sub parse_command {