#!/usr/bin/perl # no-alternative version 0.50. # expect a message on stdin. If it's multipart/alternative, remove all # alternatives except text/plain, and forward the message to $USER-alternative. # Presumably you've got a ~/.qmail-alternative file which stores the mail # in the user's mailbox. # grovel through the headers to get the boundary. while(<>) { $continuation = 0 if /^\S/; $continuation = 1 if m!^Content-Type: multipart/alternative;!i; $boundary = $1 if $continuation && /boundary="(.*?)"/; last if /^$/; $headers .= $_ unless $continuation; # delete multipart/alternative if found. } # dispose of messages which are not multipart/alternative unless ($boundary) { exit 0; } $boundary =~ s/\W/\\$&/g; # protect any meta characters in the boundary. $printing = 0; # we start by discarding the pre-message cuft. $header = 0; # and we start outside of a header. open(MAIL, "|forward $ENV{USER}-alternative") or die; print MAIL $headers; #print "Searching for boundary $boundary\n"; while(<>) { # print $printing?"P":" "; # print $header?"H":" "; # print $_; last if /^--$boundary--$/; if (/^--$boundary$/) { $header = 1; $printing = 0; next; # discard boundary } $printing = 0 if $header && m!^Content-Type:!i; $printing = 1 if $header && m!^Content-Type: text/plain;?!i; $header = 0 if $header and /^$/; print MAIL if $printing; } close MAIL; exit 99;