handles new claws encryption

8 files changed, 140 insertions, 161 deletions

diff --git a/lib/Config/ClawsMail.pm b/lib/Config/ClawsMail.pm
index 848113e..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) or next;
-        $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 2c538a2..f302a1d 100644
--- a/lib/Config/ClawsMail/Account.pm
+++ b/lib/Config/ClawsMail/Account.pm
@@ -1,10 +1,9 @@
 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
 
@@ -21,9 +20,15 @@ has [qw(imap smtp)] => (
 
 my @ssl_string=qw(no ssl starttls);
 sub new_from_config {
-    my ($class,$config,$password) = @_;
+    my ($class,$args) = @_;
+
+    my $config = $args->{account_config};
     return unless $config->{protocol} eq '1';
 
+    my $section = $args->{account_section};
+
+    my $password_store = $args->{password_store};
+
     my $imap_server = Config::ClawsMail::Server->new({
         host => $config->{receive_server},
         port => (
@@ -35,7 +40,7 @@ sub new_from_config {
             ),
         ssl => $ssl_string[$config->{ssl_imap}],
         %{$config}{qw(user_id)},
-        password => $password->{recv},
+        password => $password_store->password_for($section,'recv'),
     });
 
     my $smtp_server = Config::ClawsMail::Server->new({
@@ -50,7 +55,7 @@ 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($section,'send') || $password_store->password_for($section,'recv')
         ) : () ),
     });
 
@@ -72,7 +77,7 @@ sub email_transport {
         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..8fc9841
--- /dev/null
+++ b/lib/Config/ClawsMail/MainConfigParser.pm
@@ -0,0 +1,14 @@
+package Config::ClawsMail::MainConfigParser;
+use v5.26;
+use strict;
+use warnings;
+# VERSION
+use parent 'Config::INI::Reader';
+
+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..0547ec2
--- /dev/null
+++ b/lib/Config/ClawsMail/PasswordStore.pm
@@ -0,0 +1,56 @@
+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;
+
+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', 0); # 0 = no 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
+    return substr($cleartext,16);
+}
+
+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..32ce271 100644
--- a/lib/Config/ClawsMail/PasswordStoreParser.pm
+++ b/lib/Config/ClawsMail/PasswordStoreParser.pm
@@ -1,4 +1,8 @@
 package Config::ClawsMail::PasswordStoreParser;
+use v5.26;
+use strict;
+use warnings;
+# VERSION
 use parent 'Config::INI::Reader';
 
 sub parse_section_header {
diff --git a/lib/Config/ClawsMail/Server.pm b/lib/Config/ClawsMail/Server.pm
index a996e4f..c7eb420 100644
--- a/lib/Config/ClawsMail/Server.pm
+++ b/lib/Config/ClawsMail/Server.pm
@@ -24,9 +24,4 @@ has ssl => (
     default => sub { 'no' },
 );
 
-sub cleartext_password {
-    my ($self) = @_;
-    return Config::ClawsMail::Password::cleartext_password($self->password);
-}
-
 1;