Net::IMAP::Server::Connection - Connection to a client

package Net::IMAP::Server::Connection;

use warnings;
use strict;

use base 'Class::Accessor';

use Coro;
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
       )
);

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;
}

sub auth {
    my $self = shift;
    if (@_) {
        $self->{auth} = shift;
        $self->server->model_class->require || $self->log(1, $@);
        $self->update_timer;
        $self->model(
            $self->server->model_class->new( { auth => $self->{auth} } ) );
    }
    return $self->{auth};
}

sub client_id {
    my $self = shift;
    if (@_ > 1) {
        $self->{client} = {%{$self->{client} || {}}, @_};
    }
    return $self->{client} || {};
}

sub selected {
    my $self = shift;
    my ($mailbox, $read_only) = @_;

    # This is just being called as a getter
    return $self->_selected unless @_;

    # This is a setter, but isn't actually changing the mailbox, nor
    # changing the read-only-ness.
    return $self->_selected if ($mailbox || "") eq ($self->_selected || "")
        and ($self->selected_read_only || 0) == ($read_only || 0);

    # Otherwise, flush any untagged messages, close the old, and open
    # the new.
    $self->send_untagged;
    $self->_selected->close if $self->_selected;
    $self->_selected( $mailbox );
    if ($self->_selected) {
        $self->selected_read_only( $read_only );
        $self->_selected->select;
    }

    return $self->_selected;
}

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

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 )
            {
                $self->out(
                    "* BYE Don't noodle around so much before logging in!");
                last;
            }
            $self->update_timer;
            cede;
        }

        $self->log( 4,
            "-(@{[$self]},@{[$self->auth ? $self->auth->user : '???']},@{[$self->is_selected ? $self->selected->full_path : 'unselected']}): Connection closed by remote host"
        );
    };
    my $err = $@;
    $self->log(1, $err)
        if $err and not( $err eq "Error printing\n" or $err eq "Timeout\n" );
    eval { $self->out("* BYE Idle timeout; I fell asleep.") if $err eq "Timeout\n"; };
    $self->close;
}

sub update_timer {
    my $self = shift;
    $self->timer->stop if $self->timer;
    $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( EV::timer $self->server->unauth_idle, 0, $timeout );
    } elsif ( $self->server->auth_idle ) {
        $self->timer( EV::timer $self->server->auth_idle, 0, $timeout );
    }
}

sub handle_command {
    my $self    = shift;
    my $content = shift;

    my $output = $content;
    $output =~ s/[\r\n]+$//;
    $self->log( 4,
        "C(@{[$self]},@{[$self->auth ? $self->auth->user : '???']},@{[$self->is_selected ? $self->selected->full_path : 'unselected']}): $output"
    );

    if ( $self->pending ) {
        $self->pending->($content);
        return;
    }

    my ( $id, $cmd, $options ) = $self->parse_command($content);
    return unless defined $id;

    my $handler = $self->class_for($cmd)->new(
        {   server      => $self->server,
            connection  => $self,
            options_str => $options,
            command_id  => $id,
            command     => $cmd
        }
    );
    return if $handler->has_literal;

    eval { $handler->run() if $handler->validate; };
    if ( my $error = $@ ) {
        if ($error eq "Timeout\n" or $error eq "Error printing\n") {
            die $error;
        } elsif ($error =~ /^NO (.*)/) {
            $handler->no_command($1);
        } elsif ($error =~ /^BAD (.*)/) {
            $handler->bad_command($1);
        } else {
            $handler->no_command("Server error");
            $self->log(1, $error);
        }
    }
    return $handler;
}

sub class_for {
    my $self = shift;
    my $cmd = shift;
    my $classref = $self->server->command_class;
    my $cmd_class = $classref->{lc $cmd} || $classref->{$cmd} || $classref->{uc $cmd}
         || "Net::IMAP::Server::Command::$cmd";
    my $class_path = $cmd_class;
    $class_path =~ s{::}{/}g;

    $cmd_class->require();
    my $err = $@;
    if ($err and $err !~ /^Can't locate $class_path.pm in \@INC/) {
        $self->log(1, $@);
        $cmd_class = "Net::IMAP::Server::Error";
    }

    return $cmd_class->can('run') ? $cmd_class : "Net::IMAP::Server::Command";
}

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

