diff options
Diffstat (limited to 'lib/Config/ClawsMail/Account.pm')
-rw-r--r-- | lib/Config/ClawsMail/Account.pm | 73 |
1 files changed, 63 insertions, 10 deletions
diff --git a/lib/Config/ClawsMail/Account.pm b/lib/Config/ClawsMail/Account.pm index 6cd291f..2487250 100644 --- a/lib/Config/ClawsMail/Account.pm +++ b/lib/Config/ClawsMail/Account.pm @@ -1,14 +1,14 @@ package Config::ClawsMail::Account; +use v5.26; use Moo; # VERSION -use 5.020; use Types::Standard qw(Str InstanceOf); use Config::ClawsMail::Server; use namespace::clean; # ABSTRACT: Claws-Mail account -has [qw(account_name name address)] => ( +has [qw(account_name name address organization)] => ( is => 'ro', required => 1, isa => Str, @@ -20,9 +20,55 @@ 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,$config,$password) = @_; - die "unhandled protocol" unless $config->{protocol} eq '1'; + my ($class,$args) = @_; + + my $config = $args->{account_config}; + return unless $config->{protocol} eq '1'; + + my $section = $args->{account_section}; + (my $password_section = $section)=~ s{Account: }{account:}; + + my $password_store = $args->{password_store}; my $imap_server = Config::ClawsMail::Server->new({ host => $config->{receive_server}, @@ -35,7 +81,8 @@ sub new_from_config { ), ssl => $ssl_string[$config->{ssl_imap}], %{$config}{qw(user_id)}, - password => $password->{recv}, + 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({ @@ -50,12 +97,13 @@ 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->{send} || $password->{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), ) : () ), }); return $class->new({ - %{$config}{qw(account_name name address)}, + %{$config}{qw(account_name name address organization)}, imap => $imap_server, smtp => $smtp_server, }); @@ -64,15 +112,20 @@ sub new_from_config { sub email_transport { my ($self) = @_; - require Email::Sender::Transport::SMTPS; + # 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::SMTPS->new( + return Email::Sender::Transport::SMTP->new( host => $smtp->host, port => $smtp->port, ssl => $smtp->ssl, ( $smtp->user_id ? ( sasl_username => $smtp->user_id, - sasl_password => $smtp->cleartext_password, + sasl_password => $smtp->password, ) : () ) ); } |