[Mew-dist 14651] mewinc

Shun-ichi TAHARA ( 田原 俊一 ) jado at example.com
2000年 10月 19日 (木) 02:04:19 JST


というわけで、修正版 mewinc です。

[Mew-dist 14630]からの変更点:
  ・$mailfolder および -mailfolder が導入された。
    これらを指定すると、そこの下にメールを落とす。
    デフォルトは undef で、この場合はカレントディレクトリに落とす。
  ・-mailbox - で STDIN からメールを取る。
  ・-keep オプションが導入された。
  ・1文字のオプションも使えるようになった。

とりあえず ~/.mewdir はめんどいのでパスしてます。すみません。

私的には、このあたりで一度fixしたいなという気分ですので、これで特に問
題なければ、contribに突っ込んで頂けますでしょうか?
_______________________________
田原 俊一   jado at example.com, shunichi_tahara at example.com
                                  http://flowernet.gr.jp/jado/
FingerPrint: 16 9E 70 3B 05 86 5D 08 - B8 4C 47 3A E7 E9 8E D9
 ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄
-------------- next part --------------
#!/usr/local/bin/perl

##
## mewinc: mewls helper for local spool
##         [from imget]
##
## Author: Shun-ichi TAHARA <jado at example.com>
## Time-stamp: <00/10/19 01:48:48 jado at example.com>
##

### Configuration variables:

### Local spool path:
$mailspool = '/var/spool/mail';
#$mailspool = '/usr/spool/mail';
#$mailspool = '/var/mail';
#$mailspool = '/usr/mail';

### Mail folders path:
## If you want to use mewinc alone, set this.
## You need not to be set while you use mewinc only from mewls, even if you set
##   mew-mail-path to be different from the default.
$mailfolder = undef;
#$mailfolder = "$ENV{HOME}/Mail";
#$mailfolder = (getpwuid($<))[7]."/Mail";

### Use Content-Length: header:
## Solaris 2.x (and so on) needs setting this to 1.
$obeycl = 0;

### Use flock() included in Perl:
## flock() function in Perl uses flock, fcntl or lockf syscall inside it.
## If your OS has flock/fcntl/lockf feature, and locking methods are same
##   between Perl and mail.local(and so on), set this to 1.
## Generally, you can use this safely if your OS has flock syscall, however,
##   fcntl may be used in perl and lockf in mail.local, if not (for example,
##   Solaris 2.x). In this case, you could not lock your mail spool with
##   flock() in Perl, so you must consider using lock file explained below.
$useflock = 1;

### Use lock file:
## If your OS doesn't have flock/fcntl/lockf feature, or file locking features
##   are different between Perl and mail.local(and so on), set this to 1.
## As documented above, Solaris 2.x (and so on) may need setting this to 1.
$uselockfile = 0;

### System call number of fsync():
## This may found on "SYS_fsync" macro in /usr/include/sys/syscall.h.
## If not found and your mail folders are over NFS, take care of file system
##   overflow!
$fsync_no = undef;
#$fsync_no = "118";	# Linux
#$fsync_no = "95";	# FreeBSD

### End of configuration variables.

require 5.003;

use Cwd;
use Fcntl;
use integer;

$folder = 'inbox';
$keep = 0;
$mbopt = 0;
$mailbox = '';
$mfopt = 0;

sub fsync ($) {
    my ($fno) = @_;

    if ($fsync_no and syscall($fsync_no, $fno) < 0) {
	return 0;
    }
    return 1;
}

sub LOCK_SH { 1 }
sub LOCK_EX { 2 }
sub LOCK_NB { 4 }
sub LOCK_UN { 8 }

$locked_by_file = 0;
$locked_by_flock = 0;

sub lockmbox ($) {
    my ($base) = @_;
    my ($retry);

    $retry = 0;
    $locked_by_file = 0;
    $locked_by_flock = 0;

    return 1 unless $useflock || $uselockfile;
    if ($useflock) {
	if (open(LOCK_FH, "+<$base") and flock(LOCK_FH, LOCK_EX | LOCK_NB)) {
	    $locked_by_flock = 1;
	}
    }
    if ($uselockfile) {
	open(LOCKFILE, ">$base.$$") or goto NEXT;
	binmode(LOCKFILE);
	print LOCKFILE "$$\n";
	close(LOCKFILE);
	while (!link("$base.$$", "$base.lock")) {
	    if ($retry >= 10) {
		unlink("$base.$$");
		goto NEXT;
	    }
	    $retry++;
	    sleep(5);
	}
	unlink("$base.$$");
	$locked_by_file = 1;
      NEXT:
    }
    return 0 unless $locked_by_flock || $locked_by_file;
    return 1;
}

