Question

我希望自己撒谎，但是我花了几个月的时间试图让它发挥作用，我不得不承认我的perl脚本编写技巧的失败。我无法完成这项工作并需要帮助（我将非常感激）。

背景：我正在使用第三方Listserv运行讨论电子邮件列表。我想通过对电子邮件地址进行数据库查找，然后将用户名和公司代码添加到From标头，然后将其发送，将收到的电子邮件中的“From”标题更改为我的域中的地址。

例如，Super Dave更改为David Smith（ABC-LON），然后列表成员将看到该标题而不是他选择的任何标题为“来自自由文本”。

我开发的脚本运行得很好......除了更复杂的电子邮件似乎让它昏迷。现在，脚本采用电子邮件的文本版本，删除所有MIME部分和html位，并更改标题。如果它遇到一个新的电子邮件格式（并且我没有编写代码行来处理），它就会停止。我可以继续修复进入的每种类型的电子邮件，但我认为这有点过分 - 我需要回到KISS方法。

注意：数据库查找没有问题。问题在于电子邮件正文最终到达列表服务器。

而不是这个，我想保持原始电子邮件不变，但只需更改From标题。没有其他的。有没有办法做到这一点？这是脚本的（显着部分）。

接下来是一个更简单的方法来搜索来自Header的电子邮件，将其更改为其他值，然后将其发送。

思想？

$connect = DBI->connect($dsn, $user, $pw);
open FH, ">mail.txt" or die "can't open mail.txt: $!";
while ( $_ = <STDIN>) {
print FH "$_";
}
close(FH);
$file_content = `cat 'mail.txt' | grep -m1 From |tail -n+1`;
chomp($file_content);
$from = `echo "$file_content"| sed -e "s/.*<//;s/>.*//"`;
chomp($from);
$subject=`cat mail.txt |grep -m1 Subject| sed -e "s/.*Subject: //"`;
chomp($subject);
system('./body.sh');
$encoded=`cat body.txt`;

#Decode the mail and save output to dbody.txt. Still have header+body at this stage.
$body=decode_qp($encoded);
open FF, ">dbody.txt" or die $!;
print FF $body;
close FF;
#If body still has headers, Look for first blank line, and delete all before - this is the body
$bodycheck =`cat dbody.txt`;
if ($bodycheck =~ /Message-Id/ ){
$bodyfinal= `sed '0,/^\$/d' dbody.txt`;
} else {
$bodyfinal =$bodycheck
}

#Save the output to bodyfinal.txt
open FF, ">bodyfinal.txt" or die $!;
print FF $bodyfinal;
close FF;

#THIS SECTION contains code to query the database with the original FROM email address
#get username and domain and then change to lower case for the query
$case_username = substr($from, 0, index($from, '@'));
$m_username = lc($case_username);
$case_domain = substr($from, index($from, '@')+1);
$m_domain = lc($case_domain);
#print "\n##############$m_username\@$m_domain#################\n";
$query = "select user_real_name, company_code, location_code from user where user_email='$m_username\@$m_domain'";
$query_handle = $connect->prepare($query);
$query_handle->execute() or die $DBI::errstr;
@result=$query_handle->fetchrow_array();
print "\n@result\n";
##Forward the mail


sub sendEmail
 {
        my ($to, $from_sub, $subject, $message) = @_;
        my $sendmail = '/usr/sbin/sendmail';
        open(MAIL, "|$sendmail -oi -t");
                print MAIL "From: $from_sub\n";
                print MAIL "To: $to\n";
                print MAIL "Subject: $subject\n\n";
                print MAIL "$message\n";
        close(MAIL);
 }

{my $msg = MIME::Lite->new
(
        Subject => "$subject",
        From    => "$result[0] ($result[1]/$codes[0]-$result[2])<listmail@>",
        To      => 'opg@maillist.com',
        Type    => 'text/plain',
        Encoding => '7bit',
        Data    => "From: $result[0]/$result[1]-$codes[0]/$result[2] \n________________________________________________ \n \n$bodyfinal \n"
);
$msg->send();
}

Answer 1

要回答“搜索某些文件以查找From：标头的简单方法，将其更改为其他值，并将其发送？“：使用Tie::File;

给定一个名为“email”的文件，其中包含this page的示例标题，

#! /usr/bin/env perl
use common::sense;
use Tie::File;

tie my @f, 'Tie::File', 'email' or die $!;

for (@f) {
  if (/^From:/) {
    say "old: $_";
    s/(?<=^From:).*$/ A New Sender <anewsender\@ans.com>/;
    say "new: $_";
    last
  }
}

untie @f;

输出：

$ perl tie-ex 
old: From: Taylor Evans <example_from@dc.edu>
new: From: A New Sender <anewsender@ans.com>

$ grep ^From email
From: A New Sender <anewsender@ans.com>

介意，这有各种各样的错误。标题不需要整齐地排在一条线上;可以有多个From：header（例如，由别人的脚本错误）;在标题中甚至可以没有From：标题，然后在正文中随机出现：随机：垃圾邮件发送者做的很奇怪。但是，如果您的原始代码已包含这些限制，并且您对它们感到满意，请尝试使用它。

与此同时，已经有很好的Perl模块可以处理邮件。看一下Email :: modules listed here。

Perl解析电子邮件，更改“发件人：”标题，然后发送

1 个答案: