view release on metacpan or  search on metacpan

lib/Mail/IMAPTalk.pm  view on Meta::CPAN

Connected, logged in and have 'select'ed a current folder.

=back

=cut

# Constants for the possible states the connection can be in {{{
# Object not connected
use constant Unconnected => 0;
# connected; not logged in
use constant Connected => 1;
# logged in; no mailbox selected
use constant Authenticated => 2;
# mailbox selected
use constant Selected => 3;

# What a link break is on the network connection
use constant LB => "\015\012";
use constant LBLEN => length(LB);

# Regexps used to determine if header is MIME encoded (we remove . from
#  especials because of dumb ANSI_X3.4-1968 encoding)
my $RFC2047Token = qr/[^\x00-\x1f\(\)\<\>\@\,\;\:\"\/\[\]\?\=\ ]+/;
my $RFC2047Encoded = qr/=\?$RFC2047Token\?$RFC2047Token\?[^\?]*\?=/;
my $NonAsciiData = qr/[\x1b\x80-\xff]/; # Anything with high-bits or ESC

# Known untagged responses
my %UntaggedResponses = map { $_ => 1 } qw(exists expunge recent);

# Default responses
my %RespDefaults = ('annotation' => 'hash', 'metadata' => 'hash', 'fetch' => 'hash', 'list' => 'array', 'lsub' => 'array', 'sort' => 'array', 'search' => 'array');

# }}}

=head1 CONSTRUCTOR

=over 4

=cut

=item I<Mail::IMAPTalk-E<gt>new(%Options)>

Creates new Mail::IMAPTalk object. The following options are supported.

=item B<Connection Options>

=over 4

=item B<Server>

The hostname or IP address to connect to. This must be supplied unless
the B<Socket> option is supplied.

=item B<Port>

The port number on the host to connect to. Defaults to 143 if not supplied
or 993 if not supplied and UseSSL is true.

=item B<UseSSL>

If true, use an IO::Socket::SSL connection. All other SSL_* arguments
are passed to the IO::Socket::SSL constructor.

=item B<Socket>

An existing socket to use as the connection to the IMAP server. If you
supply the B<Socket> option, you should not supply a B<Server> or B<Port>
option.

This is useful if you want to create an SSL socket connection using
IO::Socket::SSL and then pass in the connected socket to the new() call.

It's also useful in conjunction with the C<release_socket()> method
described below for reusing the same socket beyond the lifetime of the IMAPTalk
object. See a description in the section C<release_socket()> method for
more information.

You must have write flushing enabled for any
socket you pass in here so that commands will actually be sent,
and responses received, rather than just waiting and eventually
timing out. you can do this using the Perl C<select()> call and
$| ($AUTOFLUSH) variable as shown below.

  my $ofh = select($Socket); $| = 1; select ($ofh);

=item B<UseBlocking>

For historical reasons, when reading from a socket, the module
sets the socket to non-blocking and does a select(). If you're
using an SSL socket that doesn't work, so you have to set
UseBlocking to true to use blocking reads instead.

=item B<State>

If you supply a C<Socket> option, you can specify the IMAP state the
socket is currently in, namely one of 'Unconnected', 'Connected',
'Authenticated' or 'Selected'. This defaults to 'Connected' if not
supplied and the C<Socket> option is supplied.

=item B<ExpectGreeting>

If supplied and true, and a socket is supplied via the C<Socket>
option, checks that a greeting line is supplied by the server
and reads the greeting line.

=item B<PreserveINBOX>

For historical reasons, the special name "INBOX" is rewritten as
Inbox because it looks nicer on the way out, and back on the way
in.  If you want to preserve the name INBOX on the outside, set
this flag to true.

=item B<UseCompress>

If you have the Compress::Zlib package installed, and the server
supports compress, then setting this flag to true will cause
compression to be enabled immediately after login.

=back

=item B<Login Options>

=over 4

=item B<Username>

The username to connect to the IMAP server as. If not supplied, no login
is attempted and the IMAP object is left in the B<CONNECTED> state.
If supplied, you must also supply the B<Password> option and a login
is attempted. If the login fails, the connection is closed and B<undef>
is returned. If you want to do something with a connection even if the

lib/Mail/IMAPTalk.pm  view on Meta::CPAN

=item B<NoLiteralPlus>

If set, this avoids ever sending literal+ non-synchronising literals.
The default is off (false value).  Use this if you're dealing with a
buggy server that doesn't handle literal+ correctly.  Also turns off
RFC7888 "literal-" support.

=back

Examples:

  $imap = Mail::IMAPTalk->new(
    Server          => 'foo.com',
    Port            => 143,
    Username        => 'joebloggs',
    Password        => 'mypassword',
    Separator       => '.',
    RootFolder      => 'INBOX',
  ) || die "Connection to foo.com failed. Reason: $@";

  $imap = Mail::IMAPTalk->new(
    Socket => $SSLSocket,
    State  => Mail::IMAPTalk::Authenticated,
    Uid    => 0
  ) || die "Could not query on existing socket. Reason: $@";

=cut
sub new {
  my $Proto = shift;
  my $Class = ref($Proto) || $Proto;
  my %Args = @_;

  # Two main possible new() modes. Either connect to server
  #   or use existing socket passed
  $Args{Server} || $Args{Socket}
    || die "No 'Server' or 'Socket' specified";
  $Args{Server} && $Args{Socket}
    && die "Can not specify 'Server' and 'Socket' simultaneously";

  # Set ourself to empty to start with
  my $Self = {};
  bless ($Self, $Class);

  # Empty buffer
  $Self->{ReadBuf} = '';

  # Create new socket to server
  my $Socket;
  if ($Args{Server}) {

    # Set starting state
    $Self->state(Unconnected);

    my %SocketOpts;
    my $DefaultPort = 143;
    my $SocketClass = $DefSocketClass;

    my $SSLOpt = $Args{UseSSL};
    if ($SSLOpt) {
      my $SSLUse = $SSLOpt eq '1' ? '' : " qw($SSLOpt)";
      eval "use IO::Socket::SSL$SSLUse; 1;" || return undef;
      $SocketClass = "IO::Socket::SSL";
      $DefaultPort = 993;
      $SocketOpts{$_} = $Args{$_} for grep { /^SSL_/ } keys %Args;
    }

    $SocketOpts{PeerHost} = $Self->{Server} = $Args{Server} || die "No Server name given";
    $SocketOpts{PeerPort} = $Self->{Port} = $Args{Port} || $DefaultPort;

    # Clear any errors before creating the socket
    $! = 0;
    $@ = "";

    $Socket = ($Args{NewSocketCB} || sub { shift->new(@_) })->($SocketClass, %SocketOpts);
    if (!$Socket) {
      # Divine error from system level IO::Socket ($!), IO::Socket::Paranoid ($@) or SSL level IO::Socket::SSL.
      my $Err = $! || $@ || ($SSLOpt ? IO::Socket::SSL::errstr() : "") || "Unknown";
      $! = 0; # Clear so only $@ is set
      $@ = "IMAPTalk: socket connection failed - $Err";
      return undef;
    }

    # Force flushing after every write to the socket
    my $ofh = select($Socket); $| = 1; select ($ofh);

    # Set to connected state
    $Self->state(Connected);
  }

  # We have an existing socket
  else {
    # Copy socket
    $Socket = $Args{Socket};
    delete $Args{Socket};

    # Set state
    $Self->state(exists $Args{State} ? $Args{State} : Connected);
  }

  $Self->{Socket} = $Socket;

  # Save socket for later use and create IO::Select
  $Self->{Select} = IO::Select->new();
  $Self->{Select}->add($Socket);
  $Self->{LocalFD} = fileno($Socket);
  $Self->{UseBlocking} = $Args{UseBlocking};
  $Self->{Pedantic} = $Args{Pedantic};
  $Self->{PreserveINBOX} = $Args{PreserveINBOX};
  $Self->{UseCompress} = $Args{UseCompress};
  $Self->{NoLiteralPlus} = $Args{NoLiteralPlus};

  # Do this now, so we trace greeting line as well
  $Self->set_tracing($AlwaysTrace);

  # Process greeting
  if ($Args{Server} || $Args{ExpectGreeting}) {
    $Self->{CmdId} = "*";
    my ($CompletionResp, $DataResp) = $Self->_parse_response('');
    if ($CompletionResp !~ /^ok/i) {
      $@ = "IMAPTalk: Unexpected greeting line: $CompletionResp";
      return undef;
    }

    # At this point, the cached "remainder" should be the banner greeting.  We'll
    # save this into the ServerGreeting cache entry so we can refer to it later,
    # if we want to.  This is fairly fragile, so may need reworking later.
    # -- rjbs, 2023-08-11
    $Self->{Cache}{ServerGreeting} = $Self->{Cache}{remainder};
  }

  # Start counter when sending commands
  $Self->{CmdId} = 1;

  # Set base modes
  $Self->uid(exists($Args{Uid}) ? $Args{Uid} : 1);
  $Self->parse_mode(Envelope => 1, BodyStructure => 1, Annotation => 1);
  $Self->{CurrentFolder} = '';