[Mew-dist 1685] concatination of partial messages (patch for IM-65)

Motonori Nakamura motonori at example.com
1997年 8月 27日 (水) 20:18:03 JST


message/partial なメッセージを imcat で結合するためのパッチです。
分割されたメッセージがどれであるか、という情報は MsgDB に格納
されますので、MsgDB を有効にしておかないと機能しません。
このパッチを当ると、imget した際に、自動的に情報が登録されますので、
このパッチを当てた後なら、とりたてて新たな操作は必要ありません。
すでに、フォルダに取り込まれてしまったメッセージを結合する
ためには、一度 imhist --add=+inbox などで、MsgDB に
必要な情報を追加させてください。

結合して表示するには、imcat --join +inbox 12 のように、--join を
指定します。指定するメッセージは、何番目の partial message でも
構いません。

あとは、mew で partial なメッセージを表示している時に、何かの
キーを押すと、imcat を呼び出して結合し、MIME の解析をする
というような機能がつけば OK でしょうか。

なお、- なフォルダや % なフォルダへの対応は今後の課題です ^^;

あと、このパッチは imput の multipart/partial なメッセージの送出に
関するバグの fix も含んでいます。

とりあえず動くことを目指したおおざっぱなコードなので、あら探し歓迎です ^^;

- motonori


diff -ur ../im-65-/IM.in/History.pm.in ./IM.in/History.pm.in
--- ../im-65-/IM.in/History.pm.in	Mon Aug 25 15:04:27 1997
+++ ./IM.in/History.pm.in	Wed Aug 27 19:38:05 1997
@@ -143,7 +143,7 @@
 	return ();
     }
     my ($msgid, $field) = @_;
