├── .github ├── FUNDING.yml ├── ISSUE_TEMPLATE │ ├── feature_request.md │ └── bug_report.md └── workflows │ ├── critic.yml │ ├── ci.yml │ └── codecov.yml ├── .coveralls.yml ├── example └── report_cgi.png ├── share ├── html │ ├── plugins │ │ ├── grid.addons.js.gz │ │ ├── grid.postext.js.gz │ │ ├── grid.setcolumns.js.gz │ │ ├── jquery.tablednd.js.gz │ │ ├── ui.multiselect.js.gz │ │ ├── jquery.contextmenu.js.gz │ │ ├── jquery.searchFilter.js.gz │ │ ├── searchFilter.css │ │ └── ui.multiselect.css │ ├── js │ │ ├── jquery.jqGrid.min.js.gz │ │ └── i18n │ │ │ ├── grid.locale-ar.js.gz │ │ │ ├── grid.locale-bg.js.gz │ │ │ ├── grid.locale-cat.js.gz │ │ │ ├── grid.locale-cn.js.gz │ │ │ ├── grid.locale-cs.js.gz │ │ │ ├── grid.locale-da.js.gz │ │ │ ├── grid.locale-de.js.gz │ │ │ ├── grid.locale-dk.js.gz │ │ │ ├── grid.locale-el.js.gz │ │ │ ├── grid.locale-en.js.gz │ │ │ ├── grid.locale-es.js.gz │ │ │ ├── grid.locale-fa.js.gz │ │ │ ├── grid.locale-fi.js.gz │ │ │ ├── grid.locale-fr.js.gz │ │ │ ├── grid.locale-gl.js.gz │ │ │ ├── grid.locale-he.js.gz │ │ │ ├── grid.locale-hr.js.gz │ │ │ ├── grid.locale-hu.js.gz │ │ │ ├── grid.locale-id.js.gz │ │ │ ├── grid.locale-is.js.gz │ │ │ ├── grid.locale-it.js.gz │ │ │ ├── grid.locale-ja.js.gz │ │ │ ├── grid.locale-kr.js.gz │ │ │ ├── grid.locale-lt.js.gz │ │ │ ├── grid.locale-mne.js.gz │ │ │ ├── grid.locale-nl.js.gz │ │ │ ├── grid.locale-no.js.gz │ │ │ ├── grid.locale-pl.js.gz │ │ │ ├── grid.locale-pt.js.gz │ │ │ ├── grid.locale-ro.js.gz │ │ │ ├── grid.locale-ru.js.gz │ │ │ ├── grid.locale-sk.js.gz │ │ │ ├── grid.locale-sr.js.gz │ │ │ ├── grid.locale-sv.js.gz │ │ │ ├── grid.locale-th.js.gz │ │ │ ├── grid.locale-tr.js.gz │ │ │ ├── grid.locale-tw.js.gz │ │ │ ├── grid.locale-ua.js.gz │ │ │ ├── grid.locale-vi.js.gz │ │ │ ├── grid.locale-bg1251.js.gz │ │ │ ├── grid.locale-hr1250.js.gz │ │ │ ├── grid.locale-pt-br.js.gz │ │ │ └── grid.locale-sr-latin.js.gz │ ├── css │ │ ├── ellipsis-xbl.xml │ │ └── ui.multiselect.css │ └── index.html ├── mail-dmarc.cron ├── dmarc_whitelist ├── mail-dmarc.ini ├── mail_dmarc_schema.pgsql └── mail_dmarc_schema.sqlite ├── FAQ.md ├── .test ├── cleanup.sh ├── install-db.sh └── install-deps.sh ├── MANIFEST.SKIP ├── xt ├── release-pod-syntax.t ├── author-critic.t └── perlcritic.rc ├── .release ├── update-readme.sh ├── do.sh ├── update-psl.sh ├── copyright_year.sh ├── publish-to-cpan.sh ├── tag.sh ├── base.sh └── version_increment.sh ├── .gitignore ├── t ├── whitelist ├── 23.Report.Send.HTTP.t ├── 20.Report.URI.t ├── 21.Report.Send.t ├── backends │ ├── mail-dmarc.sql.Pg.ini │ ├── mail-dmarc.sql.mysql.ini │ └── mail-dmarc.sql.SQLite.ini ├── mail-dmarc.ini ├── 16.Report.Aggregate.Record.Auth_Results.t ├── 09.HTTP.t ├── 25.Report.Receive.t ├── 13.Report.Aggregate.t ├── 10.Report.t ├── 11.Report.Store.t ├── 15.Report.Aggregate.Record.t ├── 14.Report.Aggregate.Metadata.t ├── 17.Report.Aggregate.Schema.t ├── 22.Report.Send.SMTP.t ├── 26.Report.Sender.t └── 03.Base.t ├── bin ├── dmarc_send_reports ├── dmarc_update_public_suffix_list ├── dmarc_receive ├── dmarc_lookup ├── dmarc_httpd └── dmarc_http_client ├── lib └── Mail │ └── DMARC │ ├── Test │ └── Transport.pm │ ├── Report │ ├── Aggregate │ │ ├── Record │ │ │ ├── Identifiers.pm │ │ │ ├── Row.pm │ │ │ ├── Row │ │ │ │ └── Policy_Evaluated.pm │ │ │ ├── Auth_Results │ │ │ │ ├── DKIM.pm │ │ │ │ └── SPF.pm │ │ │ └── Auth_Results.pm │ │ ├── Record.pm │ │ └── Metadata.pm │ ├── Send │ │ └── HTTP.pm │ ├── Store.pm │ ├── Send.pm │ ├── URI.pm │ └── Store │ │ └── SQL │ │ └── Grammars │ │ └── MySQL.pm │ ├── Result │ └── Reason.pm │ ├── Result.pm │ ├── HTTP.pm │ └── Report.pm ├── TODO.md ├── .perltidyrc ├── INSTALL.md ├── DEVELOP.md ├── MANIFEST ├── META.yml ├── Build.PL ├── Makefile.PL └── META.json /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: msimerson 2 | -------------------------------------------------------------------------------- /.coveralls.yml: -------------------------------------------------------------------------------- 1 | repo_token: ${{ secrets.COVERALLS_REPO_TOKEN }} 2 | -------------------------------------------------------------------------------- /example/report_cgi.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/example/report_cgi.png -------------------------------------------------------------------------------- /share/html/plugins/grid.addons.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/plugins/grid.addons.js.gz -------------------------------------------------------------------------------- /share/html/js/jquery.jqGrid.min.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/jquery.jqGrid.min.js.gz -------------------------------------------------------------------------------- /share/html/plugins/grid.postext.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/plugins/grid.postext.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-ar.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-ar.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-bg.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-bg.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-cat.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-cat.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-cn.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-cn.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-cs.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-cs.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-da.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-da.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-de.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-de.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-dk.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-dk.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-el.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-el.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-en.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-en.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-es.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-es.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-fa.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-fa.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-fi.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-fi.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-fr.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-fr.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-gl.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-gl.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-he.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-he.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-hr.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-hr.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-hu.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-hu.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-id.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-id.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-is.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-is.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-it.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-it.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-ja.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-ja.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-kr.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-kr.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-lt.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-lt.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-mne.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-mne.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-nl.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-nl.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-no.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-no.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-pl.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-pl.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-pt.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-pt.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-ro.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-ro.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-ru.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-ru.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-sk.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-sk.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-sr.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-sr.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-sv.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-sv.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-th.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-th.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-tr.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-tr.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-tw.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-tw.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-ua.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-ua.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-vi.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-vi.js.gz -------------------------------------------------------------------------------- /share/html/plugins/grid.setcolumns.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/plugins/grid.setcolumns.js.gz -------------------------------------------------------------------------------- /share/html/plugins/jquery.tablednd.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/plugins/jquery.tablednd.js.gz -------------------------------------------------------------------------------- /share/html/plugins/ui.multiselect.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/plugins/ui.multiselect.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-bg1251.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-bg1251.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-hr1250.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-hr1250.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-pt-br.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-pt-br.js.gz -------------------------------------------------------------------------------- /share/html/plugins/jquery.contextmenu.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/plugins/jquery.contextmenu.js.gz -------------------------------------------------------------------------------- /share/html/js/i18n/grid.locale-sr-latin.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/js/i18n/grid.locale-sr-latin.js.gz -------------------------------------------------------------------------------- /share/html/plugins/jquery.searchFilter.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/msimerson/mail-dmarc/HEAD/share/html/plugins/jquery.searchFilter.js.gz -------------------------------------------------------------------------------- /FAQ.md: -------------------------------------------------------------------------------- 1 | 2 | The Mail::DMARC [FAQ is here](https://github.com/msimerson/mail-dmarc/wiki). 3 | 4 | https://github.com/msimerson/mail-dmarc/wiki 5 | 6 | -------------------------------------------------------------------------------- /.test/cleanup.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | mysql -e 'DROP DATABASE dmarc_report' 4 | 5 | if [ -f t/reports-test.sqlite ]; then 6 | rm t/reports-test.sqlite 7 | fi 8 | 9 | if [ -f dmarc_reports.sqlite ]; then 10 | rm dmarc_reports.sqlite 11 | fi 12 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .coveralls.yml 3 | .git 4 | .test 5 | .release 6 | .tar.gz 7 | .travis.yml 8 | ^_build 9 | ^blib 10 | ^Makefile$ 11 | ^Makefile.old$ 12 | ^Build$ 13 | ^MANIFEST\.bak$ 14 | ^MYMETA. 15 | dmarc_reports.sqlite 16 | t/reports-test.sqlite 17 | -------------------------------------------------------------------------------- /xt/release-pod-syntax.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | BEGIN { 4 | unless ($ENV{RELEASE_TESTING}) { 5 | require Test::More; 6 | Test::More::plan(skip_all => 'these tests are for release candidate testing'); 7 | } 8 | } 9 | 10 | use Test::More; 11 | use Test::Pod 1.41; 12 | 13 | all_pod_files_ok(); 14 | -------------------------------------------------------------------------------- /.release/update-readme.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | . .release/base.sh || exit 4 | 5 | assure_repo_is_clean || exit 6 | 7 | pod2markdown --perldoc-url-prefix=sco lib/Mail/DMARC.pm > README.md 8 | 9 | if ! repo_is_clean; then 10 | git add README.md 11 | git commit -m "doc(README): updated" 12 | fi 13 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | blib/ 2 | .build/ 3 | _build/ 4 | cover_db/ 5 | inc/ 6 | Build 7 | !Build/ 8 | Build.bat 9 | .last_cover_stats 10 | Makefile 11 | Makefile.old 12 | MANIFEST.bak 13 | MYMETA.json 14 | MYMETA.yml 15 | nytprof.out 16 | pm_to_blib 17 | Mail-DMARC-* 18 | t/reports-test.sqlite 19 | dmarc_reports.sqlite 20 | *.bak 21 | -------------------------------------------------------------------------------- /.release/do.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # shellcheck source=.release/base.sh 4 | . .release/base.sh 5 | 6 | assure_changes_has_entry || exit 7 | 8 | .release/version_increment.sh 9 | .release/copyright_year.sh 10 | .release/update-psl.sh 11 | .release/update-readme.sh 12 | .release/tag.sh 13 | .release/publish-to-cpan.sh 14 | -------------------------------------------------------------------------------- /t/whitelist: -------------------------------------------------------------------------------- 1 | # Format: IP *whitespace* type *whitespace* comment 2 | # Reason types: forwarded sampled_out trusted_forwarder mailing_list local_policy other 3 | # any IP without a type specified will default to 'other' 4 | # Comment is a free form entry 5 | 127.0.0.3 trusted_forwarder Test Comment 6 | 127.0.0.1 local_policy 7 | -------------------------------------------------------------------------------- /.release/update-psl.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | . .release/base.sh || exit 4 | 5 | assure_repo_is_clean || exit 6 | 7 | curl -o share/public_suffix_list https://publicsuffix.org/list/effective_tld_names.dat 8 | 9 | if ! repo_is_clean; then 10 | git add share/public_suffix_list 11 | git commit -m "chore: updated PSL" 12 | fi 13 | -------------------------------------------------------------------------------- /.test/install-db.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | psql -c 'CREATE DATABASE dmarc_report;' -U postgres || exit 4 | psql -U postgres dmarc_report < share/mail_dmarc_schema.pgsql || exit 5 | 6 | mysql -e 'CREATE DATABASE IF NOT EXISTS dmarc_report;' || exit 7 | mysql -u root --password="" dmarc_report < share/mail_dmarc_schema.mysql || exit 8 | 9 | exit 0 -------------------------------------------------------------------------------- /share/mail-dmarc.cron: -------------------------------------------------------------------------------- 1 | # /etc/cron.d/dmarc_update_public_suffix_list: crontab entries for the Mail::DMARC package 2 | 3 | SHELL=/bin/sh 4 | PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin 5 | 6 | # Periodically (once a week) check for updates of the public suffix list 7 | 0 4 * * 0 root dmarc_update_public_suffix_list --random 8 | 9 | -------------------------------------------------------------------------------- /.release/copyright_year.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | . .release/base.sh || exit 4 | 5 | assure_repo_is_clean || exit 6 | 7 | YEAR=$(date "+%Y") 8 | 9 | sed -i '' \ 10 | -e "/copyright/ s/20[[:digit:]][[:digit:]]/$YEAR/" \ 11 | LICENSE $(find lib -type f -name '*.pm') 12 | 13 | if ! repo_is_clean; then 14 | git add . 15 | git commit -m "doc: bump copyright to $YEAR" 16 | fi 17 | -------------------------------------------------------------------------------- /.release/publish-to-cpan.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ -n "$PERL_PUBLISH_SETUP" ]; then 4 | perl -MCPAN -e 'install Module::Build' 5 | perl -MCPAN -e 'install Mozilla::CA' 6 | perl -MCPAN -e 'install CPAN::Uploader' 7 | fi 8 | 9 | for _f in Mail-DMARC-*; 10 | do 11 | echo "rm $_f" 12 | rm $_f 13 | done 14 | 15 | perl Build.PL 16 | ./Build dist 17 | ./Build distclean 18 | cpan-upload Mail-DMARC-*.tar.gz 19 | -------------------------------------------------------------------------------- /.test/install-deps.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | DMARC_DEPS="Regexp::Common Config::Tiny File::ShareDir Net::DNS::Resolver DBD::SQLite DBD::Pg DBD::mysql Net::IP Socket6 Email::MIME Net::SMTPS XML::LibXML Email::Sender DBIx::Simple HTTP::Tiny Test::File::ShareDir Test::Output Net::IDN::Encode CGI XML::Validator::Schema Net::DNS::Resolver::Mock" 4 | 5 | for _d in $DMARC_DEPS; do 6 | cpanm --quiet --notest "$_d" || exit 7 | done 8 | -------------------------------------------------------------------------------- /share/html/plugins/searchFilter.css: -------------------------------------------------------------------------------- 1 | .ui-searchFilter { display: none; position: absolute; z-index: 770; overflow: visible;} 2 | .ui-searchFilter table {position:relative; margin:0em; width:auto} 3 | .ui-searchFilter table td {margin: 0em; padding: 1px;} 4 | .ui-searchFilter table td input, .ui-searchFilter table td select {margin: 0.1em;} 5 | .ui-searchFilter .ui-state-default { cursor: pointer; } 6 | .ui-searchFilter .divider hr {margin: 1px; } -------------------------------------------------------------------------------- /t/23.Report.Send.HTTP.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use lib 'lib'; 8 | 9 | foreach my $req ( 'Net::HTTP' ) { 10 | eval "use $req"; 11 | if ($@) { 12 | plan( skip_all => "$req not available" ); 13 | exit; 14 | } 15 | }; 16 | 17 | my $mod = 'Mail::DMARC::Report::Send::HTTP'; 18 | use_ok($mod); 19 | my $http = $mod->new; 20 | isa_ok( $http, $mod ); 21 | 22 | done_testing(); 23 | exit; 24 | 25 | -------------------------------------------------------------------------------- /xt/author-critic.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | BEGIN { 4 | unless ($ENV{AUTHOR_TESTING}) { 5 | require Test::More; 6 | Test::More::plan(skip_all => 'these tests are for testing by the author'); 7 | } 8 | } 9 | 10 | 11 | use strict; 12 | use warnings; 13 | 14 | use Test::More; 15 | use English qw(-no_match_vars); 16 | 17 | eval "use Test::Perl::Critic"; 18 | plan skip_all => 'Test::Perl::Critic required to criticise code' if $@; 19 | Test::Perl::Critic->import( -profile => "xt/perlcritic.rc" ) if -e "xt/perlcritic.rc"; 20 | all_critic_ok(); 21 | -------------------------------------------------------------------------------- /bin/dmarc_send_reports: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | use Mail::DMARC::Report::Sender; 5 | my $sender = Mail::DMARC::Report::Sender->new; 6 | $sender->run; 7 | 8 | __END__ 9 | 10 | =pod 11 | 12 | =head1 NAME 13 | 14 | dmarc_send_reports: send aggregate reports 15 | 16 | =head1 AUTHORS 17 | 18 | =over 4 19 | 20 | =item * 21 | 22 | Matt Simerson 23 | 24 | =item * 25 | 26 | Davide Migliavacca 27 | 28 | =item * 29 | 30 | Marc Bradshaw 31 | 32 | =back 33 | 34 | =cut 35 | -------------------------------------------------------------------------------- /share/html/css/ellipsis-xbl.xml: -------------------------------------------------------------------------------- 1 | 2 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /xt/perlcritic.rc: -------------------------------------------------------------------------------- 1 | severity = stern 2 | ; gentle stern harsh cruel brutal 3 | 4 | verbose = [%p] %m at line %l, column %c. %e. (Severity: %s)\n 5 | 6 | [-Documentation::RequirePodSections] 7 | 8 | [-TestingAndDebugging::RequireUseStrict] 9 | [-TestingAndDebugging::RequireUseWarnings] 10 | 11 | ; in general, I agree, but I disagree in mail::critic::result::evaluated 12 | [-Modules::ProhibitMultiplePackages] 13 | 14 | [Subroutines::RequireArgUnpacking] 15 | short_subroutine_statements = 5 16 | 17 | [RegularExpressions::RequireExtendedFormatting] 18 | minimum_regex_length_to_complain_about = 8 19 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Test/Transport.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Test::Transport; 2 | # VERSION 3 | use strict; 4 | use warnings; 5 | use Email::Sender::Transport::Test; 6 | 7 | sub new { 8 | my $class = shift; 9 | my $self = {}; 10 | return bless $self, $class; 11 | }; 12 | 13 | { 14 | my $global_transport = Email::Sender::Transport::Test->new; 15 | sub get_test_transport { 16 | return $global_transport; 17 | } 18 | } 19 | 20 | sub get_transports_for { 21 | my ( $self,$args ) = @_; 22 | my @transports; 23 | push @transports, $self->get_test_transport; 24 | return @transports; 25 | } 26 | 27 | 1; 28 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | 2 | ### Planned Features 3 | 4 | * [ ] Forensic reports 5 | * [ ] HTTP report delivery 6 | * [ ] more SMTP error reporting 7 | * [ ] Report SPF records in dmarc\_lookup output 8 | * [ ] add a 'cron' mode for dmarc\_send and dmarc\_receive, if no controlling TTY, don't output status messages 9 | * [ ] skip DMARC reporting for incoming DMARC reports destined to config->organization->email 10 | 11 | 12 | ### Maybe TODO: 13 | 14 | * [ ] detect > 1 From recipient, apply strongest policy 15 | 16 | 17 | ### Done 18 | 19 | * [x] automatically delete reports after 12 delivery errors 20 | * [x] send a 'too big' notification email 21 | -------------------------------------------------------------------------------- /.release/tag.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | . .release/base.sh || exit 4 | 5 | assure_repo_is_clean || exit 6 | 7 | TAGNAME="v$(get_version)" 8 | echo "tag $TAGNAME" 9 | 10 | git tag "$TAGNAME" 11 | git push --tags 12 | 13 | # GitHub CLI api 14 | # https://cli.github.com/manual/gh_api 15 | 16 | gh api \ 17 | --method POST \ 18 | -H "Accept: application/vnd.github+json" \ 19 | -H "X-GitHub-Api-Version: 2022-11-28" \ 20 | /repos/msimerson/mail-dmarc/releases \ 21 | -f tag_name="$TAGNAME" \ 22 | -f target_commitish='master' \ 23 | -f name="$TAGNAME" \ 24 | -F draft=true \ 25 | -F prerelease=false \ 26 | -F generate_release_notes=true 27 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Is your feature request related to a problem? Please describe.** 11 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 12 | 13 | **Describe the solution you'd like** 14 | A clear and concise description of what you want to happen. 15 | 16 | **Describe alternatives you've considered** 17 | A clear and concise description of any alternative solutions or features you've considered. 18 | 19 | **Additional context** 20 | Add any other context or screenshots about the feature request here. 21 | -------------------------------------------------------------------------------- /.perltidyrc: -------------------------------------------------------------------------------- 1 | -l=78 # Max line width is 78 cols 2 | -i=4 # Indent level is 4 cols 3 | -ci=4 # Continuation indent is 4 cols 4 | #-st # Output to STDOUT 5 | -b # edit in place and backup 6 | -se # Errors to STDERR 7 | -vt=2 # Maximal vertical tightness 8 | -cti=0 # No extra indentation for closing brackets 9 | -pt=1 # Medium parenthesis tightness 10 | -bt=1 # Medium brace tightness 11 | -sbt=1 # Medium square bracket tightness 12 | -bbt=1 # Medium block brace tightness 13 | -nsfs # No space before semicolons 14 | -nolq # Don't outdent long quoted strings 15 | -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" 16 | # Break before all operators 17 | 18 | -------------------------------------------------------------------------------- /.release/base.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | get_version() 4 | { 5 | echo "1.$(date '+%Y%m%d')" 6 | } 7 | 8 | repo_is_clean() 9 | { 10 | if [ -z "$(git status --porcelain)" ]; then 11 | return 0 12 | fi 13 | 14 | return 1 15 | } 16 | 17 | assure_repo_is_clean() 18 | { 19 | if repo_is_clean; then return 0; fi 20 | 21 | echo 22 | echo "ERROR: Uncommitted changes, cowardly refusing to continue..." 23 | echo 24 | sleep 2 25 | 26 | git status 27 | 28 | return 1 29 | } 30 | 31 | assure_changes_has_entry() 32 | { 33 | THIS_VERSION=$(get_version) 34 | 35 | if ! grep -q "$THIS_VERSION" Changes.md; then 36 | echo "OOPS, Changes.md has no entry for version $THIS_VERSION" 37 | return 1 38 | fi 39 | 40 | return 0 41 | } -------------------------------------------------------------------------------- /.release/version_increment.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | . .release/base.sh || exit 4 | 5 | assure_repo_is_clean || exit 6 | 7 | NEWVER="$(get_version)" 8 | 9 | update_modules() 10 | { 11 | # shellcheck disable=SC2046 12 | sed -i '' \ 13 | -e "/VERSION =/ s/= .*$/= '$NEWVER';/" \ 14 | -e "/^version / s/.*/version $NEWVER/" \ 15 | $(find lib -type f -name '*.pm') 16 | 17 | git add lib 18 | } 19 | 20 | update_readme() 21 | { 22 | pod2markdown lib/Mail/DMARC.pm README.md 23 | git add README.md 24 | } 25 | 26 | update_meta() 27 | { 28 | # update the version in META.* files 29 | perl Build.PL 30 | ./Build distclean 31 | git add META.* 32 | } 33 | 34 | update_modules 35 | update_readme 36 | update_meta 37 | 38 | if ! repo_is_clean; then 39 | git status 40 | git add . 41 | fi 42 | 43 | git commit -m "release version $NEWVER" 44 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Describe the bug** 11 | A clear and concise description of what the bug is. 12 | 13 | **To Reproduce** 14 | Steps to reproduce the behavior: 15 | 1. Go to '...' 16 | 2. Click on '....' 17 | 3. Scroll down to '....' 18 | 4. See error 19 | 20 | **Expected behavior** 21 | A clear and concise description of what you expected to happen. 22 | 23 | **Screenshots** 24 | If applicable, add screenshots to help explain your problem. 25 | 26 | **Server (please complete the following information):** 27 | - OS: [e.g. Ubuntu] 28 | - Version [e.g. 10] 29 | 30 | **Perl (please complete the following information):** 31 | - Version [e.g. 5.28] 32 | 33 | **Additional context** 34 | Add any other context about the problem here. 35 | -------------------------------------------------------------------------------- /.github/workflows/critic.yml: -------------------------------------------------------------------------------- 1 | name: Perl Critic 2 | 3 | on: [ push, pull_request ] 4 | 5 | jobs: 6 | perl_tester: 7 | runs-on: ubuntu-latest 8 | name: "perl v${{ matrix.perl-version }}" 9 | 10 | strategy: 11 | fail-fast: false 12 | matrix: 13 | perl-version: 14 | - "5.30" 15 | 16 | container: 17 | image: perl:${{ matrix.perl-version }} 18 | 19 | steps: 20 | - name: Checkout Code 21 | uses: actions/checkout@v4 22 | with: 23 | fetch-depth: 1 24 | 25 | - name: Install Perl Modules 26 | uses: perl-actions/install-with-cpanm@v1 27 | with: 28 | install: | 29 | Test::More 30 | Test::Perl::Critic 31 | sudo: false 32 | 33 | - run: perl Makefile.PL 34 | 35 | - name: Perl Critic 36 | env: 37 | AUTHOR_TESTING: 1 38 | run: prove xt/author-critic.t 39 | -------------------------------------------------------------------------------- /INSTALL.md: -------------------------------------------------------------------------------- 1 | 2 | # Install Mail::DMARC's dependencies 3 | 4 | ## The fast way, using your systems package manager (yum, apt, ports): 5 | 6 | perl bin/install_deps.pl 7 | 8 | If your system doesn't have a package manager, or the package version fails, or the version installed by your systems package manager isn't new enough, install_deps will also attempt to install the latest version via CPAN. 9 | 10 | Once the dependencies are installed, install Mail::DMARC as any other perl module: 11 | 12 | perl Makefile.PL 13 | make 14 | make install clean 15 | 16 | Copy the mail-dmarc.ini file to your systems preferred local etc directory (/etc, /usr/local/etc, opt/local/etc) and edit at least the settings in the [organization] block: 17 | 18 | cp mail-dmarc.ini /etc/ 19 | $EDITOR /etc/mail-dmarc.ini 20 | 21 | NOTE: Most of the dependencies are optionally required for the DMARC reporting features. Mail::DMARC will perform validation with only these modules: 22 | 23 | Regexp::Common 24 | Config::Tiny 25 | File::ShareDir 26 | Net::DNS::Resolver 27 | Net::IP 28 | Socket6 29 | 30 | -------------------------------------------------------------------------------- /share/dmarc_whitelist: -------------------------------------------------------------------------------- 1 | # Format: IP *whitespace* type *whitespace* comment 2 | # 3 | # Reason types: forwarded sampled_out trusted_forwarder mailing_list local_policy other 4 | # any IP without a type specified will default to 'other' 5 | # 6 | # Comment is a free form text entry 7 | 127.0.0.3 trusted_forwarder Test Comment 8 | 127.0.0.1 local_policy 9 | 10 | 140.211.11.3 mailing_list apache.org 11 | 12 | 141.42.206.35 mailing_list charite.de 13 | 14 | 146.112.225.21 mailing_list phishtank.com 15 | 16 | 168.100.1.1 mailing_list cloud9.net 17 | 168.100.1.3 mailing_list cloud9.net 18 | 168.100.1.4 mailing_list cloud9.net 19 | 168.100.1.7 mailing_list cloud9.net 20 | 21 | 2604:8d00:0:1::3 mailing_list cloud9.net 22 | 2604:8d00:0:1::4 mailing_list cloud9.net 23 | 2604:8d00:0:1::7 mailing_list cloud9.net 24 | 25 | 198.148.79.53 mailing_list clamav.net 26 | 27 | 208.69.40.157 mailing_list blackops.org 28 | 29 | 95.128.36.21 mailing_list kolabsys.com 30 | 95.128.36.22 mailing_list kolabsys.com 31 | 95.128.36.23 mailing_list kolabsys.com 32 | 33 | 199.185.178.25 mailing_list openbsd.org 34 | 199.247.13.58 mailing_list opensmtpd.org 35 | -------------------------------------------------------------------------------- /t/20.Report.URI.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use lib 'lib'; 8 | 9 | my $mod = 'Mail::DMARC::Report::URI'; 10 | use_ok($mod); 11 | my $uri = $mod->new; 12 | isa_ok( $uri, $mod ); 13 | 14 | test_get_size_limit(); 15 | test_parse(); 16 | 17 | done_testing(); 18 | exit; 19 | 20 | sub test_get_size_limit { 21 | my %tests = ( 22 | '51m' => 53477376, 23 | '20k' => 20480, 24 | '5m' => 5242880, 25 | '10m' => 10485760, 26 | '1g' => 1073741824, 27 | '500' => 500, 28 | ); 29 | 30 | foreach my $t ( keys %tests ) { 31 | cmp_ok( $uri->get_size_limit($t), 32 | '==', $tests{$t}, "get_size_limit, $tests{$t}" ); 33 | } 34 | } 35 | 36 | sub test_parse { 37 | my @good = ( 38 | 'http://www.example.com/dmarc-feedback', 39 | 'https://www.example.com/dmarc-feedback', 40 | 'mailto:dmarc@example.com', 41 | 'mailto:dmarc-feedback@example.com,mailto:tld-test@thirdparty.example.net!10m', 42 | ); 43 | 44 | foreach (@good) { 45 | my $uris = $uri->parse($_); 46 | ok( $uris, "parse, $_" ); 47 | ok( scalar @$uris, "parse, count " . scalar @$uris ); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /t/21.Report.Send.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use Test::File::ShareDir 8 | -share => { -dist => { 'Mail-DMARC' => 'share' } }; 9 | 10 | use lib 'lib'; 11 | 12 | my $mod = 'Mail::DMARC::Report::Send'; 13 | use_ok($mod); 14 | my $send = $mod->new; 15 | isa_ok( $send, $mod ); 16 | isa_ok( $send->smtp, 'Mail::DMARC::Report::Send::SMTP' ); 17 | isa_ok( $send->http, 'Mail::DMARC::Report::Send::HTTP' ); 18 | 19 | my $body = $send->too_big_report( 20 | { uri => 'mailto:matt@example.com', 21 | report_bytes => 500000, 22 | report_id => 1, 23 | report_domain=> 'destination.com', 24 | } 25 | ); 26 | 27 | ok( $body, 'too_big_report'); 28 | #cmp_ok( $body, 'eq', sample_too_big(), 'too_big_report: content'); 29 | 30 | done_testing(); 31 | exit; 32 | 33 | sub sample_too_big { 34 | return <<'EO_TOO_BIG' 35 | This is a \'too big\' DMARC notice. The aggregate report was NOT delivered. 36 | 37 | Report-Date: Wed, 14 Aug 2013 22:15:04 -0700 38 | Report-Domain: destination.com 39 | Report-ID: 1 40 | Report-Size: 500000 41 | Submitter: example.com 42 | Submitting-URI: mailto:matt@example.com 43 | 44 | Submitted by My Great Company 45 | Generated with Mail::DMARC 46 | 47 | EO_TOO_BIG 48 | ; 49 | }; 50 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI Tests 2 | 3 | on: [ push, pull_request ] 4 | 5 | jobs: 6 | perl_tester: 7 | runs-on: ubuntu-latest 8 | name: "perl v${{ matrix.perl-version }}" 9 | 10 | strategy: 11 | fail-fast: false 12 | matrix: 13 | perl-version: 14 | - "5.32" 15 | - "5.28" 16 | - "5.26" 17 | 18 | container: 19 | image: perl:${{ matrix.perl-version }} 20 | 21 | steps: 22 | - name: Checkout Code 23 | uses: actions/checkout@v4 24 | with: 25 | fetch-depth: 1 26 | 27 | - name: Install Perl Modules with cpanm 28 | uses: perl-actions/install-with-cpanm@v1 29 | continue-on-error: true 30 | with: 31 | install: | 32 | Regexp::Common 33 | Config::Tiny 34 | File::ShareDir 35 | Net::DNS::Resolver 36 | DBD::SQLite 37 | DBD::Pg 38 | DBD::mysql 39 | Net::IP 40 | Socket6 41 | Email::MIME 42 | Net::SMTPS 43 | XML::LibXML 44 | Email::Sender 45 | DBIx::Simple 46 | HTTP::Tiny 47 | Test::File::ShareDir 48 | Test::Output 49 | Test::Exception 50 | Net::IDN::Encode 51 | CGI 52 | XML::Validator::Schema 53 | Net::DNS::Resolver::Mock 54 | sudo: false 55 | 56 | - run: perl Makefile.PL 57 | 58 | - name: Run CI Tests 59 | run: make test 60 | -------------------------------------------------------------------------------- /t/backends/mail-dmarc.sql.Pg.ini: -------------------------------------------------------------------------------- 1 | ; This is YOU. DMARC reports include information about the reports. Enter it here. 2 | [organization] 3 | domain = example-test.com 4 | org_name = My Great Company 5 | email = noreply@example.com 6 | extra_contact_info = http://www.example.com/dmarc-policy/ 7 | 8 | ; aggregate DMARC reports need to be stored somewhere. Any database 9 | ; with a DBI module (MySQL, SQLite, DBD, etc.) should work. 10 | ; SQLite and MySQL and Postgresql are supported. 11 | ; Default is sqlite. 12 | [report_store] 13 | backend = SQL 14 | dsn = dbi:Pg:database=dmarc_report;port=5432 15 | user = postgres 16 | pass = 17 | 18 | ; backend can be perl or libopendmarc 19 | [dmarc] 20 | backend = perl 21 | 22 | [dns] 23 | timeout = 5 24 | public_suffix_list = share/public_suffix_list 25 | 26 | [smtp] 27 | ; hostname is the external FQDN of this MTA 28 | hostname = mail.example.com 29 | cc = set.this@for.a.while.example.com 30 | whitelist = t/whitelist 31 | 32 | ; By default, we attempt to email directly to the report recipient. 33 | ; Set these to relay via a SMTP smart host. 34 | smarthost = 35 | smartuser = 36 | smartpass = 37 | 38 | [imap] 39 | server = mail.example.com 40 | user = 41 | pass = 42 | ; the imap folder where new dmarc messages will be found 43 | folder = dmarc 44 | ; the folders to store processed reports (a=aggregate, f=forensic) 45 | f_done = dmarc.forensic 46 | a_done = dmarc.aggregate 47 | 48 | [http] 49 | port = 8080 50 | 51 | [https] 52 | port = 8443 53 | ssl_crt = 54 | ssl_key = 55 | -------------------------------------------------------------------------------- /t/backends/mail-dmarc.sql.mysql.ini: -------------------------------------------------------------------------------- 1 | ; This is YOU. DMARC reports include information about the reports. Enter it here. 2 | [organization] 3 | domain = example-test.com 4 | org_name = My Great Company 5 | email = noreply@example.com 6 | extra_contact_info = http://www.example.com/dmarc-policy/ 7 | 8 | ; aggregate DMARC reports need to be stored somewhere. Any database 9 | ; with a DBI module (MySQL, SQLite, DBD, etc.) should work. 10 | ; SQLite and MySQL and Postgresql are supported. 11 | ; Default is sqlite. 12 | [report_store] 13 | backend = SQL 14 | dsn = dbi:mysql:database=dmarc_report;port=3306 15 | user = root 16 | pass = 17 | 18 | ; backend can be perl or libopendmarc 19 | [dmarc] 20 | backend = perl 21 | 22 | [dns] 23 | timeout = 5 24 | public_suffix_list = share/public_suffix_list 25 | 26 | [smtp] 27 | ; hostname is the external FQDN of this MTA 28 | hostname = mail.example.com 29 | cc = set.this@for.a.while.example.com 30 | whitelist = t/whitelist 31 | 32 | ; By default, we attempt to email directly to the report recipient. 33 | ; Set these to relay via a SMTP smart host. 34 | smarthost = 35 | smartuser = 36 | smartpass = 37 | 38 | [imap] 39 | server = mail.example.com 40 | user = 41 | pass = 42 | ; the imap folder where new dmarc messages will be found 43 | folder = dmarc 44 | ; the folders to store processed reports (a=aggregate, f=forensic) 45 | f_done = dmarc.forensic 46 | a_done = dmarc.aggregate 47 | 48 | [http] 49 | port = 8080 50 | 51 | [https] 52 | port = 8443 53 | ssl_crt = 54 | ssl_key = 55 | -------------------------------------------------------------------------------- /t/backends/mail-dmarc.sql.SQLite.ini: -------------------------------------------------------------------------------- 1 | ; This is YOU. DMARC reports include information about the reports. Enter it here. 2 | [organization] 3 | domain = example-test.com 4 | org_name = My Great Company 5 | email = noreply@example.com 6 | extra_contact_info = http://www.example.com/dmarc-policy/ 7 | 8 | ; aggregate DMARC reports need to be stored somewhere. Any database 9 | ; with a DBI module (MySQL, SQLite, DBD, etc.) should work. 10 | ; SQLite and MySQL and Postgresql are supported. 11 | ; Default is sqlite. 12 | [report_store] 13 | backend = SQL 14 | dsn = dbi:SQLite:dbname=t/reports-test.sqlite 15 | ; dsn = dbi:SQLite:dbname=:memory: 16 | user = 17 | pass = 18 | 19 | ; backend can be perl or libopendmarc 20 | [dmarc] 21 | backend = perl 22 | 23 | [dns] 24 | timeout = 5 25 | public_suffix_list = share/public_suffix_list 26 | 27 | [smtp] 28 | ; hostname is the external FQDN of this MTA 29 | hostname = mail.example.com 30 | cc = set.this@for.a.while.example.com 31 | whitelist = t/whitelist 32 | 33 | ; By default, we attempt to email directly to the report recipient. 34 | ; Set these to relay via a SMTP smart host. 35 | smarthost = 36 | smartuser = 37 | smartpass = 38 | 39 | [imap] 40 | server = mail.example.com 41 | user = 42 | pass = 43 | ; the imap folder where new dmarc messages will be found 44 | folder = dmarc 45 | ; the folders to store processed reports (a=aggregate, f=forensic) 46 | f_done = dmarc.forensic 47 | a_done = dmarc.aggregate 48 | 49 | [http] 50 | port = 8080 51 | 52 | [https] 53 | port = 8443 54 | ssl_crt = 55 | ssl_key = 56 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Record/Identifiers.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Record::Identifiers; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | 8 | sub new { 9 | my ( $class, @args ) = @_; 10 | croak "invalid arguments" if @args % 2; 11 | my %args = @args; 12 | my $self = bless {}, $class; 13 | foreach my $key ( keys %args ) { 14 | $self->$key( $args{$key} ); 15 | } 16 | return $self; 17 | } 18 | 19 | sub envelope_to { 20 | return $_[0]->{envelope_to} if 1 == scalar @_; 21 | return $_[0]->{envelope_to} = $_[1]; 22 | } 23 | 24 | sub envelope_from { 25 | return $_[0]->{envelope_from} if 1 == scalar @_; 26 | return $_[0]->{envelope_from} = $_[1]; 27 | } 28 | 29 | sub header_from { 30 | return $_[0]->{header_from} if 1 == scalar @_; 31 | return $_[0]->{header_from} = $_[1]; 32 | } 33 | 34 | 1; 35 | 36 | __END__ 37 | 38 | =pod 39 | 40 | =head1 NAME 41 | 42 | Mail::DMARC::Report::Aggregate::Record::Identifiers - identifiers section of a DMARC aggregate record 43 | 44 | =head1 VERSION 45 | 46 | version 1.20250805 47 | 48 | =head1 AUTHORS 49 | 50 | =over 4 51 | 52 | =item * 53 | 54 | Matt Simerson 55 | 56 | =item * 57 | 58 | Davide Migliavacca 59 | 60 | =item * 61 | 62 | Marc Bradshaw 63 | 64 | =back 65 | 66 | =head1 COPYRIGHT AND LICENSE 67 | 68 | This software is copyright (c) 2025 by Matt Simerson. 69 | 70 | This is free software; you can redistribute it and/or modify it under 71 | the same terms as the Perl 5 programming language system itself. 72 | 73 | =cut 74 | 75 | -------------------------------------------------------------------------------- /.github/workflows/codecov.yml: -------------------------------------------------------------------------------- 1 | name: Coverage Test 2 | 3 | on: [ push, pull_request ] 4 | 5 | jobs: 6 | perl_tester: 7 | runs-on: ubuntu-latest 8 | name: "perl v${{ matrix.perl-version }}" 9 | 10 | strategy: 11 | fail-fast: false 12 | matrix: 13 | perl-version: 14 | - "5.30" 15 | 16 | container: 17 | image: perl:${{ matrix.perl-version }} 18 | 19 | steps: 20 | - name: Checkout Code 21 | uses: actions/checkout@v4 22 | with: 23 | fetch-depth: 1 24 | 25 | - name: Install Perl Modules 26 | uses: perl-actions/install-with-cpanm@v1 27 | continue-on-error: true 28 | with: 29 | install: | 30 | Regexp::Common 31 | Config::Tiny 32 | File::ShareDir 33 | Net::DNS::Resolver 34 | DBD::SQLite 35 | DBD::Pg 36 | DBD::mysql 37 | Net::IP 38 | Socket6 39 | Email::MIME 40 | Net::HTTP 41 | Net::SMTPS 42 | XML::LibXML 43 | Email::Sender 44 | DBIx::Simple 45 | HTTP::Tiny 46 | Test::File::ShareDir 47 | Test::Output 48 | Test::Exception 49 | Net::IDN::Encode 50 | CGI 51 | XML::Validator::Schema 52 | Devel::Cover::Report::Coveralls 53 | Net::DNS::Resolver::Mock 54 | sudo: false 55 | 56 | - run: perl Makefile.PL 57 | 58 | - name: Coveralls 59 | env: 60 | COVERALLS_REPO_TOKEN: ${{ secrets.COVERALLS_REPO_TOKEN }} 61 | run: cover -test -report coveralls 62 | -------------------------------------------------------------------------------- /t/mail-dmarc.ini: -------------------------------------------------------------------------------- 1 | ; This is YOU. DMARC reports include information about the reports. Enter it here. 2 | [organization] 3 | domain = example-test.com 4 | org_name = My Great Company 5 | email = noreply@example.com 6 | extra_contact_info = http://www.example.com/dmarc-policy/ 7 | 8 | ; aggregate DMARC reports need to be stored somewhere. Any database 9 | ; with a DBI module (MySQL, SQLite, DBD, etc.) should work. 10 | ; SQLite and MySQL and Postgresql are supported. 11 | ; Default is sqlite. 12 | [report_store] 13 | backend = SQL 14 | dsn = dbi:SQLite:dbname=t/reports-test.sqlite 15 | ;dsn = dbi:mysql:database=dmarc_report;host=db;port=3306 16 | ;dsn = dbi:Pg:database=dmarc_report;host=db;port=5432 17 | user = 18 | pass = 19 | 20 | ; backend can be perl or libopendmarc 21 | [dmarc] 22 | backend = perl 23 | 24 | [dns] 25 | timeout = 5 26 | public_suffix_list = share/public_suffix_list 27 | 28 | [smtp] 29 | ; hostname is the external FQDN of this MTA 30 | hostname = mail.example.com 31 | cc = set.this@for.a.while.example.com 32 | whitelist = t/whitelist 33 | transports = Mail::DMARC::Test::Transport 34 | 35 | ; By default, we attempt to email directly to the report recipient. 36 | ; Set these to relay via a SMTP smart host. 37 | smarthost = 38 | smartuser = 39 | smartpass = 40 | 41 | [imap] 42 | server = mail.example.com 43 | user = 44 | pass = 45 | ; the imap folder where new dmarc messages will be found 46 | folder = dmarc 47 | ; the folders to store processed reports (a=aggregate, f=forensic) 48 | f_done = dmarc.forensic 49 | a_done = dmarc.aggregate 50 | 51 | [http] 52 | port = 8080 53 | 54 | [https] 55 | port = 8443 56 | ssl_crt = 57 | ssl_key = 58 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Result/Reason.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Result::Reason; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | 8 | sub new { 9 | my ( $class, @args ) = @_; 10 | croak "invalid arguments" if @args % 2; 11 | my %args = @args; 12 | my $self = bless {}, $class; 13 | foreach my $key ( keys %args ) { 14 | $self->$key( $args{$key} ); 15 | } 16 | return $self; 17 | } 18 | 19 | sub type { 20 | return $_[0]->{type} if 1 == scalar @_; 21 | croak "invalid type" 22 | if 0 == grep {/^$_[1]$/ix} 23 | qw/ forwarded sampled_out trusted_forwarder 24 | mailing_list local_policy other /; 25 | return $_[0]->{type} = $_[1]; 26 | } 27 | 28 | sub comment { 29 | return $_[0]->{comment} if 1 == scalar @_; 30 | 31 | # comment is optional and requires no validation 32 | return $_[0]->{comment} = $_[1]; 33 | } 34 | 35 | 1; 36 | 37 | __END__ 38 | 39 | =pod 40 | 41 | =head1 NAME 42 | 43 | Mail::DMARC::Result::Reason - policy override reason 44 | 45 | =head1 VERSION 46 | 47 | version 1.20250805 48 | 49 | =head1 METHODS 50 | 51 | =head2 type 52 | 53 | Type is the type of override used, and is one of a number of fixed strings. 54 | 55 | =head2 comment 56 | 57 | Comment may or may not be present, and may be anything. 58 | 59 | =head1 AUTHORS 60 | 61 | =over 4 62 | 63 | =item * 64 | 65 | Matt Simerson 66 | 67 | =item * 68 | 69 | Davide Migliavacca 70 | 71 | =item * 72 | 73 | Marc Bradshaw 74 | 75 | =back 76 | 77 | =head1 COPYRIGHT AND LICENSE 78 | 79 | This software is copyright (c) 2025 by Matt Simerson. 80 | 81 | This is free software; you can redistribute it and/or modify it under 82 | the same terms as the Perl 5 programming language system itself. 83 | 84 | =cut 85 | 86 | -------------------------------------------------------------------------------- /t/16.Report.Aggregate.Record.Auth_Results.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use lib 'lib'; 8 | 9 | my $mod = 'Mail::DMARC::Report::Aggregate::Record::Auth_Results'; 10 | use_ok($mod); 11 | my $ar = $mod->new; 12 | 13 | _auth_results(); 14 | _spf(); 15 | _dkim(); 16 | 17 | done_testing(); 18 | exit; 19 | 20 | sub _auth_results { 21 | isa_ok( $ar, $mod ); 22 | }; 23 | 24 | sub _spf { 25 | is_deeply( $ar->spf, [], "spf, empty"); 26 | 27 | my %spf_res = ( 28 | domain => 'test.com', 29 | result => 'pass', 30 | scope => 'mfrom', 31 | ); 32 | 33 | $ar->spf( %spf_res ); 34 | is_deeply( $ar->spf, [ \%spf_res ], "spf, hash"); 35 | 36 | $ar->spf( %spf_res ); 37 | is_deeply( $ar->spf, [ \%spf_res, \%spf_res ], "spf, hashref"); 38 | 39 | $ar = $mod->new; 40 | $ar->spf([ \%spf_res, \%spf_res ]); 41 | is_deeply( $ar->spf, [ \%spf_res, \%spf_res ], "spf, arrayref of hashref"); 42 | 43 | #warn Dumper($ar->spf); 44 | } 45 | 46 | sub _dkim { 47 | is_deeply( $ar->dkim, [], "dkim"); 48 | 49 | my %dkim_res = ( 50 | domain => 'tnpi.net', 51 | selector => 'jan2015', 52 | result => 'fail', 53 | human_result=> 'fail (body has been altered)', 54 | ); 55 | 56 | $ar->dkim( %dkim_res ); 57 | is_deeply( $ar->dkim, [ \%dkim_res ], "dkim, as hash"); 58 | 59 | 60 | $ar->dkim( \%dkim_res ); 61 | is_deeply( $ar->dkim, [ \%dkim_res, \%dkim_res ], "dkim, as hashref"); 62 | 63 | $ar->dkim( \%dkim_res ); 64 | is_deeply( $ar->dkim, [ \%dkim_res, \%dkim_res, \%dkim_res ], "dkim, as hashref again"); 65 | 66 | 67 | $ar = $mod->new; 68 | $ar->dkim([ \%dkim_res, \%dkim_res ]); 69 | is_deeply( $ar->dkim, [ \%dkim_res, \%dkim_res ], "dkim, as arrayref of hashrefs"); 70 | 71 | #warn Dumper($ar->dkim); 72 | } 73 | -------------------------------------------------------------------------------- /DEVELOP.md: -------------------------------------------------------------------------------- 1 | # Find the source 2 | 3 | [The source code is hosted on GitHub](https://github.com/msimerson/mail-dmarc) 4 | 5 | 6 | # Download the source 7 | 8 | To make changes or submit patches, visit the GitHub URL and click the ***Fork*** button. Then clone your fork to your local disk: 9 | 10 | git clone git@github.com:YOUR-USER-NAME/mail-dmarc.git 11 | 12 | 13 | # Use the source 14 | 15 | Use git in the normal way: 16 | 17 | cd mail-dmarc 18 | .... make a change or two ... 19 | git status ( see changes ) 20 | git diff ( show diffs ) 21 | git add ... ( stage changes ) 22 | git commit 23 | 24 | If your changes are significant and might possibly involve more than one commit, create a branch first: 25 | 26 | git checkout -b fix-knob-handle 27 | ... make changes ... 28 | git commit 29 | ... make more related changes ... 30 | git commit 31 | 32 | When you are done making changes, push them to GitHub: 33 | 34 | git push origin (push to your GitHub account) 35 | 36 | When the new feature branch is no longer useful, delete it: 37 | 38 | git branch -d fix-knob-handle 39 | 40 | # Submit your changes 41 | 42 | git push origin master (push to your GitHub account) 43 | 44 | Visit your fork on the GitHub web site. On the main page of your fork is a ***Pull Request*** button. That is how you submit your changes to the main repo. A collaborator will review your PR and either comment or merge it. 45 | 46 | # Check build status: 47 | 48 | [![Build Status](https://github.com/msimerson/mail-dmarc/actions/workflows/ci.yml/badge.svg)](https://github.com/msimerson/mail-dmarc/actions/workflows/ci.yml) 49 | 50 | GitHub Actions automatically runs build tests when commits are pushed to GitHub, and sends notifications to the author(s) in case of failure. For everyone else, checking the build status after a push request is merged is a good idea. 51 | 52 | # Release 53 | 54 | ````sh 55 | .release/do.sh 56 | ```` 57 | -------------------------------------------------------------------------------- /share/html/css/ui.multiselect.css: -------------------------------------------------------------------------------- 1 | /* Multiselect 2 | ----------------------------------*/ 3 | 4 | .ui-multiselect { border: solid 1px; font-size: 0.8em; } 5 | .ui-multiselect ul { -moz-user-select: none; } 6 | .ui-multiselect li { margin: 0; padding: 0; cursor: default; line-height: 20px; height: 20px; font-size: 11px; list-style: none; } 7 | .ui-multiselect li a { color: #999; text-decoration: none; padding: 0; display: block; float: left; cursor: pointer;} 8 | .ui-multiselect li.ui-draggable-dragging { padding-left: 10px; } 9 | 10 | .ui-multiselect div.selected { position: relative; padding: 0; margin: 0; border: 0; float:left; } 11 | .ui-multiselect ul.selected { position: relative; padding: 0; overflow: auto; overflow-x: hidden; background: #fff; margin: 0; list-style: none; border: 0; position: relative; width: 100%; } 12 | .ui-multiselect ul.selected li { } 13 | 14 | .ui-multiselect div.available { position: relative; padding: 0; margin: 0; border: 0; float:left; border-left: 1px solid; } 15 | .ui-multiselect ul.available { position: relative; padding: 0; overflow: auto; overflow-x: hidden; background: #fff; margin: 0; list-style: none; border: 0; width: 100%; } 16 | .ui-multiselect ul.available li { padding-left: 10px; } 17 | 18 | .ui-multiselect .ui-state-default { border: none; margin-bottom: 1px; position: relative; padding-left: 20px;} 19 | .ui-multiselect .ui-state-hover { border: none; } 20 | .ui-multiselect .ui-widget-header {border: none; font-size: 11px; margin-bottom: 1px;} 21 | 22 | .ui-multiselect .add-all { float: right; padding: 7px;} 23 | .ui-multiselect .remove-all { float: right; padding: 7px;} 24 | .ui-multiselect .search { float: left; padding: 4px;} 25 | .ui-multiselect .count { float: left; padding: 7px;} 26 | 27 | .ui-multiselect li span.ui-icon-arrowthick-2-n-s { position: absolute; left: 2px; } 28 | .ui-multiselect li a.action { position: absolute; right: 2px; top: 2px; } 29 | 30 | .ui-multiselect input.search { height: 14px; padding: 1px; opacity: 0.5; margin: 4px; width: 100px; } -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Record/Row.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Record::Row; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | require Mail::DMARC::Report::Aggregate::Record::Row::Policy_Evaluated; 8 | 9 | sub new { 10 | my ( $class, @args ) = @_; 11 | croak "invalid arguments" if @args % 2; 12 | my %args = @args; 13 | my $self = bless {}, $class; 14 | foreach my $key ( keys %args ) { 15 | $self->$key( $args{$key} ); 16 | } 17 | return $self; 18 | } 19 | 20 | sub source_ip { 21 | return $_[0]->{source_ip} if 1 == scalar @_; 22 | return $_[0]->{source_ip} = $_[1]; 23 | } 24 | 25 | sub policy_evaluated { 26 | my ($self, @args) = @_; 27 | 28 | if (0 == scalar @args) { 29 | return $self->{policy_evaluated} if $self->{policy_evaluated}; 30 | } 31 | 32 | if (1 == scalar @args) { 33 | if ('HASH' eq ref $args[0]) { 34 | @args = %{ $args[0] }; 35 | } 36 | } 37 | 38 | return $self->{policy_evaluated} = 39 | Mail::DMARC::Report::Aggregate::Record::Row::Policy_Evaluated->new(@args); 40 | } 41 | 42 | sub count { 43 | return $_[0]->{count} if 1 == scalar @_; 44 | return $_[0]->{count} = $_[1]; 45 | } 46 | 47 | 1; 48 | 49 | __END__ 50 | 51 | =pod 52 | 53 | =head1 NAME 54 | 55 | Mail::DMARC::Report::Aggregate::Record::Row - row section of a DMARC aggregate record 56 | 57 | =head1 VERSION 58 | 59 | version 1.20250805 60 | 61 | =head1 AUTHORS 62 | 63 | =over 4 64 | 65 | =item * 66 | 67 | Matt Simerson 68 | 69 | =item * 70 | 71 | Davide Migliavacca 72 | 73 | =item * 74 | 75 | Marc Bradshaw 76 | 77 | =back 78 | 79 | =head1 COPYRIGHT AND LICENSE 80 | 81 | This software is copyright (c) 2025 by Matt Simerson. 82 | 83 | This is free software; you can redistribute it and/or modify it under 84 | the same terms as the Perl 5 programming language system itself. 85 | 86 | =cut 87 | 88 | -------------------------------------------------------------------------------- /share/html/plugins/ui.multiselect.css: -------------------------------------------------------------------------------- 1 | /* Multiselect 2 | ----------------------------------*/ 3 | 4 | .ui-multiselect { border: solid 1px; font-size: 0.8em; } 5 | .ui-multiselect ul { -moz-user-select: none; } 6 | .ui-multiselect li { margin: 0; padding: 0; cursor: default; line-height: 20px; height: 20px; font-size: 11px; list-style: none; } 7 | .ui-multiselect li a { color: #999; text-decoration: none; padding: 0; display: block; float: left; cursor: pointer;} 8 | .ui-multiselect li.ui-draggable-dragging { padding-left: 10px; } 9 | 10 | .ui-multiselect div.selected { position: relative; padding: 0; margin: 0; border: 0; float:left; } 11 | .ui-multiselect ul.selected { position: relative; padding: 0; overflow: auto; overflow-x: hidden; background: #fff; margin: 0; list-style: none; border: 0; position: relative; width: 100%; } 12 | .ui-multiselect ul.selected li { } 13 | 14 | .ui-multiselect div.available { position: relative; padding: 0; margin: 0; border: 0; float:left; border-left: 1px solid; } 15 | .ui-multiselect ul.available { position: relative; padding: 0; overflow: auto; overflow-x: hidden; background: #fff; margin: 0; list-style: none; border: 0; width: 100%; } 16 | .ui-multiselect ul.available li { padding-left: 10px; } 17 | 18 | .ui-multiselect .ui-state-default { border: none; margin-bottom: 1px; position: relative; padding-left: 20px;} 19 | .ui-multiselect .ui-state-hover { border: none; } 20 | .ui-multiselect .ui-widget-header {border: none; font-size: 11px; margin-bottom: 1px;} 21 | 22 | .ui-multiselect .add-all { float: right; padding: 7px;} 23 | .ui-multiselect .remove-all { float: right; padding: 7px;} 24 | .ui-multiselect .search { float: left; padding: 4px;} 25 | .ui-multiselect .count { float: left; padding: 7px;} 26 | 27 | .ui-multiselect li span.ui-icon-arrowthick-2-n-s { position: absolute; left: 2px; } 28 | .ui-multiselect li a.action { position: absolute; right: 2px; top: 2px; } 29 | 30 | .ui-multiselect input.search { height: 14px; padding: 1px; opacity: 0.5; margin: 4px; width: 100px; } -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Record/Row/Policy_Evaluated.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Record::Row::Policy_Evaluated; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | 8 | sub new { 9 | my ( $class, @args ) = @_; 10 | croak "invalid arguments" if @args % 2; 11 | my %args = @args; 12 | my $self = bless { reason => [] }, $class; 13 | foreach my $key ( keys %args ) { 14 | $self->$key( $args{$key} ); 15 | } 16 | return $self; 17 | } 18 | 19 | sub disposition { 20 | return $_[0]->{disposition} if 1 == scalar @_; 21 | croak "invalid disposition ($_[1]" 22 | if 0 == grep {/^$_[1]$/ix} qw/ reject quarantine none /; 23 | return $_[0]->{disposition} = $_[1]; 24 | } 25 | 26 | sub dkim { 27 | return $_[0]->{dkim} if 1 == scalar @_; 28 | return $_[0]->{dkim} = $_[1]; 29 | } 30 | 31 | sub spf { 32 | return $_[0]->{spf} if 1 == scalar @_; 33 | return $_[0]->{spf} = $_[1]; 34 | } 35 | 36 | sub reason { 37 | return $_[0]->{reason} if 1 == scalar @_; 38 | if ('ARRAY' eq ref $_[1]) { # one shot argument 39 | $_[0]->{reason} = $_[1]; 40 | } 41 | else { 42 | push @{ $_[0]->{reason} }, $_[1]; 43 | } 44 | return $_[0]->{reason}; 45 | } 46 | 47 | 1; 48 | 49 | __END__ 50 | 51 | =pod 52 | 53 | =head1 NAME 54 | 55 | Mail::DMARC::Report::Aggregate::Record::Row::Policy_Evaluated - row/policy_evaluated section of a DMARC aggregate record 56 | 57 | =head1 VERSION 58 | 59 | version 1.20250805 60 | 61 | =head1 AUTHORS 62 | 63 | =over 4 64 | 65 | =item * 66 | 67 | Matt Simerson 68 | 69 | =item * 70 | 71 | Davide Migliavacca 72 | 73 | =item * 74 | 75 | Marc Bradshaw 76 | 77 | =back 78 | 79 | =head1 COPYRIGHT AND LICENSE 80 | 81 | This software is copyright (c) 2025 by Matt Simerson. 82 | 83 | This is free software; you can redistribute it and/or modify it under 84 | the same terms as the Perl 5 programming language system itself. 85 | 86 | =cut 87 | -------------------------------------------------------------------------------- /bin/dmarc_update_public_suffix_list: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Getopt::Long; 6 | use HTTP::Tiny; 7 | use Mail::DMARC; 8 | use Pod::Usage; 9 | 10 | my $dryrun = 0; 11 | my $random = 0; 12 | 13 | GetOptions ( 14 | 'dryrun' => \$dryrun, 15 | 'help' => \my $help, 16 | 'random' => \$random, 17 | 'config-file=s' => \my $config_file, 18 | ); 19 | 20 | pod2usage if $help; 21 | 22 | if ( $random ) { 23 | my $sleep_for = int(rand(60*60)); 24 | sleep $sleep_for; 25 | } 26 | 27 | Mail::DMARC->new( 28 | (defined $config_file ? (config_file => $config_file) : ()) 29 | )->update_psl_file($dryrun); 30 | 31 | __END__ 32 | 33 | =pod 34 | 35 | =head1 NAME 36 | 37 | dmarc_update_public_suffix_list: command line tool to download updated public suffix list 38 | 39 | =head1 SYNOPSIS 40 | 41 | dmarc_update_public_suffix_list [ --option=value ] 42 | 43 | =head1 DESCRIPTION 44 | 45 | Downloads a new Public Suffix List to the location specified by /etc/mail-dmarc.ini 46 | 47 | The PSL is maintained by the Mozilla Foundation. It is updated a few times per 48 | month, you are requested to download no more than once per day. 49 | 50 | The URL of the file is https://publicsuffix.org/list/effective_tld_names.dat 51 | More details can be found at https://publicsuffix.org/ 52 | 53 | =head2 Options 54 | 55 | dmarc_update_public_suffix_list [ --dryrun --help ] 56 | 57 | dryrun - show what would be done without overwriting file 58 | random - introduce a random delay to spread server load 59 | intended for use when running from crontab 60 | config-file - alternate config file path 61 | help - print this syntax guide 62 | 63 | =head1 EXAMPLES 64 | 65 | To check that a new file can be downloaded without error but not download the file: 66 | 67 | dmarc_update_public_suffix_list --dryrun 68 | 69 | To download a new Public Suffix List to the location specified my mail-dmarc.ini 70 | 71 | dmarc_update_public_suffix_list 72 | 73 | =head1 AUTHORS 74 | 75 | =over 4 76 | 77 | =item * 78 | 79 | Matt Simerson 80 | 81 | =item * 82 | 83 | Davide Migliavacca 84 | 85 | =item * 86 | 87 | Marc Bradshaw 88 | 89 | =back 90 | 91 | =cut 92 | -------------------------------------------------------------------------------- /bin/dmarc_receive: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Data::Dumper; 6 | use Getopt::Long; 7 | use Pod::Usage; 8 | 9 | use Mail::DMARC::Report::Receive; 10 | 11 | $|++; 12 | 13 | my %command_line_options = ( 14 | 'file:s' => \my $file, 15 | 'imap' => \my $imap, 16 | 'mbox' => \my $mbox, 17 | 'verbose+' => \my $verbose, 18 | ); 19 | GetOptions (%command_line_options); 20 | 21 | pod2usage(0) if ! $imap && ! $mbox && ! $file; 22 | 23 | ## no critic (Carp) 24 | my $recv = Mail::DMARC::Report::Receive->new() or die; 25 | $recv->verbose($verbose) if $verbose; 26 | $recv->from_imap if $imap; 27 | $recv->from_mbox($mbox) if $mbox; 28 | $recv->from_file($file) if $file; 29 | 30 | exit; 31 | 32 | __END__ 33 | 34 | =head1 NAME 35 | 36 | dmarc_receive: receive aggregate reports via IMAP, mbox, or message file(s) 37 | 38 | =head1 USAGE 39 | 40 | dmarc_receive [ --imap | --mbox | --file ] 41 | 42 | 43 | =head1 DESCRIPTION 44 | 45 | This script processes incoming DMARC reports from IMAP, files, or a mbox formatted file. 46 | 47 | =head2 IMAP 48 | 49 | To process reports with IMAP, you must configure the [imap] settings in mail-dmarc.ini. This program will: 50 | 51 | * log into the IMAP account 52 | * select the specified folder (INBOX, dmarc, etc) 53 | * for every unread (Unseen) message, search for DMARC reports 54 | 55 | =head3 IMAP Aggregate report 56 | 57 | IMAP aggregate reports are detected by the presence of zip or gzip attachments. When an aggregate report is detected: 58 | 59 | * the attachment is decompressed 60 | * the XML is parsed 61 | * the report is saved to the report store 62 | * the message is marked as read/seen 63 | * move message to [imap][a_done] folder (if defined) 64 | 65 | =head3 IMAP Forensic report 66 | 67 | IMAP forensic reports are detected by the presence of the content-types message/feedback-report and text/rfc822-headers. When a forensic report is detected it is moved to the [imap][f_done] IMAP folder. 68 | 69 | =head2 File as message 70 | 71 | Accepts the filename of a file containing a mail message. The message is parsed and stored. 72 | 73 | =head2 Mbox 74 | 75 | Accepts the filename of a mbox format file containing mail messages. The messages are parsed and stored. 76 | 77 | =cut 78 | -------------------------------------------------------------------------------- /t/09.HTTP.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Net::DNS::Resolver::Mock; 6 | use Test::More; 7 | 8 | use Test::File::ShareDir 9 | -share => { -dist => { 'Mail-DMARC' => 'share' } }; 10 | 11 | use lib 'lib'; 12 | 13 | foreach my $req ( 'CGI', 'DBD::SQLite 1.31', 'JSON', 'Net::Server::HTTP' ) { 14 | eval "use $req"; 15 | if ($@) { 16 | plan( skip_all => "$req not available" ); 17 | exit; 18 | } 19 | }; 20 | 21 | my $resolver = new Net::DNS::Resolver::Mock(); 22 | $resolver->zonefile_parse(join("\n", 23 | 'tnpi.net. 600 A 66.128.51.170', 24 | '_dmarc.tnpi.net. 600 TXT "v=DMARC1; p=reject; rua=mailto:dmarc-feedback@theartfarm.com; ruf=mailto:dmarc-feedback@theartfarm.com; pct=100"', 25 | #'tnpi.net. 600 MX 10 mail.theartfarm.com.', 26 | '')); 27 | 28 | my $mod = 'Mail::DMARC::HTTP'; 29 | use_ok($mod); 30 | my $http = $mod->new; 31 | isa_ok( $http, $mod ); 32 | 33 | my $cgi = CGI->new(); 34 | my $r = Mail::DMARC::HTTP::serve_validator($cgi, $resolver); 35 | ok($r eq 'missing POST data', "serve_validator, missing POST data"); 36 | 37 | $cgi->param('POSTDATA', 'foo'); 38 | $r = Mail::DMARC::HTTP::serve_validator($cgi, $resolver); 39 | like($r, qr/expected/, "serve_validator, invalid JSON"); 40 | 41 | $cgi->param('POSTDATA', '{"foo":"bar"}'); 42 | $r = Mail::DMARC::HTTP::serve_validator($cgi, $resolver); 43 | like($r, qr/no header_from/, "serve_validator, missing header_from"); 44 | 45 | $cgi->param('POSTDATA', '{"header_from":"tnpi.net"}'); 46 | $r = Mail::DMARC::HTTP::serve_validator($cgi, $resolver); 47 | like($r, qr/"spf":""/, "serve_validator, missing SPF"); 48 | like($r, qr/"dkim":"fail"/, "serve_validator, missing DKIM"); 49 | 50 | $cgi->param('POSTDATA', '{"header_from":"tnpi.net","spf":[{"domain":"tnpi.net","scope":"mfrom","result":"pass"}]}'); 51 | $r = Mail::DMARC::HTTP::serve_validator($cgi, $resolver); 52 | like($r, qr/"spf":"pass"/, "serve_validator, pass SPF"); 53 | like($r, qr/"dkim":"fail"/, "serve_validator, missing DKIM"); 54 | 55 | $cgi->param('POSTDATA', '{"header_from":"tnpi.net","dkim":[{"domain":"tnpi.net","selector":"mar2013","result":"pass"}]}'); 56 | $r = Mail::DMARC::HTTP::serve_validator($cgi, $resolver); 57 | like($r, qr/"spf":""/, "serve_validator, missing SPF"); 58 | like($r, qr/"dkim":"pass"/, "serve_validator, pass DKIM"); 59 | 60 | # this starts up the httpd daemon 61 | #$http->dmarc_httpd(); 62 | 63 | done_testing(); 64 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Send/HTTP.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Send::HTTP; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '1.20250805'; 6 | 7 | use Carp; 8 | 9 | #use Data::Dumper; 10 | #use HTTP::Tiny; # a possibility 11 | #use Net::HTTP; # lazy loaded in 'post' 12 | 13 | use parent 'Mail::DMARC::Base'; 14 | 15 | sub post { 16 | my ( $self, $uri, $report, $gz ) = @_; 17 | 18 | carp "http send feature not complete!"; 19 | return; 20 | 21 | ## no critic (Unreachable,Eval) 22 | # TODO: test against real HTTP server, validate HTTP response 23 | eval "require Net::HTTP" or return; 24 | 25 | my $ver = $Mail::DMARC::Base::VERSION; 26 | my $s = Net::HTTP->new( Host => $uri->host ) or croak $@; 27 | $s->write_request( 28 | POST => $uri->path, 29 | 'User-Agent' => "Mail::DMARC/$ver" 30 | ); 31 | my ( $code, $mess, %h ) = $s->read_response_headers; 32 | 33 | while (1) { 34 | my $buf; 35 | my $n = $s->read_entity_body( $buf, 1024 ); 36 | croak "read failed: $!" unless defined $n; 37 | last unless $n; 38 | print $buf; 39 | return 1; 40 | } 41 | return 0; 42 | } 43 | 44 | 1; 45 | 46 | __END__ 47 | 48 | =pod 49 | 50 | =head1 NAME 51 | 52 | Mail::DMARC::Report::Send::HTTP - utility methods to send reports by HTTP 53 | 54 | =head1 VERSION 55 | 56 | version 1.20250805 57 | 58 | =head1 12.2.2. HTTP 59 | 60 | Where an "http" or "https" method is requested in a Domain Owner's 61 | URI list, the Mail Receiver MAY encode the data using the 62 | "application/gzip" media type ([GZIP]) or MAY send the Appendix C 63 | data uncompressed or unencoded. 64 | 65 | The header portion of the POST or PUT request SHOULD contain a 66 | Subject field as described in Section 12.2.1. 67 | 68 | HTTP permits the use of Content-Transfer-Encoding to upload gzip 69 | content using the POST or PUT instruction after translating the 70 | content to 7-bit ASCII. 71 | 72 | =head1 AUTHORS 73 | 74 | =over 4 75 | 76 | =item * 77 | 78 | Matt Simerson 79 | 80 | =item * 81 | 82 | Davide Migliavacca 83 | 84 | =item * 85 | 86 | Marc Bradshaw 87 | 88 | =back 89 | 90 | =head1 COPYRIGHT AND LICENSE 91 | 92 | This software is copyright (c) 2025 by Matt Simerson. 93 | 94 | This is free software; you can redistribute it and/or modify it under 95 | the same terms as the Perl 5 programming language system itself. 96 | 97 | =cut 98 | 99 | -------------------------------------------------------------------------------- /t/25.Report.Receive.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use IO::Compress::Gzip; 8 | use IO::Compress::Zip; 9 | 10 | use lib 'lib'; 11 | 12 | my $mod = 'Mail::DMARC::Report::Receive'; 13 | use_ok($mod); 14 | my $recv = $mod->new; 15 | isa_ok( $recv, $mod ); 16 | 17 | $recv->config('t/mail-dmarc.ini'); 18 | 19 | test_from_email_file(); 20 | test_get_submitter_from_subject(); 21 | test_from_imap(); 22 | 23 | done_testing(); 24 | exit; 25 | 26 | sub test_from_imap { 27 | my $skip_reason = ''; 28 | 29 | eval "require Net::IMAP::Simple"; 30 | $skip_reason .= "Net::IMAP::Simple not installed" if $@; 31 | 32 | my $c = $recv->config->{imap}; 33 | if ( !$c->{server} || !$c->{user} || !$c->{pass} ) { 34 | $skip_reason .= " and \n" if $skip_reason; 35 | $skip_reason .= "imap not configured in mail-dmarc.ini"; 36 | } 37 | 38 | SKIP: { 39 | skip $skip_reason, 1 if $skip_reason; 40 | ok( $recv->from_imap(), "from_imap" ); 41 | } 42 | } 43 | 44 | sub test_get_submitter_from_subject { 45 | my %subjects = ( 46 | 'aol.com' => 'Subject: Report Domain:theartfarm.com Submitter:aol.com 47 | Report-ID:theartfarm.com_1366084800', 48 | 'ivenue.com' => 49 | 'Subject: Report Domain: tnpi.net Submitter: Ivenue.com Report-ID: tnpi.net-1366977854@Ivenue.com', 50 | 'hotmail.com' => 51 | 'Subject: =?utf-8?B?UmVwb3J0IERvbWFpbjogc2ltZXJzb24ubmV0IFN1Ym1pdHRlcjogaG90bWFpbC5jb20gUmVwb3J0LUlEOiA8YTY2YWVmZWIzZjI3NGNhYmJmZGM2MWMwMTVlNTg2N2VAaG90bWFpbC5jb20+?=', 52 | 'google.com' => 53 | 'Subject: Report domain: timbersmart.com Submitter: google.com Report-ID: 6022178961730607282', 54 | 'hotmail.com' => 55 | 'Subject: =?utf-8?B?UmVwb3J0IERvbWFpbjogbHluYm95ZXIuY29tIFN1Ym1pdHRlcjogaG90bWFpbC5jb20gUmVwb3J0LUlEOiA8MDJjNTM5YWY0ZjE2NGFlZGE3ZGQxZTdhYWJhOTc1MWJAaG90bWFpbC5jb20+?=', 56 | 'yahoo.com' => 57 | 'Subject: Report Domain: timbersmart.com Submitter: yahoo.com Report-ID: <1368868092.438744>', 58 | ); 59 | 60 | foreach my $dom ( keys %subjects ) { 61 | my $subject = $subjects{$dom}; 62 | cmp_ok( $recv->get_submitter_from_subject($subject), 63 | 'eq', $dom, "get_submitter_from_subject, $dom" ); 64 | } 65 | } 66 | 67 | sub test_from_email_file { 68 | if ( -f 'report.msg' ) { 69 | $recv->verbose(1); 70 | ok( $recv->from_file('report.msg'), 'from_file' ); 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Store.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Store; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | use Module::Load; 8 | 9 | use parent 'Mail::DMARC::Base'; 10 | 11 | sub delete_report { 12 | my $self = shift; 13 | return $self->backend->delete_report(@_); 14 | } 15 | 16 | sub error { 17 | my $self = shift; 18 | return $self->backend->insert_error(@_); 19 | } 20 | 21 | sub retrieve { 22 | my $self = shift; 23 | return $self->backend->retrieve(@_); 24 | } 25 | 26 | sub next_todo { 27 | my $self = shift; 28 | return $self->backend->next_todo(@_); 29 | } 30 | 31 | sub retrieve_todo { 32 | my $self = shift; 33 | return $self->backend->retrieve_todo(@_); 34 | } 35 | 36 | sub backend { 37 | my $self = shift; 38 | my $backend = $self->config->{report_store}{backend}; 39 | 40 | croak "no backend defined?!" if !$backend; 41 | 42 | return $self->{$backend} if ref $self->{$backend}; 43 | my $module = "Mail::DMARC::Report::Store::$backend"; 44 | load $module; 45 | if ($@) { 46 | croak "Unable to load backend $backend: $@\n"; 47 | } 48 | 49 | return $self->{$backend} = $module->new; 50 | } 51 | 52 | 1; 53 | 54 | __END__ 55 | 56 | =pod 57 | 58 | =head1 NAME 59 | 60 | Mail::DMARC::Report::Store - persistent storage broker for reports 61 | 62 | =head1 VERSION 63 | 64 | version 1.20250805 65 | 66 | =head1 SYNOPSIS 67 | 68 | =head1 DESCRIPTION 69 | 70 | At present, the only storage module is L. 71 | 72 | I experimented with perl's AnyDBM storage backend, but chose to deploy with SQL because a single SQL implementation supports many DBD drivers, including SQLite, MySQL, and DBD (same as AnyDBM). 73 | 74 | This Store class provides a layer of indirection, allowing one to write a new Mail::DMARC::Report::Store::MyGreatDB module, update their config file, and not alter the innards of Mail::DMARC. Much. 75 | 76 | =head1 AUTHORS 77 | 78 | =over 4 79 | 80 | =item * 81 | 82 | Matt Simerson 83 | 84 | =item * 85 | 86 | Davide Migliavacca 87 | 88 | =item * 89 | 90 | Marc Bradshaw 91 | 92 | =back 93 | 94 | =head1 COPYRIGHT AND LICENSE 95 | 96 | This software is copyright (c) 2025 by Matt Simerson. 97 | 98 | This is free software; you can redistribute it and/or modify it under 99 | the same terms as the Perl 5 programming language system itself. 100 | 101 | =cut 102 | -------------------------------------------------------------------------------- /t/13.Report.Aggregate.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use lib 'lib'; 8 | use Mail::DMARC::Policy; 9 | use Mail::DMARC::Report::Aggregate::Record; 10 | 11 | eval "use DBD::SQLite 1.31"; 12 | if ($@) { 13 | plan( skip_all => 'DBD::SQLite not available' ); 14 | exit; 15 | } 16 | 17 | my $mod = 'Mail::DMARC::Report::Aggregate'; 18 | use_ok($mod); 19 | my $agg = $mod->new; 20 | isa_ok( $agg, $mod ); 21 | 22 | my $ip = '192.2.1.1'; 23 | my $test_r = Mail::DMARC::Report::Aggregate::Record->new( 24 | identifiers => { 25 | header_from => 'example.com', 26 | envelope_from => 'example.com', 27 | }, 28 | auth_results => { dkim => [ ], spf => [ ] }, 29 | row => { 30 | source_ip => $ip, 31 | count => 1, 32 | policy_evaluated => { disposition=>'none', dkim => 'pass', spf=>'pass' }, 33 | }, 34 | ); 35 | 36 | test_metadata_isa(); 37 | test_record(); 38 | test_policy_published(); 39 | test_as_xml(); 40 | 41 | done_testing(); 42 | exit; 43 | 44 | sub test_metadata_isa { 45 | isa_ok( $agg->metadata, "Mail::DMARC::Report::Aggregate::Metadata"); 46 | }; 47 | 48 | sub test_policy_published { 49 | ok( ! defined $agg->policy_published, "policy_published, empty" ); 50 | my $pol = Mail::DMARC::Policy->new(); 51 | $pol->apply_defaults; 52 | $pol->domain('test.com'); 53 | ok( $agg->policy_published($pol), "policy_published, default" ); 54 | } 55 | 56 | sub test_record { 57 | is_deeply( $agg->record, [],"Mail::DMARC::Report::Aggregate::Record, empty"); 58 | 59 | my $r; 60 | eval { $r = $agg->record( $test_r ) }; 61 | ok( $r, "record, test") or diag Dumper($r); 62 | 63 | #delete $agg->record->[0]{config_file}; 64 | is_deeply( $agg->record, [ $test_r ], "record, deeply"); 65 | 66 | ok( $agg->record( $test_r ), "record, empty, again"); 67 | #delete $agg->record->[1]{config_file}; 68 | is_deeply( $agg->record, [ $test_r,$test_r ], "record, deeply, multiple"); 69 | }; 70 | 71 | sub test_as_xml { 72 | 73 | $agg->metadata->report_id(1); 74 | foreach my $m ( qw/ org_name email extra_contact_info error uuid / ) { 75 | $agg->metadata->$m("test"); 76 | }; 77 | foreach my $m ( qw/ begin end / ) { 78 | $agg->metadata->$m(time); 79 | }; 80 | 81 | #$agg->record( $test_r ); 82 | ok( $agg->metadata->as_xml(), "metadata, as_xml"); 83 | ok( $agg->get_policy_published_as_xml(), "policy_published, as_xml"); 84 | ok( $agg->get_record_as_xml(), "record, as_xml"); 85 | ok( $agg->as_xml(), "as_xml"); 86 | }; 87 | -------------------------------------------------------------------------------- /bin/dmarc_lookup: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Data::Dumper; 6 | use Getopt::Long; 7 | use Pod::Usage; 8 | $Data::Dumper::Sortkeys = 1; 9 | $Data::Dumper::Quotekeys = 0; 10 | 11 | use Mail::DMARC::PurePerl; 12 | 13 | my %command_line_options = ( 14 | 'domain:s' => \my $domain, 15 | 'verbose' => \my $verbose, 16 | ); 17 | GetOptions (%command_line_options); 18 | $verbose = 1 if ! defined $verbose; 19 | 20 | $domain ||= $ARGV[0]; 21 | $domain or pod2usage; 22 | 23 | my $dmarc = Mail::DMARC::PurePerl->new; 24 | $dmarc->verbose($verbose); 25 | $dmarc->header_from($domain); 26 | my $policy = $dmarc->discover_policy() or 27 | die "no DMARC policy published for $domain\n"; 28 | 29 | print Dumper( $policy ); 30 | if ( $policy->rua ) { 31 | print "\n"; 32 | my $uri_count = $dmarc->has_valid_reporting_uri( $policy->rua ); 33 | print "valid report URI: "; 34 | print $uri_count ? "yes\n" : "no\n"; 35 | }; 36 | 37 | exit; 38 | 39 | __END__ 40 | 41 | =pod 42 | 43 | =head1 NAME 44 | 45 | dmarc_lookup: look up DMARC policy for a domain 46 | 47 | =head1 SYNOPSIS 48 | 49 | dmarc_lookup example.com [ --verbose ] 50 | 51 | =head1 DESCRIPTION 52 | 53 | Query the DNS for a DMARC policy for a (sub)domain. Displays any found results as the DNS record as a perl object. In the simplest case, where the domain name in the email From header matches the I, this is roughly equivalent to the following commands: 54 | 55 | dig +short _dmarc.example.com TXT 56 | 57 | print $_->txtdata."\n" 58 | for Net::DNS::Resolver->new(dnsrch=>0)->send('_dmarc.example.com','TXT')->answer; 59 | 60 | When the domain name in the email From header (header_from) is not an Organizational Domain (ex: www.example.com), an attempt is made to determine the O.D. using the Mozilla Public Suffix List. When the O.D. differs from the header_from, a second DNS query is sent to _dmarc.[O.D.]. 61 | 62 | =head1 EXAMPLES 63 | 64 | A DMARC record in DNS format looks like this: 65 | 66 | v=DMARC1; p=reject; adkim=s; aspf=s; rua=mailto:dmarc@example.com; pct=100; 67 | 68 | DMARC records are stored as TXT resource records in the DNS, at _dmarc.example.com. 69 | 70 | Other ways to retrieve a DMARC record for a domain are: 71 | 72 | =head1 SEE ALSO 73 | 74 | L 75 | 76 | =head1 AUTHORS 77 | 78 | =over 4 79 | 80 | =item * 81 | 82 | Matt Simerson 83 | 84 | =item * 85 | 86 | Davide Migliavacca 87 | 88 | =item * 89 | 90 | Marc Bradshaw 91 | 92 | =back 93 | 94 | =cut 95 | -------------------------------------------------------------------------------- /bin/dmarc_httpd: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Mail::DMARC; 6 | use Mail::DMARC::HTTP; 7 | 8 | my $dmarc = Mail::DMARC->new(); 9 | $dmarc->is_public_suffix('tnpi.net'); 10 | my $report = $dmarc->report; 11 | my $http = Mail::DMARC::HTTP->new; 12 | $http->dmarc_httpd($report); 13 | exit; 14 | 15 | __END__ 16 | 17 | =pod 18 | 19 | =head1 NAME 20 | 21 | dmarc_httpd: a web server for DMARC validation and report viewing 22 | 23 | =head1 SYNOPSIS 24 | 25 | A HTTP interface for: 26 | 27 | =over 4 28 | 29 | =item * local DMARC reports 30 | 31 | =item * DMARC validator service 32 | 33 | =back 34 | 35 | Start the HTTP server: 36 | 37 | dmarc_httpd 38 | 39 | Connect with a web browser to L. 40 | 41 | =head1 DESCRIPTION 42 | 43 | The HTTP server handles 4 types of requests: 44 | 45 | =over 4 46 | 47 | =item * / 48 | 49 | Serves files stored in the perl share directory of the Mail::DMARC module. 50 | This presently entails one HTML file and a handful of CSS and JS files for 51 | the report viewing feature. 52 | 53 | =item * /dmarc/json/validate - DMARC validation requests 54 | 55 | Accepts a JSON encoded HTTP POST request. Validates the request, performs a 56 | DMARC validation and returns a JSON encoded result object. This is the API 57 | for non-perl applications to utilize Mail::DMARC. 58 | 59 | See the dmarc_http_client app for a usage example. 60 | 61 | =item * /dmarc/json/report 62 | 63 | Accepts AJAX requests from the browser and returns JSON encoded DMARC reports. 64 | 65 | =item * /dmarc/json/row 66 | 67 | Accepts AJAX requests from the browser and returns JSON encoded DMARC report rows. 68 | 69 | =back 70 | 71 | An implementation that uses the http validation service is the included and another is the dmarc plugin in the . 72 | 73 | A L is available which shows the web interface. It is implemented almost entirely in JavaScript, using jQuery, jQueryUI, and jqGrid. 74 | 75 | Web server settings are in the [http] and [https] sections of mail-dmarc.ini. 76 | 77 | =head1 THANKS 78 | 79 | jQuery - http://www.jquery.com/ 80 | 81 | jqGrid - http://www.trirand.com/blog/ 82 | 83 | =head1 AUTHORS 84 | 85 | =over 4 86 | 87 | =item * 88 | 89 | Matt Simerson 90 | 91 | =item * 92 | 93 | Davide Migliavacca 94 | 95 | =item * 96 | 97 | Marc Bradshaw 98 | 99 | =back 100 | 101 | =cut 102 | -------------------------------------------------------------------------------- /t/10.Report.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use IO::Compress::Gzip; 8 | use IO::Uncompress::Gunzip qw($GunzipError); 9 | #use IO::Compress::Zip; # legacy format 10 | #use IO::Uncompress::Unzip qw($UnzipError); 11 | 12 | use lib 'lib'; 13 | 14 | eval "use DBD::SQLite 1.31"; 15 | if ($@) { 16 | plan( skip_all => 'DBD::SQLite not available' ); 17 | exit; 18 | } 19 | 20 | my $mod = 'Mail::DMARC::PurePerl'; 21 | use_ok($mod); 22 | my $dmarc = $mod->new; 23 | isa_ok( $dmarc, $mod ); 24 | 25 | # this is equivalent to: 26 | # Mail::DMARC::Report( dmarc => $dmarc ); 27 | my $report = $dmarc->report; 28 | isa_ok( $report, 'Mail::DMARC::Report' ); 29 | 30 | isa_ok( $report->sendit, 'Mail::DMARC::Report::Send' ); 31 | isa_ok( $report->store, 'Mail::DMARC::Report::Store' ); 32 | isa_ok( $report->receive, 'Mail::DMARC::Report::Receive' ); 33 | 34 | my $test_dom = 'tnpi.net'; 35 | 36 | test_compress(); 37 | 38 | #setup_dmarc_result() or die "failed setup\n"; 39 | #$dmarc->report->store() or diag Dumper( $dmarc->report ); 40 | 41 | #unlink $test_db_file; 42 | done_testing(); 43 | exit; 44 | 45 | sub setup_dmarc_result { 46 | 47 | $dmarc->init(); 48 | $dmarc->header_from($test_dom); 49 | $dmarc->source_ip('192.2.1.1'); 50 | $dmarc->dkim( 51 | [ { domain => $test_dom, result => 'pass', selector => 'apr2013' } ] 52 | ); 53 | $dmarc->spf( 54 | { domain => $test_dom, scope => 'mfrom', result => 'pass' } ); 55 | $dmarc->validate() or diag Dumper($dmarc) and return; 56 | delete $dmarc->result->{published}; 57 | is_deeply( 58 | $dmarc->result, 59 | { 'result' => 'pass', 60 | 'disposition' => 'none', 61 | 'dkim_meta' => { 62 | 'domain' => 'tnpi.net', 63 | 'identity' => '', 64 | 'selector' => 'apr2013', 65 | }, 66 | 'dkim' => 'pass', 67 | 'spf' => 'pass', 68 | 'dkim_align' => 'strict', 69 | 'spf_align' => 'strict', 70 | }, 71 | "result, pass, strict, $test_dom" 72 | ) or diag Dumper( $dmarc->result ); 73 | } 74 | 75 | sub test_compress { 76 | 77 | # has to be moderately large to overcome zip format overhead 78 | my $xml = '' x 200; 79 | my $compressed = $report->compress( \$xml ); 80 | ok( length $xml > length $compressed, 'compress_report' ); 81 | 82 | my $decompressed; 83 | IO::Uncompress::Gunzip::gunzip( \$compressed => \$decompressed ) 84 | or die "unzip failed: $GunzipError\n"; 85 | cmp_ok( $decompressed, 'eq', $xml, "compress_report, extracts" ); 86 | } 87 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/DKIM.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | 5 | use Carp; 6 | 7 | sub new { 8 | my ( $class, @args ) = @_; 9 | 10 | croak "missing arguments" if 0 == scalar @args; 11 | 12 | my $self = bless {}, $class; 13 | 14 | # a bare hash 15 | return $self->_from_hash(@args) if scalar @args > 1; 16 | 17 | my $dkim = shift @args; 18 | croak "dkim argument not a ref" if ! ref $dkim; 19 | 20 | return $dkim if ref $dkim eq $class; # been here before... 21 | 22 | return $self->_from_hashref($dkim) if 'HASH' eq ref $dkim; 23 | 24 | croak "invalid dkim argument"; 25 | } 26 | 27 | sub domain { 28 | return $_[0]->{domain} if 1 == scalar @_; 29 | return $_[0]->{domain} = $_[1]; 30 | } 31 | 32 | sub selector { 33 | return $_[0]->{selector} if 1 == scalar @_; 34 | return $_[0]->{selector} = $_[1]; 35 | } 36 | 37 | sub result { 38 | return $_[0]->{result} if 1 == scalar @_; 39 | croak "invalid DKIM result" if ! grep { $_ eq $_[1] } 40 | qw/ pass fail neutral none permerror policy temperror /; 41 | return $_[0]->{result} = $_[1]; 42 | } 43 | 44 | sub human_result { 45 | return $_[0]->{human_result} if 1 == scalar @_; 46 | return $_[0]->{human_result} = $_[1]; 47 | } 48 | 49 | sub _from_hash { 50 | my ($self, %args) = @_; 51 | 52 | foreach my $key ( keys %args ) { 53 | $self->$key( $args{$key} ); 54 | } 55 | 56 | $self->is_valid; 57 | return $self; 58 | } 59 | 60 | sub _from_hashref { 61 | return $_[0]->_from_hash(%{ $_[1] }); 62 | } 63 | 64 | sub is_valid { 65 | my $self = shift; 66 | 67 | foreach my $f (qw/ domain result /) { 68 | if ( ! defined $self->{$f} ) { 69 | croak "DKIM value $f is required!"; 70 | } 71 | } 72 | return; 73 | } 74 | 75 | 1; 76 | 77 | __END__ 78 | 79 | =pod 80 | 81 | =head1 NAME 82 | 83 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM - auth_results/dkim section of a DMARC aggregate record 84 | 85 | =head1 VERSION 86 | 87 | version 1.20250805 88 | 89 | =head1 AUTHORS 90 | 91 | =over 4 92 | 93 | =item * 94 | 95 | Matt Simerson 96 | 97 | =item * 98 | 99 | Davide Migliavacca 100 | 101 | =item * 102 | 103 | Marc Bradshaw 104 | 105 | =back 106 | 107 | =head1 COPYRIGHT AND LICENSE 108 | 109 | This software is copyright (c) 2025 by Matt Simerson. 110 | 111 | This is free software; you can redistribute it and/or modify it under 112 | the same terms as the Perl 5 programming language system itself. 113 | 114 | =cut 115 | 116 | -------------------------------------------------------------------------------- /share/mail-dmarc.ini: -------------------------------------------------------------------------------- 1 | ; This is YOU. DMARC reports include information about the reports. Enter it here. 2 | [organization] 3 | domain = example.com 4 | org_name = My Great Company 5 | email = noreply@example.com 6 | extra_contact_info = http://www.example.com/dmarc-policy/ 7 | 8 | ; aggregate DMARC reports need to be stored somewhere. Any database 9 | ; with a DBI module (MySQL, SQLite, DBD, etc.) should work. 10 | ; SQLite, MySQL and Postgresql are supported. 11 | ; Default is sqlite. 12 | [report_store] 13 | backend = SQL 14 | dsn = dbi:SQLite:dbname=dmarc_reports.sqlite 15 | ;dsn = dbi:mysql:database=dmarc_report;host=db;port=3306 16 | ;dsn = dbi:Pg:database=dmarc_report;port=5432 17 | user = 18 | pass = 19 | ; when validating DMARC messages, reports are not saved by default. This 20 | ; enables 'save by default' 21 | auto_save = 0 22 | 23 | ; Sign outgoing report emails with DKIM 24 | ; Options match those which would be passed 25 | ; to Mail::DKIM::Signer 26 | [report_sign] 27 | algorithm = rsa-sha1 28 | method = relaxed 29 | domain = signer.example.com 30 | selector = dkim 31 | keyfile = /path/to/private.key 32 | 33 | [report_sending] 34 | ; minimum reporting interval in seconds: default: none 35 | ; min_interval = 3600 36 | ; 37 | ; maximum reporting interval in seconds: default: none 38 | ; max_interval = 86400 39 | 40 | ; backend can be perl or libopendmarc 41 | [dmarc] 42 | backend = perl 43 | 44 | [dns] 45 | timeout = 5 46 | retrans = 5 47 | public_suffix_list = share/public_suffix_list 48 | 49 | [smtp] 50 | ; hostname is the external FQDN of this MTA 51 | hostname = mail.example.com 52 | cc = set.this@for.a.while.example.com 53 | 54 | ; list IP addresses to whitelist (bypass DMARC reject/quarantine) 55 | ; see sample whitelist in share/dmarc_whitelist 56 | whitelist = /path/to/etc/dmarc_whitelist 57 | 58 | ; By default, we attempt to email directly to the report recipient. 59 | ; Set these to relay via a SMTP smart host. 60 | smarthost = 61 | smartuser = 62 | smartpass = 63 | 64 | ; Send error report emails, if set, we will send a simple report to 65 | ; any report handler when we were unable to send an aggregate report 66 | ; This currently covers errors where the report was too large to send. 67 | send_errors = 1 68 | 69 | [imap] 70 | server = mail.example.com 71 | port = 993 72 | user = 73 | pass = 74 | 75 | ; SSL_verify_mode = 0 76 | ; setting to 0 disables TLS certificate validation 77 | 78 | ; the imap folder where new dmarc messages will be found 79 | folder = dmarc 80 | ; the folders to store processed reports (a=aggregate, f=forensic) 81 | f_done = dmarc.forensic 82 | a_done = dmarc.aggregate 83 | 84 | [http] 85 | port = 8080 86 | 87 | [https] 88 | port = 8443 89 | ssl_crt = 90 | ssl_key = 91 | 92 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Record.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Record; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | 8 | use parent 'Mail::DMARC::Base'; 9 | require Mail::DMARC::Report::Aggregate::Record::Identifiers; 10 | require Mail::DMARC::Report::Aggregate::Record::Auth_Results; 11 | require Mail::DMARC::Report::Aggregate::Record::Row; 12 | 13 | sub new { 14 | my ( $class, @args ) = @_; 15 | croak "invalid arguments" if @args % 2; 16 | 17 | my $self = bless {}, $class; 18 | return $self if 0 == scalar @args; 19 | 20 | my %args = @args; 21 | foreach my $key ( keys %args ) { 22 | $self->$key( $args{$key} ); 23 | } 24 | 25 | return $self; 26 | } 27 | 28 | sub identifiers { 29 | my ($self, @args) = @_; 30 | 31 | if ( !scalar @args ) { 32 | return $self->{identifiers} if $self->{identifiers}; 33 | } 34 | 35 | if ('HASH' eq ref $args[0]) { 36 | @args = %{ $args[0] }; 37 | } 38 | 39 | return $self->{identifiers} = 40 | Mail::DMARC::Report::Aggregate::Record::Identifiers->new(@args); 41 | } 42 | 43 | sub auth_results { 44 | my ($self, @args) = @_; 45 | 46 | if ( !scalar @args ) { 47 | return $self->{auth_results} if $self->{auth_results}; 48 | } 49 | 50 | if ( 1 == scalar @args && 'HASH' eq ref $args[0] ) { 51 | @args = %{ $args[0] }; 52 | } 53 | 54 | return $self->{auth_results} = 55 | Mail::DMARC::Report::Aggregate::Record::Auth_Results->new(@args); 56 | } 57 | 58 | sub row { 59 | my ($self, @args) = @_; 60 | 61 | if ( 0 == scalar @args ) { 62 | return $self->{row} if $self->{row}; 63 | } 64 | 65 | if ( 1 == scalar @args && 'HASH' eq ref $args[0] ) { 66 | @args = %{ $args[0] }; 67 | } 68 | 69 | return $self->{row} = 70 | Mail::DMARC::Report::Aggregate::Record::Row->new(@args); 71 | } 72 | 73 | 1; 74 | 75 | __END__ 76 | 77 | =pod 78 | 79 | =head1 NAME 80 | 81 | Mail::DMARC::Report::Aggregate::Record - record section of aggregate report 82 | 83 | =head1 VERSION 84 | 85 | version 1.20250805 86 | 87 | =head1 DESCRIPTION 88 | 89 | An aggregate report record, with object methods for identifiers, auth_results, and each row. 90 | 91 | =head1 AUTHORS 92 | 93 | =over 4 94 | 95 | =item * 96 | 97 | Matt Simerson 98 | 99 | =item * 100 | 101 | Davide Migliavacca 102 | 103 | =item * 104 | 105 | Marc Bradshaw 106 | 107 | =back 108 | 109 | =head1 COPYRIGHT AND LICENSE 110 | 111 | This software is copyright (c) 2025 by Matt Simerson. 112 | 113 | This is free software; you can redistribute it and/or modify it under 114 | the same terms as the Perl 5 programming language system itself. 115 | 116 | =cut 117 | -------------------------------------------------------------------------------- /bin/dmarc_http_client: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Data::Dumper; 6 | use Getopt::Long; 7 | use HTTP::Request; 8 | use JSON; 9 | use LWP::UserAgent; 10 | 11 | my %command_line_options = ( 12 | 'host:s' => \my $host, 13 | 'port:s' => \my $port, 14 | 'data:s' => \my $data, 15 | ); 16 | GetOptions (%command_line_options); 17 | 18 | if (!$host) { $host = 'localhost'; warn "using default: --host=$host\n"; }; 19 | if (!$port) { $port = '8080'; warn "using default: --port=$port\n"; }; 20 | if (!$data) { $data = get_json_request(); warn "using sample --data\n"; }; 21 | if ($data eq '-') { 22 | $data = ''; 23 | while ($_ = <>) { chomp; $data .= $_; }; 24 | } 25 | 26 | my $url = "http://$host:$port/dmarc/json/validate"; 27 | my $ua = LWP::UserAgent->new; 28 | my $req = HTTP::Request->new(POST => $url); 29 | $req->content_type('application/json'); 30 | $req->content($data); 31 | 32 | my $response = $ua->request($req)->decoded_content; 33 | #print Dumper($response); # raw JSON response 34 | my $result; 35 | eval { $result = JSON->new->utf8->decode($response) }; 36 | if ($result) { 37 | print Dumper($result); # pretty formatted struct 38 | exit; 39 | }; 40 | 41 | die $response; 42 | 43 | sub get_json_request { 44 | return JSON->new->encode ({ 45 | source_ip => '192.0.1.1', 46 | envelope_to => 'example.com', 47 | envelope_from => 'cars4you.info', 48 | header_from => 'yahoo.com', 49 | dkim => [ 50 | { domain => 'example.com', 51 | selector => 'apr2013', 52 | result => 'fail', 53 | human_result => 'fail (body has been altered)', 54 | } 55 | ], 56 | spf => [ 57 | { domain => 'example.com', 58 | scope => 'mfrom', 59 | result => 'pass', 60 | } 61 | ], 62 | }); 63 | }; 64 | 65 | __END__ 66 | 67 | =pod 68 | 69 | =head1 NAME 70 | 71 | dmarc_http_client: an HTTP client for submitting a DMARC validation request 72 | 73 | =head1 SYNOPSIS 74 | 75 | Send JSON encoded HTTP requests to the DMARC validation service provided by dmarc_httpd. 76 | 77 | dmarc_http_client --host=localhost 78 | --port=8080 79 | --data='{"envelope_from":"cars4you.info"...}' 80 | 81 | The data option accepts a special '-' value that will read the JSON encoded data from STDIN. Use it like this: 82 | 83 | cat /path/to/data.json | dmarc_http_client --data=- 84 | 85 | =head1 AUTHORS 86 | 87 | =over 4 88 | 89 | =item * 90 | 91 | Matt Simerson 92 | 93 | =item * 94 | 95 | Davide Migliavacca 96 | 97 | =item * 98 | 99 | Marc Bradshaw 100 | 101 | =back 102 | 103 | =cut 104 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Record::Auth_Results; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | require Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF; 8 | require Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM; 9 | 10 | sub new { 11 | my ( $class, @args ) = @_; 12 | croak "invalid arguments" if @args % 2; 13 | 14 | my $self = bless { spf => [], dkim => [] }, $class; 15 | return $self if 0 == scalar @args; 16 | 17 | my %args = @args; 18 | foreach my $key ( keys %args ) { 19 | $self->$key( $args{$key} ); 20 | } 21 | 22 | return $self; 23 | } 24 | 25 | sub spf { 26 | my ($self, @args) = @_; 27 | return $self->{spf} if 0 == scalar @args; 28 | 29 | # one shot 30 | if (1 == scalar @args && ref $args[0] eq 'ARRAY') { 31 | #warn "SPF one shot"; 32 | my $iter = 0; 33 | foreach my $d ( @{ $args[0] }) { 34 | $self->{spf}->[$iter] = 35 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF->new($d); 36 | $iter++; 37 | } 38 | return $self->{spf}; 39 | } 40 | 41 | #warn "SPF iterative"; 42 | push @{ $self->{spf} }, 43 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF->new(@args); 44 | 45 | return $self->{spf}; 46 | } 47 | 48 | sub dkim { 49 | my ($self, @args) = @_; 50 | return $self->{dkim} if 0 == scalar @args; 51 | 52 | if (1 == scalar @args && ref $args[0] eq 'ARRAY') { 53 | #warn "dkim one shot"; 54 | my $iter = 0; 55 | foreach my $d ( @{ $args[0] }) { 56 | $self->{dkim}->[$iter] = 57 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM->new($d); 58 | $iter++; 59 | } 60 | return $self->{dkim}; 61 | } 62 | 63 | #warn "dkim iterative"; 64 | push @{ $self->{dkim}}, 65 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM->new(@args); 66 | 67 | return $self->{dkim}; 68 | } 69 | 70 | 1; 71 | 72 | __END__ 73 | 74 | =pod 75 | 76 | =head1 NAME 77 | 78 | Mail::DMARC::Report::Aggregate::Record::Auth_Results - auth_results section of a DMARC aggregate record 79 | 80 | =head1 VERSION 81 | 82 | version 1.20250805 83 | 84 | =head1 AUTHORS 85 | 86 | =over 4 87 | 88 | =item * 89 | 90 | Matt Simerson 91 | 92 | =item * 93 | 94 | Davide Migliavacca 95 | 96 | =item * 97 | 98 | Marc Bradshaw 99 | 100 | =back 101 | 102 | =head1 COPYRIGHT AND LICENSE 103 | 104 | This software is copyright (c) 2025 by Matt Simerson. 105 | 106 | This is free software; you can redistribute it and/or modify it under 107 | the same terms as the Perl 5 programming language system itself. 108 | 109 | =cut 110 | 111 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/SPF.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | 5 | use Carp; 6 | use parent 'Mail::DMARC::Base'; 7 | 8 | sub new { 9 | my ( $class, @args ) = @_; 10 | 11 | my $self = bless {}, $class; 12 | 13 | if (0 == scalar @args) { 14 | return $self; 15 | } 16 | 17 | # a bare hash 18 | return $self->_from_hash(@args) if scalar @args > 1; 19 | 20 | my $spf = shift @args; 21 | return $spf if ref $spf eq $class; 22 | 23 | return $self->_from_hashref($spf) if 'HASH' eq ref $spf; 24 | 25 | croak "invalid spf argument"; 26 | } 27 | 28 | sub domain { 29 | return $_[0]->{domain} if 1 == scalar @_; 30 | return $_[0]->{domain} = lc $_[1]; 31 | } 32 | 33 | sub result { 34 | return $_[0]->{result} if 1 == scalar @_; 35 | croak if !$_[0]->is_valid_spf_result( $_[1] ); 36 | return $_[0]->{result} = $_[1]; 37 | } 38 | 39 | sub scope { 40 | return $_[0]->{scope} if 1 == scalar @_; 41 | croak if ! $_[0]->is_valid_spf_scope( $_[1] ); 42 | return $_[0]->{scope} = $_[1]; 43 | } 44 | 45 | sub _from_hash { 46 | my ($self, %args) = @_; 47 | 48 | foreach my $key ( keys %args ) { 49 | # scope is frequently absent on received reports 50 | next if ($key eq 'scope' && !$args{$key}); 51 | $self->$key( $args{$key} ); 52 | } 53 | 54 | $self->is_valid; 55 | return $self; 56 | } 57 | 58 | sub _from_hashref { 59 | return $_[0]->_from_hash(%{ $_[1] }); 60 | } 61 | 62 | sub is_valid { 63 | my $self = shift; 64 | 65 | foreach my $f (qw/ domain result scope /) { 66 | next if $self->{$f}; 67 | if ($f ne 'scope') { 68 | # quite a few DMARC reporters don't include scope 69 | warn "SPF $f is required but missing!\n"; 70 | } 71 | return 0; 72 | } 73 | 74 | if ( $self->{result} =~ /^pass$/i && !$self->{domain} ) { 75 | warn "SPF pass MUST include the RFC5321.MailFrom domain!\n"; 76 | return 0; 77 | } 78 | 79 | return 1; 80 | } 81 | 82 | 1; 83 | 84 | __END__ 85 | 86 | =pod 87 | 88 | =head1 NAME 89 | 90 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF - auth_results/spf section of a DMARC aggregate record 91 | 92 | =head1 VERSION 93 | 94 | version 1.20250805 95 | 96 | =head1 AUTHORS 97 | 98 | =over 4 99 | 100 | =item * 101 | 102 | Matt Simerson 103 | 104 | =item * 105 | 106 | Davide Migliavacca 107 | 108 | =item * 109 | 110 | Marc Bradshaw 111 | 112 | =back 113 | 114 | =head1 COPYRIGHT AND LICENSE 115 | 116 | This software is copyright (c) 2025 by Matt Simerson. 117 | 118 | This is free software; you can redistribute it and/or modify it under 119 | the same terms as the Perl 5 programming language system itself. 120 | 121 | =cut 122 | 123 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Send.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Send; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '1.20250805'; 6 | 7 | use parent 'Mail::DMARC::Base'; 8 | use Mail::DMARC::Report::Send::SMTP; 9 | use Mail::DMARC::Report::Send::HTTP; 10 | 11 | sub http { 12 | my $self = shift; 13 | return $self->{http} if ref $self->{http}; 14 | return $self->{http} = Mail::DMARC::Report::Send::HTTP->new(); 15 | } 16 | 17 | sub smtp { 18 | my $self = shift; 19 | return $self->{smtp} if ref $self->{smtp}; 20 | return $self->{smtp} = Mail::DMARC::Report::Send::SMTP->new(); 21 | } 22 | 23 | sub too_big_report { 24 | my ( $self, $arg_ref ) = @_; 25 | 26 | my $OrgName = $self->config->{organization}{org_name}; 27 | my $Domain = $self->config->{organization}{domain}; 28 | my $ver = $Mail::DMARC::Base::VERSION || ''; # undef in author environ 29 | my $uri = $arg_ref->{uri}; 30 | my $bytes = $arg_ref->{report_bytes}; 31 | my $report_id = $arg_ref->{report_id}; 32 | my $rep_domain= $arg_ref->{report_domain}; 33 | my $date = $self->smtp->get_timestamp_rfc2822; 34 | 35 | return <<"EO_TOO_BIG" 36 | 37 | This is a 'too big' DMARC notice. The aggregate report was NOT delivered. 38 | 39 | Report-Date: $date 40 | Report-Domain: $rep_domain 41 | Report-ID: $report_id 42 | Report-Size: $bytes 43 | Submitter: $Domain 44 | Submitting-URI: $uri 45 | 46 | Submitted by $OrgName 47 | Generated with Mail::DMARC $ver 48 | 49 | EO_TOO_BIG 50 | ; 51 | } 52 | 53 | 1; 54 | 55 | __END__ 56 | 57 | =pod 58 | 59 | =head1 NAME 60 | 61 | Mail::DMARC::Report::Send - report sending dispatch class 62 | 63 | =head1 VERSION 64 | 65 | version 1.20250805 66 | 67 | =head1 DESCRIPTION 68 | 69 | Send DMARC reports, via SMTP or HTTP. 70 | 71 | =head2 Report Sender 72 | 73 | A report sender needs to: 74 | 75 | 1. store reports 76 | 2. bundle aggregated reports 77 | 3. format report in XML 78 | 4. gzip the XML 79 | 5. deliver report to Author Domain 80 | 81 | This class and subclasses provide methods used by L. 82 | 83 | =head1 12.2.1 Email 84 | 85 | L 86 | 87 | =head1 12.2.2. HTTP 88 | 89 | L 90 | 91 | =head1 12.2.3. Other Methods 92 | 93 | Other registered URI schemes may be explicitly supported in later versions. 94 | 95 | =head1 AUTHORS 96 | 97 | =over 4 98 | 99 | =item * 100 | 101 | Matt Simerson 102 | 103 | =item * 104 | 105 | Davide Migliavacca 106 | 107 | =item * 108 | 109 | Marc Bradshaw 110 | 111 | =back 112 | 113 | =head1 COPYRIGHT AND LICENSE 114 | 115 | This software is copyright (c) 2025 by Matt Simerson. 116 | 117 | This is free software; you can redistribute it and/or modify it under 118 | the same terms as the Perl 5 programming language system itself. 119 | 120 | =cut 121 | 122 | -------------------------------------------------------------------------------- /t/11.Report.Store.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Net::DNS::Resolver::Mock; 6 | use Test::More; 7 | 8 | use Test::File::ShareDir 9 | -share => { -dist => { 'Mail-DMARC' => 'share' } }; 10 | 11 | use lib 'lib'; 12 | 13 | eval "use DBD::SQLite 1.31"; 14 | if ($@) { 15 | plan( skip_all => 'DBD::SQLite not available' ); 16 | exit; 17 | } 18 | 19 | my $resolver = new Net::DNS::Resolver::Mock(); 20 | $resolver->zonefile_parse(join("\n", 21 | 'tnpi.net. 600 A 66.128.51.170', 22 | 'tnpi.net. 600 MX 10 mail.theartfarm.com.', 23 | '_dmarc.mail-dmarc.tnpi.net. 600 TXT "v=DMARC1; p=reject; rua=mailto:invalid@theartfarm.com; ruf=mailto:invalid@theartfarm.com; pct=90"', 24 | '_dmarc.tnpi.net. 600 TXT "v=DMARC1; p=reject; rua=mailto:dmarc-feedback@theartfarm.com; ruf=mailto:dmarc-feedback@theartfarm.com; pct=100"', 25 | 'mail-dmarc.tnpi.net. 600 TXT "test zone for Mail::DMARC perl module"', 26 | 'mail-dmarc.tnpi.net._report._dmarc.theartfarm.com. 600 TXT "v=DMARC1; rua=mailto:invalid-test@theartfarm.com;"', 27 | '')); 28 | 29 | use_ok('Mail::DMARC::PurePerl'); 30 | my $dmarc = Mail::DMARC::PurePerl->new(); 31 | $dmarc->set_resolver($resolver); 32 | isa_ok( $dmarc, 'Mail::DMARC::PurePerl' ); 33 | 34 | isa_ok( $dmarc->report, 'Mail::DMARC::Report' ); 35 | isa_ok( $dmarc->report->store, 'Mail::DMARC::Report::Store' ); 36 | ok( $dmarc->report->store->backend, "selected backend loaded" ); 37 | 38 | my $test_dom = 'tnpi.net'; 39 | 40 | # gotta have something to store. Populate a DMARC object 41 | setup_dmarc_result() or die "failed setup\n"; 42 | 43 | # tell storage backend to use test settings 44 | $dmarc->report->store->backend->config('t/mail-dmarc.ini'); 45 | 46 | test_reason(); 47 | 48 | done_testing(); 49 | exit; 50 | 51 | sub test_reason { 52 | ok( $dmarc->result->reason( type => 'other', comment => 'testing' ), "reason"); 53 | } 54 | 55 | sub setup_dmarc_result { 56 | 57 | $dmarc->init(); 58 | ok( $dmarc->header_from($test_dom), "header_from" ); 59 | ok( $dmarc->envelope_to('recipient.com'), 'envelope_to' ); 60 | ok( $dmarc->source_ip('192.2.1.1'), 'source_ip' ); 61 | $dmarc->dkim([ { domain => $test_dom, result => 'pass', selector => 'apr2013' } ]); 62 | $dmarc->spf({ domain => $test_dom, scope => 'mfrom', result => 'pass' } ); 63 | $dmarc->validate() or diag Dumper($dmarc) and return; 64 | my $pub = delete $dmarc->result->{published}; 65 | ok( $pub, "pub" ); 66 | is_deeply( 67 | $dmarc->result, 68 | { 'result' => 'pass', 69 | 'disposition' => 'none', 70 | 'dkim_meta' => { 71 | 'domain' => 'tnpi.net', 72 | 'identity' => '', 73 | 'selector' => 'apr2013', 74 | }, 75 | 'dkim' => 'pass', 76 | 'spf' => 'pass', 77 | 'dkim_align' => 'strict', 78 | 'spf_align' => 'strict', 79 | 'reason' => [], 80 | }, 81 | "result, pass, strict, $test_dom" 82 | ) or diag Dumper( $dmarc->result ); 83 | return $dmarc->result->published($pub); 84 | } 85 | 86 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Aggregate/Metadata.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Aggregate::Metadata; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '1.20250805'; 6 | 7 | use XML::LibXML; 8 | 9 | use parent 'Mail::DMARC::Base'; 10 | 11 | sub org_name { 12 | return $_[0]->{org_name} if 1 == scalar @_; 13 | return $_[0]->{org_name} = $_[1]; 14 | } 15 | 16 | sub email { 17 | return $_[0]->{email} if 1 == scalar @_; 18 | return $_[0]->{email} = $_[1]; 19 | } 20 | 21 | sub extra_contact_info { 22 | return $_[0]->{extra_contact_info} if 1 == scalar @_; 23 | return $_[0]->{extra_contact_info} = $_[1]; 24 | } 25 | 26 | sub report_id { 27 | return $_[0]->{report_id} if 1 == scalar @_; 28 | return $_[0]->{report_id} = $_[1]; 29 | } 30 | 31 | sub date_range { 32 | return $_[0]->{date_range} if 1 == scalar @_; 33 | 34 | # croak "invalid date_range" if ('HASH' ne ref $_->[1]); 35 | return $_[0]->{date_range} = $_[1]; 36 | } 37 | 38 | sub begin { 39 | return $_[0]->{date_range}{begin} if 1 == scalar @_; 40 | return $_[0]->{date_range}{begin} = $_[1]; 41 | } 42 | 43 | sub end { 44 | return $_[0]->{date_range}{end} if 1 == scalar @_; 45 | return $_[0]->{date_range}{end} = $_[1]; 46 | } 47 | 48 | sub error { 49 | return $_[0]->{error} if 1 == scalar @_; 50 | return push @{ $_[0]->{error} }, $_[1]; 51 | } 52 | 53 | sub uuid { 54 | return $_[0]->{uuid} if 1 == scalar @_; 55 | return $_[0]->{uuid} = $_[1]; 56 | } 57 | 58 | sub as_xml { 59 | my $self = shift; 60 | my $meta = "\t\n"; 61 | 62 | foreach my $f (qw/ org_name email extra_contact_info report_id /) { 63 | my $val = $self->$f or next; 64 | $val = XML::LibXML::Text->new( $val )->toString(); 65 | $meta .= "\t\t<$f>$val\n"; 66 | } 67 | my $begin = XML::LibXML::Text->new( $self->begin )->toString(); 68 | my $end = XML::LibXML::Text->new( $self->end )->toString(); 69 | $meta .= "\t\t\n\t\t\t" . $begin . "\n" 70 | . "\t\t\t" . $end . "\n\t\t\n"; 71 | 72 | my $errors = $self->error; 73 | if ( $errors && @$errors ) { 74 | foreach my $err ( @$errors ) { 75 | $err = XML::LibXML::Text->new( $err )->toString(); 76 | $meta .= "\t\t$err\n"; 77 | }; 78 | }; 79 | $meta .= "\t"; 80 | return $meta; 81 | } 82 | 83 | 1; 84 | 85 | __END__ 86 | 87 | =pod 88 | 89 | =head1 NAME 90 | 91 | Mail::DMARC::Report::Aggregate::Metadata - metadata section of aggregate report 92 | 93 | =head1 VERSION 94 | 95 | version 1.20250805 96 | 97 | =head1 AUTHORS 98 | 99 | =over 4 100 | 101 | =item * 102 | 103 | Matt Simerson 104 | 105 | =item * 106 | 107 | Davide Migliavacca 108 | 109 | =item * 110 | 111 | Marc Bradshaw 112 | 113 | =back 114 | 115 | =head1 COPYRIGHT AND LICENSE 116 | 117 | This software is copyright (c) 2025 by Matt Simerson. 118 | 119 | This is free software; you can redistribute it and/or modify it under 120 | the same terms as the Perl 5 programming language system itself. 121 | 122 | =cut 123 | 124 | -------------------------------------------------------------------------------- /t/15.Report.Aggregate.Record.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use lib 'lib'; 8 | 9 | my $mod = 'Mail::DMARC::Report::Aggregate::Record'; 10 | use_ok($mod); 11 | my $rec = $mod->new; 12 | isa_ok( $rec, $mod ); 13 | 14 | my $ip = '192.2.1.1'; 15 | 16 | test_identifiers(); 17 | test_auth_results(); 18 | test_row(); 19 | 20 | done_testing(); 21 | exit; 22 | 23 | sub test_identifiers { 24 | my $id = $rec->identifiers; 25 | 26 | ok( $id->envelope_to( 'to.example.com' ), "envelope_to, set"); 27 | ok( $id->envelope_to eq 'to.example.com', "envelope_to, get"); 28 | 29 | ok( $id->header_from( 'from.example.com' ), "header_from, set"); 30 | ok( $id->header_from eq 'from.example.com', "header_from, get"); 31 | 32 | ok( $id->envelope_from( 'from.example.com' ), "envelope_from, set"); 33 | ok( $id->envelope_from eq 'from.example.com', "envelope_from, get"); 34 | 35 | # one shot 36 | $id = $rec->identifiers( 37 | envelope_to => 'to.example.com', 38 | header_from => 'from.example.com', 39 | envelope_from=> 'from.example.com', 40 | ); 41 | ok( $id->envelope_to eq 'to.example.com', "envelope_to, get"); 42 | ok( $id->header_from eq 'from.example.com', "header_from, get"); 43 | ok( $id->envelope_from eq 'from.example.com', "envelope_from, get"); 44 | }; 45 | 46 | sub test_auth_results { 47 | my $ar = $rec->auth_results; 48 | 49 | my $expected = bless { dkim => [], spf => [] }, 'Mail::DMARC::Report::Aggregate::Record::Auth_Results'; 50 | is_deeply( $ar, $expected, "auth_results, empty"); 51 | 52 | my $spf1 = { domain => 'first', result => 'none', scope => 'helo' }; 53 | $expected = { dkim => [], spf => [ $spf1 ]}; 54 | $ar->spf( { domain => 'first', result => 'none', scope => 'helo' } ); 55 | is_deeply( $ar, $expected, "auth_results, one SPF"); 56 | 57 | my $spf2 = { domain => 'second', scope => 'helo', result => 'temperror' }; 58 | $expected = { dkim => [], spf => [ $spf1, $spf2 ] }; 59 | $ar->spf( { domain => 'second', result => 'temperror', scope => 'helo' } ); 60 | is_deeply( $ar, $expected, "auth_results, two SPF"); 61 | 62 | my $dkim1 = { domain => 'first', result => 'none' }; 63 | $expected = { dkim => [ $dkim1 ], spf => [ $spf1, $spf2 ] }; 64 | $ar->dkim( $dkim1 ); 65 | is_deeply( $ar, $expected, "auth_results, two SPF, one DKIM"); 66 | 67 | my $dkim2 = { domain => 'second', result => 'none' }; 68 | $expected = { dkim => [ $dkim1, $dkim2 ], spf => [ $spf1, $spf2 ] }; 69 | $ar->dkim( $dkim2 ); 70 | is_deeply( $ar, $expected, "auth_results, two SPF, two DKIM"); 71 | }; 72 | 73 | sub test_row { 74 | my $ar = $rec->row; 75 | 76 | my $expected = bless {}, 'Mail::DMARC::Report::Aggregate::Record::Row'; 77 | is_deeply( $ar, $expected, "row, empty"); 78 | 79 | $ar->source_ip( $ip ); 80 | $expected = { source_ip => $ip }; 81 | is_deeply( $ar, $expected, "row, source_ip"); 82 | 83 | $ar->count( 1 ); 84 | $expected = { count => 1, source_ip => $ip }; 85 | is_deeply( $ar, $expected, "row, count"); 86 | 87 | my $pe = { disposition => 'none', spf => 'fail', dkim => 'fail' }; 88 | $ar->policy_evaluated( $pe ); 89 | $pe->{reason} = []; 90 | $expected = { policy_evaluated => $pe, count => 1, source_ip => $ip }; 91 | is_deeply( $ar, $expected, "row, policy_evaluated"); 92 | }; 93 | 94 | -------------------------------------------------------------------------------- /t/14.Report.Aggregate.Metadata.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Test::More; 6 | 7 | use lib 'lib'; 8 | 9 | eval "use DBD::SQLite 1.31"; 10 | if ($@) { 11 | plan( skip_all => 'DBD::SQLite not available' ); 12 | exit; 13 | } 14 | 15 | my $mod = 'Mail::DMARC::Report::Aggregate'; 16 | use_ok($mod); 17 | my $agg = $mod->new; 18 | isa_ok( $agg, $mod ); 19 | my $meta = $agg->metadata; 20 | isa_ok( $meta, 'Mail::DMARC::Report::Aggregate::Metadata' ); 21 | 22 | my $start = time; 23 | my $end = time + 10; 24 | 25 | test_org_name(); 26 | test_email(); 27 | test_extra_contact_info(); 28 | test_report_id(); 29 | test_date_range(); 30 | test_begin(); 31 | test_end(); 32 | test_error(); 33 | test_uuid(); 34 | test_as_xml(); 35 | 36 | done_testing(); 37 | exit; 38 | 39 | sub test_org_name { 40 | my $name = 'Test Org'; 41 | ok( $meta->org_name($name), "org_name, set"); 42 | cmp_ok( $meta->org_name, 'eq', $name, "org_name, get"); 43 | }; 44 | sub test_email { 45 | my $email = 'test@example.com'; 46 | ok( $meta->email( $email ), "test_email, set"); 47 | cmp_ok( $meta->email, 'eq', $email, "test_email, get"); 48 | }; 49 | sub test_extra_contact_info { 50 | my $eci = 'http://www.example.com/path/to/dmarc.cgi'; 51 | ok( $meta->extra_contact_info( $eci ), 'extra_contact_info, set'); 52 | cmp_ok( $meta->extra_contact_info, 'eq', $eci, "extra_contact_info, get"); 53 | }; 54 | sub test_report_id { 55 | my $id = '12345566677888@sender.com'; 56 | ok( $meta->report_id($id), "report_id, set"); 57 | cmp_ok( $meta->report_id, 'eq', $id, "report_id, get"); 58 | }; 59 | sub test_date_range { 60 | my $range_ref = {begin=>$start,end=>$end}; 61 | ok( $meta->date_range($range_ref), "date_range, set"); 62 | is_deeply( $meta->date_range, $range_ref, "date_range, get"); 63 | cmp_ok( $meta->begin, '==', $start, "date_range, get start"); 64 | cmp_ok( $meta->end, '==', $end, "date_range, get end"); 65 | }; 66 | sub test_begin { 67 | ok( $meta->begin( $start ), "begin, set"); 68 | cmp_ok( $meta->begin, '==', $start, "date_range, get start"); 69 | }; 70 | sub test_end { 71 | ok( $meta->end( $end ), "end, set"); 72 | cmp_ok( $meta->end, '==', $end, "date_range, get end"); 73 | }; 74 | sub test_error { 75 | my $test_errors = [ 76 | 'error #1 for test', 77 | 'error #2 for testing', 78 | ]; 79 | foreach ( @$test_errors ) { 80 | ok( $meta->error( $_ ), "error, $_"); 81 | }; 82 | is_deeply($meta->error, $test_errors, "error, deeply"); 83 | }; 84 | sub test_uuid { 85 | my $uuid = '1234908748913u41u4-1203847308924-adskfjadslfj-13i41230984'; 86 | ok( $meta->uuid($uuid), "uuid, set"); 87 | cmp_ok( $meta->uuid, 'eq', $uuid, "uuid, get"); 88 | }; 89 | sub test_as_xml { 90 | my $expected = <<"EO_XML" 91 | \t 92 | \t\tTest Org 93 | \t\ttest\@example.com 94 | \t\thttp://www.example.com/path/to/dmarc.cgi 95 | \t\t12345566677888\@sender.com 96 | \t\t 97 | \t\t\t$start 98 | \t\t\t$end 99 | \t\t 100 | \t\terror #1 for test 101 | \t\terror #2 for testing 102 | \t 103 | EO_XML 104 | ; 105 | chomp $expected; 106 | cmp_ok( $meta->as_xml, 'eq', $expected, "as_xml"); 107 | }; 108 | 109 | -------------------------------------------------------------------------------- /t/17.Report.Aggregate.Schema.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Net::DNS::Resolver::Mock; 6 | use Test::Exception; 7 | use Test::More; 8 | use Test::File::ShareDir -share => { -dist => { 'Mail-DMARC' => 'share' } }; 9 | 10 | use lib 'lib'; 11 | use Mail::DMARC::PurePerl; 12 | use Mail::DMARC::Report; 13 | 14 | eval "use DBD::SQLite 1.31"; 15 | if ($@) { 16 | plan( skip_all => 'DBD::SQLite not available' ); 17 | exit; 18 | } 19 | 20 | eval "use XML::SAX::ParserFactory;"; 21 | if ($@) { 22 | plan( skip_all => 'XML::SAX::ParserFactory not available' ); 23 | exit; 24 | } 25 | 26 | eval "use XML::Validator::Schema;"; 27 | if ($@) { 28 | plan( skip_all => 'XML::Validator::Schema not available' ); 29 | exit; 30 | } 31 | 32 | my $resolver = new Net::DNS::Resolver::Mock(); 33 | $resolver->zonefile_parse(join("\n", 34 | 'tnpi.net. 600 A 66.128.51.170', 35 | 'tnpi.net. 600 MX 10 mail.theartfarm.com.', 36 | '_dmarc.mail-dmarc.tnpi.net. 600 TXT "v=DMARC1; p=reject; rua=mailto:invalid@theartfarm.com; ruf=mailto:invalid@theartfarm.com; pct=90"', 37 | '_dmarc.tnpi.net. 600 TXT "v=DMARC1; p=reject; rua=mailto:dmarc-feedback@theartfarm.com; ruf=mailto:dmarc-feedback@theartfarm.com; pct=100"', 38 | 'mail-dmarc.tnpi.net. 600 TXT "test zone for Mail::DMARC perl module"', 39 | 'mail-dmarc.tnpi.net._report._dmarc.theartfarm.com. 600 TXT "v=DMARC1; rua=mailto:invalid-test@theartfarm.com;"', 40 | '')); 41 | 42 | my $dmarc = Mail::DMARC::PurePerl->new(); 43 | $dmarc->set_resolver($resolver); 44 | my $store = $dmarc->report->store; 45 | 46 | $store->config('t/mail-dmarc.ini'); 47 | $store->backend->config('t/mail-dmarc.ini'); 48 | 49 | die 'Not using test store' if $store->backend->config->{'report_store'}->{'dsn'} ne 'dbi:SQLite:dbname=t/reports-test.sqlite'; 50 | 51 | $dmarc->source_ip('66.128.51.165'); 52 | $dmarc->envelope_to('recipient.example.com'); 53 | $dmarc->envelope_from('dmarc-nonexist.tnpi.net'); 54 | $dmarc->header_from('mail-dmarc.tnpi.net'); 55 | $dmarc->dkim([ 56 | { 57 | domain => 'tnpi.net', 58 | selector => 'jan2015', 59 | result => 'fail', 60 | human_result=> 'fail (body has been altered)', 61 | } 62 | ]); 63 | $dmarc->spf([ 64 | { domain => 'tnpi.net', 65 | scope => 'mfrom', 66 | result => 'pass', 67 | }, 68 | { 69 | scope => 'helo', 70 | domain => 'mail.tnpi.net', 71 | result => 'fail', 72 | }, 73 | ]); 74 | 75 | my $policy = $dmarc->discover_policy; 76 | my $result = $dmarc->validate($policy); 77 | 78 | my $report_id = $dmarc->save_aggregate(); 79 | ok( $report_id, "saved report $report_id"); 80 | 81 | my $a = $store->backend->query('UPDATE report SET begin=begin-86400, end=end-86400 WHERE id=1'); 82 | $a = $store->backend->query('INSERT INTO report_error(report_id,error,time) VALUES(1," Test error & encoding",100)'); 83 | 84 | my $agg = $store->retrieve_todo()->[0]; 85 | 86 | test_against_schema(); 87 | 88 | done_testing(); 89 | exit; 90 | 91 | sub test_against_schema { 92 | 93 | $agg->metadata->report_id(1); 94 | 95 | my $xml = $agg->as_xml(); 96 | lives_ok( sub{ 97 | my $validator = XML::Validator::Schema->new(file => 'share/rua-schema.xsd'); 98 | my $parser = XML::SAX::ParserFactory->parser(Handler => $validator); 99 | $parser->parse_string( $xml ); 100 | }, 'Check schema' ); 101 | # print $xml; 102 | } 103 | -------------------------------------------------------------------------------- /t/22.Report.Send.SMTP.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Net::DNS::Resolver::Mock; 6 | use Test::More; 7 | 8 | use IO::Compress::Gzip; 9 | 10 | use lib 'lib'; 11 | use Mail::DMARC::Policy; 12 | use Mail::DMARC::Report::Aggregate; 13 | use Mail::DMARC::Report::Aggregate::Record; 14 | 15 | my $resolver = new Net::DNS::Resolver::Mock(); 16 | $resolver->zonefile_parse(join("\n", 17 | 'tnpi.net. 600 MX 10 mail.theartfarm.com.', 18 | '')); 19 | 20 | my $mod = 'Mail::DMARC::Report::Send::SMTP'; 21 | use_ok($mod); 22 | my $smtp = $mod->new; 23 | $smtp->set_resolver($resolver); 24 | isa_ok( $smtp, $mod ); 25 | $smtp->config('t/mail-dmarc.ini'); 26 | 27 | open my $REP, '<', 'share/rua-schema.xsd' 28 | or die "unable to open: $!"; 29 | my $report = join( '', <$REP> ); 30 | close $REP; 31 | my $zipped; 32 | IO::Compress::Gzip::gzip( \$report, \$zipped ) or die "unable to compress"; 33 | 34 | my $agg = Mail::DMARC::Report::Aggregate->new; 35 | my $pol = Mail::DMARC::Policy->new; 36 | 37 | $pol->domain('they.com'); 38 | $agg->policy_published( $pol ); 39 | $agg->metadata->begin( time - 10000 ); 40 | $agg->metadata->end( time - 100 ); 41 | $agg->metadata->report_id( '2013.06.01.6789' ); 42 | 43 | test_get_subject(); 44 | test_get_domain_mx(); 45 | test_get_smtp_hosts(); 46 | test_human_summary(); 47 | test_get_filename(); 48 | test_get_timestamp_rfc2822(); 49 | test_get_helo_hostname(); 50 | test_assemble_message(); 51 | 52 | done_testing(); 53 | exit; 54 | 55 | sub test_get_subject { 56 | my $subject = $smtp->get_subject( \$agg ); 57 | ok( $subject, "get_subject, $subject" ); 58 | }; 59 | 60 | sub test_get_helo_hostname { 61 | my $helo = $smtp->get_helo_hostname(); 62 | ok( $helo, "get_helo_hostname, $helo" ); 63 | }; 64 | 65 | sub test_get_timestamp_rfc2822 { 66 | my $r = $smtp->get_timestamp_rfc2822(); 67 | ok( $r, "get_timestamp_rfc2822, $r"); 68 | }; 69 | 70 | sub test_get_domain_mx { 71 | my %tests = ( 72 | 'tnpi.net' => [ { 'pref' => 10, 'addr' => 'mail.theartfarm.com' } ], 73 | ); 74 | 75 | foreach my $dom ( keys %tests ) { 76 | my $r = $smtp->get_domain_mx( $dom ); 77 | if (!$r || $r eq 'Does not exist') { 78 | print "it appears your DNS is not working.\n"; 79 | next; 80 | } 81 | 82 | ok( $r, "get_domain_mx, $dom"); 83 | is_deeply( $r, $tests{$dom}, "get_domain_mx, $dom, deeply"); 84 | # print Dumper($r); 85 | }; 86 | }; 87 | 88 | sub test_human_summary { 89 | my $record = Mail::DMARC::Report::Aggregate::Record->new( 90 | auth_results => { spf => [] }, 91 | identifiers => { 92 | header_from => 'they.com', 93 | }, 94 | row => { 95 | source_ip => '192.2.0.1', 96 | policy_evaluated => { 97 | disposition=>'none', 98 | dkim => 'pass', 99 | spf => 'fail' 100 | } 101 | } 102 | ); 103 | $agg->record( $record ); 104 | $record->row->policy_evaluated->dkim('fail'); 105 | $record->row->policy_evaluated->spf('pass'); 106 | $agg->record( $record ); 107 | $record->row->policy_evaluated->dkim('fail'); 108 | $record->row->policy_evaluated->spf('fail'); 109 | $agg->record( $record ); 110 | my $sum = $smtp->human_summary( \$agg ); 111 | ok( $sum, 'human_summary' ); 112 | # print $sum; 113 | } 114 | 115 | sub test_get_filename { 116 | my $name = $smtp->get_filename(\$agg); 117 | ok( $name, "get_filename, $name"); 118 | }; 119 | 120 | sub test_assemble_message { 121 | my $mess = $smtp->assemble_message_object( \$agg, 'matt@example.com', $zipped )->as_string; 122 | ok( $mess, "assemble_message_object" ); 123 | #warn print $mess; 124 | } 125 | 126 | sub test_get_smtp_hosts { 127 | my $initial_smarthost = $smtp->config->{smtp}{smarthost}; 128 | $smtp->config->{smtp}{smarthost} = undef; 129 | my $tnpi_expected = [ 'mail.theartfarm.com', 'tnpi.net' ]; 130 | my @hosts = $smtp->get_smtp_hosts('tnpi.net'); 131 | is_deeply( \@hosts, $tnpi_expected, "get_smtp_hosts, tnpi.net"); 132 | # print Dumper(\@hosts); 133 | 134 | $smtp->config->{smtp}{smarthost} = $initial_smarthost; 135 | } 136 | 137 | -------------------------------------------------------------------------------- /share/mail_dmarc_schema.pgsql: -------------------------------------------------------------------------------- 1 | -- $Id$ 2 | 3 | -- Dump of table author 4 | -- ------------------------------------------------------------ 5 | 6 | DROP TABLE IF EXISTS author CASCADE; 7 | CREATE TABLE author ( 8 | id serial unique, 9 | org_name varchar(253) NOT NULL DEFAULT '', 10 | email varchar(255) DEFAULT NULL, 11 | extra_contact varchar(255) DEFAULT NULL 12 | ); 13 | 14 | 15 | -- Dump of table domain 16 | -- ------------------------------------------------------------ 17 | 18 | DROP TABLE IF EXISTS domain CASCADE; 19 | CREATE TABLE domain ( 20 | id serial unique, 21 | domain varchar(253) NOT NULL DEFAULT '', 22 | UNIQUE (domain) 23 | ); 24 | 25 | 26 | -- Dump of table report 27 | -- ------------------------------------------------------------ 28 | 29 | DROP TABLE IF EXISTS report CASCADE; 30 | CREATE TABLE report ( 31 | id serial unique, 32 | "begin" int NOT NULL, 33 | "end" int NOT NULL, 34 | author_id int NOT NULL REFERENCES author (id) ON DELETE NO ACTION, 35 | rcpt_domain_id int DEFAULT NULL, 36 | from_domain_id int NOT NULL REFERENCES domain (id), 37 | uuid varchar(253) DEFAULT NULL 38 | ); 39 | 40 | 41 | DROP TABLE IF EXISTS report_error CASCADE; 42 | CREATE TABLE report_error ( 43 | id serial unique, 44 | report_id int REFERENCES report(id) ON DELETE CASCADE, 45 | error varchar(255) NOT NULL DEFAULT '', 46 | time timestamp NOT NULL DEFAULT now() 47 | ); 48 | 49 | 50 | -- Dump of table report_policy_published 51 | -- ------------------------------------------------------------ 52 | 53 | DROP TABLE IF EXISTS report_policy_published CASCADE; 54 | CREATE TABLE report_policy_published ( 55 | id serial unique, 56 | report_id int NOT NULL REFERENCES report (id) ON DELETE CASCADE, 57 | adkim varchar(1) DEFAULT NULL, 58 | aspf varchar(1) DEFAULT NULL, 59 | p varchar(10) DEFAULT NULL, 60 | sp varchar(10) DEFAULT NULL, 61 | pct int DEFAULT NULL, 62 | rua varchar(255) DEFAULT NULL 63 | ); 64 | 65 | 66 | -- Dump of table report_record 67 | -- ------------------------------------------------------------ 68 | 69 | DROP TABLE IF EXISTS report_record CASCADE; 70 | CREATE TABLE report_record ( 71 | id serial unique, 72 | report_id int NOT NULL REFERENCES report (id) ON DELETE CASCADE, 73 | source_ip INET NOT NULL, 74 | count int DEFAULT NULL, 75 | disposition varchar(10) NOT NULL, 76 | dkim varchar(4) NOT NULL DEFAULT '', 77 | spf varchar(4) NOT NULL DEFAULT '', 78 | envelope_to_did int DEFAULT NULL, 79 | envelope_from_did int DEFAULT NULL, 80 | header_from_did int NOT NULL 81 | ); 82 | 83 | 84 | DROP TABLE IF EXISTS report_record_reason CASCADE; 85 | CREATE TABLE report_record_reason ( 86 | id serial unique, 87 | report_record_id int NOT NULL REFERENCES report_record (id) ON DELETE CASCADE, 88 | type varchar(24) NOT NULL, 89 | comment varchar(255) DEFAULT NULL 90 | ); 91 | 92 | 93 | -- Dump of table report_record_dkim 94 | -- ------------------------------------------------------------ 95 | 96 | DROP TABLE IF EXISTS report_record_dkim CASCADE; 97 | CREATE TABLE report_record_dkim ( 98 | id serial unique, 99 | report_record_id int NOT NULL REFERENCES report_record (id) ON DELETE CASCADE, 100 | domain_id int NOT NULL, 101 | selector varchar(253) DEFAULT NULL, 102 | result varchar(9) NOT NULL DEFAULT '', 103 | human_result varchar(64) DEFAULT NULL 104 | ); 105 | 106 | 107 | -- Dump of table report_record_spf 108 | -- ------------------------------------------------------------ 109 | 110 | DROP TABLE IF EXISTS report_record_spf CASCADE; 111 | CREATE TABLE report_record_spf ( 112 | id serial unique, 113 | report_record_id int NOT NULL REFERENCES report_record (id) ON DELETE CASCADE, 114 | domain_id int NOT NULL, 115 | scope varchar(5) DEFAULT NULL, 116 | result varchar(9) NOT NULL 117 | ); 118 | 119 | 120 | -- Indexes 121 | -- ----------------------------------------------------------- 122 | 123 | CREATE INDEX report_record_spf_report_record_id_idx ON report_record_spf(report_record_id); 124 | CREATE INDEX report_record_dkim_report_record_id_idx ON report_record_dkim(report_record_id); 125 | CREATE INDEX report_record_report_id_idx ON report_record(report_id); 126 | CREATE INDEX report_record_reason_report_record_id_idx ON report_record_reason(report_record_id); 127 | CREATE INDEX report_policy_published_report_id_idx ON report_policy_published(report_id); 128 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | .perltidyrc 2 | bin/dmarc_http_client 3 | bin/dmarc_httpd 4 | bin/dmarc_lookup 5 | bin/dmarc_receive 6 | bin/dmarc_send_reports 7 | bin/dmarc_update_public_suffix_list 8 | bin/dmarc_view_reports 9 | bin/install_deps.pl 10 | Build.PL 11 | Changes.md 12 | DEVELOP.md 13 | example/report_cgi.png 14 | FAQ.md 15 | INSTALL.md 16 | lib/Mail/DMARC.pm 17 | lib/Mail/DMARC/Base.pm 18 | lib/Mail/DMARC/HTTP.pm 19 | lib/Mail/DMARC/Policy.pm 20 | lib/Mail/DMARC/PurePerl.pm 21 | lib/Mail/DMARC/Report.pm 22 | lib/Mail/DMARC/Report/Aggregate.pm 23 | lib/Mail/DMARC/Report/Aggregate/Metadata.pm 24 | lib/Mail/DMARC/Report/Aggregate/Record.pm 25 | lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results.pm 26 | lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/DKIM.pm 27 | lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/SPF.pm 28 | lib/Mail/DMARC/Report/Aggregate/Record/Identifiers.pm 29 | lib/Mail/DMARC/Report/Aggregate/Record/Row.pm 30 | lib/Mail/DMARC/Report/Aggregate/Record/Row/Policy_Evaluated.pm 31 | lib/Mail/DMARC/Report/Receive.pm 32 | lib/Mail/DMARC/Report/Send.pm 33 | lib/Mail/DMARC/Report/Send/HTTP.pm 34 | lib/Mail/DMARC/Report/Send/SMTP.pm 35 | lib/Mail/DMARC/Report/Sender.pm 36 | lib/Mail/DMARC/Report/Store.pm 37 | lib/Mail/DMARC/Report/Store/SQL.pm 38 | lib/Mail/DMARC/Report/Store/SQL/Grammars/MySQL.pm 39 | lib/Mail/DMARC/Report/Store/SQL/Grammars/PostgreSQL.pm 40 | lib/Mail/DMARC/Report/Store/SQL/Grammars/SQLite.pm 41 | lib/Mail/DMARC/Report/URI.pm 42 | lib/Mail/DMARC/Result.pm 43 | lib/Mail/DMARC/Result/Reason.pm 44 | lib/Mail/DMARC/Test/Transport.pm 45 | LICENSE 46 | Makefile.PL 47 | MANIFEST This list of files 48 | MANIFEST.SKIP 49 | META.json 50 | META.yml 51 | README.md 52 | share/dmarc_whitelist 53 | share/html/css/ellipsis-xbl.xml 54 | share/html/css/ui.jqgrid.css 55 | share/html/css/ui.multiselect.css 56 | share/html/index.html 57 | share/html/js/i18n/grid.locale-ar.js.gz 58 | share/html/js/i18n/grid.locale-bg.js.gz 59 | share/html/js/i18n/grid.locale-bg1251.js.gz 60 | share/html/js/i18n/grid.locale-cat.js.gz 61 | share/html/js/i18n/grid.locale-cn.js.gz 62 | share/html/js/i18n/grid.locale-cs.js.gz 63 | share/html/js/i18n/grid.locale-da.js.gz 64 | share/html/js/i18n/grid.locale-de.js.gz 65 | share/html/js/i18n/grid.locale-dk.js.gz 66 | share/html/js/i18n/grid.locale-el.js.gz 67 | share/html/js/i18n/grid.locale-en.js.gz 68 | share/html/js/i18n/grid.locale-es.js.gz 69 | share/html/js/i18n/grid.locale-fa.js.gz 70 | share/html/js/i18n/grid.locale-fi.js.gz 71 | share/html/js/i18n/grid.locale-fr.js.gz 72 | share/html/js/i18n/grid.locale-gl.js.gz 73 | share/html/js/i18n/grid.locale-he.js.gz 74 | share/html/js/i18n/grid.locale-hr.js.gz 75 | share/html/js/i18n/grid.locale-hr1250.js.gz 76 | share/html/js/i18n/grid.locale-hu.js.gz 77 | share/html/js/i18n/grid.locale-id.js.gz 78 | share/html/js/i18n/grid.locale-is.js.gz 79 | share/html/js/i18n/grid.locale-it.js.gz 80 | share/html/js/i18n/grid.locale-ja.js.gz 81 | share/html/js/i18n/grid.locale-kr.js.gz 82 | share/html/js/i18n/grid.locale-lt.js.gz 83 | share/html/js/i18n/grid.locale-mne.js.gz 84 | share/html/js/i18n/grid.locale-nl.js.gz 85 | share/html/js/i18n/grid.locale-no.js.gz 86 | share/html/js/i18n/grid.locale-pl.js.gz 87 | share/html/js/i18n/grid.locale-pt-br.js.gz 88 | share/html/js/i18n/grid.locale-pt.js.gz 89 | share/html/js/i18n/grid.locale-ro.js.gz 90 | share/html/js/i18n/grid.locale-ru.js.gz 91 | share/html/js/i18n/grid.locale-sk.js.gz 92 | share/html/js/i18n/grid.locale-sr-latin.js.gz 93 | share/html/js/i18n/grid.locale-sr.js.gz 94 | share/html/js/i18n/grid.locale-sv.js.gz 95 | share/html/js/i18n/grid.locale-th.js.gz 96 | share/html/js/i18n/grid.locale-tr.js.gz 97 | share/html/js/i18n/grid.locale-tw.js.gz 98 | share/html/js/i18n/grid.locale-ua.js.gz 99 | share/html/js/i18n/grid.locale-vi.js.gz 100 | share/html/js/jquery.jqGrid.min.js.gz 101 | share/html/plugins/grid.addons.js.gz 102 | share/html/plugins/grid.postext.js.gz 103 | share/html/plugins/grid.setcolumns.js.gz 104 | share/html/plugins/jquery.contextmenu.js.gz 105 | share/html/plugins/jquery.searchFilter.js.gz 106 | share/html/plugins/jquery.tablednd.js.gz 107 | share/html/plugins/searchFilter.css 108 | share/html/plugins/ui.multiselect.css 109 | share/html/plugins/ui.multiselect.js.gz 110 | share/mail-dmarc.cron 111 | share/mail-dmarc.ini 112 | share/mail_dmarc_schema.mysql 113 | share/mail_dmarc_schema.pgsql 114 | share/mail_dmarc_schema.sqlite 115 | share/public_suffix_list 116 | share/rua-schema.xsd 117 | t/00.Dmarc.t 118 | t/01.Policy.t 119 | t/03.Base.t 120 | t/04.PurePerl.t 121 | t/06.Result.t 122 | t/09.HTTP.t 123 | t/10.Report.t 124 | t/11.Report.Store.t 125 | t/12.Report.Store.SQL.t 126 | t/13.Report.Aggregate.t 127 | t/14.Report.Aggregate.Metadata.t 128 | t/15.Report.Aggregate.Record.t 129 | t/16.Report.Aggregate.Record.Auth_Results.t 130 | t/17.Report.Aggregate.Schema.t 131 | t/20.Report.URI.t 132 | t/21.Report.Send.t 133 | t/22.Report.Send.SMTP.t 134 | t/23.Report.Send.HTTP.t 135 | t/25.Report.Receive.t 136 | t/26.Report.Sender.t 137 | t/backends/mail-dmarc.sql.mysql.ini 138 | t/backends/mail-dmarc.sql.Pg.ini 139 | t/backends/mail-dmarc.sql.SQLite.ini 140 | t/mail-dmarc.ini 141 | t/whitelist 142 | TODO.md 143 | xt/author-critic.t 144 | xt/perlcritic.rc 145 | -------------------------------------------------------------------------------- /t/26.Report.Sender.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use Net::DNS::Resolver::Mock; 6 | 7 | $ENV{MAIL_DMARC_CONFIG_FILE} = 't/mail-dmarc.ini'; 8 | 9 | use lib 'lib'; 10 | use Mail::DMARC::PurePerl; 11 | use Test::File::ShareDir 12 | -share => { -dist => { 'Mail-DMARC' => 'share' } }; 13 | 14 | use Mail::DMARC::Test::Transport; 15 | use Email::Sender::Transport::Failable; 16 | use Email::Sender::Transport::Test; 17 | 18 | my $resolver = new Net::DNS::Resolver::Mock(); 19 | $resolver->zonefile_parse(join("\n", 20 | 'fastmaildmarc.com. 600 MX 10 in1-smtp.messagingengine.com.', 21 | '_dmarc.fastmaildmarc.com. 600 TXT "v=DMARC1; p=reject; rua=mailto:rua@fastmaildmarc.com"', 22 | '')); 23 | 24 | # We test both method and object type callbacks 25 | foreach my $callback_type ( qw{ method object fail fallback } ) { 26 | 27 | subtest $callback_type => sub{ 28 | unlink 't/reports-test.sqlite' if -e 't/reports-test.sqlite'; # Clear test database for each run 29 | 30 | my $dmarc = Mail::DMARC::PurePerl->new; 31 | $dmarc->set_resolver($resolver); 32 | 33 | $dmarc->set_fake_time( time-86400); 34 | $dmarc->init(); 35 | $dmarc->source_ip('66.128.51.165'); 36 | $dmarc->envelope_to('fastmaildmarc.com'); 37 | $dmarc->envelope_from('fastmaildmarc.com'); 38 | $dmarc->header_from('fastmaildmarc.com'); 39 | $dmarc->dkim([ 40 | { 41 | domain => 'tnpi.net', 42 | selector => 'jan2015', 43 | result => 'fail', 44 | human_result=> 'fail (body has been altered)', 45 | } 46 | ]); 47 | $dmarc->spf([ 48 | { domain => 'tnpi.net', 49 | scope => 'mfrom', 50 | result => 'pass', 51 | }, 52 | { 53 | scope => 'helo', 54 | domain => 'mail.tnpi.net', 55 | result => 'fail', 56 | }, 57 | ]); 58 | 59 | my $policy = $dmarc->discover_policy; 60 | my $result = $dmarc->validate($policy); 61 | $dmarc->save_aggregate; 62 | $dmarc->set_fake_time( time+86400); 63 | use Mail::DMARC::Report::Sender; 64 | my $sender = Mail::DMARC::Report::Sender->new; 65 | my @deliveries; 66 | 67 | if ( $callback_type eq 'method' ) { 68 | my $transport = Email::Sender::Transport::Test->new; 69 | $sender->set_transports_method( sub{ 70 | my @transports; 71 | push @transports, $transport; 72 | return @transports; 73 | }); 74 | $sender->run; 75 | @deliveries = $transport->deliveries; 76 | } 77 | elsif ( $callback_type eq 'object' ) { 78 | my $transports = Mail::DMARC::Test::Transport->new; 79 | $sender->set_transports_object( $transports ); 80 | $sender->run; 81 | @deliveries = $transports->get_test_transport->deliveries; 82 | } 83 | elsif ( $callback_type eq 'fail' ) { 84 | my $transport = Email::Sender::Transport::Test->new; 85 | my $transport_fail = Email::Sender::Transport::Failable->new( 86 | transport => $transport, 87 | failure_conditions => [ sub{ return 1 } ], 88 | ); 89 | $sender->set_transports_method( sub{ 90 | my @transports; 91 | push @transports, $transport_fail; 92 | return @transports; 93 | }); 94 | $sender->run; 95 | @deliveries = $transport_fail->transport->deliveries; 96 | } 97 | elsif ( $callback_type eq 'fallback' ) { 98 | my $transport = Email::Sender::Transport::Test->new; 99 | my $transport_fail = Email::Sender::Transport::Failable->new( 100 | transport => $transport, 101 | failure_conditions => [ sub{ return 1 } ], 102 | ); 103 | $sender->set_transports_method( sub{ 104 | my @transports; 105 | push @transports, $transport_fail; 106 | push @transports, $transport; 107 | return @transports; 108 | }); 109 | $sender->run; 110 | @deliveries = $transport->deliveries; 111 | } 112 | else { 113 | die 'Unknown callback type in test'; 114 | } 115 | 116 | if ( $callback_type eq 'fail' ) { 117 | is( scalar @deliveries, 0, 'Email send fails' ); 118 | } 119 | else { 120 | is( scalar @deliveries, 1, '1 Email sent' ); 121 | is( $deliveries[0]->{envelope}->{to}->[0], 'rua@fastmaildmarc.com', 'Sent to correct address' ); 122 | my $body = ${$deliveries[0]->{email}->[0]->{body}}; 123 | is( $body =~ /This is a DMARC aggregate report for fastmaildmarc.com/, 1, 'Human readable description' ); 124 | is( $body =~ /1 records.\n0 passed.\n1 failed./, 1, 'Human readable summary'); 125 | is( $body =~ /Content-Type: application\/gzip/, 1, 'Gzip attachment' ); 126 | } 127 | }; 128 | 129 | } 130 | 131 | done_testing; 132 | 133 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/URI.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::URI; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '1.20250805'; 6 | 7 | use Carp; 8 | use URI; 9 | 10 | sub new { 11 | my $class = shift; 12 | return bless {}, $class; 13 | } 14 | 15 | sub parse { 16 | my $self = shift; 17 | my $str = shift or croak "URI string is required!"; 18 | 19 | my @valids = (); 20 | foreach my $raw ( split /,/, $str ) { 21 | # warn "raw: $raw\n"; 22 | my ( $u, $size_f ) = split /!/, $raw; 23 | my $bytes = $self->get_size_limit($size_f); 24 | my $uri = URI->new($u) or do { 25 | carp "can't parse URI from $u"; 26 | next; 27 | }; 28 | my $scheme = $uri->scheme or next; 29 | if ( $scheme eq 'mailto' && lc substr( $u, 0, 7 ) eq 'mailto:' ) { 30 | push @valids, { max_bytes => $bytes, uri => $uri }; 31 | next; 32 | } 33 | if ( $scheme =~ /^http(s)?/x && lc substr( $u, 0, 4 ) eq 'http' ) { 34 | push @valids, { max_bytes => $bytes, uri => $uri }; 35 | next; 36 | } 37 | 38 | # print "invalid URI scheme: $scheme in $u\n"; 39 | # 12.1 Discovery - URI schemes found in "rua" tag that are not implemented by 40 | # a Mail Receiver MUST be ignored. 41 | } 42 | return \@valids; 43 | } 44 | 45 | sub get_size_limit { 46 | my ( $self, $size ) = @_; 47 | return 0 if !defined $size; # no limit 48 | return $size if $size =~ /^\d+$/; # no units, raw byte count 49 | 50 | # 6.3 Formal Definition 51 | # units are considered to be powers of two; a kilobyte is 2^10, a megabyte is 2^20, 52 | my $unit = lc chop $size; 53 | return $size * ( 2**10 ) if 'k' eq $unit; 54 | return $size * ( 2**20 ) if 'm' eq $unit; 55 | return $size * ( 2**30 ) if 'g' eq $unit; 56 | return $size * ( 2**40 ) if 't' eq $unit; 57 | croak "unrecognized unit ($unit) in size ($size)"; 58 | } 59 | 60 | 1; 61 | 62 | __END__ 63 | 64 | =pod 65 | 66 | =head1 NAME 67 | 68 | Mail::DMARC::Report::URI - a DMARC report URI 69 | 70 | =head1 VERSION 71 | 72 | version 1.20250805 73 | 74 | =head1 SYNOPSIS 75 | 76 | use Mail::DMARC::URI; 77 | my $duri = Mail::DMARC::URI->new; 78 | my $uri_ref = $duri->parse('mailto:rua@example.com,mailto:rua@external.otherdomain.com'); 79 | foreach my $u ( @$uri_ref ) { 80 | my $method = $u->{uri}; 81 | my $max = $u->{max_bytes}; 82 | ... do some URI stuff ... 83 | }; 84 | 85 | =head1 DESCRIPTION 86 | 87 | defines a generic syntax for identifying a resource. The DMARC 88 | mechanism uses this as the format by which a Domain Owner specifies 89 | the destination for the two report types that are supported. 90 | 91 | The place such URIs are specified (see Section 6.2) allows a list of 92 | these to be provided. A report is to be sent to each listed URI. 93 | Mail Receivers MAY impose a limit on the number of URIs that receive 94 | reports, but MUST support at least two. The list of URIs is 95 | separated by commas (ASCII 0x2C). 96 | 97 | Each URI can have associated with it a maximum report size that may 98 | be sent to it. This is accomplished by appending an exclamation 99 | point (ASCII 0x21), followed by a maximum size indication, before a 100 | separating comma or terminating semi-colon. 101 | 102 | Thus, a DMARC URI is a URI within which any commas or exclamation 103 | points are percent-encoded per [URI], followed by an OPTIONAL 104 | exclamation point and a maximum size specification, and, if there are 105 | additional reporting URIs in the list, a comma and the next URI. 106 | 107 | For example, the URI "mailto:reports@example.com!50m" would request a 108 | report be sent via email to "reports@example.com" so long as the 109 | report payload does not exceed 50 megabytes. 110 | 111 | A formal definition is provided in Section 6.3. 112 | 113 | =head1 ABNF 114 | 115 | dmarc-uri = URI [ "!" 1*DIGIT [ "k" / "m" / "g" / "t" ] ] 116 | ; "URI" is imported from [URI]; commas (ASCII 0x2c) 117 | ; and exclamation points (ASCII 0x21) MUST be encoded 118 | 119 | URI is imported from RFC 3986: https://www.ietf.org/rfc/rfc3986.txt 120 | 121 | Only mailto, http, and https URIs are currently supported, examples: 122 | 123 | https://www.ietf.org/rfc/rfc3986.txt 124 | mailto:John.Doe@example.com 125 | 126 | With an optional size limit (see SIZE LIMIT). 127 | 128 | =head1 SIZE LIMIT 129 | 130 | A size limitation in a dmarc-uri, if provided, is interpreted as a 131 | count of units followed by an OPTIONAL unit size ("k" for kilobytes, 132 | "m" for megabytes, "g" for gigabytes, "t" for terabytes). Without a 133 | unit, the number is presumed to be a basic byte count. Note that the 134 | units are considered to be powers of two; a kilobyte is 2^10, a 135 | megabyte is 2^20, etc. 136 | 137 | =head1 AUTHORS 138 | 139 | =over 4 140 | 141 | =item * 142 | 143 | Matt Simerson 144 | 145 | =item * 146 | 147 | Davide Migliavacca 148 | 149 | =item * 150 | 151 | Marc Bradshaw 152 | 153 | =back 154 | 155 | =head1 COPYRIGHT AND LICENSE 156 | 157 | This software is copyright (c) 2025 by Matt Simerson. 158 | 159 | This is free software; you can redistribute it and/or modify it under 160 | the same terms as the Perl 5 programming language system itself. 161 | 162 | =cut 163 | 164 | -------------------------------------------------------------------------------- /share/html/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Mail::DMARC::HTTP 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 28 | 29 | 127 | 128 | 129 | 130 | 131 |

Mail::DMARC::HTTP.

132 | 133 |
134 | 135 |
136 |
137 |
138 |
139 | 140 | 141 | 142 | -------------------------------------------------------------------------------- /share/mail_dmarc_schema.sqlite: -------------------------------------------------------------------------------- 1 | 2 | DROP TABLE IF EXISTS `author`; 3 | 4 | CREATE TABLE `author` ( 5 | `id` INTEGER PRIMARY KEY AUTOINCREMENT, 6 | `org_name` TEXT NOT NULL, 7 | `email` TEXT DEFAULT NULL, 8 | `extra_contact` TEXT DEFAULT NULL 9 | ); 10 | 11 | CREATE UNIQUE INDEX "org_name_idx" ON "author" ("org_name"); 12 | 13 | 14 | 15 | DROP TABLE IF EXISTS `domain`; 16 | 17 | CREATE TABLE `domain` ( 18 | `id` INTEGER PRIMARY KEY AUTOINCREMENT, 19 | `domain` TEXT NOT NULL 20 | ); 21 | 22 | CREATE UNIQUE INDEX "domain_idx" ON "domain" ("domain"); 23 | 24 | 25 | DROP TABLE IF EXISTS `fk_disposition`; 26 | 27 | CREATE TABLE `fk_disposition` ( 28 | `disposition` TEXT NOT NULL, 29 | PRIMARY KEY (`disposition`) 30 | ); 31 | INSERT INTO "fk_disposition" VALUES ('none'); 32 | INSERT INTO "fk_disposition" VALUES ('quarantine'); 33 | INSERT INTO "fk_disposition" VALUES ('reject'); 34 | 35 | 36 | DROP TABLE IF EXISTS `fk_disposition_reason`; 37 | 38 | CREATE TABLE `fk_disposition_reason` ( 39 | `type` TEXT NOT NULL, 40 | PRIMARY KEY (`type`) 41 | ); 42 | 43 | INSERT INTO "fk_disposition_reason" VALUES ('forwarded'); 44 | INSERT INTO "fk_disposition_reason" VALUES ('local_policy'); 45 | INSERT INTO "fk_disposition_reason" VALUES ('mailing_list'); 46 | INSERT INTO "fk_disposition_reason" VALUES ('other'); 47 | INSERT INTO "fk_disposition_reason" VALUES ('sampled_out'); 48 | INSERT INTO "fk_disposition_reason" VALUES ('trusted_forwarder'); 49 | 50 | 51 | DROP TABLE IF EXISTS `fk_dkim_result`; 52 | 53 | CREATE TABLE `fk_dkim_result` ( 54 | `result` TEXT NOT NULL, 55 | PRIMARY KEY (`result`) 56 | ); 57 | 58 | INSERT INTO "fk_dkim_result" VALUES ('fail'); 59 | INSERT INTO "fk_dkim_result" VALUES ('neutral'); 60 | INSERT INTO "fk_dkim_result" VALUES ('none'); 61 | INSERT INTO "fk_dkim_result" VALUES ('pass'); 62 | INSERT INTO "fk_dkim_result" VALUES ('permerror'); 63 | INSERT INTO "fk_dkim_result" VALUES ('policy'); 64 | INSERT INTO "fk_dkim_result" VALUES ('temperror'); 65 | 66 | 67 | DROP TABLE IF EXISTS `fk_spf_result`; 68 | 69 | CREATE TABLE `fk_spf_result` ( 70 | `result` TEXT NOT NULL, 71 | PRIMARY KEY (`result`) 72 | ); 73 | 74 | INSERT INTO "fk_spf_result" VALUES ('fail'); 75 | INSERT INTO "fk_spf_result" VALUES ('neutral'); 76 | INSERT INTO "fk_spf_result" VALUES ('none'); 77 | INSERT INTO "fk_spf_result" VALUES ('pass'); 78 | INSERT INTO "fk_spf_result" VALUES ('permerror'); 79 | INSERT INTO "fk_spf_result" VALUES ('softfail'); 80 | INSERT INTO "fk_spf_result" VALUES ('temperror'); 81 | 82 | 83 | 84 | DROP TABLE IF EXISTS `fk_spf_scope`; 85 | 86 | CREATE TABLE `fk_spf_scope` ( 87 | `scope` TEXT NOT NULL, 88 | PRIMARY KEY (`scope`) 89 | ); 90 | 91 | INSERT INTO "fk_spf_scope" VALUES ('helo'); 92 | INSERT INTO "fk_spf_scope" VALUES ('mfrom'); 93 | 94 | 95 | 96 | DROP TABLE IF EXISTS `report`; 97 | 98 | CREATE TABLE `report` ( 99 | `id` INTEGER PRIMARY KEY AUTOINCREMENT, 100 | `begin` INTEGER NOT NULL, 101 | `end` INTEGER NOT NULL, 102 | `author_id` INTEGER NOT NULL REFERENCES `author`(`id`) ON UPDATE CASCADE ON DELETE CASCADE, 103 | `rcpt_domain_id` INTEGER DEFAULT NULL, 104 | `from_domain_id` INTEGER NOT NULL REFERENCES `domain`(`id`) ON UPDATE CASCADE ON DELETE CASCADE, 105 | `uuid` TEXT DEFAULT NULL 106 | ); 107 | 108 | 109 | 110 | DROP TABLE IF EXISTS `report_error`; 111 | 112 | CREATE TABLE "report_error" ( 113 | `report_id` INTEGER NOT NULL REFERENCES "report"("id") ON UPDATE CASCADE ON DELETE CASCADE, 114 | `error` TEXT NOT NULL, 115 | `time` TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL 116 | ); 117 | 118 | 119 | DROP TABLE IF EXISTS `report_policy_published`; 120 | 121 | CREATE TABLE `report_policy_published` ( 122 | `report_id` INTEGER NOT NULL REFERENCES "report"("id") ON UPDATE CASCADE ON DELETE CASCADE, 123 | `adkim` TEXT DEFAULT NULL, 124 | `aspf` TEXT DEFAULT NULL, 125 | `p` TEXT DEFAULT NULL, 126 | `sp` TEXT DEFAULT NULL, 127 | `pct` INTEGER DEFAULT NULL, 128 | `rua` TEXT DEFAULT NULL 129 | ); 130 | 131 | 132 | DROP TABLE IF EXISTS `report_record`; 133 | 134 | CREATE TABLE `report_record` ( 135 | `id` INTEGER PRIMARY KEY AUTOINCREMENT, 136 | `report_id` INTEGER NOT NULL REFERENCES "report"("id") ON UPDATE CASCADE ON DELETE CASCADE, 137 | `source_ip` varbinary(16) NOT NULL, 138 | `count` INTEGER DEFAULT NULL, 139 | `disposition` TEXT NOT NULL REFERENCES "fk_disposition"("disposition") ON UPDATE CASCADE ON DELETE NO ACTION, 140 | `dkim` TEXT DEFAULT NULL, 141 | `spf` TEXT DEFAULT NULL, 142 | `envelope_to_did` INTEGER DEFAULT NULL, 143 | `envelope_from_did` INTEGER DEFAULT NULL, 144 | `header_from_did` INTEGER NOT NULL 145 | ); 146 | 147 | 148 | DROP TABLE IF EXISTS `report_record_reason`; 149 | 150 | CREATE TABLE `report_record_reason` ( 151 | `report_record_id` INTEGER NOT NULL REFERENCES "report_record"("id") ON UPDATE CASCADE ON DELETE CASCADE, 152 | `type` TEXT NOT NULL REFERENCES "fk_disposition_reason"("type") ON UPDATE CASCADE ON DELETE CASCADE, 153 | `comment` TEXT DEFAULT NULL 154 | ); 155 | 156 | 157 | DROP TABLE IF EXISTS `report_record_dkim`; 158 | 159 | CREATE TABLE `report_record_dkim` ( 160 | `report_record_id` INTEGER NOT NULL REFERENCES "report_record"("id") ON UPDATE CASCADE ON DELETE CASCADE, 161 | `domain_id` INTEGER NOT NULL, 162 | `selector` TEXT DEFAULT NULL, 163 | `result` TEXT DEFAULT NULL REFERENCES "fk_dkim_result"("result") ON UPDATE CASCADE ON DELETE CASCADE, 164 | `human_result` TEXT DEFAULT NULL 165 | ); 166 | 167 | 168 | DROP TABLE IF EXISTS `report_record_spf`; 169 | 170 | CREATE TABLE `report_record_spf` ( 171 | `report_record_id` INTEGER NOT NULL REFERENCES "report_record"("id") ON UPDATE CASCADE ON DELETE CASCADE, 172 | `domain_id` INTEGER NOT NULL, 173 | `scope` TEXT DEFAULT NULL REFERENCES "fk_spf_scope"("scope") ON UPDATE CASCADE ON DELETE RESTRICT, 174 | `result` TEXT NOT NULL REFERENCES "fk_spf_result"("result") ON UPDATE CASCADE ON DELETE CASCADE 175 | ); 176 | -------------------------------------------------------------------------------- /META.yml: -------------------------------------------------------------------------------- 1 | --- 2 | abstract: 'Perl implementation of DMARC' 3 | author: 4 | - 'Matt Simerson ' 5 | - 'Davide Migliavacca ' 6 | - 'Marc Bradshaw ' 7 | build_requires: 8 | Module::Build: '0.3601' 9 | Net::DNS::Resolver::Mock: '0' 10 | Test::Exception: '0' 11 | Test::File::ShareDir: '0' 12 | Test::More: '0' 13 | Test::Output: '0' 14 | configure_requires: 15 | File::ShareDir::Install: '0.06' 16 | Module::Build: '0.3601' 17 | dynamic_config: 1 18 | generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010' 19 | license: perl 20 | meta-spec: 21 | url: http://module-build.sourceforge.net/META-spec-v1.4.html 22 | version: '1.4' 23 | name: Mail-DMARC 24 | provides: 25 | Mail::DMARC: 26 | file: lib/Mail/DMARC.pm 27 | version: '1.20250805' 28 | Mail::DMARC::Base: 29 | file: lib/Mail/DMARC/Base.pm 30 | version: '1.20250805' 31 | Mail::DMARC::HTTP: 32 | file: lib/Mail/DMARC/HTTP.pm 33 | version: '1.20250805' 34 | Mail::DMARC::Policy: 35 | file: lib/Mail/DMARC/Policy.pm 36 | version: '1.20250805' 37 | Mail::DMARC::PurePerl: 38 | file: lib/Mail/DMARC/PurePerl.pm 39 | version: '1.20250805' 40 | Mail::DMARC::Report: 41 | file: lib/Mail/DMARC/Report.pm 42 | version: '1.20250805' 43 | Mail::DMARC::Report::Aggregate: 44 | file: lib/Mail/DMARC/Report/Aggregate.pm 45 | version: '1.20250805' 46 | Mail::DMARC::Report::Aggregate::Metadata: 47 | file: lib/Mail/DMARC/Report/Aggregate/Metadata.pm 48 | version: '1.20250805' 49 | Mail::DMARC::Report::Aggregate::Record: 50 | file: lib/Mail/DMARC/Report/Aggregate/Record.pm 51 | version: '1.20250805' 52 | Mail::DMARC::Report::Aggregate::Record::Auth_Results: 53 | file: lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results.pm 54 | version: '1.20250805' 55 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM: 56 | file: lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/DKIM.pm 57 | version: '1.20250805' 58 | Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF: 59 | file: lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/SPF.pm 60 | version: '1.20250805' 61 | Mail::DMARC::Report::Aggregate::Record::Identifiers: 62 | file: lib/Mail/DMARC/Report/Aggregate/Record/Identifiers.pm 63 | version: '1.20250805' 64 | Mail::DMARC::Report::Aggregate::Record::Row: 65 | file: lib/Mail/DMARC/Report/Aggregate/Record/Row.pm 66 | version: '1.20250805' 67 | Mail::DMARC::Report::Aggregate::Record::Row::Policy_Evaluated: 68 | file: lib/Mail/DMARC/Report/Aggregate/Record/Row/Policy_Evaluated.pm 69 | version: '1.20250805' 70 | Mail::DMARC::Report::Receive: 71 | file: lib/Mail/DMARC/Report/Receive.pm 72 | version: '1.20250805' 73 | Mail::DMARC::Report::Send: 74 | file: lib/Mail/DMARC/Report/Send.pm 75 | version: '1.20250805' 76 | Mail::DMARC::Report::Send::HTTP: 77 | file: lib/Mail/DMARC/Report/Send/HTTP.pm 78 | version: '1.20250805' 79 | Mail::DMARC::Report::Send::SMTP: 80 | file: lib/Mail/DMARC/Report/Send/SMTP.pm 81 | version: '1.20250805' 82 | Mail::DMARC::Report::Sender: 83 | file: lib/Mail/DMARC/Report/Sender.pm 84 | Mail::DMARC::Report::Store: 85 | file: lib/Mail/DMARC/Report/Store.pm 86 | version: '1.20250805' 87 | Mail::DMARC::Report::Store::SQL: 88 | file: lib/Mail/DMARC/Report/Store/SQL.pm 89 | version: '1.20250805' 90 | Mail::DMARC::Report::Store::SQL::Grammars::MySQL: 91 | file: lib/Mail/DMARC/Report/Store/SQL/Grammars/MySQL.pm 92 | version: '1.20250805' 93 | Mail::DMARC::Report::Store::SQL::Grammars::PostgreSQL: 94 | file: lib/Mail/DMARC/Report/Store/SQL/Grammars/PostgreSQL.pm 95 | version: '1.20250805' 96 | Mail::DMARC::Report::Store::SQL::Grammars::SQLite: 97 | file: lib/Mail/DMARC/Report/Store/SQL/Grammars/SQLite.pm 98 | version: '1.20250805' 99 | Mail::DMARC::Report::URI: 100 | file: lib/Mail/DMARC/Report/URI.pm 101 | version: '1.20250805' 102 | Mail::DMARC::Result: 103 | file: lib/Mail/DMARC/Result.pm 104 | version: '1.20250805' 105 | Mail::DMARC::Result::Reason: 106 | file: lib/Mail/DMARC/Result/Reason.pm 107 | version: '1.20250805' 108 | Mail::DMARC::Test::Transport: 109 | file: lib/Mail/DMARC/Test/Transport.pm 110 | recommends: 111 | Mail::DKIM: '0' 112 | Net::IMAP::Simple: '0' 113 | Net::SMTPS: '0' 114 | requires: 115 | Carp: '0' 116 | Config::Tiny: '0' 117 | DBD::SQLite: '1.31' 118 | DBIx::Simple: '1.35' 119 | Data::Dumper: '0' 120 | Email::MIME: '0' 121 | Email::Sender: '0' 122 | Email::Sender::Simple: '1.300032' 123 | Email::Simple: '0' 124 | Encode: '0' 125 | English: '0' 126 | File::ShareDir: '1.00' 127 | Getopt::Long: '0' 128 | HTTP::Tiny: '0' 129 | IO::Compress::Gzip: '0' 130 | IO::Compress::Zip: '0' 131 | IO::File: '0' 132 | IO::Socket::SSL: '0' 133 | IO::Uncompress::Gunzip: '0' 134 | IO::Uncompress::Unzip: '0' 135 | Module::Load: '0' 136 | Net::DNS::Resolver: '0' 137 | Net::IDN::Encode: '0' 138 | Net::IP: '0' 139 | Net::SSLeay: '0' 140 | POSIX: '0' 141 | Pod::Usage: '0' 142 | Regexp::Common: '2013031301' 143 | Socket: '0' 144 | Socket6: '0.23' 145 | Sys::Hostname: '0' 146 | Sys::Syslog: '0' 147 | Test::File::ShareDir: '0' 148 | URI: '0' 149 | XML::LibXML: '0' 150 | perl: v5.10.0 151 | resources: 152 | bugtracker: https://github.com/msimerson/mail-dmarc/issues 153 | homepage: https://github.com/msimerson/mail-dmarc/wiki 154 | license: http://dev.perl.org/licenses/ 155 | repository: https://github.com/msimerson/mail-dmarc 156 | version: '1.20250805' 157 | x_contributors: 158 | - 'Benny Pedersen ' 159 | - 'Jean Paul Galea ' 160 | - 'Marisa Clardy ' 161 | - 'Priyadi Iman Nurcahyo ' 162 | - 'Ricardo Signes ' 163 | x_serialization_backend: 'CPAN::Meta::YAML version 0.020' 164 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Module::Build 0.3601; 5 | 6 | my $module_build_args = { 7 | "build_requires" => { 8 | "Module::Build" => "0.3601" 9 | }, 10 | "configure_requires" => { 11 | "File::ShareDir::Install" => "0.06", 12 | "Module::Build" => "0.3601" 13 | }, 14 | "dist_abstract" => "Perl implementation of DMARC", 15 | "dist_author" => [ 16 | "Matt Simerson ", 17 | "Davide Migliavacca ", 18 | "Marc Bradshaw " 19 | ], 20 | "dist_name" => "Mail-DMARC", 21 | "license" => "perl", 22 | "module_name" => "Mail::DMARC", 23 | "release_status" => "stable", 24 | "add_to_cleanup" => [ "dmarc_reports.sqlite", "t/reports-test.sqlite"], 25 | "recommends" => { 26 | "Mail::DKIM" => 0, 27 | # "MIME::Lite" => 0, 28 | "Net::IMAP::Simple" => 0, 29 | "Net::SMTPS" => 0, 30 | }, 31 | "requires" => { 32 | "perl" => "5.10.0", 33 | "Carp" => 0, 34 | "Config::Tiny" => 0, 35 | "DBD::SQLite" => "1.31", 36 | "DBIx::Simple" => "1.35", 37 | "Data::Dumper" => 0, 38 | "Email::MIME" => 0, 39 | "Email::Sender" => 0, 40 | "Email::Sender::Simple" => "1.300032", 41 | "Email::Simple" => 0, 42 | "Encode" => 0, 43 | "English" => 0, 44 | "File::ShareDir" => 0, 45 | "Getopt::Long" => 0, 46 | "HTTP::Tiny" => 0, 47 | "IO::Compress::Gzip" => 0, 48 | "IO::Compress::Zip" => 0, 49 | "IO::File" => 0, 50 | "IO::Socket::SSL" => 0, 51 | "IO::Uncompress::Gunzip" => 0, 52 | "IO::Uncompress::Unzip" => 0, 53 | "Module::Load" => 0, 54 | "Net::DNS::Resolver" => 0, 55 | "Net::IDN::Encode" => 0, 56 | "Net::IP" => 0, 57 | "Net::SSLeay" => 0, 58 | "POSIX" => 0, 59 | "Pod::Usage" => 0, 60 | "Regexp::Common" => "2013031301", 61 | "Socket" => 0, 62 | "Socket6" => "0.23", 63 | "Sys::Hostname" => 0, 64 | "Sys::Syslog" => 0, 65 | "Test::File::ShareDir" => 0, 66 | "URI" => 0, 67 | "XML::LibXML" => 0, 68 | }, 69 | "auto_features" => { 70 | "mysql" => { 71 | "description" => "MySQL backend storage", 72 | "prereqs" => { 73 | "runtime" => { 74 | "requires" => { 75 | 'DBD::mysql' => '4.001', 76 | } 77 | } 78 | } 79 | }, 80 | "postgres" => { 81 | "description" => "PostgresQL backend storage", 82 | "prereqs" => { 83 | "runtime" => { 84 | "requires" => { 85 | 'DBD::Pg' => '0' 86 | } 87 | } 88 | } 89 | }, 90 | "web_services" => { 91 | "description" => "HTTP API and web UI to DMARC reports", 92 | "prereqs" => { 93 | "runtime" => { 94 | "requires" => { 95 | "CGI" => 0, 96 | "HTTP::Request" => 0, 97 | "JSON" => 0, 98 | "LWP::UserAgent" => 0, 99 | "Net::HTTP" => 0, 100 | "Net::Server::HTTP" => 0, 101 | "Net::Server" => 2, 102 | } 103 | } 104 | } 105 | }, 106 | "smtp_sending" => { 107 | "description" => "Send DMARC reports via SMTP", 108 | "prereqs" => { 109 | "runtime" => { 110 | "Net::SMTPS" => 0, 111 | "Mail::DKIM::PrivateKey" => 0, 112 | "Mail::DKIM::Signer" => 0, 113 | "Mail::DKIM::TextWrap" => 0, 114 | } 115 | } 116 | }, 117 | "imap_fetch" => { 118 | "description" => "Retrieve DMARC reports from an IMAP account", 119 | "prereqs" => { 120 | "runtime" => { 121 | "Net::IMAP::Simple" => 0, 122 | } 123 | } 124 | } 125 | }, 126 | "recursive_test_files" => 1, 127 | "script_files" => [ 128 | "bin/dmarc_update_public_suffix_list", 129 | "bin/dmarc_send_reports", 130 | "bin/dmarc_httpd", 131 | "bin/dmarc_lookup", 132 | "bin/dmarc_receive", 133 | "bin/dmarc_http_client", 134 | "bin/dmarc_view_reports" 135 | ], 136 | "share_dir" => { 137 | "dist" => "share" 138 | }, 139 | "test_requires" => { 140 | "Test::Exception" => 0, 141 | "Test::File::ShareDir" => 0, 142 | "Test::More" => 0, 143 | "Test::Output" => 0, 144 | "Net::DNS::Resolver::Mock" => 0 145 | }, 146 | "develop_requires" => { 147 | "Test::Pod" => "1.41" 148 | }, 149 | "meta_add" => { 150 | }, 151 | "meta_merge" => { 152 | "prereqs" => { 153 | "test" => { 154 | "recommends" => { 155 | "XML::SAX::ParserFactory" => "0", 156 | "XML::Validator::Schema" => "0" 157 | }, 158 | }, 159 | "develop" => { 160 | "requires" => { 161 | "Test::Pod" => "1.41" 162 | }, 163 | "suggests" => { 164 | "Test::Perl::Critic" => "0" 165 | } 166 | }, 167 | }, 168 | "resources" => { 169 | "bugtracker" => "https://github.com/msimerson/mail-dmarc/issues", 170 | "homepage" => "https://github.com/msimerson/mail-dmarc/wiki", 171 | "repository" => "https://github.com/msimerson/mail-dmarc", 172 | }, 173 | "x_contributors" => [ 174 | "Benny Pedersen ", 175 | "Jean Paul Galea ", 176 | "Marisa Clardy ", 177 | "Priyadi Iman Nurcahyo ", 178 | "Ricardo Signes " 179 | ], 180 | } 181 | }; 182 | 183 | my $fallback_build_requires = { 184 | "Module::Build" => "0.3601", 185 | "Test::Exception" => 0, 186 | "Test::File::ShareDir" => 0, 187 | "Test::More" => 0, 188 | "Test::Output" => 0 189 | }; 190 | 191 | unless ( eval { Module::Build->VERSION(0.4004) } ) { 192 | delete $module_build_args->{test_requires}; 193 | $module_build_args->{build_requires} = $fallback_build_requires; 194 | } 195 | 196 | my $build = Module::Build->new(%$module_build_args); 197 | 198 | # if ( $build->prompt( "Database engine", "sqlite" ) ) { 199 | # $build->notes( 'DB_ENGINE' => $build->args('db_engine') ); 200 | # } 201 | 202 | $build->create_build_script; 203 | -------------------------------------------------------------------------------- /t/03.Base.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Data::Dumper; 5 | use Net::DNS::Resolver::Mock; 6 | use Test::More; 7 | 8 | use Test::File::ShareDir 9 | -share => { -dist => { 'Mail-DMARC' => 'share' } }; 10 | 11 | use lib 'lib'; 12 | 13 | my $mod = 'Mail::DMARC::Base'; 14 | use_ok($mod); 15 | my $base = $mod->new; 16 | isa_ok( $base, $mod ); 17 | isa_ok( $base->config, 'Config::Tiny' ); 18 | isa_ok( $base->get_resolver(), 'Net::DNS::Resolver' ); 19 | 20 | # invalid config file 21 | $base = $mod->new( config_file => 'no such config' ); 22 | eval { $base->config }; 23 | chomp $@; 24 | ok( $@, "invalid config file" ); 25 | 26 | # alternate config file 27 | $base = $mod->new(); 28 | eval { $base->config('t/mail-dmarc.ini'); }; 29 | chomp $@; 30 | ok( !$@, "alternate config file" ); 31 | 32 | my $resolver = new Net::DNS::Resolver::Mock(); 33 | $base->set_resolver($resolver); 34 | 35 | __any_inet_to(); 36 | __is_public_suffix(); 37 | __has_dns_rr(); 38 | __is_valid_ip(); 39 | __is_valid_domain(); 40 | __epoch_to_iso(); 41 | __get_prefix(); 42 | __get_sharefile(); 43 | __psl_cached(); 44 | __psl_cached_reload(); 45 | 46 | done_testing(); 47 | exit; 48 | 49 | #warn Dumper($base); 50 | 51 | sub __epoch_to_iso { 52 | my $iso = $base->epoch_to_iso(time); 53 | ok( $iso, "epoch_to_iso, $iso" ); 54 | }; 55 | 56 | sub __any_inet_to { 57 | 58 | my @test_ips = ( 59 | '1.1.1.1', '10.0.1.1', 60 | '2002:4c79:6240::1610:9fff:fee5:fb5', '2607:f060:b008:feed::6', 61 | ); 62 | 63 | foreach my $ip (@test_ips) { 64 | my $bin = $base->any_inet_pton($ip); 65 | ok( $bin, "any_inet_pton, $ip" ); 66 | my $pres = $base->any_inet_ntop($bin); 67 | ok( $pres, "any_inet_ntop, $ip" ); 68 | if ( $pres eq $ip ) { 69 | cmp_ok( $pres, 'eq', $ip, "any_inet_ntop, $ip" ); 70 | } 71 | else { 72 | # on some systems, a :: pattern gets a zero inserted. Mimic that 73 | my $zero_filled = $ip; 74 | $zero_filled =~ s/::/:0:/g; 75 | cmp_ok( $pres, 'eq', $zero_filled, "any_inet_ntop, $ip" ) 76 | or diag "presentation: $zero_filled\nresult: $pres"; 77 | } 78 | } 79 | } 80 | 81 | sub __is_valid_ip { 82 | 83 | # positive tests 84 | foreach (qw/ 0.0.0.0 1.1.1.1 255.255.255.255 2607:f060:b008:feed::2 /) { 85 | ok( $base->is_valid_ip($_), "is_valid_ip, $_" ); 86 | } 87 | 88 | # negative tests 89 | foreach (qw/ 256.1.1.1 a 1.1.1.256 /) { 90 | ok( !$base->is_valid_ip($_), "is_valid_ip, neg, $_" ); 91 | } 92 | } 93 | 94 | sub __is_valid_domain { 95 | 96 | # positive tests 97 | foreach (qw/ test.sch.uk example.com bbc.co.uk 3.am /) { 98 | ok( $base->is_valid_domain($_), "is_valid_domain, $_" ); 99 | } 100 | 101 | # negative tests 102 | foreach (qw/ example.m bbc.co.k 3.a /) { 103 | ok( !$base->is_valid_domain($_), "is_valid_domain, $_" ); 104 | } 105 | 106 | } 107 | 108 | sub __has_dns_rr { 109 | 110 | my %tests = ( 111 | 'NS:tnpi.net' => 1, 112 | 'NS:fake.mail-dmarc.tnpi.net' => 0, 113 | 'A:www.tnpi.net' => 1, 114 | 'MX:tnpi.net' => 1, 115 | 'MX:gmail.com' => 1, 116 | ); 117 | 118 | foreach my $dom ( keys %tests ) { 119 | my $r = $base->has_dns_rr( split /:/, $dom ); 120 | 121 | # no need to raise test errors for CPAN test systems with unreliable DNS 122 | next if !$r && $tests{$dom}; 123 | ok( $r >= $tests{$dom}, "has_dns_rr, $dom" ); 124 | } 125 | } 126 | 127 | sub __is_public_suffix { 128 | my %tests = ( 129 | 'www.tnpi.net' => 0, 130 | 'tnpi.net' => 0, 131 | 'net' => 1, 132 | 'com' => 1, 133 | 'co.uk' => 1, 134 | '*.uk' => 0, 135 | 'google.com' => 0, 136 | 'a' => 0, 137 | 'z' => 0, 138 | 'test.sch.uk' => 1, 139 | 'sch.uk' => 0, 140 | ); 141 | 142 | foreach my $dom ( keys %tests ) { 143 | my $t = $tests{$dom} == 0 ? 'neg' : 'pos'; 144 | cmp_ok( 145 | $tests{$dom}, '==', 146 | $base->is_public_suffix($dom), 147 | "is_public_suffix, $t, $dom" 148 | ); 149 | } 150 | } 151 | 152 | sub __get_prefix { 153 | is_deeply( 154 | [ $base->get_prefix() ], 155 | [ '/usr/local/', '/opt/local/', '/', './' ], 156 | "get_prefix: /usr/local/, /opt/local/, /, ./", 157 | ); 158 | 159 | is_deeply( 160 | [ $base->get_prefix('etc') ], 161 | [ '/usr/local/etc', '/opt/local/etc', '/etc', './etc' ], 162 | "get_prefix(etc): /usr/local/etc, /opt/local/etc, /etc, ./etc", 163 | ); 164 | 165 | is_deeply( 166 | [ $base->get_prefix('share') ], 167 | [ '/usr/local/share', '/opt/local/share', '/share', './share' ], 168 | "get_prefix(share): /usr/local/share, /opt/local/share, /share, ./share", 169 | ); 170 | } 171 | 172 | sub __get_sharefile { 173 | # throws an exception until after 'make install' has been run 174 | my $r; 175 | eval { $r = $base->get_sharefile('mail-dmarc.ini'); }; 176 | 177 | SKIP: { 178 | skip '"make install" not yet run', 1 if $@; 179 | 180 | ok($r, "get_sharefile: $r"); 181 | }; 182 | } 183 | 184 | sub __psl_cached { 185 | no warnings 'once'; 186 | cmp_ok($Mail::DMARC::psl_loads, '==', 1, 'Public Suffix List cached'); 187 | } 188 | 189 | sub __psl_cached_reload { 190 | no warnings 'once'; 191 | cmp_ok($Mail::DMARC::psl_loads, '==', 1, 'Public Suffix List loaded'); 192 | 193 | my $file = $base->find_psl_file(); 194 | my $future = time() + 3600; 195 | utime ( $future, $future, $file ); 196 | 197 | my $check = $base->check_public_suffix_list(); 198 | cmp_ok($Mail::DMARC::psl_loads, '==', 2, 'Public Suffix List reloaded'); 199 | cmp_ok($check, '==', 1, 'Public Suffix List reloaded true return'); 200 | 201 | $check = $base->check_public_suffix_list(); 202 | cmp_ok($check, '==', 0, 'Public Suffix List reloaded false return'); 203 | } 204 | 205 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Result.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Result; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use Carp; 7 | require Mail::DMARC::Result::Reason; 8 | 9 | sub new { 10 | my $class = shift; 11 | return bless { 12 | dkim => '', 13 | spf => '', 14 | reason => [], 15 | }, 16 | $class; 17 | } 18 | 19 | sub published { 20 | my ( $self, $policy ) = @_; 21 | 22 | if ( !$policy ) { 23 | if ( !defined $self->{published} ) { 24 | croak 25 | "no policy discovered. Did you validate(), or at least fetch_dmarc_record() first? Or inspected results to detect a 'No Results Found' type error?"; 26 | } 27 | return $self->{published}; 28 | } 29 | 30 | $policy->{domain} 31 | or croak 32 | "tag the policy object with a domain indicating where the DMARC record was found!"; 33 | return $self->{published} = $policy; 34 | } 35 | 36 | sub disposition { 37 | return $_[0]->{disposition} if 1 == scalar @_; 38 | croak "invalid disposition ($_[1]" 39 | if 0 == grep {/^$_[1]$/ix} qw/ reject quarantine none /; 40 | return $_[0]->{disposition} = $_[1]; 41 | } 42 | 43 | sub dkim { 44 | return $_[0]->{dkim} if 1 == scalar @_; 45 | croak "invalid dkim" if 0 == grep {/^$_[1]$/ix} qw/ pass fail /; 46 | return $_[0]->{dkim} = $_[1]; 47 | } 48 | 49 | sub dkim_align { 50 | return $_[0]->{dkim_align} if 1 == scalar @_; 51 | croak "invalid dkim_align" 52 | if 0 == grep {/^$_[1]$/ix} qw/ relaxed strict /; 53 | return $_[0]->{dkim_align} = $_[1]; 54 | } 55 | 56 | sub dkim_meta { 57 | return $_[0]->{dkim_meta} if 1 == scalar @_; 58 | return $_[0]->{dkim_meta} = $_[1]; 59 | } 60 | 61 | sub spf { 62 | return $_[0]->{spf} if 1 == scalar @_; 63 | croak "invalid spf" if 0 == grep {/^$_[1]$/ix} qw/ pass fail /; 64 | return $_[0]->{spf} = $_[1]; 65 | } 66 | 67 | sub spf_align { 68 | return $_[0]->{spf_align} if 1 == scalar @_; 69 | croak "invalid spf_align" if 0 == grep {/^$_[1]$/ix} qw/ relaxed strict /; 70 | return $_[0]->{spf_align} = $_[1]; 71 | } 72 | 73 | sub result { 74 | return $_[0]->{result} if 1 == scalar @_; 75 | croak "invalid result" if 0 == grep {/^$_[1]$/ix} qw/ pass fail none /; 76 | return $_[0]->{result} = $_[1]; 77 | } 78 | 79 | sub reason { 80 | my ($self, @args) = @_; 81 | return $self->{reason} if ! scalar @args; 82 | push @{ $self->{reason}}, Mail::DMARC::Result::Reason->new(@args); 83 | return $self->{reason}; 84 | } 85 | 86 | 1; 87 | 88 | __END__ 89 | 90 | =pod 91 | 92 | =head1 NAME 93 | 94 | Mail::DMARC::Result - an aggregate report result object 95 | 96 | =head1 VERSION 97 | 98 | version 1.20250805 99 | 100 | =head1 OVERVIEW 101 | 102 | A L object is the product of instantiating a L object, populating the variables, and running $dmarc->validate. The results object looks like this: 103 | 104 | result => 'pass', # pass, fail 105 | disposition => 'none', # reject, quarantine, none 106 | reason => [ # there can be many reasons... 107 | { 108 | type => '', # forwarded, sampled_out, trusted_forwarder, 109 | comment => '', # mailing_list, local_policy, other 110 | }, 111 | ], 112 | dkim => 'pass', # pass, fail 113 | dkim_align => 'strict', # strict, relaxed 114 | spf => 'pass', # pass, fail 115 | spf_align => 'strict', # strict, relaxed 116 | published => L, 117 | 118 | Reasons are optional and may not be present. 119 | 120 | The dkim_align and spf_align fields will only be present if the corresponding test value equals pass. They are additional info not specified by the DMARC spec. 121 | 122 | =head1 METHODS 123 | 124 | =head2 published 125 | 126 | Published is a L tagged with a domain. The domain attribute is the DNS domain name where the DMARC record was found. This may not be the same as the header_from domain (ex: bounces.amazon.com -vs- amazon.com). 127 | 128 | =head2 result 129 | 130 | Whether the message passed the DMARC test. Possible values are: pass, fail. 131 | 132 | In order to pass, at least one authentication alignment must pass. The 2013 draft defines two authentication methods: DKIM and SPF. The list is expected to grow. 133 | 134 | =head2 disposition 135 | 136 | When the DMARC result is not I, disposition is the results of applying DMARC policy to a message. Generally this is the same as the header_from domains published DMARC L. When it is not, the reason SHOULD be specified. 137 | 138 | =head2 dkim 139 | 140 | Whether the message passed or failed DKIM alignment. In order to pass the DMARC DKIM alignment test, a DKIM signature that matches the RFC5322.From domain must be present. An unsigned messsage, a message with an invalid signature, or signatures that don't match the RFC5322.From field are all considered failures. 141 | 142 | =head2 dkim_align 143 | 144 | If the message passed the DKIM alignment test, this indicates whether the alignment was strict or relaxed. 145 | 146 | =head2 spf 147 | 148 | Whether the message passed or failed SPF alignment. To pass SPF alignment, the RFC5321.MailFrom domain must match the RFC5322.From field. 149 | 150 | =head2 spf_align 151 | 152 | If the message passed the SPF alignment test, this indicates whether the alignment was strict or relaxed. 153 | 154 | =head2 reason 155 | 156 | If the applied policy differs from the sites published policy, the result policy should contain a reason and optionally a comment. 157 | 158 | A DMARC result reason has two attributes, type, and comment. 159 | 160 | reason => { 161 | type => '', 162 | comment => '', 163 | }, 164 | 165 | =head3 type 166 | 167 | The following reason types are defined and valid: 168 | 169 | forwarded 170 | sampled_out 171 | trusted_forwarder 172 | mailing_list 173 | local_policy 174 | other 175 | 176 | =head3 comment 177 | 178 | Comment is a free form text field. 179 | 180 | =head1 AUTHORS 181 | 182 | =over 4 183 | 184 | =item * 185 | 186 | Matt Simerson 187 | 188 | =item * 189 | 190 | Davide Migliavacca 191 | 192 | =item * 193 | 194 | Marc Bradshaw 195 | 196 | =back 197 | 198 | =head1 COPYRIGHT AND LICENSE 199 | 200 | This software is copyright (c) 2025 by Matt Simerson. 201 | 202 | This is free software; you can redistribute it and/or modify it under 203 | the same terms as the Perl 5 programming language system itself. 204 | 205 | =cut 206 | 207 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/HTTP.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::HTTP; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | use parent 'Net::Server::HTTP'; 7 | 8 | use CGI; 9 | use Data::Dumper; 10 | use File::ShareDir; 11 | use IO::Uncompress::Gunzip; 12 | use JSON -convert_blessed_universally; 13 | use URI; 14 | 15 | our $report; 16 | use Mail::DMARC::PurePerl; 17 | 18 | my %mimes = ( 19 | css => 'text/css', 20 | html => 'text/html', 21 | js => 'application/javascript', 22 | json => 'application/json', 23 | ); 24 | 25 | sub new { 26 | my $class = shift; 27 | return bless {}, $class; 28 | } 29 | 30 | sub dmarc_httpd { 31 | my $self = shift; 32 | $report = shift; 33 | 34 | my $port = $report->config->{http}{port} || 8080; 35 | my $ports = $report->config->{https}{port}; 36 | my $sslkey = $report->config->{https}{ssl_key}; 37 | my $sslcrt = $report->config->{https}{ssl_crt}; 38 | 39 | Net::Server::HTTP->run( 40 | app => sub { &dmarc_dispatch }, 41 | port => [$port, (($ports && $sslkey && $sslcrt) ? "$ports/ssl" : ()) ], 42 | ipv => '*', # IPv6 if available 43 | ($sslkey ? (SSL_key_file => $sslkey) : ()), 44 | ($sslcrt ? (SSL_cert_file => $sslcrt) : ()), 45 | log_file => 'Sys::Syslog', 46 | syslog_ident => 'mail_dmarc', 47 | syslog_facility => 'MAIL', 48 | ); 49 | return; 50 | } 51 | 52 | sub dmarc_dispatch { 53 | my $self = shift; 54 | 55 | # warn Dumper( { CGI->new->Vars } ); 56 | 57 | my $path = $self->{request_info}{request_path}; 58 | if ($path) { 59 | warn "path: $path\n"; 60 | return report_json_report() if $path eq '/dmarc/json/report'; 61 | return report_json_rr() if $path eq '/dmarc/json/row'; 62 | return serve_validator() if $path eq '/dmarc/json/validate'; 63 | return serve_file($path) if $path =~ /\.(?:js|css|html|gz)$/x; 64 | }; 65 | 66 | return serve_file('/dmarc/index.html'); 67 | } 68 | 69 | sub serve_pretty_error { 70 | my $error = shift || 'Sorry, that operation is not supported.'; 71 | return print <<"EO_ERROR" 72 | Content-Type: text/html 73 | 74 |

$error

75 | 76 | EO_ERROR 77 | ; 78 | } 79 | 80 | sub return_json_error { 81 | my ($err) = @_; 82 | #warn $err; 83 | print JSON->new->utf8->encode( { err => $err } ); # to HTTP client 84 | print "\n"; 85 | return $err; # to caller 86 | } 87 | 88 | sub serve_validator { 89 | my $cgi = shift || CGI->new(); # passed in $cgi for testing 90 | my $resolver = shift; # passed in $resolver for testing 91 | my $json = JSON->new->utf8; 92 | 93 | print $cgi->header("application/json"); 94 | 95 | my $post = $cgi->param('POSTDATA'); 96 | if (!$post) { return return_json_error("missing POST data"); } 97 | 98 | my ($input, $dmpp, $res); 99 | eval { $input = $json->decode( $post ); }; 100 | if ($@) { return return_json_error($@); } 101 | 102 | if (!$input || !ref $input) { 103 | return return_json_error("invalid request $post"); 104 | } 105 | 106 | eval { $dmpp = Mail::DMARC::PurePerl->new( %$input ) }; 107 | if ($@) { return return_json_error($@); } 108 | 109 | $dmpp->set_resolver($resolver) if $resolver; 110 | 111 | eval { $res = $dmpp->validate(); }; 112 | if ($@) { return return_json_error($@); } 113 | 114 | my $return = $json->allow_blessed->convert_blessed->encode( $res ); 115 | print "$return\n"; 116 | return $return; 117 | } 118 | 119 | sub serve_file { 120 | my ($path) = @_; 121 | 122 | my @bits = split /\//, $path; 123 | shift @bits; 124 | return serve_pretty_error("file not found") if (!$bits[0] || 'dmarc' ne $bits[0]); 125 | shift @bits; 126 | $path = join '/', @bits; 127 | my $file = $bits[-1]; 128 | $file =~ s/[^[ -~]]//g; # strip out any non-printable chars 129 | 130 | my ($extension) = (split /\./, $file)[-1]; 131 | return serve_pretty_error("$extension not recognized") if ! $mimes{$extension}; 132 | 133 | my $dir = "share/html"; # distribution dir 134 | if ( ! -d $dir ) { 135 | $dir = File::ShareDir::dist_dir( 'Mail-DMARC' ); # installed loc. 136 | $dir .= "/html"; 137 | }; 138 | return serve_pretty_error("no such path") if ! $dir; 139 | return serve_gzip("$dir/$path.gz") if -f "$dir/$path.gz"; 140 | return serve_pretty_error("no such file") if ! -f "$dir/$path"; 141 | 142 | open my $FH, '<', "$dir/$path" or 143 | return serve_pretty_error( "unable to read $dir/$path: $!" ); 144 | print "Content-Type: $mimes{$extension}\n\n"; 145 | print <$FH>; 146 | close $FH; 147 | return 1; 148 | } 149 | 150 | sub serve_gzip { 151 | my $file = shift; 152 | 153 | open my $FH, '<', "$file" or 154 | return serve_pretty_error( "unable to read $file: $!" ); 155 | my $contents = do { local $/; <$FH> }; ## no critic (Local) 156 | close $FH; 157 | 158 | my $decomp = substr($file, 0, -3); # remove .gz suffix 159 | my ($extension) = (split /\./, $decomp)[-1]; 160 | 161 | # browser accepts gz encoding, serve compressed 162 | if ( grep {/gzip/} $ENV{HTTP_ACCEPT_ENCODING} ) { 163 | my $length = length $contents; 164 | return print <<"EO_GZ" 165 | Content-Length: $length 166 | Content-Type: $mimes{$extension} 167 | Content-Encoding: gzip 168 | 169 | $contents 170 | EO_GZ 171 | ; 172 | } 173 | 174 | # browser doesn't support gzip, decompress and serve 175 | my $out; 176 | IO::Uncompress::Gunzip::gunzip( \$contents => \$out ) 177 | or return serve_pretty_error( "unable to decompress" ); 178 | my $length = length $out; 179 | 180 | return print <<"EO_UNGZ" 181 | Content-Length: $length 182 | Content-Type: $mimes{$extension} 183 | 184 | $out 185 | EO_UNGZ 186 | ; 187 | } 188 | 189 | sub report_json_report { 190 | print "Content-type: application/json\n\n"; 191 | my $reports = $report->store->backend->get_report( CGI->new->Vars ); 192 | print encode_json $reports; 193 | return; 194 | } 195 | 196 | sub report_json_rr { 197 | print "Content-type: application/json\n\n"; 198 | my $row = $report->store->backend->get_rr( CGI->new->Vars ); 199 | print encode_json $row; 200 | # warn Dumper($row); 201 | return; 202 | } 203 | 204 | 1; 205 | 206 | __END__ 207 | 208 | =pod 209 | 210 | =head1 NAME 211 | 212 | Mail::DMARC::HTTP - view stored reports via HTTP 213 | 214 | =head1 VERSION 215 | 216 | version 1.20250805 217 | 218 | =head1 SYNOPSIS 219 | 220 | See the POD docs / man page for L. 221 | 222 | =head1 AUTHORS 223 | 224 | =over 4 225 | 226 | =item * 227 | 228 | Matt Simerson 229 | 230 | =item * 231 | 232 | Davide Migliavacca 233 | 234 | =item * 235 | 236 | Marc Bradshaw 237 | 238 | =back 239 | 240 | =head1 COPYRIGHT AND LICENSE 241 | 242 | This software is copyright (c) 2025 by Matt Simerson. 243 | 244 | This is free software; you can redistribute it and/or modify it under 245 | the same terms as the Perl 5 programming language system itself. 246 | 247 | =cut 248 | 249 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings FATAL => 'all'; 3 | 4 | use 5.008; 5 | use ExtUtils::MakeMaker; 6 | 7 | use File::ShareDir::Install; 8 | $File::ShareDir::Install::INCLUDE_DOTFILES = 1; 9 | $File::ShareDir::Install::INCLUDE_DOTDIRS = 1; 10 | install_share dist => "share"; 11 | 12 | my %META = ( 13 | "prereqs" => { 14 | "configure" => { 15 | "requires" => { 16 | "ExtUtils::MakeMaker" => 0, 17 | "File::ShareDir::Install" => "0.06", 18 | } 19 | }, 20 | "build" => { 21 | "requires" => { 22 | } 23 | }, 24 | "test" => { 25 | "recommends" => { 26 | "XML::SAX::ParserFactory" => "0", 27 | "XML::Validator::Schema" => "0" 28 | }, 29 | "requires" => { 30 | "Test::Exception" => 0, 31 | "Test::File::ShareDir" => 0, 32 | "Test::More" => 0, 33 | "Test::Output" => 0, 34 | "Net::DNS::Resolver::Mock" => 0 35 | } 36 | }, 37 | "runtime" => { 38 | "recommends" => { 39 | "CGI" => 0, 40 | "HTTP::Request" => 0, 41 | "JSON" => 0, 42 | "LWP::UserAgent" => 0, 43 | "Mail::DKIM::PrivateKey" => 0, 44 | "Mail::DKIM::Signer" => 0, 45 | "Mail::DKIM::TextWrap" => 0, 46 | "Net::HTTP" => 0, 47 | "Net::SMTPS" => 0, 48 | "Net::Server::HTTP" => 0, 49 | }, 50 | "requires" => { 51 | "perl" => "5.10.0", 52 | "CPAN" => 0, 53 | "Carp" => 0, 54 | "Config::Tiny" => 0, 55 | "DBD::SQLite" => "1.31", 56 | "DBIx::Simple" => "1.35", 57 | "Data::Dumper" => 0, 58 | "Email::MIME" => 0, 59 | "Email::Sender" => 0, 60 | "Email::Sender::Simple" => "1.300032", 61 | "Email::Simple" => 0, 62 | "Encode" => 0, 63 | "English" => 0, 64 | "File::ShareDir" => 0, 65 | "Getopt::Long" => 0, 66 | "HTTP::Tiny" => 0, 67 | "IO::Compress::Gzip" => 0, 68 | "IO::Compress::Zip" => 0, 69 | "IO::File" => 0, 70 | "IO::Socket::SSL" => 0, 71 | "IO::Uncompress::Gunzip" => 0, 72 | "IO::Uncompress::Unzip" => 0, 73 | "Module::Load" => 0, 74 | "Net::DNS::Resolver" => 0, 75 | "Net::IDN::Encode" => 0, 76 | "Net::IP" => 0, 77 | "Net::SSLeay" => 0, 78 | "POSIX" => 0, 79 | "Pod::Usage" => 0, 80 | "Regexp::Common" => "2013031301", 81 | "Socket" => 0, 82 | "Socket6" => "0.23", 83 | "Sys::Hostname" => 0, 84 | "Sys::Syslog" => 0, 85 | "URI" => 0, 86 | "XML::LibXML" => 0, 87 | } 88 | }, 89 | "develop" => { 90 | "requires" => { 91 | }, 92 | "suggests" => { 93 | } 94 | }, 95 | }, 96 | "resources" => { 97 | "bugtracker" => { 98 | "web" => "https://github.com/msimerson/mail-dmarc/issues" 99 | }, 100 | "homepage" => "https://github.com/msimerson/mail-dmarc/wiki", 101 | "repository" => { 102 | "type" => "git", 103 | "url" => "git://github.com/msimerson/mail-dmarc.git", 104 | "web" => "https://github.com/msimerson/mail-dmarc" 105 | }, 106 | "license" => [ 'http://dev.perl.org/licenses/' ], 107 | }, 108 | "optional_features" => { 109 | "MySQL" => { 110 | "description" => "MySQL backend storage", 111 | "prereqs" => { 112 | "runtime" => { 113 | "requires" => { 114 | 'DBD::mysql' => '4.001', 115 | } 116 | } 117 | } 118 | }, 119 | "Postgres" => { 120 | "description" => "PostgresQL backend storage", 121 | "prereqs" => { 122 | "runtime" => { 123 | "requires" => { 124 | 'DBD::Pg' => '0' 125 | } 126 | } 127 | } 128 | }, 129 | "web_service" => { 130 | "description" => "HTTP web UI to DMARC reports", 131 | "prereqs" => { 132 | "runtime" => { 133 | "requires" => { 134 | "CGI" => 0, 135 | "HTTP::Request" => 0, 136 | "JSON" => 0, 137 | "Net::HTTP" => 0, 138 | "Net::Server::HTTP" => 0, 139 | } 140 | } 141 | } 142 | }, 143 | "smtp_sending" => { 144 | "description" => "Send DMARC reports via SMTP", 145 | "prereqs" => { 146 | "runtime" => { 147 | "requires" => { 148 | "Email::Sender" => 0, 149 | "Net::SMTPS" => 0, 150 | "Mail::DKIM::PrivateKey" => 0, 151 | "Mail::DKIM::Signer" => 0, 152 | "Mail::DKIM::TextWrap" => 0 153 | } 154 | } 155 | } 156 | }, 157 | "imap_fetch" => { 158 | "description" => "Retrieve DMARC reports from an IMAP account", 159 | "prereqs" => { 160 | "runtime" => { 161 | "requires" => { 162 | "Net::IMAP::Simple" => 0, 163 | } 164 | } 165 | } 166 | } 167 | }, 168 | ); 169 | 170 | my %MM_ARGS = ( 171 | "NAME" => "Mail::DMARC", 172 | "ABSTRACT" => "Perl implementation of DMARC", 173 | "AUTHOR" => "Matt Simerson , Davide Migliavacca , Marc Bradshaw ", 174 | "DISTNAME" => "Mail-DMARC", 175 | "EXE_FILES" => [ 176 | "bin/dmarc_update_public_suffix_list", 177 | "bin/dmarc_send_reports", 178 | "bin/dmarc_httpd", 179 | "bin/dmarc_lookup", 180 | "bin/dmarc_receive", 181 | "bin/dmarc_http_client", 182 | "bin/dmarc_view_reports" 183 | ], 184 | "META_MERGE" => { 185 | "meta-spec" => { version => 2 }, 186 | "x_contributors" => [ 187 | "Benny Pedersen ", 188 | "Jean Paul Galea ", 189 | "Marisa Clardy ", 190 | "Priyadi Iman Nurcahyo ", 191 | "Ricardo Signes " 192 | ], 193 | }, 194 | "MIN_PERL_VERSION" => "5.008", 195 | "VERSION" => "1.20191025", 196 | "test" => { 197 | "TESTS" => "t/*.t" 198 | }, 199 | "clean" => { "FILES" => [ "dmarc_reports.sqlite", "t/reports-test.sqlite", 'MANIFEST.bak' ] }, 200 | ); 201 | 202 | # some nifty boilerplate from local::lib 203 | my $requires = $MM_ARGS{PREREQ_PM} = { %{$META{prereqs}{runtime}{requires}} }; 204 | 205 | $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }; 206 | 207 | for (qw(configure build test runtime)) { 208 | my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; 209 | my $r = $MM_ARGS{$key} = { 210 | %{$META{prereqs}{$_}{requires} || {}}, 211 | %{delete $MM_ARGS{$key} || {}}, 212 | }; 213 | defined $r->{$_} or delete $r->{$_} for keys %$r; 214 | } 215 | 216 | my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; 217 | 218 | if ( $eumm_version < 6.47_01 ) { 219 | delete $MM_ARGS{MIN_PERL_VERSION}; 220 | } 221 | 222 | if ( $eumm_version < 6.51_03 ) { 223 | delete $MM_ARGS{CONFIGURE_REQUIRES}; 224 | } 225 | 226 | if ( $eumm_version < 6.63_03 ) { 227 | $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}}; 228 | } 229 | 230 | if ( $eumm_version < 6.55_01 ) { 231 | $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} 232 | } 233 | 234 | my %WriteMakefileArgs = (%MM_ARGS); 235 | 236 | WriteMakefile(%WriteMakefileArgs); 237 | 238 | { 239 | package 240 | MY; 241 | use File::ShareDir::Install qw(postamble); 242 | } 243 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '1.20250805'; 6 | 7 | use Carp; 8 | use IO::Compress::Gzip; 9 | use IO::Compress::Zip; 10 | 11 | use parent 'Mail::DMARC::Base'; 12 | 13 | require Mail::DMARC::Report::Aggregate; 14 | require Mail::DMARC::Report::Send; 15 | require Mail::DMARC::Report::Store; 16 | require Mail::DMARC::Report::Receive; 17 | require Mail::DMARC::Report::URI; 18 | 19 | sub compress { 20 | my ( $self, $xml_ref ) = @_; 21 | croak "xml is not a reference!" if 'SCALAR' ne ref $xml_ref; 22 | my $shrunk; 23 | my $zipper = { 24 | gz => \&IO::Compress::Gzip::gzip, # 2013 draft 25 | zip => \&IO::Compress::Zip::zip, # legacy format 26 | }; 27 | # WARNING: changes here MAY require updates in SMTP::assemble_message 28 | my $cf = 'gz'; 29 | $zipper->{$cf}->( $xml_ref, \$shrunk ) or croak "unable to compress: $!"; 30 | return $shrunk; 31 | } 32 | 33 | sub init { 34 | my $self = shift; 35 | delete $self->{dmarc}; 36 | delete $self->{aggregate}; 37 | return; 38 | } 39 | 40 | sub aggregate { 41 | my $self = shift; 42 | return $self->{aggregate} if ref $self->{aggregate}; 43 | return $self->{aggregate} = Mail::DMARC::Report::Aggregate->new(); 44 | } 45 | 46 | sub dmarc { 47 | my $self = shift; 48 | return $self->{dmarc}; 49 | } 50 | 51 | sub receive { 52 | my $self = shift; 53 | return $self->{receive} if ref $self->{receive}; 54 | return $self->{receive} = Mail::DMARC::Report::Receive->new; 55 | } 56 | 57 | sub sendit { 58 | my $self = shift; 59 | return $self->{sendit} if ref $self->{sendit}; 60 | return $self->{sendit} = Mail::DMARC::Report::Send->new(); 61 | } 62 | 63 | sub store { 64 | my $self = shift; 65 | return $self->{store} if ref $self->{store}; 66 | return $self->{store} = Mail::DMARC::Report::Store->new(); 67 | } 68 | 69 | sub uri { 70 | my $self = shift; 71 | return $self->{uri} if ref $self->{uri}; 72 | return $self->{uri} = Mail::DMARC::Report::URI->new(); 73 | } 74 | 75 | sub save_aggregate { 76 | my $self = shift; 77 | return $self->store->backend->save_aggregate( $self->aggregate ); 78 | } 79 | 80 | 1; 81 | 82 | __END__ 83 | 84 | =pod 85 | 86 | =head1 NAME 87 | 88 | Mail::DMARC::Report - A DMARC report interface 89 | 90 | =head1 VERSION 91 | 92 | version 1.20250805 93 | 94 | =head1 DESCRIPTION 95 | 96 | DMARC reports are information that a DMARC implementing Mail Transfer Agent (MTA) sends to Author Domains and also something that an Author Domain owner receives from other DMARC implementing MTAs. Mail::DMARC supports both roles, as a sender and a receiver. 97 | 98 | There are two report types, L and forensic. 99 | 100 | =head1 Aggregate Reports 101 | 102 | See L 103 | 104 | =head2 Forensic Reports 105 | 106 | TODO 107 | 108 | =head2 Report Sender 109 | 110 | See L 111 | 112 | 1. store reports 113 | 2. bundle aggregated reports 114 | 3. format report in XML 115 | 4. gzip the XML 116 | 5. deliver report to Author Domain 117 | 118 | =head2 Report Receiver 119 | 120 | See L 121 | 122 | 1. accept reports via HTTP or SMTP 123 | 2. parse the compressed XML message 124 | 3. store the report 125 | 4. present stored data 126 | 127 | =head2 Verify External Destinations 128 | 129 | 1. Extract the host portion of the authority component of the URI. 130 | Call this the "destination host". 131 | 132 | 2. Prepend the string "_report._dmarc". 133 | 134 | 3. Prepend the domain name from which the policy was retrieved. 135 | 136 | 4. Query the DNS for a TXT record at the constructed name. If the 137 | result of this request is a temporary DNS error of some kind 138 | (e.g., a timeout), the Mail Receiver MAY elect to temporarily 139 | fail the delivery so the verification test can be repeated later. 140 | 141 | 5. If the result includes no TXT resource records or multiple TXT 142 | resource records, a positive determination of the external 143 | reporting relationship cannot be made; stop. 144 | 145 | 6. Parse the result, if any, as a series of "tag=value" pairs, i.e., 146 | the same overall format as the policy record. In particular, the 147 | "v=DMARC1" tag is mandatory and MUST appear first in the list. 148 | If at least that tag is present and the record overall is 149 | syntactically valid per Section 6.3, then the external reporting 150 | arrangement was authorized by the destination ADMD. 151 | 152 | 7. If a "rua" or "ruf" tag is thus discovered, replace the 153 | corresponding value extracted from the domain's DMARC policy 154 | record with the one found in this record. This permits the 155 | report receiver to override the report destination. However, to 156 | prevent loops or indirect abuse, the overriding URI MUST use the 157 | same destination host from the first step. 158 | 159 | =head1 ERROR REPORTS 160 | 161 | 12.2.4. Error Reports 162 | 163 | When a Mail Receiver is unable to complete delivery of a report via 164 | any of the URIs listed by the Domain Owner, the Mail Receiver SHOULD 165 | generate an error message. An attempt MUST be made to send this 166 | report to all listed "mailto" URIs and MAY also be sent to any or all 167 | other listed URIs. 168 | 169 | The error report MUST be formatted per [MIME]. A text/plain part 170 | MUST be included that contains field-value pairs such as those found 171 | in Section 2 of [DSN]. The fields required, which may appear in any 172 | order, are: 173 | 174 | Report-Date: A [MAIL]-formatted date expression indicating when the transport failure occurred. 175 | 176 | Report-Domain: The domain-name about which the failed report was generated. 177 | 178 | Report-ID: The Report-ID: that the report tried to use. 179 | 180 | Report-Size: The size, in bytes, of the report that was unable to be 181 | sent. This MUST represent the number of bytes that the Mail 182 | Receiver attempted to send. Where more than one transport system 183 | was attempted, the sizes may be different; in such cases, separate 184 | error reports MUST be generated so that this value matches the 185 | actual attempt that was made. For example, a "mailto" error 186 | report would be sent to the "mailto" URIs with one size, while the 187 | "https" reports might be POSTed to those URIs with a different 188 | size, as they have different transport and encoding requirements. 189 | 190 | Submitter: The domain-name representing the Mail Receiver that generated, but was unable to submit, the report. 191 | 192 | Submitting-URI: The URI(s) to which the Mail Receiver tried, but failed, to submit the report. 193 | 194 | An additional text/plain part MAY be included that gives a human- 195 | readable explanation of the above, and MAY also include a URI that 196 | can be used to seek assistance. 197 | 198 | [NOTE: A more rigorous syntax specification, including ABNF and 199 | possible registration of a new media type, will be added here when 200 | more operational experience is acquired.] 201 | 202 | =head1 AFRF reports 203 | 204 | =head1 IODEF reports 205 | 206 | https://datatracker.ietf.org/doc/draft-kucherawy-dmarc-base/?include_text=1 207 | 208 | Section 3.5 Out of Scope: 209 | 210 | This first version of DMARC supports only a single reporting format. 211 | 212 | =head1 AUTHORS 213 | 214 | =over 4 215 | 216 | =item * 217 | 218 | Matt Simerson 219 | 220 | =item * 221 | 222 | Davide Migliavacca 223 | 224 | =item * 225 | 226 | Marc Bradshaw 227 | 228 | =back 229 | 230 | =head1 COPYRIGHT AND LICENSE 231 | 232 | This software is copyright (c) 2025 by Matt Simerson. 233 | 234 | This is free software; you can redistribute it and/or modify it under 235 | the same terms as the Perl 5 programming language system itself. 236 | 237 | =cut 238 | 239 | -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "Perl implementation of DMARC", 3 | "author" : [ 4 | "Matt Simerson ", 5 | "Davide Migliavacca ", 6 | "Marc Bradshaw " 7 | ], 8 | "dynamic_config" : 1, 9 | "generated_by" : "Module::Build version 0.4234", 10 | "license" : [ 11 | "perl_5" 12 | ], 13 | "meta-spec" : { 14 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 15 | "version" : 2 16 | }, 17 | "name" : "Mail-DMARC", 18 | "prereqs" : { 19 | "build" : { 20 | "requires" : { 21 | "Module::Build" : "0.3601" 22 | } 23 | }, 24 | "configure" : { 25 | "requires" : { 26 | "File::ShareDir::Install" : "0.06", 27 | "Module::Build" : "0.3601" 28 | } 29 | }, 30 | "runtime" : { 31 | "recommends" : { 32 | "Mail::DKIM" : "0", 33 | "Net::IMAP::Simple" : "0", 34 | "Net::SMTPS" : "0" 35 | }, 36 | "requires" : { 37 | "Carp" : "0", 38 | "Config::Tiny" : "0", 39 | "DBD::SQLite" : "1.31", 40 | "DBIx::Simple" : "1.35", 41 | "Data::Dumper" : "0", 42 | "Email::MIME" : "0", 43 | "Email::Sender" : "0", 44 | "Email::Sender::Simple" : "1.300032", 45 | "Email::Simple" : "0", 46 | "Encode" : "0", 47 | "English" : "0", 48 | "File::ShareDir" : "1.00", 49 | "Getopt::Long" : "0", 50 | "HTTP::Tiny" : "0", 51 | "IO::Compress::Gzip" : "0", 52 | "IO::Compress::Zip" : "0", 53 | "IO::File" : "0", 54 | "IO::Socket::SSL" : "0", 55 | "IO::Uncompress::Gunzip" : "0", 56 | "IO::Uncompress::Unzip" : "0", 57 | "Module::Load" : "0", 58 | "Net::DNS::Resolver" : "0", 59 | "Net::IDN::Encode" : "0", 60 | "Net::IP" : "0", 61 | "Net::SSLeay" : "0", 62 | "POSIX" : "0", 63 | "Pod::Usage" : "0", 64 | "Regexp::Common" : "2013031301", 65 | "Socket" : "0", 66 | "Socket6" : "0.23", 67 | "Sys::Hostname" : "0", 68 | "Sys::Syslog" : "0", 69 | "Test::File::ShareDir" : "0", 70 | "URI" : "0", 71 | "XML::LibXML" : "0", 72 | "perl" : "v5.10.0" 73 | } 74 | }, 75 | "test" : { 76 | "requires" : { 77 | "Net::DNS::Resolver::Mock" : "0", 78 | "Test::Exception" : "0", 79 | "Test::File::ShareDir" : "0", 80 | "Test::More" : "0", 81 | "Test::Output" : "0" 82 | } 83 | } 84 | }, 85 | "provides" : { 86 | "Mail::DMARC" : { 87 | "file" : "lib/Mail/DMARC.pm", 88 | "version" : "1.20250805" 89 | }, 90 | "Mail::DMARC::Base" : { 91 | "file" : "lib/Mail/DMARC/Base.pm", 92 | "version" : "1.20250805" 93 | }, 94 | "Mail::DMARC::HTTP" : { 95 | "file" : "lib/Mail/DMARC/HTTP.pm", 96 | "version" : "1.20250805" 97 | }, 98 | "Mail::DMARC::Policy" : { 99 | "file" : "lib/Mail/DMARC/Policy.pm", 100 | "version" : "1.20250805" 101 | }, 102 | "Mail::DMARC::PurePerl" : { 103 | "file" : "lib/Mail/DMARC/PurePerl.pm", 104 | "version" : "1.20250805" 105 | }, 106 | "Mail::DMARC::Report" : { 107 | "file" : "lib/Mail/DMARC/Report.pm", 108 | "version" : "1.20250805" 109 | }, 110 | "Mail::DMARC::Report::Aggregate" : { 111 | "file" : "lib/Mail/DMARC/Report/Aggregate.pm", 112 | "version" : "1.20250805" 113 | }, 114 | "Mail::DMARC::Report::Aggregate::Metadata" : { 115 | "file" : "lib/Mail/DMARC/Report/Aggregate/Metadata.pm", 116 | "version" : "1.20250805" 117 | }, 118 | "Mail::DMARC::Report::Aggregate::Record" : { 119 | "file" : "lib/Mail/DMARC/Report/Aggregate/Record.pm", 120 | "version" : "1.20250805" 121 | }, 122 | "Mail::DMARC::Report::Aggregate::Record::Auth_Results" : { 123 | "file" : "lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results.pm", 124 | "version" : "1.20250805" 125 | }, 126 | "Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM" : { 127 | "file" : "lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/DKIM.pm", 128 | "version" : "1.20250805" 129 | }, 130 | "Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF" : { 131 | "file" : "lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/SPF.pm", 132 | "version" : "1.20250805" 133 | }, 134 | "Mail::DMARC::Report::Aggregate::Record::Identifiers" : { 135 | "file" : "lib/Mail/DMARC/Report/Aggregate/Record/Identifiers.pm", 136 | "version" : "1.20250805" 137 | }, 138 | "Mail::DMARC::Report::Aggregate::Record::Row" : { 139 | "file" : "lib/Mail/DMARC/Report/Aggregate/Record/Row.pm", 140 | "version" : "1.20250805" 141 | }, 142 | "Mail::DMARC::Report::Aggregate::Record::Row::Policy_Evaluated" : { 143 | "file" : "lib/Mail/DMARC/Report/Aggregate/Record/Row/Policy_Evaluated.pm", 144 | "version" : "1.20250805" 145 | }, 146 | "Mail::DMARC::Report::Receive" : { 147 | "file" : "lib/Mail/DMARC/Report/Receive.pm", 148 | "version" : "1.20250805" 149 | }, 150 | "Mail::DMARC::Report::Send" : { 151 | "file" : "lib/Mail/DMARC/Report/Send.pm", 152 | "version" : "1.20250805" 153 | }, 154 | "Mail::DMARC::Report::Send::HTTP" : { 155 | "file" : "lib/Mail/DMARC/Report/Send/HTTP.pm", 156 | "version" : "1.20250805" 157 | }, 158 | "Mail::DMARC::Report::Send::SMTP" : { 159 | "file" : "lib/Mail/DMARC/Report/Send/SMTP.pm", 160 | "version" : "1.20250805" 161 | }, 162 | "Mail::DMARC::Report::Sender" : { 163 | "file" : "lib/Mail/DMARC/Report/Sender.pm" 164 | }, 165 | "Mail::DMARC::Report::Store" : { 166 | "file" : "lib/Mail/DMARC/Report/Store.pm", 167 | "version" : "1.20250805" 168 | }, 169 | "Mail::DMARC::Report::Store::SQL" : { 170 | "file" : "lib/Mail/DMARC/Report/Store/SQL.pm", 171 | "version" : "1.20250805" 172 | }, 173 | "Mail::DMARC::Report::Store::SQL::Grammars::MySQL" : { 174 | "file" : "lib/Mail/DMARC/Report/Store/SQL/Grammars/MySQL.pm", 175 | "version" : "1.20250805" 176 | }, 177 | "Mail::DMARC::Report::Store::SQL::Grammars::PostgreSQL" : { 178 | "file" : "lib/Mail/DMARC/Report/Store/SQL/Grammars/PostgreSQL.pm", 179 | "version" : "1.20250805" 180 | }, 181 | "Mail::DMARC::Report::Store::SQL::Grammars::SQLite" : { 182 | "file" : "lib/Mail/DMARC/Report/Store/SQL/Grammars/SQLite.pm", 183 | "version" : "1.20250805" 184 | }, 185 | "Mail::DMARC::Report::URI" : { 186 | "file" : "lib/Mail/DMARC/Report/URI.pm", 187 | "version" : "1.20250805" 188 | }, 189 | "Mail::DMARC::Result" : { 190 | "file" : "lib/Mail/DMARC/Result.pm", 191 | "version" : "1.20250805" 192 | }, 193 | "Mail::DMARC::Result::Reason" : { 194 | "file" : "lib/Mail/DMARC/Result/Reason.pm", 195 | "version" : "1.20250805" 196 | }, 197 | "Mail::DMARC::Test::Transport" : { 198 | "file" : "lib/Mail/DMARC/Test/Transport.pm" 199 | } 200 | }, 201 | "release_status" : "stable", 202 | "resources" : { 203 | "bugtracker" : { 204 | "web" : "https://github.com/msimerson/mail-dmarc/issues" 205 | }, 206 | "homepage" : "https://github.com/msimerson/mail-dmarc/wiki", 207 | "license" : [ 208 | "http://dev.perl.org/licenses/" 209 | ], 210 | "repository" : { 211 | "url" : "https://github.com/msimerson/mail-dmarc" 212 | } 213 | }, 214 | "version" : "1.20250805", 215 | "x_contributors" : [ 216 | "Benny Pedersen ", 217 | "Jean Paul Galea ", 218 | "Marisa Clardy ", 219 | "Priyadi Iman Nurcahyo ", 220 | "Ricardo Signes " 221 | ], 222 | "x_serialization_backend" : "JSON::PP version 4.06" 223 | } 224 | -------------------------------------------------------------------------------- /lib/Mail/DMARC/Report/Store/SQL/Grammars/MySQL.pm: -------------------------------------------------------------------------------- 1 | package Mail::DMARC::Report::Store::SQL::Grammars::MySQL; 2 | our $VERSION = '1.20250805'; 3 | use strict; 4 | use warnings; 5 | 6 | sub new { 7 | my $class = shift; 8 | my $self = { }; 9 | bless $self, $class; 10 | return $self; 11 | } 12 | 13 | sub language { 14 | return 'mysql'; 15 | } 16 | 17 | sub dsn { 18 | return 'mysql'; 19 | } 20 | 21 | sub and_arg { 22 | my ($self, $column, $operator) = @_; 23 | $operator //= '='; 24 | 25 | return " AND $column $operator ?"; 26 | } 27 | 28 | sub report_record_id { 29 | return 'SELECT id FROM report_record WHERE report_id=?'; 30 | } 31 | 32 | sub delete_from_where_record_in { 33 | my ($self, $table) = @_; 34 | return "DELETE FROM $table WHERE report_record_id IN (??)" 35 | } 36 | 37 | sub delete_from_where_report { 38 | my ($self, $table) = @_; 39 | return "DELETE FROM $table WHERE report_id=?"; 40 | } 41 | 42 | sub delete_report { 43 | return "DELETE FROM report WHERE id=?"; 44 | } 45 | 46 | sub select_domain_id { 47 | return 'SELECT id FROM domain WHERE domain=?'; 48 | } 49 | 50 | sub insert_domain { 51 | return 'INSERT INTO domain (domain) VALUES (?)'; 52 | } 53 | 54 | sub select_author_id { 55 | return 'SELECT id FROM author WHERE org_name=?'; 56 | } 57 | 58 | sub insert_author { 59 | return 'INSERT INTO author (org_name,email,extra_contact) VALUES (?,?,?)'; 60 | } 61 | 62 | sub select_report_id { 63 | return 'SELECT id FROM report WHERE uuid=? AND author_id=?'; 64 | } 65 | 66 | sub select_id_with_end { 67 | return 'SELECT id FROM report WHERE from_domain_id=? AND end > ? AND author_id=?'; 68 | } 69 | 70 | sub insert_report { 71 | return 'INSERT INTO report (from_domain_id, begin, end, author_id, uuid) VALUES (?,?,?,?,?)'; 72 | } 73 | 74 | sub order_by { 75 | my ($self, $arg, $order) = @_; 76 | return " ORDER BY $arg $order"; 77 | } 78 | 79 | sub count_reports { 80 | return 'SELECT COUNT(*) FROM report'; 81 | } 82 | 83 | sub limit { 84 | my ($self, $number_of_entries) = @_; 85 | $number_of_entries //= 1; 86 | return " LIMIT $number_of_entries"; 87 | } 88 | 89 | sub limit_args { 90 | my ($self, $number_of_entries) = @_; 91 | my $return = ' LIMIT '; 92 | $number_of_entries //= 1; 93 | for (my $i = 1; $i <= $number_of_entries; $i++) { 94 | $return .= '?'; 95 | $return .= ',' if $i < $number_of_entries; 96 | } 97 | return $return; 98 | } 99 | 100 | sub select_report_policy_published { 101 | return 'SELECT * from report_policy_published WHERE report_id=?'; 102 | } 103 | 104 | sub select_report_reason { 105 | return 'SELECT type,comment FROM report_record_reason WHERE report_record_id=?'; 106 | } 107 | 108 | sub select_report_error { 109 | return 'SELECT error FROM report_error WHERE report_id=?'; 110 | } 111 | 112 | sub select_report_record { 113 | return 'SELECT id FROM report_record WHERE report_id=? AND source_ip=? AND count=?' 114 | } 115 | 116 | sub select_todo_query { 117 | return <<'EO_TODO_QUERY' 118 | SELECT r.id AS rid, 119 | r.begin AS begin, 120 | r.end AS end, 121 | a.org_name AS author, 122 | fd.domain AS from_domain 123 | FROM report r 124 | LEFT JOIN report_record rr ON r.id=rr.report_id 125 | LEFT JOIN author a ON r.author_id=a.id 126 | LEFT JOIN domain fd ON r.from_domain_id=fd.id 127 | WHERE rr.count IS NULL 128 | AND rr.report_id IS NOT NULL 129 | AND r.end < ? 130 | GROUP BY r.id 131 | ORDER BY r.id ASC 132 | EO_TODO_QUERY 133 | ; 134 | } 135 | 136 | sub select_row_spf { 137 | return <<"EO_SPF_ROW" 138 | SELECT d.domain AS domain, 139 | s.result AS result, 140 | s.scope AS scope 141 | FROM report_record_spf s 142 | LEFT JOIN domain d ON s.domain_id=d.id 143 | WHERE s.report_record_id=? 144 | EO_SPF_ROW 145 | ; 146 | } 147 | 148 | 149 | sub select_row_dkim { 150 | return <<"EO_DKIM_ROW" 151 | SELECT d.domain AS domain, 152 | k.selector AS selector, 153 | k.result AS result, 154 | k.human_result AS human_result 155 | FROM report_record_dkim k 156 | LEFT JOIN domain d ON k.domain_id=d.id 157 | WHERE report_record_id=? 158 | EO_DKIM_ROW 159 | ; 160 | } 161 | 162 | sub select_row_reason { 163 | return <<"EO_ROW_QUERY" 164 | SELECT type,comment 165 | FROM report_record_reason 166 | WHERE report_record_id=? 167 | EO_ROW_QUERY 168 | ; 169 | } 170 | 171 | sub select_rr_query { 172 | return <<'EO_ROW_QUERY' 173 | SELECT rr.*, 174 | etd.domain AS envelope_to, 175 | efd.domain AS envelope_from, 176 | hfd.domain AS header_from 177 | FROM report_record rr 178 | LEFT JOIN domain etd ON etd.id=rr.envelope_to_did 179 | LEFT JOIN domain efd ON efd.id=rr.envelope_from_did 180 | LEFT JOIN domain hfd ON hfd.id=rr.header_from_did 181 | WHERE report_id = ? 182 | ORDER BY id ASC 183 | EO_ROW_QUERY 184 | ; 185 | } 186 | 187 | sub select_report_query { 188 | return <<'EO_REPORTS' 189 | SELECT r.id AS rid, 190 | r.uuid, 191 | r.begin AS begin, 192 | r.end AS end, 193 | a.org_name AS author, 194 | fd.domain AS from_domain 195 | FROM report r 196 | LEFT JOIN author a ON r.author_id=a.id 197 | LEFT JOIN domain fd ON r.from_domain_id=fd.id 198 | WHERE 1=1 199 | EO_REPORTS 200 | ; 201 | } 202 | 203 | sub select_from { 204 | my ($self, $columns, $table) = @_; 205 | my $colStr = join( ', ', @$columns ); 206 | return "SELECT $colStr FROM $table WHERE 1=1"; 207 | } 208 | 209 | sub insert_error { 210 | my ( $self, $which ) = @_; 211 | if ( $which == 0 ) { 212 | return 'UPDATE report SET end=? WHERE id=?'; 213 | } else { 214 | return 'INSERT INTO report_error (report_id, error) VALUES (?,?)'; 215 | } 216 | } 217 | 218 | sub insert_rr_reason { 219 | return 'INSERT INTO report_record_reason (report_record_id, type, comment) VALUES (?,?,?)' 220 | } 221 | 222 | sub insert_rr_dkim { 223 | my ( $self, $fields ) = @_; 224 | my $fields_str = join ', ', @$fields; 225 | return <<"EO_DKIM" 226 | INSERT INTO report_record_dkim 227 | (report_record_id, $fields_str) 228 | VALUES (??) 229 | EO_DKIM 230 | ; 231 | } 232 | 233 | sub insert_rr_spf { 234 | my ( $self, $fields ) = @_; 235 | my $fields_str = join ', ', @$fields; 236 | return "INSERT INTO report_record_spf (report_record_id, $fields_str) VALUES(??)"; 237 | } 238 | 239 | sub insert_rr { 240 | return <<'EO_ROW_INSERT' 241 | INSERT INTO report_record 242 | (report_id, source_ip, count, header_from_did, envelope_to_did, envelope_from_did, 243 | disposition, dkim, spf) 244 | VALUES (??) 245 | EO_ROW_INSERT 246 | ; 247 | } 248 | 249 | sub insert_policy_published { 250 | return <<"EO_RPP" 251 | INSERT INTO report_policy_published 252 | (report_id, adkim, aspf, p, sp, pct, rua) 253 | VALUES (??) 254 | EO_RPP 255 | ; 256 | } 257 | 258 | sub insert_into { 259 | my ($self, $table, $cols) = @_; 260 | my $columns = join ', ', @$cols; 261 | return "INSERT INTO $table ($columns) VALUES (??)"; 262 | } 263 | 264 | sub replace_into { 265 | my ($self, $table, $cols) = @_; 266 | my $columns = join ', ', @$cols; 267 | return "REPLACE INTO $table ($columns) VALUES (??)"; 268 | } 269 | 270 | sub update { 271 | my ($self, $table, $cols) = @_; 272 | my $columns = join( ' = ?, ') . ' = ?'; 273 | return "UPDATE $table SET $columns WHERE 1=1"; 274 | } 275 | 276 | sub delete_from { 277 | my ($self, $table) = @_; 278 | return "DELETE FROM $table WHERE 1=1"; 279 | } 280 | 281 | 1; 282 | 283 | __END__ 284 | 285 | =pod 286 | 287 | =head1 NAME 288 | 289 | Mail::DMARC::Report::Store::SQL::Grammars::MySQL - Grammar for working with mysql databases. 290 | 291 | =head1 VERSION 292 | 293 | version 1.20250805 294 | 295 | =head1 SYPNOSIS 296 | 297 | Allow DMARC to be able to speak to MySQL databases. 298 | 299 | =head1 DESCRIPTION 300 | 301 | Uses ANSI SQL syntax, keeping the SQL as portable as possible. 302 | 303 | =head1 AUTHORS 304 | 305 | =over 4 306 | 307 | =item * 308 | 309 | Matt Simerson 310 | 311 | =item * 312 | 313 | Davide Migliavacca 314 | 315 | =item * 316 | 317 | Marc Bradshaw 318 | 319 | =back 320 | 321 | =head1 COPYRIGHT AND LICENSE 322 | 323 | This software is copyright (c) 2025 by Matt Simerson. 324 | 325 | This is free software; you can redistribute it and/or modify it under 326 | the same terms as the Perl 5 programming language system itself. 327 | 328 | =cut 329 | --------------------------------------------------------------------------------