14 files changed, 269 insertions, 209 deletions

diff --git a/dist.ini b/dist.ini
index 5b62300..d08f13f 100644
--- a/dist.ini
+++ b/dist.ini
@@ -2,14 +2,12 @@ name = Config-ClawsMail
 author  = Gianni Ceccarelli <dakkar@thenautilus.net>
 license = Perl_5
 copyright_holder = Gianni Ceccarelli <dakkar@thenautilus.net>
-copyright_year   = 2016
+copyright_year   = 2023
 
 [GatherDir]
 
-[InlineModule]
-module = Config::ClawsMail::Password
-
 [PodWeaver]
+; authordep Pod::Elemental::Transformer::List
 
 [PruneCruft]
 
@@ -38,10 +36,12 @@ first_version = 0.0.1
 
 [Test::Perl::Critic]
 
-[PodCoverageTests]
+[Test::Pod::Coverage::Configurable]
 
 [PodSyntaxTests]
 
+[Test::PodSpelling]
+
 [ExtraTests]
 
 [Repository]
@@ -58,6 +58,8 @@ dir = scripts
 
 [ShareDir]
 
+[MakeMaker]
+
 [Manifest]
 
 [License]
@@ -80,4 +82,5 @@ branch = release/master
 tag_format = v%v%t
 
 [ConfirmRelease]
-[UploadToCPAN]
+
+[FakeRelease]
diff --git a/lib/Authen/SASL/Perl/XOAUTH2.pm b/lib/Authen/SASL/Perl/XOAUTH2.pm
new file mode 100644
index 0000000..2cabcd4
--- /dev/null
+++ b/lib/Authen/SASL/Perl/XOAUTH2.pm
@@ -0,0 +1,23 @@
+package Authen::SASL::Perl::XOAUTH2;
+use strict;
+use warnings;
+use 5.020;
+use parent 'Authen::SASL::Perl';
+
+sub _order { 10 }
+
+sub mechanism { 'XOAUTH2' }
+
+sub client_start { '' }
+
+sub client_step {
+    my ($self, $string) = @_;
+    my ($username, $token) = map {
+        my $v = $self->_call($_);
+        defined($v) ? $v : ''
+    } qw(user pass);
+
+    "user=${username}\cAauth=Bearer $token\cA\cA",
+}
+
+1;
diff --git a/lib/Config/ClawsMail.pm b/lib/Config/ClawsMail.pm
index 9c11636..3ad6ab2 100644
--- a/lib/Config/ClawsMail.pm
+++ b/lib/Config/ClawsMail.pm
@@ -1,46 +1,78 @@
 package Config::ClawsMail;
+use v5.26;
 use Moo;
 # VERSION
-use Config::INI::Reader;
+use experimental 'signatures';
+
 use Config::ClawsMail::Account;
+use Config::ClawsMail::PasswordStore;
+use Config::ClawsMail::MainConfigParser;
 use Config::ClawsMail::PasswordStoreParser;
 use Types::Standard qw(HashRef InstanceOf);
-use Path::Tiny;
+use Types::Path::Tiny qw(Path);
 use namespace::clean;
 
 # ABSTRACT: Claws-Mail config parser
 
