異動の時期に活躍するスクリプト - file-glob こと k.daibaの日記

異動の時期になりました．この時期の管理者はメール転送なんかをやらなきゃならない．でも，タイミングが悪いとスプールにメールが溜まっていたり，そもそもサーバに残す設定にしている人がいる．そんなこんなで考えたのがこのスクリプト．全部どかんと載せると長いから，少しずつ．

#!perl -w

{
  package Mine;
  use base qw(Net::SMTP::Multipart);
  use Carp;

Net::POP3を使ってサーバにアクセスし，Net::SMTP::Multipartを使って取得したメールを添付形式で投げている．

  sub Text
  {
    my $self = shift;
    my $text = shift;
    $text .= "\n";
    $self->datasend(sprintf"\n--%s\n",$Net::SMTP::Multipart::b);
    $self->datasend("Content-Type: text/plain; charset=iso-2022-jp\n");
    $self->datasend("Content-Transfer-Encoding: 7bit\n");
    $self->datasend("Content-Description: Mail message body\n\n");
    $self->datasend($text);
    $self->datasend("\n\n");
  }

Net::SMTP::MultipartはContent-Typeの設定がなくてテキストが表示できなかったので，Net::SMTP::Multipartを継承してMineというクラスを作り，Textメソッドをオーバーライト．

  sub FileAttach {
    my $self = shift;
    my $type = shift;

    foreach my $file (@_) {
      unless (-f $file) {
        carp 'Net::SMTP::Multipart:FileAttach: unable to find file $file';
        next;
      }
      my($bytesread,$buffer,$data,$total);
      open(FH,"$file") || carp "Net::SMTP::Multipart:FileAttach: failed to open $file\n";
      binmode(FH);
      while ( ($bytesread=sysread(FH,$buffer, 1024))==1024 ){
        $total += $bytesread;
        $data .= $buffer;
      }
      if ($bytesread) {
        $data .= $buffer;
        $total += $bytesread ;
      }
      close FH;

FileAttachメソッドもオーバーライトする．といっても，ここら辺には変更は特になし．Content-Typeの情報を取得するために，typeという引数を増やしている．

      if ($data){
        $self->datasend("--$Net::SMTP::Multipart::b\n");
        $self->datasend("Content-Type: $type ; name=\"$file\"\n");
        $self->datasend("Content-Disposition: attachment; filename=\"$file\"\n\n");
        $self->datasend($data);
        $self->datasend("--$Net::SMTP::Multipart::b\n");
      }
    }
  }
}

元のNet::SMTP::MultipartはMIMEencodeしているけど，その処理をはずした．そして，Content-Typeを設定している．

## mail catch and release script
#
use Net::POP3;
use File::Temp qw /mkstemps/;
use strict;

my $pops  = "xxx.xxx.xxx.xxx";
my $smtps = "xxx.xxx.xxx.xxx";
my $from  = "from@hoge.jp";
my $user  = shift or die "specify username\n";
my $pass  = $user;
my $to    = shift or die "specify to mail address\n";

スクリプト本体の開始．$pops, $smtpsには使っているpop3サーバ，smtpサーバの値を設定．$fromには誰かのメールなのかを指定する．そういえば，このスクリプトは，pop before smtpには対応してない．今回は使わなくてすんだので，その処理はここではパス．ここでは，ユーザ名とパスワードに同じ値を設定している例を書いている．このスクリプトの使い方は，"hoge.pl username to_mail_address"　としている．

my $pop = Net::POP3->new($pops);
unless (my $num = $pop->login($user, $pass)){
  unless (defined $num){
    print "USER or PASS mismatched\n";
    exit;
  }else{
    print "No mails for $user\n";
    exit;
  }
}
my $msgsref = $pop->list;
my $count;

ここが，POP3にアクセスしてメッセージを取得するまでの流れ．

for my $msgref (sort {$a <=> $b} keys %$msgsref){
  my ($fh, $filename) = mkstemps("robotXXXXX", ".eml");
  $pop->get($msgref, $fh);
  close $fh;

メッセージを，.emlという拡張子を持つテンポラリファイルに格納する．

  my $smtp = Mine->new($smtps);
  my $subj = sprintf "Forwarding mail No.%d.", ++$count;
  $smtp->Header(
    To   => $to,
    Subj => $subj,
    From => $from);
  $smtp->Text("Hi, ");
  $smtp->FileAttach("message/rfc822", $filename);
  $smtp->End();
  unlink $filename;
}
$pop->quit;
printf "%d mails forwarded for %s.\n", $count, $user;

ホントは"unlink $filename"というのは必要ないはずだが，なぜかwin32ではうまく動かない．そのため，明示的にファイルを削除した．これでメールがぱかすかと飛んでいく．