sub parse_command {
    my $self = shift;
    my $line = shift;
    $line =~ s/[\r\n]+$//;
    my $TAG = qr/([^\(\)\{ \*\%"\\\+}]+)/;
    unless ( $line =~ /^$TAG\s+(\w+)(?:\s+(.+?))?$/ ) {
        if ( $line !~ /^$TAG\s+/ ) {
            $self->out("* BAD Invalid tag");
        } else {
            $self->out("* BAD Null command ('$line')");
        }
        return undef;
    }

    my $id   = $1;
    my $cmd  = $2;
    my $args = $3 || '';
    $cmd = ucfirst( lc($cmd) );
    return ( $id, $cmd, $args );
}

sub is_unauth {
    my $self = shift;
    return not defined $self->auth;
}

sub is_auth {
    my $self = shift;
    return defined $self->auth;
}

sub is_selected {
    my $self = shift;
    return defined $self->selected;
}

sub is_encrypted {
    my $self   = shift;
    return $self->io_handle->is_ssl;
}

sub poll {
    my $self = shift;
    $self->selected->poll;
    $self->last_poll(time);
}

sub force_poll {
    my $self = shift;
    $self->last_poll(0);
}

sub send_untagged {
    my $self = shift;
    my %args = (
        expunged => 1,
        @_
    );
    return unless $self->is_auth and $self->is_selected;

    if ( time >= $self->last_poll + $self->server->poll_every ) {
        # We record that we're in a poll so that EXPUNGE knows that
        # this connection should get a temporary message store if need
        # be.
        $self->in_poll(1);
        $self->poll;
        $self->in_poll(0);
    }

    for my $s ( keys %{ $self->_unsent_fetch } ) {
        my ($m) = $self->get_messages($s);
        $self->untagged_response(
                  $s 
                . " FETCH "
                . Net::IMAP::Server::Command->data_out(
                [ $m->fetch( [ keys %{ $self->_unsent_fetch->{$s} } ] ) ]
                )
        );
    }
    $self->_unsent_fetch( {} );

    if ( $args{expunged} ) {

# Make sure that they know of at least the existence of what's being expunged.
        my $max = 0;
        $max = $max < $_ ? $_ : $max for @{ $self->_unsent_expunge };
        $self->untagged_response("$max EXISTS")
            if $max > $self->previous_exists;

        # Send the expunges, clear out the temporary message store
        $self->previous_exists(
            $self->previous_exists - @{ $self->_unsent_expunge } );
        $self->untagged_response( map {"$_ EXPUNGE"}
                @{ $self->_unsent_expunge } );
        $self->_unsent_expunge( [] );
        $self->temporary_messages(undef);
    }

    # Let them know of more EXISTS
    my $expected = $self->previous_exists;
    my $now = @{ $self->temporary_messages || $self->selected->messages };
    $self->untagged_response( $now . ' EXISTS' ) if $expected != $now;
    $self->previous_exists($now);
}

sub get_messages {
    my $self = shift;
    my $str  = shift;

    my $messages = $self->temporary_messages || $self->selected->messages;

    my %ids;
    for ( split ',', $str ) {
        if (/^(\d+):(\d+)$/) {
            $ids{$_}++ for $2 > $1 ? $1 .. $2 : $2 .. $1;
        } elsif ( /^(\d+):\*$/ or /^\*:(\d+)$/ ) {
            $ids{$_}++ for @{$messages} + 0, $1 .. @{$messages} + 0;
        } elsif (/^(\d+)$/) {
            $ids{$1}++;
        } elsif (/^\*$/) {
            $ids{ @{$messages} + 0 }++;
        }
    }
    return grep {defined}
        map { $messages->[ $_ - 1 ] } sort { $a <=> $b } keys %ids;
}

sub sequence {
    my $self    = shift;
    my $message = shift;

    return $message->sequence unless $self->temporary_messages;
    return $self->temporary_sequence_map->{$message};
}

sub capability {
    my $self = shift;

    my $base = $self->server->capability;
    if ( $self->is_encrypted ) {
        my $auth = $self->auth || $self->server->auth_class->new;
        $base = join( " ",
            grep { $_ ne "STARTTLS" } split( ' ', $base ),
            map {"AUTH=$_"} $auth->sasl_provides );
    } else {
        $base = "$base LOGINDISABLED";
    }

    return $base;
}

sub log {
    my $self = shift;
    $self->server->log(@_);
}

sub untagged_response {
    my $self = shift;
    $self->out("* $_") for grep defined, @_;
}

sub out {
    my $self = shift;
    my $msg  = shift;
    if ( $self->io_handle and $self->io_handle->peerport ) {
        if ( $self->io_handle->print( $msg . "\r\n" ) ) {
            $self->log( 4,
                "S(@{[$self]},@{[$self->auth ? $self->auth->user : '???']},@{[$self->is_selected ? $self->selected->full_path : 'unselected']}): $msg"
            );
        } else {
            $self->close;
            die "Error printing\n";
        }
    } else {
        $self->close;
        die "Error printing\n";
    }
}

1;