MIME-tools
Mariano Absatz
mailscanner at LISTS.COM.AR
Fri Mar 7 16:16:39 GMT 2003
Hi,
I know this is an old one... but I have a couple of doubts about MIME-tools.
For what I read, I don't want new versions of it, fine.
When I browse in CPAN, I find 2 versions:
5.411a (dated 16/11/2001)
5.411 (dated 5/6/2001)
I download them both... and find no difference, whatsoever (diff -rc)
Is that a packaging problem? anybody knows?
The other thing I see is that you provide 4 important security patches at:
http://www.sng.ecs.soton.ac.uk/mailscanner/install/mime-tools-patch.txt
http://www.sng.ecs.soton.ac.uk/mailscanner/install/mime-tools-patch2.txt
http://www.sng.ecs.soton.ac.uk/mailscanner/install/mime-tools-patch3.txt
http://www.sng.ecs.soton.ac.uk/mailscanner/install/mime-tools-patch4.txt
Now, why don't you combine them into just one? like the one I'm attaching?
The result should be the same and it's easier to do, isn't it?
TIA
--
Mariano Absatz
El Baby
----------------------------------------------------------
Error, no keyboard - press F1 to continue.
-------------- next part --------------
diff -rc MIME-tools-5.411/lib/MIME/Field/ParamVal.pm MIME-tools-5.411-patched4/lib/MIME/Field/ParamVal.pm
*** MIME-tools-5.411/lib/MIME/Field/ParamVal.pm Sat Nov 4 16:54:49 2000
--- MIME-tools-5.411-patched4/lib/MIME/Field/ParamVal.pm Fri Mar 7 12:44:10 2003
***************
*** 9,50 ****
=head1 SYNOPSIS
# Create an object for a content-type field:
! $field = new Mail::Field 'Content-type';
!
# Set some attributes:
$field->param('_' => 'text/html');
$field->param('charset' => 'us-ascii');
$field->param('boundary' => '---ABC---');
!
# Same:
$field->set('_' => 'text/html',
'charset' => 'us-ascii',
'boundary' => '---ABC---');
!
# Get an attribute, or undefined if not present:
print "no id!" if defined($field->param('id'));
!
# Same, but use empty string for missing values:
print "no id!" if ($field->paramstr('id') eq '');
!
# Output as string:
print $field->stringify, "\n";
=head1 DESCRIPTION
! This is an abstract superclass of most MIME fields. It handles
fields with a general syntax like this:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Comments are supported I<between> items, like this:
Content-Type: Message/Partial; (a comment)
! number=2 (another comment) ; (yet another comment) total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
=head1 PUBLIC INTERFACE
--- 9,50 ----
=head1 SYNOPSIS
# Create an object for a content-type field:
! $field = new Mail::Field 'Content-type';
!
# Set some attributes:
$field->param('_' => 'text/html');
$field->param('charset' => 'us-ascii');
$field->param('boundary' => '---ABC---');
!
# Same:
$field->set('_' => 'text/html',
'charset' => 'us-ascii',
'boundary' => '---ABC---');
!
# Get an attribute, or undefined if not present:
print "no id!" if defined($field->param('id'));
!
# Same, but use empty string for missing values:
print "no id!" if ($field->paramstr('id') eq '');
!
# Output as string:
print $field->stringify, "\n";
=head1 DESCRIPTION
! This is an abstract superclass of most MIME fields. It handles
fields with a general syntax like this:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Comments are supported I<between> items, like this:
Content-Type: Message/Partial; (a comment)
! number=2 (another comment) ; (yet another comment) total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
=head1 PUBLIC INTERFACE
***************
*** 100,105 ****
--- 100,108 ----
# token = 1*<any (ASCII) CHAR except SPACE, CTLs, or tspecials>
#
my $TSPECIAL = '()<>@,;:\</[]?="';
+
+ #" Fix emacs highlighting...
+
my $TOKEN = '[^ \x00-\x1f\x80-\xff' . "\Q$TSPECIAL\E" . ']+';
# Encoded token:
***************
*** 108,113 ****
--- 111,119 ----
# Pattern to match spaces or comments:
my $SPCZ = '(?:\s|\([^\)]*\))*';
+ # Pattern to match non-semicolon as fallback for broken MIME
+ # produced by some viruses
+ my $BADTOKEN = '[^;]+';
#------------------------------
#
***************
*** 133,139 ****
'total' => 3,
'id' => "ocj=pbe0M2");
! Note that a single argument is taken to be a I<reference> to
a paramhash, while multiple args are taken to be the elements
of the paramhash themselves.
--- 139,145 ----
'total' => 3,
'id' => "ocj=pbe0M2");
! Note that a single argument is taken to be a I<reference> to
a paramhash, while multiple args are taken to be the elements
of the paramhash themselves.
***************
*** 160,175 ****
it as a hash reference. For example, here is a field with parameters:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Here is how you'd extract them:
$params = $class->parse_params('content-type');
if ($$params{'_'} eq 'message/partial') {
! $number = $$params{'number'};
! $total = $$params{'total'};
! $id = $$params{'id'};
}
Like field names, parameter names are coerced to lowercase.
--- 166,181 ----
it as a hash reference. For example, here is a field with parameters:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Here is how you'd extract them:
$params = $class->parse_params('content-type');
if ($$params{'_'} eq 'message/partial') {
! $number = $$params{'number'};
! $total = $$params{'total'};
! $id = $$params{'id'};
}
Like field names, parameter names are coerced to lowercase.
***************
*** 181,190 ****
--- 187,226 ----
=cut
+ sub rfc2231decode {
+ my($val) = @_;
+ my($enc, $lang, $rest);
+
+ if ($val =~ m/^([^\']*)\'([^\']*)\'(.*)$/) {
+ # SHOULD REALLY DO SOMETHING MORE INTELLIGENT WITH ENCODING!!!
+ $enc = $1;
+ $lang = $2;
+ $rest = $3;
+ $rest = rfc2231percent($rest);
+ } elsif ($val =~ m/^([^\']*)\'([^\']*)$/) {
+ $enc = $1;
+ $rest = $2;
+ $rest = rfc2231percent($rest);
+ } else {
+ $rest = rfc2231percent($val);
+ }
+ return $rest;
+ }
+
+ sub rfc2231percent {
+ # Do percent-subsitution
+ my($str) = @_;
+ $str =~ s/%([0-9a-fA-F]{2})/pack("c", hex($1))/ge;
+ return $str;
+ }
+
sub parse_params {
my ($self, $raw) = @_;
my %params = ();
+ my %rfc2231params = ();
my $param;
+ my $val;
+ my $part;
# Get raw field, and unfold it:
defined($raw) or $raw = '';
***************
*** 200,208 ****
$raw =~ m/\G$SPCZ\;$SPCZ/og or last; # skip leading separator
$raw =~ m/\G($PARAMNAME)\s*=\s*/og or last; # give up if not a param
$param = lc($1);
! $raw =~ m/\G(\"([^\"]+)\")|\G($TOKEN)|\G($ENCTOKEN)/g or last; # give up if no value
! my ($qstr, $str, $token, $enctoken) = ($1, $2, $3, $4);
! $params{$param} = defined($qstr) ? $str : (defined($token) ? $token : $enctoken);
debug " field param <$param> = <$params{$param}>";
}
--- 236,282 ----
$raw =~ m/\G$SPCZ\;$SPCZ/og or last; # skip leading separator
$raw =~ m/\G($PARAMNAME)\s*=\s*/og or last; # give up if not a param
$param = lc($1);
! $raw =~ m/\G(\"([^\"]+)\")|\G($ENCTOKEN)|\G($BADTOKEN)|\G($TOKEN)/g or last; # give up if no value"
! my ($qstr, $str, $enctoken, $badtoken, $token) = ($1, $2, $3, $4, $5);
! if (defined($badtoken)) {
! # Strip leading/trailing whitespace from badtoken
! $badtoken =~ s/^\s*//;
! $badtoken =~ s/\s*$//;
! }
! $val = defined($qstr) ? $str :
! (defined($enctoken) ? $enctoken :
! (defined($badtoken) ? $badtoken : $token));
!
! # Do RFC 2231 processing
! if ($param =~ /\*/) {
! my($name, $num);
! # Pick out the parts of the parameter
! if ($param =~ m/^([^*]+)\*([^*]+)\*?$/) {
! # We have param*number* or param*number
! $name = $1;
! $num = $2;
! } else {
! # Fake a part of zero... not sure how to handle this properly
! $param =~ s/\*//g;
! $name = $param;
! $num = 0;
! }
! # Decode the value unless it was a quoted string
! if (!defined($qstr)) {
! $val = rfc2231decode($val);
! }
! $rfc2231params{$name}{$num} .= $val;
! } else {
! # Make a fake "part zero" for non-RFC2231 params
! $rfc2231params{$param}{"0"} = $val;
! }
! }
!
! # Extract reconstructed parameters
! foreach $param (keys %rfc2231params) {
! foreach $part (sort { $a <=> $b } keys %{$rfc2231params{$param}}) {
! $params{$param} .= $rfc2231params{$param}{$part};
! }
debug " field param <$param> = <$params{$param}>";
}
***************
*** 227,233 ****
# Allow use as constructor, for MIME::Head:
ref($self) or $self = bless({}, $self);
!
# Get params, and stuff them into the self object:
$self->set($self->parse_params($string));
}
--- 301,307 ----
# Allow use as constructor, for MIME::Head:
ref($self) or $self = bless({}, $self);
!
# Get params, and stuff them into the self object:
$self->set($self->parse_params($string));
}
diff -rc MIME-tools-5.411/lib/MIME/Parser.pm MIME-tools-5.411-patched4/lib/MIME/Parser.pm
*** MIME-tools-5.411/lib/MIME/Parser.pm Sun Nov 12 02:55:11 2000
--- MIME-tools-5.411-patched4/lib/MIME/Parser.pm Fri Mar 7 12:44:47 2003
***************
*** 378,393 ****
=item extract_nested_messages OPTION
I<Instance method.>
! Some MIME messages will contain a part of type C<message/rfc822>:
literally, the text of an embedded mail/news/whatever message.
This option controls whether (and how) we parse that embedded message.
If the OPTION is false, we treat such a message just as if it were a
C<text/plain> document, without attempting to decode its contents.
! If the OPTION is true (the default), the body of the C<message/rfc822>
! part is parsed by this parser, creating an entity object.
! What happens then is determined by the actual OPTION:
=over 4
--- 378,394 ----
=item extract_nested_messages OPTION
I<Instance method.>
! Some MIME messages will contain a part of type C<message/rfc822>
! or C<message/partial> or C<message/external-body>:
literally, the text of an embedded mail/news/whatever message.
This option controls whether (and how) we parse that embedded message.
If the OPTION is false, we treat such a message just as if it were a
C<text/plain> document, without attempting to decode its contents.
! If the OPTION is true (the default), the body of the C<message/rfc822>
! or C<message/partial> part is parsed by this parser, creating an
! entity object. What happens then is determined by the actual OPTION:
=over 4
***************
*** 592,597 ****
--- 593,599 ----
#
# I<Instance method.>
# Process and return the next header.
+ # Return undef if, instead of a header, the encapsulation boundary is found.
# Fatal exception on failure.
#
sub process_header {
***************
*** 612,617 ****
--- 614,623 ----
foreach (@headlines) { s/[\r\n]+\Z/\n/ } ### fold
### How did we do?
+ if ($hdr_rdr->eos_type eq 'DELIM') {
+ $self->whine("bogus part, without CRLF before body");
+ return;
+ }
($hdr_rdr->eos_type eq 'DONE') or
$self->error("unexpected end of header\n");
***************
*** 983,989 ****
### Parse and add the header:
my $head = $self->process_header($in, $rdr);
! $ent->head($head);
### Tweak the content-type based on context from our parent...
### For example, multipart/digest messages default to type message/rfc822:
--- 989,1005 ----
### Parse and add the header:
my $head = $self->process_header($in, $rdr);
! if (not defined $head) {
! $self->debug("bogus empty part");
! $head = $self->interface('HEAD_CLASS')->new;
! $head->mime_type('text/plain; charset=US-ASCII');
! $ent->head($head);
! $ent->bodyhandle($self->new_body_for($head));
! $ent->bodyhandle->open("w")->close;
! $self->results->level(-1);
! return $ent;
! }
! $ent->head($head);
### Tweak the content-type based on context from our parent...
### For example, multipart/digest messages default to type message/rfc822:
***************
*** 997,1004 ****
if ($type eq 'multipart') {
$self->process_multipart($in, $rdr, $ent);
}
! elsif (("$type/$subtype" eq "message/rfc822") &&
! $self->extract_nested_messages) {
$self->debug("attempting to process a nested message");
$self->process_message($in, $rdr, $ent);
}
--- 1013,1022 ----
if ($type eq 'multipart') {
$self->process_multipart($in, $rdr, $ent);
}
! elsif (("$type/$subtype" eq "message/rfc822" ||
! "$type/$subtype" eq "message/external-body" ||
! ("$type/$subtype" eq "message/partial" && $head->mime_attr("content-type.number") == 1)) &&
! $self->extract_nested_messages) {
$self->debug("attempting to process a nested message");
$self->process_message($in, $rdr, $ent);
}
diff -rc MIME-tools-5.411/lib/MIME/Words.pm MIME-tools-5.411-patched4/lib/MIME/Words.pm
*** MIME-tools-5.411/lib/MIME/Words.pm Fri Nov 10 13:45:12 2000
--- MIME-tools-5.411-patched4/lib/MIME/Words.pm Fri Mar 7 12:44:10 2003
***************
*** 186,192 ****
$@ = ''; ### error-return
### Collapse boundaries between adjacent encoded words:
! $encstr =~ s{(\?\=)\r?\n[ \t](\=\?)}{$1$2}gs;
pos($encstr) = 0;
### print STDOUT "ENC = [", $encstr, "]\n";
--- 186,192 ----
$@ = ''; ### error-return
### Collapse boundaries between adjacent encoded words:
! $encstr =~ s{(\?\=)\s*(\=\?)}{$1$2}gs;
pos($encstr) = 0;
### print STDOUT "ENC = [", $encstr, "]\n";
More information about the MailScanner
mailing list