I put a copy of /usr/local/nmh-1.6/share/doc/nmh/contrib/replyfilter,
into /home/norm/lib
with the following two lines inserted just after "use Encode;"
open CHECK, ">/t/replfilterLog";
print CHECK "hello norman\n";
I inserted the line:
formatproc: /home/norm/lib/replyfilter
into .mh_profile
But /home/norm/lib/replyfilter is not run when do 'repl'
I am attaching
find ~/Mail -maxdepth 1 ! -type d ! -name ',*' ! -name 'post*' >|
/tmp/find
I am attaching .mh_profile
I am attaching /home/norm/lib/replyfilter
Norman Shapiro
/home/norm/Mail/mhl.reply
/home/norm/Mail/.draft.swo
/home/norm/Mail/context
/home/norm/Mail/mhl.headers
/home/norm/Mail/aliases
/home/norm/Mail/.draft.swp
/home/norm/Mail/source
/home/norm/Mail/replcomps.hide
/home/norm/Mail/nagyComp
/home/norm/Mail/dasdAliases
/home/norm/Mail/cite
/home/norm/Mail/drop
/home/norm/Mail/mhshowLCAnZQ.html
/home/norm/Mail/history
/home/norm/Mail/ride
/home/norm/Mail/dellPrinter
/home/norm/Mail/forwcomps
/home/norm/Mail/components
--- Begin Message ---
--- End Message ---
#!/usr/bin/perl
#
# replyfilter - A reply filter for nmh
#
# The idea behind this program is that it will act as a format filter
# for nmh. It will try to extract out all text/plain parts and format
# them if necessary using a filter program.
#
# To use this program, configure nmh in the following way (nmh 1.5 or later):
#
# - Put the path to this program in your .mh_profile under formatproc:
#
# formatproc: replyfilter
#
# or invoke repl with "-fmtproc replyfilter".
#
# - Create an mhl reply filter that consists of the following line:
#
# body:nocomponent,format,nowrap,formatarg="%(trim{content-type})%(putstr)",formatarg="%(trim{content-transfer-encoding})%(putstr)",formatarg=">"
#
# By default, repl will look for the mhl reply filter by the name
# "mhl.reply", but it will look elsewhere if the -filter switch is given.
#
# To decode this a bit:
#
# body - Output the "body" component
# nocomponent - Don't output a component prefix (normally here we use a
# component prefix of ">" as a quote character, but we're
# going to have replyfilter do that).
# nowrap - Don't wrap lines if they exceed the column width
# formatarg - Arguments to formatproc. The first argument is the value
# of the Content-type header; the second is the value of the
# Content-Transfer-Encoding header. The last "formatarg"
# is used as your quoting prefix. Replace it with whatever
# you want.
#
use Mail::Field;
use MIME::Head;
use MIME::QuotedPrint;
use MIME::Base64;
use Encode;
open CHECK, ">/t/replfilterLog";
print CHECK "hello norman\n";
#
# The program we use to format "long" text. Should be capable of reading
# from standard input and sending the formatted text to standard output.
#
$filterprogram = 'par';
#
# If the above filter program has problems with some input, use the following
# regular expression to remove any problematic input. In this example we
# filter out the UTF-8 non-breaking space (U+00A0) because that makes par
# mangle the output. Uncomment this if this ends up being a problem for
# you, or feel free to add others.
#
#%filterreplace = ( "\N{U+a0}" => " " );
#
# Our output character set. This script assumes a UTF-8 locale, but if you
# want to run under a different locale the change it here.
#
$outcharset = 'utf-8';
#
# Maximum column width (used by the HTML converter and to decide if we need
# to invoke the filter program
#
$maxcolwidth = 78;
#
# Out HTML converter program & arguments. charset will be appended
#
@htmlconv = ('w3m', '-dump', '-cols', $maxcolwidth - 2, '-T', 'text/html',
'-O', $outcharset, '-I');
die "Usage: $0 Content-type content-transfer-encoding quote-prefix\n"
if $#ARGV != 2;
if ($ARGV[0] ne "") {
my $ctype = Mail::Field->new('Content-Type', $ARGV[0]);
$content_type = $ctype->type;
$charset = $ctype->charset;
$boundary = $ctype->boundary;
} else {
$content_type = 'text/plain';
$charset = 'us-ascii';
}
$encoding = $ARGV[1] eq "" ? '7bit' : lc($ARGV[1]);
$quoteprefix = $ARGV[2];
#
# Set up our output to be in our character set
#
binmode(STDOUT, ":encoding($outcharset)");
#
# The simplest case: if we have a single type of text/plain, send it
# to our format subroutine.
#
if ($content_type eq 'text/plain') {
process_text(\*STDIN, $encoding, $charset);
exit 0;
}
#
# Alright, here's what we need to do.
#
# Find any text/plain parts and decode them. Decode them via base64 or
# quoted-printable, and feed them to our formatting filter when appropriate.
# Put markers in the output for other content types.
#
($type) = (split('/', $content_type));
if ($type eq 'multipart') {
#
# For multipart messages we have to do a little extra.
# Eat the MIME prologue (everything up until the first boundary)
#
if (! defined $boundary || $boundary eq '') {
print "No boundary in Content-Type header!\n";
eat_part(\*STDIN);
exit 1;
}
while (<STDIN>) {
last if match_boundary($_, $boundary);
}
if (eof(STDIN)) {
print "Unable to find boundary in message\n";
exit 1;
}
} else {
undef $boundary;
}
process_part(\*STDIN, $content_type, $encoding, $charset, $boundary);
if ($boundary) {
#
# Eat the MIME epilog
#
eat_part(\*STDIN);
}
exit 0;
#
# Handled encoded text. I think we can assume if the encoding is q-p
# or base64 to feed it into a formatting filter.
#
sub process_text (*$$;$)
{
my ($input, $encoding, $charset, $boundary) = @_;
my $text, $filterpid, $prefixpid, $finread, $finwrite;
my $foutread, $foutwrite, $decoder, $ret, $filterflag;
my $text, $maxline = 0;
#
# In the simple case, just spit out the text prefixed by the
# quote character
#
if ($encoding eq '7bit' || $encoding eq '8bit') {
#
# Switch the character set to whatever is specified by
# the MIME message
#
binmode($input, ":encoding($charset)");
while (<$input>) {
$ret = match_boundary($_, $boundary);
if (defined $ret) {
binmode($input, ':encoding(us-ascii)');
return $ret;
}
print $quoteprefix, $_;
}
return 'EOF';
} else {
#
# If we've got some other encoding, the input text is almost
# certainly US-ASCII
#
binmode($input, ':encoding(us-ascii)');
$decoder = find_decoder(lc($encoding));
if (! defined $decoder) {
return 'EOF';
}
}
#
# Okay, assume that the encoding will make it so that we MIGHT need
# to filter it. Read it in; if the lines are too long, filter it
#
my $chardecode = find_encoding($charset);
while (<$input>) {
my @lines, $len;
last if ($ret = match_boundary($_, $boundary));
$text .= $_;
}
binmode($input, ':encoding(us-ascii)');
$text = $chardecode->decode(&$decoder($text));
grep {
my $len;
if (($len = length) > $maxline) {
$maxline = $len;
}} split(/^/, $text);
if (! defined $ret) {
$ret = 'EOF';
}
if ($maxline <= $maxcolwidth) {
#
# These are short enough; just output it now as-is
#
foreach my $line (split(/^/, $text)) {
print STDOUT $quoteprefix, $line;
}
return $ret;
}
#
# We fork a copy of ourselves to read the output from the filter
# program and prefix the quote character.
#
pipe($finread, $finwrite) || die "pipe() failed: $!\n";
pipe($foutread, $foutwrite) || die "pipe() (second) failed: $!\n";
binmode($finread, ":encoding($outcharset)");
binmode($finwrite, ":encoding($outcharset)");
binmode($foutread, ":encoding($outcharset)");
binmode($foutwrite, ":encoding($outcharset)");
if ($filterpid = fork) {
#
# Close the pipes in the parent that we're not using
#
close($finread);
close($foutwrite);
} elsif (defined $filterpid) {
#
# Close our ununsed filehandles
#
close($finwrite);
close($foutread);
#
# Dup() down the filehandles to standard input and output
#
open(STDIN, "<&", $finread) ||
die "dup(filterin) failed: $!\n";
open(STDOUT, ">&", $foutwrite) ||
die "dup(filterout) failed: $!\n";
#
# Close our copies.
#
close($finread);
close($foutwrite);
#
# Exec our filter
#
exec $filterprogram ||
die "Unable to exec $filterprogram: $!\n";
} else {
die "Fork for $filterprogram failed: $!\n";
}
#
# Fork our output handler.
#
if ($prefixpid = fork) {
#
# We don't need these anymore
#
close($foutread);
} elsif (defined $prefixpid) {
#
# Read from foutwrite, and output (with prefix) to stdout
#
close($finwrite);
while (<$foutread>) {
print STDOUT $quoteprefix, $_;
}
exit 0;
}
#
# Send our input to the filter program
#
if (%filterreplace) {
foreach my $match (keys %filterreplace) {
$text =~ s/$match/$filterreplace{$match}/g;
}
}
print $finwrite $text;
close($finwrite);
waitpid $filterpid, 0;
warn "Filter process exited with ", ($? >> 8), "\n" if $?;
waitpid $prefixpid, 0;
warn "Pipe reader process exited with ", ($? >> 8), "\n" if $?;
return $ret;
}
#
# Filter HTML through a converter program
#
sub process_html (*$$;$)
{
my ($input, $encoding, $charset, $boundary) = @_;
my $filterpid, $prefixpid, $finread, $finwrite;
my $foutread, $foutwrite, $decoder, $ret;
if (! defined($decoder = find_decoder(lc($encoding)))) {
return 'EOF';
}
#
# We fork a copy of ourselves to read the output from the filter
# program and prefix the quote character.
#
pipe($finread, $finwrite) || die "pipe() failed: $!\n";
pipe($foutread, $foutwrite) || die "pipe() (second) failed: $!\n";
binmode($finread, ":encoding($outcharset)");
binmode($finread, ":encoding($outcharset)");
binmode($foutread, ":encoding($outcharset)");
binmode($foutwrite, ":encoding($outcharset)");
if ($filterpid = fork) {
#
# Close the pipes in the parent that we're not using
#
close($finread);
close($foutwrite);
} elsif (defined $filterpid) {
#
# Close our ununsed filehandles
#
close($finwrite);
close($foutread);
#
# Dup() down the filehandles to standard input and output
#
open(STDIN, "<&", $finread) ||
die "dup(filterin) failed: $!\n";
open(STDOUT, ">&", $foutwrite) ||
die "dup(filterout) failed: $!\n";
#
# Close our copies.
#
close($finread);
close($foutwrite);
#
# Exec our converter
#
my @conv = (@htmlconv, $charset);
exec (@conv) ||
die "Unable to exec $filterprogram: $!\n";
} else {
die "Fork for $htmlconv[0] failed: $!\n";
}
#
# Fork our output handler.
#
if ($prefixpid = fork) {
#
# We don't need these anymore
#
close($foutread);
} elsif (defined $prefixpid) {
#
# Read from foutwrite, and output (with prefix) to stdout
#
close($finwrite);
while (<$foutread>) {
print STDOUT $quoteprefix, $_;
}
exit 0;
}
#
# Send our input to the filter program
#
while (<$input>) {
last if ($ret = match_boundary($_, $boundary));
print $finwrite (&$decoder($_));
}
if (! defined $ret) {
$ret = 'EOF';
}
close($finwrite);
waitpid $filterpid, 0;
warn "HTML converter process exited with ", scalar($? >> 8), "\n" if $?;
waitpid $prefixpid, 0;
warn "Pipe reader process exited with ", $? >> 8, "\n" if $?;
return $ret;
}
#
# Decide what to do, based on what kind of content it is.
#
sub process_part (*$$$$;$)
{
my ($input, $content_type, $encoding, $charset, $boundary, $name) = @_;
my ($type, $subtype) = (split('/', $content_type, -1), '');
if ($type eq 'text') {
#
# If this is a text part, right now we only deal with
# plain and HTML parts.
#
if ($subtype eq 'plain') {
return process_text($input, $encoding, $charset,
$boundary);
} elsif ($subtype eq 'html') {
return process_html($input, $encoding, $charset,
$boundary);
} else {
print ">>> $content_type content\n";
return eat_part($input, $boundary);
}
} elsif ($type eq 'multipart') {
return process_multipart($input, $subtype, $boundary);
} else {
#
# Other types we're not sure what to do with right now
# Just put a marker in there
#
print ">>> $content_type attachment";
if (defined $name) {
print ", name=$name";
}
print "\n";
return eat_part($input, $boundary);
}
}
#
# Process a multipart message.
#
# When called, we should be right after the beginning of the first
# boundary marker. So we should be pointed at header lines which describe
# the content of this part
#
sub process_multipart ($$$)
{
my ($input, $subtype, $boundary) = @_;
my $altout;
while (1) {
my $encoding, $type, $end, $name, $charset;
#
# Use the Mail::Header package to read in any headers
# corresponding to this part
#
my $head = Mail::Header->new($input, (MailFrom => 'IGNORE'));
#
# Extract out any Content-Type, Content-Transfer-Encoding, and
# Content-Disposition headers
#
my $ctype = Mail::Field->extract('Content-Type', $head);
my $cte = Mail::Field->extract('Content-Transfer-Encoding',
$head);
my $cdispo = Mail::Field->extract('Content-Disposition', $head);
if (defined $ctype) {
$type = $ctype->type;
$charset = $ctype->charset;
} else {
$type = 'text/plain';
$charset = 'us-ascii';
}
$encoding = defined $cte ? lc($cte->param('_')) : '7bit';
$name = defined $cdispo ? $cdispo->param('filename') : undef;
#
# Special handling for multipart/alternative; pick
# the "first" one we can handle (which is usually
# text/plain) and silently eat the rest, but output a
# warning if we can't handle anything.
#
if ($altout) {
$end = eat_part($input, $boundary);
} else {
my $subboundary = $boundary;
my $maintype = (split('/', $type))[0];
if ($maintype eq 'multipart') {
$subboundary = $ctype->boundary;
#
# Go until we find our beginning of this
# part
#
my $subend = eat_part($input, $subboundary);
if ($subend ne 'EOP') {
print ">>> WARNING: malformed ",
"nested multipart\n";
return $subend;
}
}
$end = process_part($input, $type, $encoding,
$charset, $subboundary, $name);
if ($subtype eq 'alternative' && ! defined $altout &&
$type eq 'text/plain') {
$altout = 1;
}
#
# Since we changed the semantics of $boundary
# above for nested multiparts, if we are
# handling a nested multipart then find the end
# of our current part
#
if ($maintype eq 'multipart') {
$end = eat_part($input, $boundary);
}
}
if ($end eq 'EOM' || $end eq 'EOF') {
if ($subtype eq 'alternative' && !defined $altout) {
print ">>>multipart/alternative: no suitable ",
"parts\n";
}
return $end;
}
}
}
#
# "Eat" a MIME part; consume content until we hit the boundary or EOF
#
sub eat_part ($$)
{
my ($input, $boundary) = @_;
my $ret;
#
# If we weren't given a boundary just eat input until EOF
#
if (! defined $boundary) {
while (<$input>) { }
return 'EOF';
}
#
# Otherwise, consume data until we hit our boundary
#
while (<$input>) {
if ($ret = match_boundary($_, $boundary)) {
return $ret;
}
}
return 'EOF';
}
#
# Return the decoder subroutine to use
#
sub find_decoder ($)
{
my ($encoding) = @_;
if ($encoding eq '7bit' || $encoding eq '8bit') {
return \&null_decoder;
} elsif ($encoding eq 'base64') {
return \&decode_base64;
} elsif ($encoding eq 'quoted-printable') {
return \&decode_qp;
} else {
warn "Unknown encoding: $encoding\n";
return undef;
}
}
sub null_decoder ($)
{
my ($input) = @_;
return $input;
}
#
# Match a line against the boundary string
#
sub match_boundary($$)
{
my ($line, $boundary) = @_;
return if ! defined $boundary;
if (substr($line, 0, 2) eq '--') {
$line =~ s/[ \t\r\n]+\Z//;
if ($line eq "--$boundary") {
return 'EOP';
} elsif ($line eq "--$boundary--") {
return 'EOM';
}
}
return undef;
}
_______________________________________________
Nmh-workers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/nmh-workers
