1

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

背景：我正在使用第三方 Listserv 运行讨论电子邮件列表。我想将传入电子邮件的“发件人”标头更改为我域中的地址，方法是在数据库中查找电子邮件地址，然后将用户名和公司代码添加到“发件人”标头，然后继续发送。

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

我开发的脚本运行良好……除了更复杂的电子邮件似乎使它昏昏欲睡。现在，脚本获取电子邮件的文本版本，删除所有 MIME 部分和 html 位，并更改标题。如果它遇到新的电子邮件格式（我还没有编写代码行来处理），它就会停止。我可以继续修复每种类型的电子邮件，但我认为这有点矫枉过正——我需要回到 KISS 方法。

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

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

我所追求的是一种更简单的方法，可以在电子邮件中搜索 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();
}
4

1 回答 1

1

只回答“什么是在某个文件中搜索 From: 标头的简单方法，将其更改为另一个值，然后继续发送？”：使用Tie::File；

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

#! /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: 标头（例如，由其他人的脚本错误）；标题中甚至可以没有 From: 标题，然后在正文中随机出现 From:。垃圾邮件发送者会做一些奇怪的事情。但是，如果您的原始代码已经包含这些限制并且您对它们感到满意，请试试这个。

同时，已经有很棒的 Perl 模块可以处理邮件。查看此处列出的 Email:: 模块。

于 2013-05-10T03:16:49.723 回答