[Mew-dist 14630] Re: incdir, incmbox
Shun-ichi TAHARA ( 田原 俊一 )
jado at example.com
2000年 10月 18日 (水) 10:44:23 JST
From: SAKAI Kiyotaka <ksakai at example.com>
Message-Id: <20001017.154623.63220401.ksakai at example.com>
> > mail.localはあればflock、なければlockfを使うようですね。で、ついでに(?)
> > *.lockというロックファイルも作るようです。
>
> ちなみに、imget でも ~/.im/Config に
>
> lock=flock+file
>
> などと書くことで、flock() とロックファイルの両方を併用することができま
> した。
なるほど。
ちょっと書き換えてみました。[Mew-dist 14627]の差し換えということで。
-------------- 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/18 10:26:33 jado at example.com>
##
### Configuration variables:
### Local spool path:
$mailpath = '/var/spool/mail';
#$mailpath = '/usr/spool/mail';
#$mailpath = '/var/mail';
#$mailpath = '/usr/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';
$mbopt = 0;
$mailbox = '';
sub fsync ($) {
my ($fno) = @_;
if ($fsync_no) {
return syscall($fsync_no, $fno);
}
return 0;
}
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;
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 -1 unless $locked_by_flock || $locked_by_file;
return 0;
}
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 -1;
binmode($MESSAGE);
return 0;
}
$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") == 0) {
# 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)) < 0 and goto ERR1;
close(ART) or goto ERR2;
print "$file\n";
return 0;
ERR1:
close(ART);
ERR2:
print STDERR "Writing to the file \"$file\" failed ($!).\n";
unlink($file) if (-z $file);
return -1;
} else {
print STDERR "Message can't be saved.\n";
return -1;
}
}
sub process_mbox ($) {
my ($src) = @_;
my ($format, $msgs, $length, $inheader, @Message);
local (*MBOX);
my ($first_line);
open(MBOX, "<$src") or return -1;
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);
if (store_message(\@Message) < 0) {
close(MBOX);
return -1;
}
}
close(MBOX);
print STDERR "$msgs message(s).\n";
return $msgs;
}
sub getmsg ($) {
my ($src) = @_;
my ($msgs);
# set default
unless ($src) {
my ($user);
$user = getlogin;
if ($user eq '' || $user eq 'root') {
$user = (getpwuid($<))[0];
}
$src = "$mailpath/$user";
}
if (-s $src) {
# FILE and not ZERO
if (lockmbox($src) < 0) {
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);
unlockmbox($src);
return $msgs;
} else {
print STDERR "No messages in mailbox.\n";
return 0;
}
}
sub usage {
print "Usage: mewinc [-mailbox mboxfile] [+folder]\n";
exit(0);
}
foreach (@ARGV) {
if ($mbopt) {
$mbopt = 0;
$mailbox = $_;
} elsif (/^-ignorecl$/) {
$obeycl = 0;
} elsif (/^-obeycl$/) {
$obeycl = 1;
} elsif (/^-noflock$/) {
$useflock = 0;
} elsif (/^-useflock$/) {
$useflock = 1;
} elsif (/^-nolockfile$/) {
$uselockfile = 0;
} elsif (/^-uselockfile$/) {
$uselockfile = 1;
} elsif (/^-mailbox$/) {
$mbopt = 1;
} elsif (/^-h/) {
usage;
} elsif (/^-/) {
die "Unknown switch \"$_\", stopped";
} else {
$folder = $_;
}
}
die "Filename expected after \"-mailbox\", stopped" if $mbopt;
$_ = $folder;
s:^.(.*)$:.*/$1\$:;
die "Must be executed on the folder \"$folder\", stopped" if cwd !~ /$_/;
getmsg($mailbox);
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. メールスプールのあるディレクトリを $mailpath に設定してください。デ
フォルトでは $mailpath/(ユーザ名) からメールを取り込みます。なお、
実行時に -mailbox オプションで実行時に直接スプールファイルを指定す
ることもできます。
3. Content-Length: へッダを見てメッセージ長を決定する必要がある場合は、
$obeycl = 1; としてください。Solaris等で設定する必要があります。な
お、実行時に -obeycl/-ignorecl オプションで、直接この機能をオン/オ
フにすることもできます。
4. Perlの flock() 関数を用いてメールスプールのロッキングを行なう場合、
$useflock = 1; としてください。なお、実行時に -useflock/-noflock オ
プションで、直接この機能をオン/オフにすることができます。
5. ロックファイル(*.lock)を作成することによってメールスプールのロッキ
ングを行なう場合、$uselockfile = 1; としてください。なお、実行時に
-uselockfile/-nolockfile オプションで、直接この機能をオン/オフにす
ることもできます。
※ 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のよ
うに、ロックファイルを作ってくれないものでは排他制御がうまくいかな
いかもしれません。
6. メールファイル生成後に 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 [-mailbox mboxfile] [+folder]
として起動すると、メールスプールからカレントディレクトリに落としてきま
す。mewls以外から起動した際に、誤って変なディレクトリにメールを取り込
んでしまうのを防ぐために、cwd() と ".*/folder$" とのマッチングを行ない
ます(デフォルトは inbox)。
メールスプールは、デフォルトでは $mailpath/$user になります($mailpath
はインストール時に設定したディレクトリ、$user はユーザ名)が、-mailbox
オプションでそれ以外のファイルを指定することもできます。
対応mbox形式はよくわかっていませんが :-)、imgetが扱える形式は大丈夫の
はずです。imgetと同様、特にunquoteはしません。
その他 ---------------------------------
mewlsは、田原俊一 <jado at example.com>が作成し、Mewに寄付しています。
著作権は主張しますが、改変・再配布等の条件はMewに準拠するものとします。
mewlsは、IM(imget)からかなりの部分を持ってきています。IMを作成された
IM development teamに感謝いたします。
mewlsを用いることによって、メールデータ消失等の不利益が生じても、作者
は一切の責任を取りません。
mewlsでは、元のIMに存在した、UNIX以外のOSに対応するコードは全部削って
しまっていますので、うまく動かない可能性が高いです。あらかじめご了承く
ださい。
Mew-dist メーリングリストの案内