[Mew-dist 05482] Re: About imstore
Nobuhiro Tsuchie
tsuchie at example.com
1998年 7月 11日 (土) 21:21:35 JST
いつもお世話になっています。土江と申します。
>>> Wed, 8 Jul 1998 13:57:56 +0900 の刻に 「田口」、すなわち
>>> taguchi at example.com(Taguchi Takeshi) 氏曰く
田口> ＃ immv と imrm に同様のからくりが存在すると完璧な
田口> ＃ 気がします．
>>>>> On Fri, 10 Jul 1998 00:18:27 +0900
>>>>> mokkun at example.com(Akihiro Motoki) said:
元木> ・immv や imrm ( imclean もか)を行ったときに、きちんとunseenから消す。
元木> Mew では refile や delete を(IMを利用せずに)自分で行うので、
元木> そっちでもインターフェースが必要である。
immv と imrm 用の各種パッチと、move.sbr を新規作成しました。添付します。
move.sbr を ~/.im に置き、~/.im/Config に MoveSbr=move.sbr と記述して下さい。
元木> ・pack や sort を行ったときはどうするのか？
元木> (これが一番むずかしいかも。IMでするのかMewでするか、それとも無視？)
元木> そういえば、マークの保存の話がありましたね。どうなったんでしょう。
まだ、対応してません。
土江 伸宏
tsuchie at example.com
-------------- next part --------------
# -*-Perl-*-
# A user customizable subroutine for immv and imrm.
# 'move_sub' is called if "MoveSbr=move.sbr" is specified in your "Config".
# The argments are the folder name, the start of the range, and the end
# of the range.
%hash = ();
sub move_sub ($@) {
my ($folder, @msgs) = @_;
my $dir = expand_path($folder);
my ($name, $val);
open(SEQ, "$dir/.mh_sequences") || return;
while (<SEQ>) {
chomp;
($name, $val) = split(': ');
$hash{$name} = " $val";
}
close(SEQ);
if (defined($hash{'unseen'})) {
foreach $msg (@msgs) {
@arts = split(' ', $hash{'unseen'});
$hash{'unseen'} = "";
foreach $art (@arts) {
if ($art =~ /[0-9]*-[0-9]*/) {
($pre, $post) = split(/-/,$art);
} else {
$pre = $art;
$post = $art;
}
if ($pre == $post) {
$hash{'unseen'} .= " $pre" if ($msg != $pre);
} else {
if ($msg == $pre) {
$msg1 = $msg + 1;
if ($msg1 == $post) {
$hash{'unseen'} .= " $post";
} else {
$hash{'unseen'} .= " $msg1-$post";
}
} elsif ($msg == $post) {
$msg1 = $msg - 1;
if ($pre == $msg1) {
$hash{'unseen'} .= " $pre";
} else {
$hash{'unseen'} .= " $pre-$msg1";
}
} elsif ($msg > $pre && $msg < $post) {
$msg1 = $msg - 1;
$msg2 = $msg + 1;
if ($pre == $msg1 && $msg2 == $post) {
$hash{'unseen'} .= " $pre $post";
} elsif ($pre == $msg1) {
$hash{'unseen'} .= " $pre $msg2-$post";
} elsif ($msg2 == $post) {
$hash{'unseen'} .= " $pre-$msg1 $post";
} else {
$hash{'unseen'} .= " $pre-$msg1 $msg2-$post";
}
} else {
$hash{'unseen'} .= " $pre-$post";
}
}
}
}
delete $hash{'unseen'} if (!$hash{'unseen'});
if (%hash) {
open(SEQ, ">$dir/.mh_sequences");
foreach (keys %hash) {
print SEQ "$_:$hash{$_}\n";
}
close (SEQ);
} else {
unlink("$dir/.mh_sequences");
}
}
}
1;
-------------- next part --------------
*** im-94/immv.in.bak Mon Jun 8 11:17:38 1998
--- im-94/immv.in Sat Jul 11 20:27:47 1998
***************
*** 86,91 ****
--- 86,92 ----
@msgs = @ARGV;
immv($opt_src, \@opt_dst, \@msgs);
+ &exec_movesbrfile($opt_src, @msgs);
exit $EXIT_SUCCESS;
##################################################
-------------- next part --------------
*** im-94/imrm.in.bak Mon Jun 8 11:17:43 1998
--- im-94/imrm.in Sat Jul 11 20:27:59 1998
***************
*** 84,89 ****
--- 84,90 ----
@msgs = @ARGV;
imrm($opt_src, \@opt_dst, \@msgs);
+ &exec_movesbrfile($opt_src, @msgs);
exit $EXIT_SUCCESS;
##################################################
-------------- next part --------------
*** im-94/IM.in/Config.pm.in.bak Wed May 6 15:10:53 1998
--- im-94/IM.in/Config.pm.in Sat Jul 11 20:30:07 1998
***************
*** 41,47 ****
folder_mode msg_mode allowcrlf no_sync
aliases_file context_file
address addresses_regex
! msgdbfile msgdbtype getsbrfile scansbrfile petnamefile
mbox_style
nntpservers nntphistoryfile
popaccount pophistoryfile imapaccount httpproxy noproxy
--- 41,47 ----
folder_mode msg_mode allowcrlf no_sync
aliases_file context_file
address addresses_regex
! msgdbfile msgdbtype getsbrfile movesbrfile scansbrfile petnamefile
mbox_style
nntpservers nntphistoryfile
popaccount pophistoryfile imapaccount httpproxy noproxy
***************
*** 105,110 ****
--- 105,111 ----
'msgdbtype;s;;MsgDBType' => 'Message database type',
'petnamefile;s;;PetNameFile' => 'PetName file',
'getsbr;s;;GetSbrFile' => 'Get hook subroutine script',
+ 'movesbr;s;;MoveSbrFile' => 'Move hook subroutine script',
'scansbr;s;;ScanSbrFile' => 'Scan hook subroutine script',
'mboxstyle;s;;MBoxStyle' => 'Style of local MBox format',
'nntpservers;s;;NNTPservers' => 'List of NNTP servers',
***************
*** 763,768 ****
--- 764,773 ----
sub getsbrfile () {
return &expand_path($GetSbrFile);
+ }
+
+ sub movesbrfile () {
+ return &expand_path($MoveSbrFile);
}
sub scansbrfile () {
-------------- next part --------------
*** im-94/IM.in/MsgStore.pm.in.bak Fri May 1 18:56:09 1998
--- im-94/IM.in/MsgStore.pm.in Sat Jul 11 20:30:21 1998
***************
*** 21,27 ****
require Exporter;
use Fcntl;
! use IM::Config qw(getsbrfile msg_mode msgdbfile expand_path no_sync);
use IM::Util;
use IM::Folder qw(message_number message_name create_folder touch_folder);
use IM::Header qw(gen_date);
--- 21,28 ----
require Exporter;
use Fcntl;
! use IM::Config qw(getsbrfile movesbrfile msg_mode msgdbfile expand_path
! no_sync);
use IM::Util;
use IM::Folder qw(message_number message_name create_folder touch_folder);
use IM::Header qw(gen_date);
***************
*** 30,36 ****
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
! @EXPORT = qw(store_message exec_getsbrfile open_fcc excl_create fsync);
=head1 NAME
--- 31,38 ----
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
! @EXPORT = qw(store_message exec_getsbrfile exec_movesbrfile open_fcc
! excl_create fsync);
=head1 NAME
***************
*** 215,220 ****
--- 217,246 ----
if ($@) {
im_warn("Form seems to be wrong.\nPerl error message is: $@");
}
+ }
+ return;
+ }
+
+ sub exec_movesbrfile ($@) {
+ my ($src, @msgs) = @_;
+ my $move_hook = movesbrfile();
+ if ($move_hook) {
+ if ($main::INSECURE) {
+ im_warn("Sorry, MoveSbr is ignored for SUID root script\n");
+ return;
+ }
+ if ($move_hook =~ /^(\S+)$/) {
+ $move_hook = $1; # to pass through taint check
+ if (-f $move_hook) {
+ require $move_hook;
+ } else {
+ im_err("move subroutine file $move_hook not found.\n");
+ }
+ }
+ eval { &move_sub($src, @msgs); };
+ if ($@) {
+ im_warn("Form seems to be wrong.\nPerl error message is: $@");
+ }
}
return;
}
Mew-dist メーリングリストの案内