Pure-FTPdでAnonymousFTPでアップロードした時にWU-FTPD風にメールを飛ばすPerlスクリプト

Tweet

XBOX 360でドリームクラブとかいうピュアな心の持ち主のためのゲームが発売されて僕の隣の席の人もレッドリング直したらしいからいよいよ買うのかもしれないなあと思いながら構築するサーバはPure-FTPdということとなっております。7年前だったらピュアと言ったらシスプリリピュアだったのに。花王だったらファミリーピュアだったのに。

AnonymousFTPでファイルをアップロードしたら、メールをするという機能は15年前のWU-FTPDでできていたのですが、このプロダクトは2003年で行進が止まっていて、WU-FTPD Development Groupはもうサーバすらつながらなく、x86_64環境だとconfigureできないという事態に至って、やはり新し目のFTPサーバを使おうと思ったわけであります。

それで、CentOS 5にPure-FTPdをインストールする場合は、RPMForgeにパッケージがあるんですけれども、アップロードしたらメールを出すスクリプトの部分が面倒。ともかく、自分で作ってみました。

#!/usr/bin/perl
 
# /etc/pure-ftpd/upload-check.pl
# chmod 700 upload-check.pl
# /usr/sbin/pure-uploadscript -B -r /etc/pure-ftpd/upload-check.pl
 
use strict;
use warnings;
use utf8;
use Encode;
use MIME::Lite;
 
# main
 
my $user = $ENV{'UPLOAD_VUSER'}; # Pure-FTPdの環境変数
if ( $user eq 'ftp' ) {
  submit_mail();
}
exit;
 
sub submit_mail {
  my $fullpath = $ARGV[0];
  my $filename = $fullpath;
  $filename =~ tr|[¥x00-¥x1f¥x7f]||d;
  $filename =~ s|^.+/||;
  my $size = $ENV{'UPLOAD_SIZE'}; # Pure-FTPdの環境変数
  
  my $data = q()
    . "uploaded $filename from anonymous user.¥n"
    . "File size is $size.¥n"
    . "Please move the file where it belongs."
    . q();
  
  my $subject = "New file uploaded: $filename";
  my $to      = 'fuga@example.com';
  my $from    = 'Pure-FTPd <hoge.example.com>';
  
  my $msg = MIME::Lite->new(
    From    => encode('MIME-Header-ISO_2022_JP', $from    ),
    To      => encode('MIME-Header-ISO_2022_JP', $to      ),
    Subject => encode('MIME-Header-ISO_2022_JP', $subject ),
    Data    => encode('ISO_2022_JP', $data ),
  );
  $msg->send();
  return;
}
 
__END__

WU-FTPDに似せてみた。あと、日本語メールもちゃんと飛ぶように作ってみたよ！

2009.09.15 23:29 投稿　大野 義貴 [Perl] | 固定リンク |