diff options
Diffstat (limited to 'lib/Config')
-rw-r--r-- | lib/Config/ClawsMail/Account.pm | 48 | ||||
-rw-r--r-- | lib/Config/ClawsMail/Server.pm | 7 |
2 files changed, 53 insertions, 2 deletions
diff --git a/lib/Config/ClawsMail/Account.pm b/lib/Config/ClawsMail/Account.pm index 164af34..5dbee78 100644 --- a/lib/Config/ClawsMail/Account.pm +++ b/lib/Config/ClawsMail/Account.pm @@ -20,6 +20,45 @@ has [qw(imap smtp)] => ( ); my @ssl_string=qw(no ssl starttls); +# these are from src/imap.h +my %imap_auth_method = ( + 1 => 'plaintext', + 2 => 'CRAM_MD5', + 4 => 'ANONYMOUS', + 8 => 'GSSAPI', + 16 => 'DIGEST_MD5', + 32 => 'SCRAM_SHA1', + 64 => 'PLAIN', + 128 => 'LOGIN', + 256 => 'XOAUTH2', + 512 => 'SCRAM_SHA224', + 1024 => 'SCRAM_SHA256', + 2048 => 'SCRAM_SHA384', + 4096 => 'SCRAM_SHA512', +); +# these are from src/common/smtp.h +my %smtp_auth_method = ( + 1 => 'LOGIN', + 2 => 'CRAM_MD5', + 4 => 'DIGEST_MD5', + 8 => 'tls_available', # ?? what does this mean? + 16 => 'PLAIN', + 32 => 'XOAUTH2', +); + +sub _expand_bitfield { + my ($bits, $map) = @_; + + my @result; + for my $key (sort { $a <=> $b } keys %$map) { + if ($bits & $key) { + push @result, $map->{$key}; + } + } + + return \@result; +} + sub new_from_config { my ($class,$args) = @_; @@ -43,6 +82,7 @@ sub new_from_config { ssl => $ssl_string[$config->{ssl_imap}], %{$config}{qw(user_id)}, password => $password_store->password_for($password_section,'recv'), + auth_methods => _expand_bitfield($config->{imap_auth_method},\%imap_auth_method), }); my $smtp_server = Config::ClawsMail::Server->new({ @@ -57,7 +97,8 @@ sub new_from_config { ssl => $ssl_string[$config->{ssl_smtp}], ( $config->{use_smtp_auth} ? ( user_id => $config->{smtp_user_id} || $config->{user_id}, - password => $password_store->password_for($password_section,'send') || $password_store->password_for($password_section,'recv') + password => $password_store->password_for($password_section,'send') || $password_store->password_for($password_section,'recv'), + auth_methods => _expand_bitfield($config->{smtp_auth_method},\%smtp_auth_method), ) : () ), }); @@ -71,6 +112,11 @@ sub new_from_config { sub email_transport { my ($self) = @_; + # once https://github.com/rjbs/Email-Sender/pull/77 gets merged, + # we can use `$smtp->auth_methods` to build a `Authen::SASL` and + # pass it as `sasl_authenticator`, to restrict which mechanism(s) + # should be used; at the same time, we should remove the `sub + # _order` from `Authen::SASL::Perl::XOAUTH2` require Email::Sender::Transport::SMTP; my $smtp = $self->smtp; return Email::Sender::Transport::SMTP->new( diff --git a/lib/Config/ClawsMail/Server.pm b/lib/Config/ClawsMail/Server.pm index 80338ba..f058a5a 100644 --- a/lib/Config/ClawsMail/Server.pm +++ b/lib/Config/ClawsMail/Server.pm @@ -2,7 +2,7 @@ package Config::ClawsMail::Server; use v5.26; use Moo; # VERSION -use Types::Standard qw(Str Enum); +use Types::Standard qw(Str Enum ArrayRef); use namespace::clean; # ABSTRACT: Claws-Mail send/receive server @@ -18,6 +18,11 @@ has [qw(user_id password)] => ( isa => Str, ); +has 'auth_methods' => ( + is => 'ro', + isa => ArrayRef[Str], +); + has ssl => ( is => 'ro', isa => Enum[qw(no ssl starttls)], |