procmail
[Top] [All Lists]

Re: Has anyone written a procmail filter to remove vcards?

1998-05-13 16:01:07
On Mon May 11, 1998 at 12:33:05PM -0400, Stan Brown wrote:

      I have no idea what they are, but an anoyingly large percentag of the
      message I get on some lists lately have a section that looks likle
      this:

      begin:          vcard

      ... Lot's of garbage

      end:                    vcard

It should be some kind of personal identification for crappy M$ software.

      These show up as a totaly different section in my version of elm that
      is configured to handle MIME.

Yes, it's usually sent as an MIME-Attachment / Multipart.

      Does anyone have a handy procmail recipe to strip these out of the
      incoming mails?

I hacked a little Perlscript today, perhaps it fits your needs.
Use Procmail to detect the mails which contain any vcard-attachment
and pipe it through the script. The `Lines:' and `Content-Length:'
Headerlines are corrected, according to the stuff that will be cut
away from the mail-body.

Here it comes, quick and dirty, please correct it if there are 
any bugs or if you have any ideas to enhance it:

------------------------>

#! /usr/bin/perl
#
# cuts off the boring vcard-attachments  
#
# (c)(w) May-13-1998 by Heinz Diehl <hd(_at_)elfie(_dot_)rhein-neckar(_dot_)de>
#
# $Id: delvcard.pl,v 1.1 1998/05/13 22:38:01 hd Exp hd $
#

while (<>) {
    chomp;
    if (/^Content-Length:\s*(\d+)/) { $clen = $1; }
    if (/^Lines:\s*(\d+)/) { $lines = $1; }
    push(@header, $_);
    
    if (/^\s*$/) {
        while (<>) {
            if (/^Content-Type:\s*text\/x-vcard/) {
                $dummy = $_;
                $sublines++;
                while (<>) {
                    $sublines++;
                    $dummy .= $_;
                    next unless /^end\s*vcard/;
                }       
            }
            push(@body, $_);
        }
    }
}

$sublength = length($dummy);
$newlength = $clen - $sublength;
$newlines = $lines - $sublines;

foreach $hline(@header) {
    if ($hline =~ /^Content-Length:/) {
        print "Content-Length: $newlength\n";
    } elsif ($hline =~ /^Lines:/) {
        print "Lines: $newlines\n";
    } else {
        print "$hline\n";
    }
}

print @body;

<-------------------------------------

-- 
    __o   Heinz Diehl, 68259 Mannheim, Germany
  _`\<,_   PGP-encrypted mails welcome, key on request [subj. get pgpkey]
 (_)/ (_)    "Tomorrow never knows what it doesn't know too soon"
~~~~~~~~~~~~    - Oasis, 'Morning Glory' -