Don Armstrong <d...@debian.org> writes:
Hi Don,
>> The get_bug_log operation of the SOAP API truncates some messages. For
>> example, look at the 4th message (indexing from 0) in bug 25235. In
>> the web interface,
>> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25235#17 , one can see
>> that the message has 2 parts, but the get_bug_log SOAP operation only
>> returns the first part.
>
> That's right; it's currently only returning the body and header of the
> mail messages, not the attachments. There probably should be an option
> to return all of them, but this particular interface isn't really the
> right way to do it.
Well, get_bug_log is already prepared to return the attachments, it just
returns an empty array for the time being. As proof of concept, I've
implemented attachments for this function, see attached patch. This
needs *much* more polishing. On debbugs.gnu.org, we run a very old
version of the debbugs software, so I needed to merge my changes into
the recent version from the debbugs git repository, and I couldn't test
that result. Furthermore, I did only some very short test runs (with the
example which triggered this bug report); I'm pretty sure the MIME
multipart handling needs much more attention.
Anyway, what do you think about?
Best regards, Michael.
diff --git a/Debbugs/MIME.pm b/Debbugs/MIME.pm
index fec3b6e..e2aea22 100644
--- a/Debbugs/MIME.pm
+++ b/Debbugs/MIME.pm
@@ -70,9 +70,9 @@ sub getmailbody
my $entity = shift;
my $type = $entity->effective_type;
if ($type eq 'text/plain' or
- ($type =~ m#text/?# and $type ne 'text/html') or
- $type eq 'application/pgp') {
- return $entity;
+ ($type =~ m#text/# and $type ne 'text/html') or
+ $type =~ m#application/pgp#) {
+ return $entity->bodyhandle;
} elsif ($type eq 'multipart/alternative') {
# RFC 2046 says we should use the last part we recognize.
for my $part (reverse $entity->parts) {
@@ -130,7 +130,7 @@ sub parse_to_mime_entity {
sub parse
{
# header and decoded body respectively
- my (@headerlines, @bodylines);
+ my (@headerlines, @bodylines, @attachments);
my $parser = MIME::Parser->new();
my $tempdir = tempdir(CLEANUP => 1);
@@ -151,6 +151,19 @@ sub parse
@bodylines = $entity_body_handle ? $entity_body_handle->as_lines() : ();
@bodylines = map {convert_to_utf8($_,$charset)} @bodylines;
chomp @bodylines;
+
+ if ($entity->is_multipart) {
+ @attachments = ();
+ my @parts = $entity->parts;
+ shift @parts;
+ for my $part (@parts) {
+ my $ret = getmailbody($part);
+ my @lines = $ret ? $ret->as_lines() : ();
+ chomp @lines;
+ shift @lines while @lines and $lines[0] !~ /\S/;
+ $attachments[$#attachments+1] = \@lines;
+ }
+ }
} else {
# Legacy pre-MIME code, kept around in case MIME::Parser fails.
my @msg = split /\n/, $_[0];
@@ -197,7 +210,9 @@ sub parse
map { s/^- // } @bodylines;
}
- return { header => [@headerlines], body => [@bodylines]};
+ return
+ {header => [@headerlines], body => [@bodylines],
+ attachments => \@attachments};
}
=head2 create_mime_message
diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm
index a0c3cbf..743848f 100644
--- a/Debbugs/SOAP.pm
+++ b/Debbugs/SOAP.pm
@@ -84,7 +84,7 @@ sub get_usertag {
use Debbugs::Status;
-=head2 get_status
+=head2 get_status
my @statuses = get_status(@bugs);
my @statuses = get_status([bug => 304234,
@@ -249,9 +249,12 @@ sub get_bug_log{
my $message = parse($record->{text});
my ($header,$body) = map {join("\n",make_list($_))}
@{$message}{qw(header body)};
+ my @attachments = map {join("\n",make_list($_))}
+ make_list (@{$message}{qw(attachments)});
+ @attachments = [] unless @attachments;
push @messages,{header => $header,
body => $body,
- attachments => [],
+ attachments => @attachments,
msg_num => $current_msg,
};
}
