view release on metacpan or  search on metacpan

bin/submit_abuse_report  view on Meta::CPAN

                 // '';
    $mail_from =~ s/^\s*<?\s*|\s*>?\s*$//g;   # strip angle brackets and whitespace
    push @fields, "Original-Mail-From: <$mail_from>" if $mail_from;

    # Original-Rcpt-To -- envelope recipient(s) of the spam
    # Use the To: header; for each distinct address found
    my $rcpt_to = $inv->header_value('to') // '';
    # Extract individual addresses (bare addr@domain or <addr@domain>)
    my %rcpt_seen;
    while ($rcpt_to =~ /<?([^\s<>,;]+\@[\w.-]+)>?/g) {
        my $addr = lc $1;
        push @fields, "Original-Rcpt-To: <$addr>" unless $rcpt_seen{$addr}++;
    }

    # Arrival-Date -- when we (the reporter) received the spam
    my $arrival = $inv->header_value('date') // '';
    push @fields, "Arrival-Date: $arrival" if $arrival;

    # Reported-Domain -- the primary contact domain
    my ($rdomain) = $inv->all_domains();
    push @fields, "Reported-Domain: $rdomain" if $rdomain;

    # Reported-Uri -- each distinct URL in the spam body
    my %uri_seen;
    for my $u ($inv->embedded_urls()) {
        push @fields, "Reported-Uri: $u->{url}"
            unless $uri_seen{ $u->{url} }++;
    }

    # Authentication-Results -- forwarded verbatim from the spam headers
    my $auth_res = $inv->header_value('authentication-results') // '';
    push @fields, "Authentication-Results: $auth_res" if $auth_res;

    return join("\r\n", @fields) . "\r\n";
}

# -----------------------------------------------------------------------
# _build_mime_message( %args ) -> string
#
# Constructs a fully RFC 5965 compliant multipart/report MIME message
# suitable for transmission via Net::SMTP->datasend().
#
# Three-part structure per RFC 5965 s.2:
#   Part 1  text/plain; charset=UTF-8  -- human-readable abuse report
#   Part 2  message/feedback-report    -- ARF machine-readable metadata
#   Part 3  message/rfc822             -- original spam message verbatim
#
# All line endings in the returned string are CRLF (\r\n).
# Part 2 uses 7bit encoding (required by RFC 5965 s.3).
# -----------------------------------------------------------------------
sub _build_mime_message {
    my (%a) = @_;

    # Boundary unique per message; must not appear in any part body
    my $boundary = sprintf 'arf_report_%s_%d',
        strftime('%Y%m%d%H%M%S', gmtime), $$;

    # Normalise line endings to CRLF throughout, then encode to raw UTF-8
    # bytes.  Net::SMTP->datasend() calls syswrite() on a raw socket and
    # cannot handle Perl strings with the Unicode flag set (wide characters).
    # The body may contain non-ASCII characters (e.g. emoji in decoded subject
    # lines) so we must encode explicitly rather than rely on the socket layer.
    (my $body_crlf     = $a{body}) =~ s/\r?\n/\r\n/g;
    my $original_crlf  = '';
    if (defined $a{original} && length ${ $a{original} }) {
        ($original_crlf = ${ $a{original} }) =~ s/\r?\n/\r\n/g;
    }
    my $feedback_report = _build_feedback_report($a{inv});

    # ---- Outer envelope headers ----
    my @msg;
    push @msg, "Date: $a{date}";
    push @msg, "From: $a{from}";
    push @msg, "To: $a{to}";
    push @msg, "Subject: $a{subject}";
    push @msg, "Message-ID: $a{msg_id}";
    push @msg, "MIME-Version: 1.0";
    # multipart/report with report-type=feedback-report per RFC 5965 s.2
    push @msg, "Content-Type: multipart/report;";
    push @msg, "    report-type=feedback-report;";
    push @msg, "    boundary=\"$boundary\"";
    push @msg, "X-Mailer: Email::Abuse::Investigator submit_abuse_report";
    push @msg, "X-Report-Monitor: $a{bcc}" if $a{bcc};
    push @msg, "";

    # Preamble for non-MIME clients
    push @msg, "This is an ARF (Abuse Reporting Format) feedback report.";
    push @msg, "See https://datatracker.ietf.org/doc/html/rfc5965";
    push @msg, "";

    # ---- Part 1: human-readable summary (RFC 5965 s.2 "first part") ----
    push @msg, "--$boundary";
    push @msg, "Content-Type: text/plain; charset=UTF-8";
    push @msg, "Content-Transfer-Encoding: 8bit";
    push @msg, "Content-Disposition: inline";
    push @msg, "";
    push @msg, $body_crlf;

    # ---- Part 2: ARF machine-readable metadata (RFC 5965 s.3) ----
    push @msg, "--$boundary";
    push @msg, "Content-Type: message/feedback-report";
    push @msg, "Content-Transfer-Encoding: 7bit";   # required by RFC 5965
    push @msg, "";
    push @msg, $feedback_report;

    # ---- Part 3: original spam message (RFC 5965 s.2 "third part") ----
    # Use base64 encoding so Outlook and other clients reliably show
    # it as a downloadable .eml attachment rather than rendering it
    # inline or discarding it.
    my $original_b64 = MIME::Base64::encode_base64($original_crlf, "\r\n");
    push @msg, "--$boundary";
    push @msg, "Content-Type: application/octet-stream; name=\"original_message.eml.txt\"";
    push @msg, "Content-Transfer-Encoding: base64";
    push @msg, "Content-Disposition: attachment;";
    push @msg, "    filename=\"original_message.eml.txt\"";
    push @msg, "Content-Description: Original spam/phishing message";
    push @msg, "";
    push @msg, $original_b64;

    # Closing boundary
    push @msg, "--${boundary}--";