-has accounts => (
+has basedir => (
     is => 'ro',
-    isa => HashRef[InstanceOf['Config::ClawsMail::Account']],
-    default => sub { +{}; },
+    isa => Path,
+    coerce => 1,
+    default => '~/.claws-mail',
 );
 
-sub BUILDARGS {
-    my ($class,@etc) = @_;
+has master_password => ( is => 'ro' );
 
-    my $args = $class->next::method(@etc);
-    return $args if $args->{accounts};
+has main_config => (
+    is => 'lazy',
+    isa => HashRef,
+);
 
-    my $config_file = delete $args->{config_file}
-        || path($ENV{HOME},'.claws-mail','accountrc');
-    my $config_hash = Config::INI::Reader->read_file(
-        $config_file,
+sub _build_main_config($self) {
+    Config::ClawsMail::MainConfigParser->read_file($self->basedir->child('clawsrc'));
+}
+
+has password_store => (
+    is => 'lazy',
+    isa => InstanceOf['Config::ClawsMail::PasswordStore'],
+);
+
+sub _build_password_store($self) {
+    my $raw_data = Config::ClawsMail::PasswordStoreParser->read_file(
+        $self->basedir->child('passwordstorerc'),
     );
-    my $password_file = delete $args->{password_file}
-        || path($ENV{HOME},'.claws-mail','passwordstorerc');
-    my $password_hash = Config::ClawsMail::PasswordStoreParser->read_file(
-        $password_file,
+
+    Config::ClawsMail::PasswordStore->new({
+        raw_data         => $raw_data,
+        master_password  => $self->master_password,
+        master_salt_bs64 => $self->main_config->{Common}{master_passphrase_salt},
+    });
+}
+
+has accounts => (
+    is => 'lazy',
+    isa => HashRef[InstanceOf['Config::ClawsMail::Account']],
+);
+
+sub _build_accounts($self) {
+    my $raw_accounts = Config::INI::Reader->read_file(
+        $self->basedir->child('accountrc'),
     );
 
-    for my $account_id (keys %{$config_hash}) {
-        my $account_conf = $config_hash->{$account_id};
-        my $password_conf = $password_hash->{$account_id};
-        my $account = Config::ClawsMail::Account->new_from_config($account_conf,$password_conf);
-        $args->{accounts}{$account->account_name} = $account;
+    my %accounts;
+
+    for my $account_id (keys $raw_accounts->%*) {
+
+        my $account = Config::ClawsMail::Account->new_from_config({
+            account_section => $account_id,
+            account_config => $raw_accounts->{$account_id},
+            password_store => $self->password_store,
+        }) or next;
+
+        $accounts{ $account->account_name } = $account;
     }
 
-    return $args;
+    return \%accounts;
 }
 
 1;
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,
         ) : () )
     );
 }
diff --git a/lib/Config/ClawsMail/MainConfigParser.pm b/lib/Config/ClawsMail/MainConfigParser.pm
new file mode 100644
index 0000000..4283e05
--- /dev/null
+++ b/lib/Config/ClawsMail/MainConfigParser.pm
@@ -0,0 +1,15 @@
+package Config::ClawsMail::MainConfigParser;
+use v5.26;
+use strict;
+use warnings;
+# VERSION
+use parent 'Config::INI::Reader';
+# ABSTRACT: Config::INI::Reader tweaked for clawsrc
+
+sub handle_unparsed_line {
+    my ($self, $line, $handle) = @_;
+    return if $line =~ m{\.so$}; # plugin name
+    return $self->next::method($line,$handle);
+}
+
+1;
diff --git a/lib/Config/ClawsMail/Password.pm b/lib/Config/ClawsMail/Password.pm
deleted file mode 100644
index ec6f8af..0000000
--- a/lib/Config/ClawsMail/Password.pm
+++ /dev/null
@@ -1,113 +0,0 @@
-package Config::ClawsMail::Password;
-use strict;
-use warnings;
-# VERSION
-use Config::ClawsMail::Password::Inline 'C';
-use MIME::Base64;
-use namespace::clean -except => [qw(decrypt_password)];
-
-# ABSTRACT: Claws-Mail password decrypter
-
-sub cleartext_password {
-    my ($password) = @_;
-    return decrypt_password(decode_base64($password));
-}
-
-1;
-
-__DATA__
-__C__
-#include <memory.h>
-
-#define PASSCRYPT_KEY "passkey0"
-unsigned char crypt_cfb_iv[64];
-int crypt_cfb_blocksize = 8;	/* 8 for DES */
-
-static void crypt_unpack(unsigned char *a) {
-    int i, j;
-
-    for (i = 7; i >= 0; --i)
-        for (j = 7; j >= 0; --j)
-            a[(i << 3) + j] = (a[i] & (0x80 >> j)) != 0;
-}
-
-static void crypt_cfb_xor(
-    unsigned char *to,
-    const unsigned char *from,
-    unsigned len) {
-    unsigned i;
-    unsigned j;
-    unsigned char c;
-
-    for (i = 0; i < len; i++) {
-        c = 0;
-        for (j = 0; j < 8; j++)
-            c = (c << 1) | *from++;
-        *to++ ^= c;
-    }
-}
-
-static void crypt_cfb_shift(
-    unsigned char *to,
-    const unsigned char *from,
-    unsigned len) {
-    unsigned i;
-    unsigned j;
-    unsigned k;
-
-    if (len < crypt_cfb_blocksize) {
-        i = len * 8;
-        j = crypt_cfb_blocksize * 8;
-        for (k = i; k < j; k++) {
-            to[0] = to[i];
-            ++to;
-        }
-    }
-
-    for (i = 0; i < len; i++) {
-        j = *from++;
-        for (k = 0x80; k; k >>= 1)
-            *to++ = ((j & k) != 0);
-    }
-}
-
-static void crypt_cfb_buf(
-    const char key[8],
-    unsigned char *buf,
-    unsigned len,
-    unsigned chunksize,
-    int decrypt) {
-    unsigned char temp[64];
-
-    memcpy(temp, key, 8);
-    crypt_unpack(temp);
-    setkey((const char *) temp);
-    memset(temp, 0, sizeof(temp));
-
-    memset(crypt_cfb_iv, 0, sizeof(crypt_cfb_iv));
-
-    if (chunksize > crypt_cfb_blocksize)
-        chunksize = crypt_cfb_blocksize;
-
-    while (len) {
-        memcpy(temp, crypt_cfb_iv, sizeof(temp));
-        encrypt((char *) temp, 0);
-        if (chunksize > len)
-            chunksize = len;
-        if (decrypt)
-            crypt_cfb_shift(crypt_cfb_iv, buf, chunksize);
-        crypt_cfb_xor((unsigned char *) buf, temp, chunksize);
-        if (!decrypt)
-            crypt_cfb_shift(crypt_cfb_iv, buf, chunksize);
-        len -= chunksize;
-        buf += chunksize;
-    }
-}
-
-SV* decrypt_password(SV* password) {
-    size_t len = sv_len(password);
-    char *tmp = (char*)malloc(len);
-    memcpy(tmp,SvPVbyte(password,len),len);
-    crypt_cfb_buf(PASSCRYPT_KEY, tmp, len, 1, 1 );
-    return newSVpvn(tmp,len);
-}
diff --git a/lib/Config/ClawsMail/Password/Inline.pm b/lib/Config/ClawsMail/Password/Inline.pm
deleted file mode 100644
index 1df0506..0000000
--- a/lib/Config/ClawsMail/Password/Inline.pm
+++ /dev/null
@@ -1,14 +0,0 @@
-# DO NOT EDIT. GENERATED BY: Inline::Module
-#
-# This module is for author-side development only. When this module is shipped
-# to CPAN, it will be automagically replaced with content that does not
-# require any Inline framework modules (or any other non-core modules).
-#
-# To regenerate this stub module, run this command:
-#
-#   perl -MInline::Module=makestub,Config::ClawsMail::Password::Inline
-
-use strict; use warnings;
-package Config::ClawsMail::Password::Inline;
-use Inline::Module stub => 'v2';
-1;
diff --git a/lib/Config/ClawsMail/PasswordStore.pm b/lib/Config/ClawsMail/PasswordStore.pm
new file mode 100644
index 0000000..3fbb68f
--- /dev/null
+++ b/lib/Config/ClawsMail/PasswordStore.pm
@@ -0,0 +1,62 @@
+package Config::ClawsMail::PasswordStore;
+use v5.26;
+use Moo;
+# VERSION
+use experimental 'signatures';
+use Types::Standard qw(HashRef);
+use Crypt::Misc qw(decode_b64);
+use Crypt::KeyDerivation qw(pbkdf2);
+use Crypt::Cipher::AES;
+use Crypt::Mode::CBC;
+use namespace::clean;
+
+# ABSTRACT: decrypt Claws-Mail password store
+
+sub PASSCRYPT_KEY() { 'passkey0' }
+
+has raw_data => (
+    is => 'ro',
+    required => 1,
+    isa => HashRef,
+);
+
+has master_password => ( is => 'ro' );
+
+has master_salt_bs64 => ( is => 'ro', required => 1 );
+has master_salt => ( is => 'lazy' );
+sub _build_master_salt($self) { decode_b64($self->master_salt_bs64) }
+
+sub decrypt($self,$input) {
+    return $input unless $input && $input =~ m{\A \{ ([a-z0-9-]+),(\d+) \} (.+) \z}smxi;
+    my ($algo,$rounds,$ciphertext) = ($1,$2,$3);
+
+    die 'unknown algo' unless $algo eq 'AES-256-CBC';
+
+    my $key = pbkdf2(
+        $self->master_password || PASSCRYPT_KEY(),
+        $self->master_salt,
+        $rounds, 'SHA1', 32, # 32 bytes = 256 bits,for AES-256
+    );
+
+    my $cipher = Crypt::Mode::CBC->new('AES', 5); # 5 = zero padding
+
+    $ciphertext = decode_b64($ciphertext);
+
+    # claws sets up 16 random bytes as IV??
+    my $iv = '0123456789abcdef';
+
+    my $cleartext = $cipher->decrypt($ciphertext, $key, $iv);
+
+    # the first 16 bytes are generated from the IV, we don't care
+    # about them
+    $cleartext = substr($cleartext,16);
+    $cleartext =~ s/\0+\z//;
+
+    return $cleartext;
+}
+
+sub password_for($self,$section,$key) {
+    return $self->decrypt($self->raw_data->{$section}{$key});
+}
+
+1;
diff --git a/lib/Config/ClawsMail/PasswordStoreParser.pm b/lib/Config/ClawsMail/PasswordStoreParser.pm
index 227baa6..0b875d8 100644
--- a/lib/Config/ClawsMail/PasswordStoreParser.pm
+++ b/lib/Config/ClawsMail/PasswordStoreParser.pm
@@ -1,12 +1,10 @@
 package Config::ClawsMail::PasswordStoreParser;
+use v5.26;
+use strict;
+use warnings;
+# VERSION
 use parent 'Config::INI::Reader';
-
-sub parse_section_header {
-    my ($head) = $_[1] =~ /^\s*\[\s*(.+?)\s*\]\s*$/
-        or return;
-    $head =~ s{account:}{Account: };
-    return $head;
-}
+# ABSTRACT: Config::INI::Reader tweaked for passwordstorerc
 
 sub parse_value_assignment {
     return ($1, $2) if $_[1] =~ /^\s*([^\s\pC]+?)\s+(.*?)\s*$/;
diff --git a/lib/Config/ClawsMail/Server.pm b/lib/Config/ClawsMail/Server.pm
index a996e4f..f058a5a 100644
--- a/lib/Config/ClawsMail/Server.pm
+++ b/lib/Config/ClawsMail/Server.pm
@@ -1,8 +1,8 @@
 package Config::ClawsMail::Server;
+use v5.26;
 use Moo;
 # VERSION
-use Types::Standard qw(Str Enum);
-use Config::ClawsMail::Password;
+use Types::Standard qw(Str Enum ArrayRef);
 use namespace::clean;
 
 # ABSTRACT: Claws-Mail send/receive server
@@ -18,15 +18,15 @@ 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)],
     default => sub { 'no' },
 );
 
