From 20018db773f4a110433ff6ae00fc8932c75d9973 Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <gianni.ceccarelli@broadbean.com>
Date: Thu, 14 Sep 2023 11:51:09 +0100
Subject: pull auth mechanism from config

---
 lib/Config/ClawsMail/Account.pm | 48 ++++++++++++++++++++++++++++++++++++++++-
 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)],
-- 
cgit v1.2.3