summaryrefslogtreecommitdiff
path: root/lib/Config/ClawsMail/Account.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Config/ClawsMail/Account.pm')
-rw-r--r--lib/Config/ClawsMail/Account.pm73
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,
) : () )
);
}