-sub cleartext_password {
-    my ($self) = @_;
-    return Config::ClawsMail::Password::cleartext_password($self->password);
-}
-
 1;
diff --git a/perlcritic.rc b/perlcritic.rc
index 651ba52..7bfe7a1 100644
--- a/perlcritic.rc
+++ b/perlcritic.rc
@@ -319,6 +319,7 @@ severity = 2
 
 # Prevent unused private subroutines.
 [Subroutines::ProhibitUnusedPrivateSubroutines]
+private_name_regex = _(?!build_)\w+
 
 # Prevent access to private subs in other packages.
 [Subroutines::ProtectPrivateSubs]
diff --git a/scripts/claws-password b/scripts/claws-password
new file mode 100755
index 0000000..e16173a
--- /dev/null
+++ b/scripts/claws-password
@@ -0,0 +1,11 @@
+#!/usr/bin/env perl
+use v5.26;
+use strict;
+use warnings;
+# VERSION
+use Config::ClawsMail;
+# PODNAME: claws-password
+# ABSTRACT: print out a cleartext password from claws store
+
+my $c = Config::ClawsMail->new();
+say $c->password_store->password_for(@ARGV);
diff --git a/t/send.t b/t/send.t
deleted file mode 100644
index 69d21a8..0000000
--- a/t/send.t
+++ /dev/null
@@ -1,29 +0,0 @@
-#!perl
-use strict;
-use warnings;
-use Test::More;
-use Config::ClawsMail;
-use Email::Sender::Simple qw(sendmail);
-use Email::Simple;
-use Email::Simple::Creator;
-
-my $claws = Config::ClawsMail->new();
-my $account = $claws->accounts->{BB};
-my $address = sprintf q{%s <%s>},
-    $account->name, $account->address;
-
-my $email = Email::Simple->create(
-    header => [
-        To => $address,
-        From => $address,
-        Subject => 'config::claws-mail test',
-    ],
-    body => "test for Config::ClawsMail\n",
-);
-ok(
-    sendmail($email, {transport => $account->email_transport}),
-    'sending should work',
-);
-
-done_testing;
-
diff --git a/weaver.ini b/weaver.ini
index 4cf1cae..2a9dfc0 100644
--- a/weaver.ini
+++ b/weaver.ini
@@ -2,6 +2,9 @@
 
 [-SingleEncoding]
 
+[Region / stopwords]
+flatten = 0
+
 [Name]
 [Version]
 
@@ -14,12 +17,27 @@
 [Collect / ATTRIBUTES]
 command = attr
 
+[Collect / COLUMNS]
+command = column
+
+[Collect / RELATIONSHIPS]
+command = rel
+
+[Collect / REQUIRED METHODS]
+command = require
+
 [Collect / METHODS]
 command = method
 
+[Collect / MODIFIED METHODS]
+command = modif
+
 [Collect / FUNCTIONS]
 command = func
 
+[Collect / TYPES]
+command = type
+
 [Leftovers]
 
 [Region  / postlude]