-    $msgid =~ s/<(.*)>/$1/;
+    $msgid =~ s/^<(.*)>$/$1/;
     if (defined($History{$msgid})) {
 	if ($field == LookUpAll) {
 	    return split("\t", $History{$msgid});
@@ -166,7 +166,7 @@
 	return -1;
     }
     my ($msgid, $folder) = @_;
-    $msgid =~ s/<(.*)>/$1/;
+    $msgid =~ s/^<(.*)>$/$1/;
     im_notice("add to history: $msgid\t$folder\n");
     if (defined($History{$msgid})) {
 	my ($ofolder) = split("\t", $History{$msgid});
@@ -184,7 +184,7 @@
 	return -1;
     }
     my ($msgid, $folder) = @_;
-    $msgid =~ s/<(.*)>/$1/;
+    $msgid =~ s/^<(.*)>$/$1/;
     if (defined($History{$msgid})) {
 	if ($folder ne '') {
 	    my ($f) = split("\t", $History{$msgid});
diff -ur ../im-65-/IM.in/Message.pm.in ./IM.in/Message.pm.in
--- ../im-65-/IM.in/Message.pm.in	Tue Aug 26 09:43:06 1997
+++ ./IM.in/Message.pm.in	Wed Aug 27 19:26:18 1997
@@ -62,8 +62,9 @@
 @Week_str = qw(Sun Mon Tue Wed Thu Fri Sat);
 @Month_str = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 
-sub cur_time {
-    return $Cur_time if ($Cur_time);
+sub cur_time ($) {
+    my $part = shift;
+    return $Cur_time if ($Cur_time && $part == 0);
     return $Cur_time = time;
 }
 
@@ -77,7 +78,7 @@
     my $part = shift;
     return $Mid_hist{$part} if ($part > 0 && $Mid_hist{$part});
     local ($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year)
-	= localtime(&cur_time);
+	= localtime(&cur_time($part));
     local ($mid_time) = sprintf("%d%02d%02d%02d%02d%02d",
 	$tm_year+1900, $tm_mon+1, $tm_mday, $tm_hour, $tm_min, $tm_sec);
     local ($mid_rnd) = sprintf("%c", 0x41 + rand(26));
@@ -114,18 +115,18 @@
 	$tm_wk, $tm_yday, $tm_tz);
     if ($main::NewsGMTdate && $main::News_flag) {
 	($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year,
-	    $tm_wk, $tm_yday) = gmtime(&cur_time);
+	    $tm_wk, $tm_yday) = gmtime(&cur_time(0));
 	$tm_tz = 'GMT';
     } else {
 	($tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year,
-	  $tm_wk, $tm_yday) = localtime(&cur_time);
+	  $tm_wk, $tm_yday) = localtime(&cur_time(0));
 	my $off;
 	if ($ENV{'TZ'} =~ /(\w\w\w)([-+]\d+)/) {
 	    $tm_tz = $1;
 	    $off = - $2*60;
 	} else {
 	    my ($gm_sec, $gm_min, $gm_hour, $gm_mday, $gm_mon,
-	      $gm_year, $gm_wk, $gm_yday) = gmtime(&cur_time);
+	      $gm_year, $gm_wk, $gm_yday) = gmtime(&cur_time(0));
 	    $off = ($tm_hour - $gm_hour) * 60 + $tm_min - $gm_min;
 	    if ($tm_year < $gm_year) {
 		$off -= 24 * 60;
@@ -639,8 +640,10 @@
 
 ##### GENERATE MIMED-BCC #####
 #
-# put_mimed_bcc(channel, protocol, header, hidden_dot, part, total)
+# put_mimed_bcc(channel, header, body, protocol, hidden_dot, part, total)
 #	channel: socket/file descriptor to write out
+#	header: message header
+#	bory: message body
 #	hidden_dot: hidden dot algorithm is used if true
 #	part: part number to be sent in partial message mode
 #	total: total number of partial messages
@@ -648,7 +651,7 @@
 #		 0: success
 #		-1: failure
 #
-sub put_mimed_bcc (*$$$$$) {
+sub put_mimed_bcc (*$$$$$$) {
     local *CHAN = shift;
     my ($Header, $Body, $proto, $hidden_dot, $part, $total) = @_;
     my $subj;
@@ -694,8 +697,10 @@
 
 ##### GENERATE PARTIAL/MIME #####
 #
-# put_mimed_partial(channel, protocol, hidden_dot, part, total)
+# put_mimed_partial(channel, header, body, protocol, hidden_dot, part, total)
 #	channel: socket/file descriptor to write out
+#	header: message header
+#	bory: message body
 #	hidden_dot: hidden dot algorithm is used if true
 #	part: part number to be sent in partial message mode
 #	total: total number of partial messages
@@ -706,6 +711,7 @@
 sub put_mimed_partial (*$$$$$$) {
     local *CHAN = shift;
     my ($Header, $Body, $proto, $hidden_dot, $part, $total) = @_;
+    my $crlf = &crlf;
 
     return -1 if (&put_header(\*CHAN, $Header, $proto, 'partial:ext') < 0);
     if ($main::Generate_message_id) {
@@ -730,9 +736,16 @@
 
 ##### GENERATE MIMED ERROR NOTIFY #####
 #
-# put_mimed_error_notify(channel, header, body, recipients, status, hidden_dot)
+# put_mimed_error_notify(channel, header, body, recipients, status, protocol,
+#			hidden_dot, session_log)
 #	channel: socket/file descriptor to write out
+#	header: message header
+#	bory: message body
+#	recipients:
+#	status:
+#	protocol:
 #	hidden_dot: hidden dot algorithm is used if true
+#	session_log: logged messaged when error occurs
 #	return value: (XXX)
 #		 0: success
 #		-1: failure
diff -ur ../im-65-/IM.in/MsgStore.pm.in ./IM.in/MsgStore.pm.in
--- ../im-65-/IM.in/MsgStore.pm.in	Sun Aug 24 16:56:18 1997
+++ ./IM.in/MsgStore.pm.in	Wed Aug 27 18:44:31 1997
@@ -146,13 +146,25 @@
 #	    }
 	}
 
+	# XXX should be optimized
 	my $mid = &header_value(\@Hdr, 'Message-ID');
 #	my $dt = &header_value(\@Hdr, 'Date');
+	(my $ver = &header_value(\@Hdr, 'Mime-Version')) =~ s/\s//g;
+	my $master = '';
+	if ($ver eq '1.0') {
+	    my $ct = &header_value(\@Hdr, 'Content-Type') . ';';
+	    $ct =~ s/\s//g;
+	    if ($ct =~ m|^Message/partial;(.*;)?id=([^;]+);|i) {
+		$master = $2;
+		$master =~ s/^"(.*)"$/$1/;
+	    }
+	}
 	if (&msgdbfile() ne '' && $mid ne '') {
 	    require IM::History && import IM::History;
 
 	    unless (open_history(1) < 0) {
 		store_history($mid, $file);
+		store_history("partial:$master", $mid) if ($master ne '');
 		close_history();
 	    }
 	}
diff -ur ../im-65-/imcat.in ./imcat.in
--- ../im-65-/imcat.in	Tue Aug 26 19:54:31 1997
+++ ./imcat.in	Wed Aug 27 20:02:45 1997
@@ -44,6 +44,7 @@
 
 @OptConfig = (
     'src;F;;'         => "Folder.",
+    'join;b;;'        => "join partial messages.",
     'help;b;;'        => "Show this message.",
     'debug;b;;'       => "debug mode.",
     'verbose;b;;'     => "verbose mode.",
@@ -69,7 +70,7 @@
 $msg = $ARGV[0];
 
 unless ($msg) {
-	im_die("no message specified.\n");
+    im_die("no message specified.\n");
 }
 
 if ($msg =~ /^http:/i) {
@@ -89,8 +90,8 @@
 	require IM::History && import IM::History;
 
 	if (open_history(0) < 0) {
-		im_die("can not open history.\n");
-		exit $EXIT_ERROR;
+	    im_die("can not open history.\n");
+	    exit $EXIT_ERROR;
 	}
 	my $msg = lookup_history($msg, LookUpMsg);
 	close_history();
@@ -98,6 +99,7 @@
 	    im_info("message is not found.\n");
 	    exit $EXIT_ERROR;
 	}
+	&join_msg($msg) if ($opt_join);
 	foreach (split(',', $msg)) {
 	    my $path = &expand_path($_);
 	    if (open(MSG, "<$path")) {
@@ -113,6 +115,7 @@
 	exit $EXIT_ERROR;
     } else {
 	my $path = &message_name($opt_src, $msg);
+	&join_msg($path) if ($opt_join);
 	if (open(MSG, "<$path")) {
 	    while (<MSG>) {
 		print;
@@ -179,6 +182,158 @@
 }
 
 exit $EXIT_SUCCESS;
+
+sub join_msg ($) {
+    my $msg = shift;
+    local $_;
+    require IM::History && import IM::History;
+
+    # get master Message-ID
+    my $header = '';
+    foreach (split(',', $msg)) {
+	if (/^\+/) {
+	    $path = &expand_path($_);
+	} else {
+	    $path = $_;
+	}
+	if (open(MSG, "<$path")) {
+	    $/ = "\n\n";
+	    $header = <MSG>;
+	    $/ = "\n";
+	    close(MSG);
+	    last;
+	}
+    }
+
+    if ($header eq '') {
+	im_err("specified message is not found at $path.\n");
+	exit $EXIT_ERROR;
+    }
+
+    $header =~ s/\n\s+//g;
+    $header =~ s/[ \t]+//g;
+    $header =~ s/\n/;\n/g;
+    $header = "\n$header";
+
+    my $master = '';
+
+    if ($header =~ m|\nContent-Type:Message/partial;(.*;)?id=([^;]+);|i) {
+	$master = $2;
+	$master =~ s/^"(.*)"$/$1/;
+    } else {
+	im_err("specified message is not a partial.\n");
+	exit $EXIT_ERROR;
+    }
+    im_notice("Master Message-ID: $master.\n");
+
+    # get Message-IDs of partial
+    if (open_history(0) < 0) {
+	im_err("can not open history.\n");
+	exit $EXIT_ERROR;
+    }
+    my $ids = lookup_history("partial:$master", LookUpMsg);
+    if ($ids eq '') {
+	im_err("information on partial messages is not found in history.\n");
+	exit $EXIT_ERROR;
+    }
+    im_notice("partial Message-IDs: $ids.\n");
+
+    # get path and part number on each part
+    my @paths;
+    my $total = 0;
+    foreach (split(',', $ids)) {
+	my $locate = lookup_history($_, LookUpMsg);
+	if ($locate eq '') {
+	    im_warn("message $_ not found, skipping.\n");
+	    next;
+	}
+	my $path = &expand_path($locate);
+	if ($path eq '') {
+	    im_warn("no path for message $locate, skipping.\n");
+	    next;
+	}
+	if (open(MSG, "<$path")) {
+	    $/ = "\n\n";
+	    $header = <MSG>;
+	    $/ = "\n";
+	    close(MSG);
+	}
+
+	$header =~ s/\n\s+//g;
+	$header =~ s/[ \t]+//g;
+	$header =~ s/\n/;\n/g;
+	$header = "\n$header";
+
+	my $number = 0;
+	my $this_total = 0;
+	if ($header =~ /\nContent-Type:Message\/partial(;[^\n]+)\n/i) {
+	    my $rest = $1;
+	    if ($rest =~ /;number=(\d+);/i) {
+		$number = $1;
+	    }
+	    if ($rest =~ /;total=(\d+);/i) {
+		$this_total = $1;
+	    }
+	}
+	if ($number == 0 || $this_total == 0) {
+	    im_warn("$_: not a partial message, skipping.\n");
+	    next;
+	}
+	if ($total) {
+	    if ($total != $this_total) {
+		im_warn("$_: total of partial messages mismatch, skipping.\n");
+		next;
+	    }
+	} else {
+	    $total = $this_total;
+	}
+	$paths[$number] = $path;
+	im_notice("$path is part $number.\n");
+    }
+    close_history();
+
+    # check existance of all partial messages
+    my $missing = 0;
+    my $i;
+    for ($i = 1; $i <= $#paths; $i++) {
+	if ($paths[$i] eq '') {
+	    im_err("part $i is missing.\n");
+	    exit $EXIT_SUCCESS;
+	}
+    }
+
+    # show in sequence
+    for ($i = 1; $i <= $#paths; $i++) {
+	if (open(MSG, "<$paths[$i]")) {
+	    $/ = "\n\n";
+	    if ($i == 1) {
+		my $header = <MSG>;
+		my $skip = 0;
+		foreach (split("\n", $header)) {
+		    next if (/^[ \t]/ && $skip);
+		    $skip = 0;
+		    if (/^(Content|Message-ID)/i) {
+			$skip = 1;
+			next;
+		    }
+		    last if (/^\n/);
+		    print "$_\n";
+		}
+	    } else {
+		# skip header part
+		<MSG>;
+	    }
+	    $/ = "\n";
+	    while (<MSG>) {
+		print;
+	    }
+	    close(MSG);
+	}
+    }
+
+    exit $EXIT_SUCCESS;
+}
+
 
 ### Local Variables:
 ### mode: perl
diff -ur ../im-65-/imhist.in ./imhist.in
--- ../im-65-/imhist.in	Sun Aug 24 16:56:18 1997
+++ ./imhist.in	Wed Aug 27 19:27:58 1997
@@ -132,11 +132,22 @@
     my ($path, $msg) = @_;
     local (@Hdr) = ();
     if (open(MSG, "<$path")) {
-	read_header(\@MSG, \@Hdr, 0);
+	&read_header(\*MSG, \@Hdr, 0);
 	my $mid = &header_value(\@Hdr, 'Message-ID');
 #	my $dt = &header_value(\@Hdr, 'Date');
-	if ($mid ne "") {
+	(my $ver = &header_value(\@Hdr, 'Mime-Version')) =~ s/\s//g;
+	my $master = '';
+	if ($ver eq '1.0') {
+	    my $ct = &header_value(\@Hdr, 'Content-Type') . ';';
+	    $ct =~ s/\s//g;
+	    if ($ct =~ m|^Message/partial;(.*;)?id=([^;]+);|i) {
+		$master = $2;
+		$master =~ s/^"(.*)"$/$1/;
+	    }
+	}
+	if ($mid ne '') {
 	    store_history($mid, $msg);
+	    store_history("partial:$master", $mid) if ($master ne '');
 	}
 	close (MSG);
 	return 0;
diff -ur ../im-65-/man/imput ./man/imput
--- ../im-65-/man/imput	Sat Aug  9 11:48:27 1997
+++ ./man/imput	Wed Aug 27 16:05:28 1997
@@ -31,7 +31,7 @@
   (/file is a path of local file and addresses described in the file is
   read and mail is sent aiming at those addresses. The address will be
   rewritten into "group:;" form.)
-* A big size message is divided into MIME Message/partial form (RFC2045).
+* A big size message can be divided into MIME Message/partial form (RFC2045).
 * Aliasing for mail addresses at individual level is supported (like MH). 
 * Aliasing for domain part of addresses at individual level is supported.
   (hostalias form of BIND.)
diff -ur ../im-65-/man/imput.jis ./man/imput.jis
--- ../im-65-/man/imput.jis	Sun Aug 10 00:26:56 1997
+++ ./man/imput.jis	Wed Aug 27 16:05:16 1997
@@ -28,7 +28,8 @@
 o "group:/file;" (非標準) 形式のアドレスが利用できます。
   (/file に記述されたメールアドレスを読み込み、それらのアドレスに向けて
   メールを発信します。ヘッダは group:; に書き換えられます。)
-o サイズの大きなメッセージは MIME Message/partial 形式 (RFC2045) で分割します。
+o サイズの大きなメッセージは MIME Message/partial 形式 (RFC2045) で分割
+  させることができます。
 o 個人レベルのメールアドレスのエイリアスをサポートします。
   (MH の alias 形式)
 o 個人レベルのドメインパートのエイリアスをサポートします。



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