30cf2e5a9f
On peut générer des clefs DKIM mais on ne peut pas encore choisir quel sélecteur utiliser pour signer les mails sortants. Une fois DKIM activé pour un domaine, on ne peut pas non plus le désactiver.
158 lines
4.0 KiB
Perl
158 lines
4.0 KiB
Perl
package Email::SpoofingDemo::DKIM;
|
||
|
||
use strict;
|
||
use warnings;
|
||
use v5.10;
|
||
use utf8;
|
||
|
||
use Exporter 'import';
|
||
|
||
our @EXPORT_OK = qw(read_signing_table read_key_table
|
||
write_signing_table write_key_table
|
||
generate_dkim_key);
|
||
|
||
sub generate_dkim_key {
|
||
my ($domain, $selector, $key_size, $key_table_name, $key_dir, $signing_table_name) = @_;
|
||
|
||
die if $domain =~ /\.\./;
|
||
|
||
my $key_domain_dir = "$key_dir/$domain";
|
||
|
||
# Generate the key
|
||
system("mkdir", "-p", $key_domain_dir);
|
||
system("opendkim-genkey",
|
||
"-D", $key_domain_dir,
|
||
"-d", $domain,
|
||
"-s", $selector,
|
||
"-b", $key_size);
|
||
system("chown", "-R", "opendkim", $key_domain_dir);
|
||
|
||
# Read in the public key
|
||
my $public_key_file = "$key_domain_dir/$selector.txt";
|
||
open(my $fh, '<', $public_key_file) or die "$key_domain_dir: $!";
|
||
my $data = eval {
|
||
local $/ = undef;
|
||
my $raw_record = <$fh>;
|
||
my ($owner, $class, $type, $data) = split(" ", $raw_record, 4);
|
||
$data =~ s/\s*;.*$//;
|
||
return $data;
|
||
};
|
||
close($fh);
|
||
|
||
# Update key table
|
||
my $key_table = read_key_table($key_table_name);
|
||
push @{$key_table->{$domain}}, $selector;
|
||
write_key_table($key_table_name, $key_dir, $key_table);
|
||
|
||
# Update signing table if it’s the first key for the domain
|
||
my $signing_table = read_signing_table($signing_table_name);
|
||
if (not exists $signing_table->{$domain}) {
|
||
$signing_table->{$domain} = $selector;
|
||
write_signing_table($signing_table_name, $signing_table);
|
||
}
|
||
|
||
# Done!
|
||
reload_opendkim();
|
||
|
||
return $data;
|
||
}
|
||
|
||
sub read_signing_table {
|
||
my ($filename) = @_;
|
||
|
||
my %sign_table;
|
||
|
||
open(my $fh, '<', $filename) or die "$filename: $!";
|
||
while (<$fh>) {
|
||
chomp;
|
||
s/#.*$//;
|
||
next if /^\s*$/;
|
||
|
||
my ($domain_or_email, $key_id) = split(" ", $_, 2);
|
||
my $domain = ($domain_or_email =~ s/^.*@//r);
|
||
my $selector = ($key_id =~ s/\._domainkey.$domain$//r);
|
||
|
||
$sign_table{$domain} = $selector;
|
||
}
|
||
close($fh);
|
||
|
||
return \%sign_table;
|
||
}
|
||
|
||
sub write_signing_table {
|
||
my ($filename, $contents) = @_;
|
||
|
||
open(my $fh, '>', $filename) or die "$filename: $!";
|
||
binmode($fh, ':utf8');
|
||
print $fh <<'EOF';
|
||
##
|
||
## FORMAT DE LA TABLE
|
||
##
|
||
## <domaine ou adresse mail> <identifiant>
|
||
##
|
||
## L’adresse mail peut être un wildcard (ex. *@expediteur.example).
|
||
##
|
||
|
||
EOF
|
||
for my $domain (sort keys %$contents) {
|
||
my $selector = $contents->{$domain};
|
||
my $key_id = "$selector._domainkey.$domain";
|
||
printf $fh "%-30s %s\n", $domain, $key_id;
|
||
}
|
||
close($fh);
|
||
}
|
||
|
||
sub read_key_table {
|
||
my ($filename) = @_;
|
||
|
||
# We only care about the list of keys that exist for a given domain.
|
||
# The rest of the data can be deduced from that mapping.
|
||
|
||
my %key_table;
|
||
|
||
open(my $fh, '<', $filename) or die "$filename: $!\n";
|
||
while (<$fh>) {
|
||
chomp;
|
||
s/#.*$//;
|
||
next if /^\s*$/;
|
||
|
||
my ($key_id, $key_spec) = split(" ", $_, 2);
|
||
my ($domain, $selector, $key_location) = split(":", $key_spec, 3);
|
||
|
||
push @{$key_table{$domain}}, $selector;
|
||
}
|
||
|
||
return \%key_table;
|
||
}
|
||
|
||
sub write_key_table {
|
||
my ($filename, $key_dir, $contents) = @_;
|
||
|
||
open(my $fh, '>', $filename) or die "$filename: $!\n";
|
||
binmode($fh, ':utf8');
|
||
print $fh <<EOF;
|
||
##
|
||
## FORMAT DE LA TABLE
|
||
##
|
||
## <identifiant> <domaine>:<sélecteur>:<fichier>
|
||
##
|
||
|
||
EOF
|
||
for my $domain (sort keys %$contents) {
|
||
for my $selector (@{$contents->{$domain}}) {
|
||
my $key_id = "$selector._domainkey.$domain";
|
||
my $key_file = "$key_dir/$domain/$selector.private";
|
||
|
||
printf $fh "%-30s %s:%s:%s\n", $key_id, $domain, $selector, $key_file;
|
||
}
|
||
}
|
||
close($fh);
|
||
}
|
||
|
||
sub reload_opendkim {
|
||
system(qw(killall -USR1 opendkim));
|
||
return (($? >> 8) == 0);
|
||
}
|
||
|
||
1;
|