[Mimedefang] FB Joins? And current copy of code we are using to handle DMARC reject/quarantine domains and mailing lists - Was Re: ADMINISTRIVIA: Yahoo users may not post to this mailing list

[Kevin A. McGrail]

Afternoon All,

Not sure if it's new but FB's dmarc rejects as well.  Noticed it when 
someone tried to share something from FB with a mailing list.

_dmarc.facebook.com.    3600    IN      TXT     "v=DMARC1\; p=reject\; 
pct=100\; rua=mailto:d at rua.agari.com,mailto:postmaster at facebook.com\; 
ruf=mailto:d at ruf.agari.com\;"
_dmarc.facebookmail.com. 2101   IN      TXT     "v=DMARC1\; p=reject\; 
pct=100\; rua=mailto:d at rua.agari.com,mailto:postmaster at facebook.com\; 
ruf=mailto:d at ruf.agari.com\;"

Here's the current version of the code we are using to intervene for 
mailing lists.  It's more generic and does a dmarc lookup each time.

to use it, filter_initialize needs   use Net::DNS;

Then in filter_end, we use this block:

     #DMARC MAILING LIST RESOLUTION
     foreach $recip (@Recipients) {
       # BLOCK IF FROM YAHOO (AND OTHERS) BECAUSE THEY SET DMARC TOO 
STRICTLY
       # 
http://www.pcworld.com/article/2141120/yahoo-email-antispoofing-policy-breaks-mailing-lists.html

       # If Sender is set to DMARC reject and recipient is a mailing 
list - NOTE Yahoo.com and AOL.com reject as of 4/23
       if (($recip =~ m/\@mailman\./i or

(logic you add for your setup)


           and

          # exclude the admnistrivia addresses like admin confirm, join, 
leave, etc.
          ($recip !~ 
/\-(admin|bounces|confirm|join|leave|owner|request|subscribe|unsubscribe)\@/i)

          ) {
         my ($container, $parser, $original, $report2, 
$dmarc_reject_notice, $sender, $dmarc_result, $sender_domain, 
$modification_subject);

         # Automatically check DMARC DNS entry
         $sender_domain = &get_domain_from_email($Sender);
         # DNS test for DMARC entry with timeout of 5 seconds
         $dmarc_result = &check_dmarc(domain=>$sender_domain, timeout=>5);

         if ($dmarc_result =~ /p=(reject|quarantine)/i) {

           # NOTIFY SENDER AND REWRITE THE SENDER TO A DO-NOT-REPLY ADDRESS
           md_syslog('warning', "Modifying message to mailing list due 
to DMARC - $recip - $Sender - $Subject");
           $dmarc_reject_notice = "Your email to $recip was modified due 
to a change your email provider implemented which causes your email on 
mailing lists to be flagged incorrectly as a forgery.

In order to permit your email through to the mailing list, we have 
rewritten the From address to a do-not-reply address.  Depending on the 
list configuration, you may not receive replies and will need to monitor 
the list.  Additionally, this may delay your email as it will require 
manual intervention by the list moderator to approve.

We apologize for the inconvenience but the cause of the issue rests 
squarely and solely on your email provider.  We recommend you consider a 
free Google account available at http://www.gmail.com/. For more 
technical information, please see: 
http://www.pcworld.com/article/2141120/yahoo-email-antispoofing-policy-breaks-mailing-lists.html 
and 
http://postmaster-blog.aol.com/2014/04/22/aol-mail-updates-dmarc-policy-to-reject/

Sincerely,

Kevin A. McGrail
President, PCCC";


           #CUSTOMIZE NOTIFICATION PARAMS
           $sender = 'do-not-reply at pccc.com';
           $modification_subject = "Important Mailing List Notification 
re:[$Subject]";

           #SEND NOTIFICATION
           action_notify_sender_immediately(Sender=>$Sender, 
DaemonName=>'PCCC Notice', DaemonAddress=>$sender, 
NotifySenderSubject=>$modification_subject, body=>$dmarc_reject_notice);

           #TEMPORARILY REMOVE MAILING LIST
           #delete_recipient($recip); - NO LONGER NEEDED WITH REWRITE OF 
FROM

           #Possible Improvement is to do a DKIM/SPF/etc. check on the 
email before rewriting to minimize forgeries getting farther in the process.

           #CHANGE SENDER ON ENVELOPE
           change_sender($sender);

           #CHANGE SENDER ON FROM
           if (&check_header(header=>'From')) {
             action_delete_all_headers('From');
             action_delete_all_headers('Reply-To');
             action_add_header("From","\"DMARC Modified Email\" <$sender>");
             action_add_header("Reply-To", "$Sender");
           }
         }
       }
     }
     #END DMARC MAILING LIST HANDLING



You will also need these functions:

# check the HEADERS file and return any instances of a specific 
parameter header (case insensitive on header name)
sub check_header {
   my (%params) = @_;
   my ($filehandle, $preslurp, $contents, $output);

   $params{'header'} || return undef;

   $filehandle = new IO::File('< ./HEADERS') or return undef;

   while (<$filehandle>) {
     if ($_ =~ /^$params{'header'}:/i) {
       $output .= $_;
     }
   }

   close ($filehandle);

   return $output;

}

sub action_notify_sender_immediately {
   my (%params) = @_;

   my ($body, $recip);

   # Send notification to sender - Based on function from mimedefang.pl
   if ($params{'Sender'} ne '<>') {
     $body = "From: $params{'DaemonName'} <$params{'DaemonAddress'}>\n";
     $body .= "To: $params{'Sender'}\n";
     $body .= gen_date_msgid_headers();
     $body .= "Auto-Submitted: auto-generated\n";
     $body .= "MIME-Version: 1.0\nContent-Type: text/plain\n";
     $body .= "Precedence: bulk\n";
     $body .= "Subject: $params{'NotifySenderSubject'}\n\n";
     $body .= "$params{'body'}\n";

     send_mail($params{'DaemonAddress'}, $params{'DaemonName'}, 
$params{'Sender'}, $body);
   }
}


sub check_dmarc {
   my (%params) = @_;
   my ($res, $packet, @answer);

   $res = Net::DNS::Resolver->new;

   $params{'timeout'} ||= 10;
   $params{'domain'} || return undef;

   if (defined ($res)) {
     $res->tcp_timeout($params{'timeout'});       #Number of Seconds 
before query will fail
     $res->udp_timeout($params{'timeout'});       #Number of Seconds 
before query will fail

     $packet = $res->query("_dmarc.$params{'domain'}","TXT","IN");

     #Parse the Query
     if (defined ($packet)) {
       if (defined ($packet->answer)) {
         @answer = $packet->answer;
         if ($answer[0]->type eq "TXT") {
           return $answer[0]->txtdata;
         }
       }
     }
   }

   return undef;
}

#get domain name from an email address
sub get_domain_from_email {
   my ($domain) = @_;

   #REMOVE ANY LEADING/TRAILING <>'s
   $domain =~ s/(^<|>$)//g;
   #REMOVE ANY LEADING/TRAILING SPACE'S
   $domain =~ s/^ *//g;
   $domain =~ s/ *$//g;
   #REMOVE EVERYTHING UP TO THE @ SYMBOL
   $domain =~ s/.*\@//g;

   return $domain;
}

regards,
KAM