1 #! /usr/bin/perl

     2 use strict;

     3 use warnings;

     4 

     5 use File::Temp qw(tempfile);

     6 use Smart::Comments;

     7 

     8 sub pass_mime($);

     9 sub forward_to_boundary($*);

    10 sub read_header(*);

    11 

    12 MAIN: {

    13     my $message = tempfile();

    14     my $out     = tempfile();

    15 

    16     select $out or die "Can't select: $!\n";

    17 

    18     # read the message into our tmp file

    19     {

    20         local $/ = \102400;

    21         print {$message} <>;

    22         chmod 0400, $message or die "Can't fchmod on tmpfile: $!\n";

    23     }

    24 

    25     seek($message, 0, 0);

    26     my %header = read_header $message;

    27 

    28 

    29 BODY: {

    30 last BODY;

    31 

    32         if (!$header{"mime-version"}) {

    33             warn "no mime-version in header\n";

    34             last BODY;

    35         }

    36 

    37         if (!$header{"content-type"}) {

    38             warn "no content-type in header\n";

    39             last BODY;

    40         }

    41 

    42 	if (pass_mime($header{"content-type"})) {

    43 	    warn "passing message ($header{'content-type'})\n";

    44 	    last BODY;

    45 	}

    46 

    47 	# looks more complicated

    48 

    49         my (undef, $boundary)

    50             = ($header{"content-type"} =~ /boundary=(["'])(.*?)\1/);

    51 

    52         if (!$boundary) {

    53             warn "no boundary in content-type\n";

    54             last BODY;

    55         }

    56 

    57 	### boundary: $boundary

    58 

    59 	$_ = forward_to_boundary($boundary, $message);

    60 

    61     }

    62     print <$message>;    # the rest

    63 

    64     # nun das TMP-File auch ausgeben

    65     select STDOUT;

    66     seek($out, 0, 0);

    67     print while <$out>;

    68 

    69 }

    70 

    71 sub forward_to_boundary($*) {

    72     my ($b, $fh) = @_;

    73     while (<$fh>) {

    74 	print;

    75 	return if /^--$b/;

    76     }

    77 }

    78 

    79 sub pass_mime($) {

    80     return $_[0] =~ m{^text/plain};

    81 }

    82 

    83 sub read_header(*) {

    84     my $msg = shift;

    85 

    86     local $/ = "";

    87     local $_ = <$msg>;

    88 

    89     print;

    90 

    91     s/\r?\n\s+/ /gm;       # FIXME: decode quoted printable

    92     s/^(\S+):/\L$1:/gm;    # header fields to lower case

    93 

    94     return (":UNIX_FROM:" => split(/^(\S+):\s*/m, $_) );

    95 

    96 }

    97 __END__

    98 

    99 my $parser = new MIME::Parser;

   100 

   101 # read the complete mail

   102 my $entity = $parser->parse(\*STDIN);