view release on metacpan or  search on metacpan

lib/Mail/Transport/POP3.pm  view on Meta::CPAN

# This code is part of Perl distribution Mail-Box-POP3 version 4.02.
# The POD got stripped from this file by OODoc version 3.06.
# For contributors see file ChangeLog.

# This software is copyright (c) 2001-2026 by Mark Overmeer.

# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later


package Mail::Transport::POP3;{
our $VERSION = '4.02';
}

use parent 'Mail::Transport::Receive';

use strict;
use warnings;

use Log::Report  'mail-box-pop3', import => [ qw/error fault __x/ ];

use IO::Socket       ();
use IO::Socket::IP   ();
use IO::Socket::SSL  qw/SSL_VERIFY_NONE/;
use Socket           qw/$CRLF/;
use Digest::MD5      qw/md5_hex/;
use MIME::Base64     qw/encode_base64/;

#--------------------

sub _OK($) { substr(shift // '', 0, 3) eq '+OK' }

sub init($)
{	my ($self, $args) = @_;
	$args->{via}    = 'pop3';
	$args->{port} ||= 110;

	$self->SUPER::init($args) or return;

	$self->{MTP_auth}     = $args->{authenticate} || 'AUTO';
	$self->{MTP_ssl}      = $args->{use_ssl};

	my $opts = $self->{MTP_ssl_opts} = $args->{ssl_options} || {};
	$opts->{verify_hostname} ||= 0;
	$opts->{SSL_verify_mode} ||= SSL_VERIFY_NONE;

	$self->socket or return;   # establish connection
	$self;
}

#--------------------

sub useSSL() { $_[0]->{MTP_ssl} }


sub SSLOptions() { $_[0]->{MTP_ssl_opts} }


sub supportsUIDL() { ! exists $_[0]->{MTP_nouidl} }

#--------------------

sub ids(;@)
{	my $self = shift;
	$self->socket or return;
	wantarray ? @{$self->{MTP_n2uidl}} : $self->{MTP_n2uidl};
}


sub messages()
{	my $self = shift;

	! wantarray
		or error __x"cannot get all messages of pop3 at once via messages().";

	$self->{MTP_messages};
}


sub folderSize() { $_[0]->{MTP_folder_size} }


sub header($;$)
{	my ($self, $uidl, $bodylines) = @_;

lib/Mail/Transport/POP3.pm  view on Meta::CPAN

	if(eval { print $socket @_} )
	{	$response = <$socket>;
		defined $response or fault __x"cannot read POP3 from socket";
	}
	else
	{	error __x"cannot write POP3 to socket: {error}", error => $@;
	}
	$response;
}


sub sendList($$)
{	my ($self, $socket) = (shift, shift);
	my $response = $self->send($socket, @_);
	$response && _OK $response or return;

	my @list;
	while(my $line = <$socket>)
	{	last if $line =~ m#^\.\r?\n#s;
		$line =~ s#^\.##;
		push @list, $line;
	}

	\@list;
}

sub DESTROY()
{	my $self = shift;
	$self->SUPER::DESTROY;
	$self->disconnect if $self->{MTP_socket}; # only when open
}

sub _connection()
{	my $self   = shift;
	my $socket = $self->{MTP_socket} // return;

	# Check if we (still) got a connection
	eval { print $socket "NOOP$CRLF" };
	if($@ || ! <$socket> )
	{	delete $self->{MTP_socket};
		return undef;
	}

	$socket;
}



sub login(;$)
{	my $self = shift;

	# Check if we can make a connection

	my ($host, $port, $username, $password) = $self->remoteHost;
	$username && $password
		or error __x"POP3 requires a username and password.";

	my $socket;
	if($self->useSSL)
	{	my $opts = $self->SSLOptions;
		$socket  = eval { IO::Socket::SSL->new(PeerAddr => "$host:$port", %$opts) };
	}
	else
	{	$socket  = eval { IO::Socket::IP->new("$host:$port") };
	}

	$socket
		or fault __x"cannot connect to {service} for POP3", service => "$host:$port";

	# Check if it looks like a POP server

	my $connected;
	my $authenticate = $self->{MTP_auth};
	my $welcome      = <$socket>;
	_OK $welcome
		or error __x"server at {service} does not seem to be talking POP3.", service => "$host:$port";

	# Check APOP login if automatic or APOP specifically requested
	if($authenticate eq 'AUTO' || $authenticate eq 'APOP')
	{	if($welcome =~ m#^\+OK .*(<\d+\.\d+\@[^>]+>)#)
		{	my $md5      = md5_hex $1.$password;
			my $response = $self->send($socket, "APOP $username $md5$CRLF");
			$connected   = _OK $response;
		}
	}

	# Check USER/PASS login if automatic and failed or LOGIN specifically
	# requested.
	unless($connected)
	{	if($authenticate eq 'AUTO' || $authenticate eq 'LOGIN')
		{	my $response = $self->send($socket, "USER $username$CRLF") or return;

			if(_OK $response)
			{	my $response2 = $self->send($socket, "PASS $password$CRLF") or return;
				$connected = _OK $response2;
			}
		}
	}

	# Try OAUTH2 login
	if(! $connected && $authenticate =~ /^OAUTH2/)
	{	# Borrowed from Net::POP3::XOAuth2 0.0.2 by Kizashi Nagata (also Perl license)
		my $token = encode_base64 "user=$username\001auth=Bearer $password\001\001";
		$token    =~ s/[\r\n]//g;    # no base64 newlines, anywhere

		if($authenticate eq 'OAUTH2_SEP')
		{	# Microsofts way
			# https://learn.microsoft.com/en-us/exchange/client-developer/legacy-protocols/how-to-authenticate-an-imap-pop-smtp-application-by-using-oauth
			my $response = $self->send($socket, "AUTH XOAUTH2$CRLF") or return;

			if($response =~ /^\+/)   # Office365 sends + here, not +OK
			{	my $response2 = $self->send($socket, "$token$CRLF") or return;
				$connected = _OK $response2;
			}
		}
		else
		{	my $response = $self->send($socket, "AUTH XOAUTH2 $token$CRLF") or return;
			$connected = _OK $response;
		}
	}