TIPS456

簡便法、Gmailにも届くさくらインターネットのメーリングリストの改良スクリプト

# YOU CAN EDIT MANUALLY AFTER HERE.
$START_HOOK = q{
# Reply-To header processing
{
    my $rt = &GET_HEADER_FIELD_VALUE('reply-to');
    $rt = '' unless defined $rt;
    
    if (&MailListMemberP($From_address)) {
        unless (length $rt) {
            &DEFINE_FIELD_FORCED("reply-to", $MAIL_LIST);
        }
    } else {
        if (length $rt) {
            &DEFINE_FIELD_FORCED("reply-to", $rt . "," . $MAIL_LIST);
        } else {
            my $fa = defined($From_address) ? $From_address : '';
            &DEFINE_FIELD_FORCED("reply-to", $fa . "," . $MAIL_LIST);
        }
    }
}

# From header rewrite ("<name> via ML:" <MAIL_LIST>)
{
    # 1) read original From safely
    my $orig_from = &GET_HEADER_FIELD_VALUE('from');
    $orig_from = '' unless defined $orig_from;
    
    # 2) keep original From for troubleshooting
    if (length $orig_from) {
        &DEFINE_FIELD_FORCED('x-original-from', $orig_from);
    }
    
    # 3) extract display-name robustly (no warnings even if patterns don't match)
    my $name = '';
    if    ($orig_from =~ /^\s*"([^"]+)"\s*<[^>]+>/) { $name = $1; }
    elsif ($orig_from =~ /^\s*([^<]+?)\s*<[^>]+>/)  { $name = $1; }
    elsif ($orig_from =~ /<([^>]+)>/)               { my $addr = $1; ($name) = split(/\@/, $addr, 2); }
    elsif ($orig_from =~ /([^\s\@]+@[^\s\@]+)/)     { my $addr = $1; ($name) = split(/\@/, $addr, 2); }
    
    # 4) trim; fallback if empty/undef
    $name = '' unless defined $name;
    $name =~ s/^\s+|\s+$//g if length $name;
    $name = 'No Name' unless length $name;
    
    # 5) build new From with " via ML:" suffix
    my $disp = $name . '_via_ML:';
    
    # 6) ensure MAIL_LIST is defined
    my $ml = defined($MAIL_LIST) ? $MAIL_LIST : '';
    
    # 7) create new From header with quotes
    my $new_from = $disp . ' <' . $ml . '>';
    
    # 8) set rewritten From only when ML address is available
    if (length $ml) {
        &DEFINE_FIELD_FORCED('from', $new_from);
    }
}
};
<||