164 lines
4.1 KiB
Perl
164 lines
4.1 KiB
Perl
#
|
||
# SPDX-FileCopyrightText: 2023 Afnic
|
||
#
|
||
# SPDX-License-Identifier: GPL-3.0-or-later
|
||
#
|
||
|
||
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;
|