1

嘘をついていたらよかったのですが、これを機能させるために数か月を費やしたので、perl スクリプトのスキルに負けたことを認めなければなりません。私はこれを機能させるのに途方に暮れており、助けが必要です (私は非常に感謝しています)。

背景: サード パーティの Listserv を使用して、ディスカッションのメーリング リストを運営しています。受信メールの「From」ヘッダーを自分のドメインのアドレスに変更したいと考えています。これには、メール アドレスのデータベース ルックアップを実行し、ユーザー名と会社コードを From ヘッダーに追加して送信します。

たとえば、 Super Dave が David Smith (ABC - LON) に変更された場合、リスト メンバーには、彼が「From free text」として選択したものではなく、そのヘッダーが表示されます。

私が開発したスクリプトは非常にうまく機能しますが、より複雑な電子メールでは機能しないようです。現在、スクリプトは電子メールのテキスト バージョンを取得し、すべての MIME 部分と html ビットを取り除き、ヘッダーを変更します。新しい電子メール形式に遭遇した場合 (そして、処理するコード行を書いていません)、停止します。受信するメールの種類ごとに修正を続けることもできますが、それはやり過ぎだと思います。KISS の方法に戻る必要があります。

注: データベース ルックアップには問題はありません。問題は、メール本文が最終的にリストサーバーに到達する方法にあります。

この代わりに、元のメールはそのままにして、From ヘッダーだけを変更したいと考えています。他には何もありません。それを行う方法はありますか？これがスクリプト (の重要な部分) です。

私が求めているのは、電子メールで from ヘッダーを検索し、それを別の値に変更してから送信する、はるかに簡単な方法です。

考え？

$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>

心に留めておいてください、これにはあらゆる種類の間違いがあります。ヘッダーは 1 行に揃える必要はありません。複数の From: ヘッダーが存在する可能性があります (たとえば、他の誰かのスクリプト エラーによる)。ヘッダーに From: ヘッダーがなくても、本文にランダムに From: がある場合もあります。スパマーは奇妙なことをします。ただし、元のコードに既にこれらの制限が含まれていて、それで十分満足している場合は、これを試してください。

一方、メールを処理する優れた Perl モジュールはすでに存在します。ここにリストされている Email:: モジュールに目を通してください。

于 2013-05-10T03:16:49.723 に答える