sub unlockmbox ($) {
    my ($base) = @_;

    if ($locked_by_flock) {
	$locked_by_flock = 0;
	flock(LOCK_FH, LOCK_UN);
    }
    if ($locked_by_file) {
	$locked_by_file = 0;
	if (-f "$base.lock") {
	    unlink("$base.lock");
	}
    }
}

sub empty_mbox ($) {
    my ($mbox) = @_;
    local (*MBOX);

    unless (truncate($mbox, 0)) {
	unless (open(MBOX, ">$mbox")) {
	    print STDERR "Can't clear mailbox.\n";
	    return;
	}
	close(MBOX);
    }
}

sub message_number {
    my ($number, @files);
    local (*DIR);

    opendir(DIR, '.') or die "Can't open current directory, stopped";
    @files = sort {$a <=> $b} grep /^\d+$/, readdir(DIR);
    closedir(DIR);

    if (scalar(@files) == 0) {
	$number = 1;
    } else {
	$number = $files[$#files] + 1;
    }

    while (-e "$number" || -e ".$number.dir") {
	$number++;
    }
    return $number;
}

sub excl_create ($$) {
    my ($MESSAGE, $file) = @_;
    my ($attr);

    $attr = Fcntl::O_RDWR | Fcntl::O_CREAT | Fcntl::O_EXCL;
    umask(066);
    sysopen($MESSAGE, $file, $attr) or return 0;
    binmode($MESSAGE);
    return 1;
}

$msgnum = 0;

sub new_message ($) {
    my ($MESSAGE) = @_;
    my ($try);

    if ($msgnum == 0) {
	$msgnum = message_number;
    } else {
	$msgnum++;
    }
    $try = 3;
    while ($try--) {
	if (excl_create($MESSAGE, "$msgnum")) {
	    # created successfully
	    return "$msgnum";
	}
	$msgnum++;
    }
    # message creation failed
    return undef;
}

sub store_message ($) {
    my ($Msg) = @_;
    local (*ART);
    my ($file);

    $file = new_message(\*ART);
    if ($file) {
	select (ART); $| = 1; select (STDOUT);
	foreach (@$Msg) {
	    print ART $_ or goto ERR1;
	}
	fsync(fileno(ART)) or goto ERR1;
	close(ART) or goto ERR2;

	print "$file\n";
	return 1;

      ERR1:
	close(ART);
      ERR2:
	print STDERR "Writing to the file \"$file\" failed ($!).\n";
	unlink($file) if (-z $file);
	return 0;
    } else {
	print STDERR "Message can't be saved.\n";
	return 0;
    }
}

sub process_mbox ($) {
    my ($src) = @_;
    my ($format, $msgs, $length, $inheader, @Message);
    local (*MBOX);
    my ($first_line);

    if ($src) {
	open(MBOX, "<$src") or return -1;
    } else {
	*MBOX = *STDIN;
    }
    chomp($first_line = <MBOX>);
    if ($first_line =~ /^From /) {
	$format = 'UNIX';
    } elsif ($first_line =~ /^\001\001\001\001$/) {
	$format = 'MMDF';
    } elsif ($first_line =~ /^BABYL OPTIONS:/) {
	$format = 'RMAIL';
    } else {
	print STDERR "Invalid mbox format: $src\n";
	return -1;
    }
    $msgs = 0;
    while ($first_line ne '') {

	if ($msgs > 0 && $format eq 'MMDF') {
	    $first_line = <MBOX>;
	    last if $first_line !~ /^\001\001\001\001$/;
	}

	if ($format eq 'RMAIL') {
	    while (<MBOX>) {
		last if /^\*\*\* EOOH \*\*\*$/;
	    }
	}

	if ($format eq 'UNIX') {
	    # convert UNIX From_ into Return-Path
	    my ($rp);

	    $rp = $first_line;
	    $rp =~ s/^From +//;
	    $rp =~ s/ +[A-Z][a-z][a-z] [A-Z][a-z][a-z] [\d ]\d \d\d:\d\d.*//;
	    $rp = "<$rp>" if $rp !~ /^<.*>$/;
	    @Message = ("Return-Path: $rp\n");
	} else {
	    @Message = ();
	}

	$first_line = '';
	$inheader = 1;
	$length = -1;
	while (<MBOX>) {
	    if ($format eq 'MMDF' && /^\001\001\001\001$/) {
		$first_line = 'MMDF';
		last;
	    } elsif ($format eq 'UNIX' && $length <= 0
		     && /^From / && $Message[$#Message] eq "\n") {
		chomp($first_line = $_);
		last;
	    } elsif ($format eq 'RMAIL' && /^\x1f/ ) {
		chomp($first_line = <MBOX>);
		last;
	    } elsif ($inheader) {
		# XXX continuous line processing needed
		push @Message, $_;
		# for Solaris 2.x or ...
		# XXX option
		if ($obeycl && /^Content-Length:(.*)/i) {
		    chomp($length = $1);
		}
		$inheader = 0 if (/^\n$/);
	    } else {
		push @Message, $_;
		$length -= length($_) if $length > 0;
	    }
	}

	if ($Message[$#Message] eq "\n") {
	    pop @Message;
	}

	$msgs++ if ($#Message >= 0);

	unless (store_message(\@Message)) {
	    close(MBOX);
	    return -1;
	}
    }
    close(MBOX);
    print STDERR "$msgs message(s).\n";
    return $msgs;
}

sub getmsg ($$) {
    my ($src, $keep) = @_;
    my ($msgs);

    # set default
    unless ($src) {
	my ($user);

	$user = getlogin;
	if ($user eq '' || $user eq 'root') {
	    $user = (getpwuid($<))[0];
	}
	$src = "$mailspool/$user";
    }

    if ($src eq '-') {
	# STDIN
	if (($msgs = process_mbox('')) < 0) {
	    die "Can't get message from STDIN, stopped";
	}
	return $msgs;
    } elsif (-s $src) {
	# FILE and not ZERO
	unless (lockmbox($src)) {
	    unlockmbox($src);
	    die "Can't lock mailbox \"$src\", stopped";
	}
	if (($msgs = process_mbox($src)) < 0) {
	    unlockmbox($src);
	    die "Can't get message from mailbox \"$src\", stopped";
	}
	empty_mbox($src) unless ($keep);
	unlockmbox($src);
	return $msgs;
    } else {
	print STDERR "No messages in mailbox.\n";
	return 0;
    }
}

sub usage {
    print "Usage: mewinc [options] [+folder]\n";
    print "  options: -mailbox|-f mboxfile|-\n";
    print "           -mailfolder|-d folderpath\n";
    print "           -keep|-k\n";
    exit(0);
}

foreach (@ARGV) {
    if ($mbopt) {
	$mbopt = 0;
	$mailbox = $_;
    } elsif ($mfopt) {
	$mfopt = 0;
	$mailfolder = $_;
    } elsif (/^-(ignorecl|c-)$/) {
	$obeycl = 0;
    } elsif (/^-(obeycl|c\+)$/) {
	$obeycl = 1;
    } elsif (/^-(noflock|s-)$/) {
	$useflock = 0;
    } elsif (/^-(useflock|s\+)$/) {
	$useflock = 1;
    } elsif (/^-(nolockfile|f-)$/) {
	$uselockfile = 0;
    } elsif (/^-(uselockfile|f\+)$/) {
	$uselockfile = 1;
    } elsif (/^-(keep|k)$/) {
	$keep = 1;
    } elsif (/^-(mailbox|f)$/) {
	$mbopt = 1;
    } elsif (/^-(mailfolder|d)$/) {
	$mfopt = 1;
    } elsif (/^-h/) {
	usage;
    } elsif (/^-/) {
	die "Unknown switch \"$_\", stopped";
    } elsif (/^\+(.+)$/) {
	$folder = $1;
    } else {
	die "Invalid parameter \"$_\", stopped";
    }
}

die "Filename expected after \"-mailbox\" or \"-f\", stopped" if $mbopt;
die "Directory expected after \"-mailfolder\" or \"-d\", stopped" if $mfopt;

if ($mailfolder) {
    $_ = "$mailfolder/$folder";
    chdir "$_" or die "Can't chdir to \"$_\", stopped\n";
} else {
    $_ = ".*/$folder\$";
    die "Must be executed on the folder \"$folder\", stopped" if cwd !~ /$_/;
}

getmsg($mailbox, $keep);

exit(0);

### Copyright Notice:

## Copyright (C) 2000 Shun-ichi TAHARA <jado at example.com>
## Copyright (C) 1997, 1998, 1999 IM developing team
## All rights reserved.
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following conditions
## are met:
##
## 1. Redistributions of source code must retain the above copyright
##    notice, this list of conditions and the following disclaimer.
## 2. Redistributions in binary form must reproduce the above copyright
##    notice, this list of conditions and the following disclaimer in the
##    documentation and/or other materials provided with the distribution.
## 3. Neither the name of the team nor the names of its contributors
##    may be used to endorse or promote products derived from this software
##    without specific prior written permission.
##
## THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
## PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
## LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
## CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
## SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
## BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
## WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
## OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
## IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

### mewinc ends here.
-------------- next part --------------
******************************* mewinc *******************************

mbox形式のローカルスプールからメールを取得する際に、mewlsから呼び出さ
れるへルパスクリプトです。

imgetからlocal mbox関連の部分を抜き出したものですので、imgetが扱える形
式は全て扱えるはずです。

インストール ---------------------------

以下を確認してスクリプトを編集した後、mewincをパスの通ったディレクトリ
にコピーしてください。

1. Perlのパスが /usr/local/bin でない場合は、1行目を修正してください。

2. メールスプールのあるディレクトリを $mailspool に設定してください。
   実際に参照されるメールスプールは、$mailspool/ユーザ名 となります。
   なお、実行時に -mailbox または -f オプションで直接メールスプールファ
   イルを指定することもできます。この時、ファイル名として - を指定する
   と、標準入力からメールを取り込みます。

3. コマンドラインから単独でmewincを使用したい場合は、メールフォルダの
   パスを $mailfolder に設定してください。Mewがデフォルトの設定であれ
   ば、$ENV{HOME}/Mail となります。なお、実行時に -mailfolder または
   -d オプションで直接メールフォルダを指定することもできます。

   mewincからしか実行しない場合は、undef のまま設定しなくても構いませ
   ん。この場合、取得したメールはカレントディレクトリに格納されます。
   mewlsは、ターゲットディレクトリにカレントディレクトリを移動してか外
   部プログラムを起動しますので、mewincは単にカレントディレクトリにメー
   ルを格納するだけで構わないからです。

4. Content-Length: へッダを見てメッセージ長を決定する必要がある場合は、
   $obeycl = 1; としてください。Solaris等で設定する必要があります。な
   お、実行時に -obeycl/-ignorecl または -c+/-c- オプションで、直接こ
   の機能をオン/オフにすることもできます。

5. Perlの flock() 関数を用いてメールスプールのロッキングを行なう場合、
   $useflock = 1; としてください。なお、実行時に -useflock/-noflock ま
   たは -s+/-s- オプションで、直接この機能をオン/オフにすることができ
   ます。

6. ロックファイル(*.lock)を作成することによってメールスプールのロッキ
   ングを行なう場合、$uselockfile = 1; としてください。なお、実行時に
   -uselockfile/-nolockfile または -f+/-f- オプションで、直接この機能
   をオン/オフにすることもできます。

※ Perlは、flock() 関数から実行されるシステムコールとして、OSに実装さ
   れているシステムコールのうち、flock(2), fcntl(2), lockf(2) の順で、
   最初に見つかったものを使用します。

   一方、メールをスプールに落とす mail.local は、スプールをロックする
   際に flock(2) または lockf(2) を使用し、同時にロックファイルも作成
   します。

   以上より、flock(2) システムコールの存在するLinuxやBSD系のOSなどでは、
   flock() 関数によるロックを用いてほぼ問題ありませんが、flock(2) が存
   在しないSolarisなど多くのSYSV系OSでは、mail.local が lockf(2) を使
   用するのに対して、Perlが fcntl(2) を使用する可能性があります。この
   場合は、ロックファイルを用いる必要があります。また、qmail-localのよ
   うに、ロックファイルを作ってくれないものでは排他制御がうまくいかな
   いかもしれません。

7. メールファイル生成後に fsync(2) システムコールを用いて、ファイルシ
   ステムの同期を取りたい場合、$fsync_no に fsync(2) のシステムコール
   番号を設定してください。これは、/usr/include/sys/syscall.h で定義さ
   れる SYS_fsync マクロの値を調べることでわかります。

※ もし、メールフォルダがNFSサーバ上に存在する場合、これを設定したほう
   がいいでしょう。そうしないと、ディスクが溢れた場合にメールのデータ
   を失うおそれがあります。

   fsync(2) システムコールの番号がわからない場合(最近のLinuxでは、イン
   クルードファイルの構造が複雑なので、/usr/include/sys/syscall.h を見
   てもわかりません)、下記のコードをコンパイルして実行すれば調べられま
   す。本当はautoconfを使うべきなのかもしれませんが。
   ------------------------------
   #include <stdio.h>
   #include <sys/syscall.h>

   int main() {
       printf("%d\n", SYS_fsync);
       return 0;
   }
   ------------------------------

Mewの設定 ------------------------------

(setq mew-mailbox-type 'mbox)
(setq mew-mbox-command "mewinc")

とすればオッケーです。mew-config-alist 内で設定する場合は、

(setq mew-config-alist
  '(("default"
      :
     ("mailbox-type"     . mbox)
     ("mbox-command"     . "mewinc")
      :
     )
    ("foo"
      :
     )))

などとします。
mewincにオプションを渡す際は、mew-mbox-command-arg を設定してください。
mew-config-alist なら、"mbox-command-arg" で指定します。

動作について ---------------------------

mewincを

  % mewinc [options] [+folder]

として起動すると、メールスプールからメールを取得します。オプションには、
以下のものが指定できます。

  -mailbox mboxfile|-
  -f mboxfile|-
    メールスプールファイルとして mboxfile を使用します。- を指定すると
    標準入力を使用します。

  -mailfolder folderpath
  -d folderpath
    メールフォルダのパスとして、folderpath を指定します。

  -keep
    メールを取得後、スプールを消去しません。

他にも、テスト用にいくつか隠しオプション(?)があります。「インストール」
の項を参照してください。

メールスプールは、デフォルトでは $mailpath/ユーザ名 ($mailpath は、イ
ンストール時に設定したメールスプールのあるディレクトリ) になりますが、
-mailbox/-f オプションでそれ以外のファイル(または標準入力)を指定するこ
ともできます。

対応mbox形式はよくわかっていませんが :-)、imgetが扱える形式は大丈夫の
はずです。imgetと同様、特にunquoteはしません。

$mailfolder 変数が設定されているか、-mailfolder/-d オプションが指定さ
れている場合、これらで指定されたディレクトリ以下の、+folder パラメータ
で指定されたフォルダにメールを格納します。+folder パラメータが指定され
ていない場合は、デフォルト値として +inbox が使われます。

$mailfolder 変数が設定されておらず、かつ、-mailfolder/-f オプションが
指定されていない場合、mewincは、カレントディレクトリにメールを格納しま
す。

mewlsは、格納先ディレクトリをカレントディレクトリとしてmewincを起動し
ますので、通常はこれでうまく動作するはずです。しかし、コマンドラインか
ら直接起動するなど、mewls以外から起動した際に、誤って変なディレクトリ
にメールを取り込んでしまうかもしれません。

mewincは、カレントディレクトリにメールを格納する前に、カレントディレク
トリのパス名が +folder パラメータで指定されたフォルダ名で終わっている
かをチェックします。これによって、メールフォルダ以外のディレクトリにメー
ルを取り込んでしまうことをある程度防ぎます。しかし、頻繁にコマンドライ
ンからmewincを起動する場合は、あらかじめ $mailfolder 変数を設定してお
くと便利でしょう。

その他 ---------------------------------

mewincは、田原俊一 <jado at example.com>が作成し、Mewに寄付しています。
著作権は主張しますが、改変・再配布等の条件はMewに準拠するものとします。

mewincは、IM(imget)からかなりの部分を持ってきています。IMを作成された
IM development teamに感謝いたします。

mewincを用いることによって、メールデータ消失等の不利益が生じても、作者
は一切の責任を取りません。

mewincでは、元のIMに存在した、UNIX以外のOSに対応するコードは全部削って
しまっていますので、うまく動かない可能性が高いです。あらかじめご了承く
ださい。


Mew-dist メーリングリストの案内