mailagent-svn Mailing List for mailagent - Perl mail filter / processor (Page 2)
Brought to you by:
rmanfredi
Menu
▾
▴
mailagent-svn — SVN repository update notifications
You can subscribe to this list here.
| 2006 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
|
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2008 |
Jan
(2) |
Feb
|
Mar
|
Apr
|
May
(21) |
Jun
(30) |
Jul
(2) |
Aug
(2) |
Sep
|
Oct
|
Nov
|
Dec
|
| 2009 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
(6) |
Oct
|
Nov
|
Dec
|
| 2010 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
| 2011 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(4) |
| 2012 |
Jan
(1) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2015 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <rma...@us...> - 2008-07-02 21:59:47
|
Revision: 57
http://mailagent.svn.sourceforge.net/mailagent/?rev=57&view=rev
Author: rmanfredi
Date: 2008-07-02 14:59:34 -0700 (Wed, 02 Jul 2008)
Log Message:
-----------
Fixed formatting bug when headers had a trailing blank that happened to be
right at the end of the line: an empty continuation line was emitted and
INN did not like that and took it as an End Of Header.
Modified Paths:
--------------
trunk/mailagent/README
trunk/mailagent/agent/pl/header.pl
trunk/mailagent/agent/test/cmd/post.t
trunk/mailagent/revision.h
Modified: trunk/mailagent/README
===================================================================
--- trunk/mailagent/README 2008-07-01 07:33:24 UTC (rev 56)
+++ trunk/mailagent/README 2008-07-02 21:59:34 UTC (rev 57)
@@ -58,7 +58,6 @@
so that the new rule I am about to add to my ~/.rules may correctly
redirect your message into a high priority folder :-)
-
There is a mailing list hosted in Japan and set up by Shigeya Suzuki
<sh...@fo...>, for discussion about the mailagent package as
a whole. It's a good place to ask questions (or answer them) and to
@@ -93,6 +92,9 @@
Raphael Manfredi <Rap...@po...>
Grenoble, France, July 12th 1999
+ Raphael Manfredi <Rap...@po...>
+ Grenoble, France, June 28th 2008
+
========================================================================
INSTALLATION
@@ -127,17 +129,7 @@
carrying useless files. You should keep this distribution intact, so
that future patches will be applyable.
-7) I have an automatic patch sender. Send me the following mail:
-
- Subject: Command
- @SH mailhelp PATH
-
-and you'll get instructions (PATH stands for YOUR e-mail address, either
-in INTERNET or in bang notation). I would recommend you to get all the
-issued patches before you start making some modifications on this
-package.
-
-8) If you wish to de-install the package, you may run "make deinstall".
+7) If you wish to de-install the package, you may run "make deinstall".
A separate "make deinstall.man" will remove the manual pages. Be sure
the makefiles are correctly set before running any deinstall target.
On USG systems, some executable have a chance to remain despite the
Modified: trunk/mailagent/agent/pl/header.pl
===================================================================
--- trunk/mailagent/agent/pl/header.pl 2008-07-01 07:33:24 UTC (rev 56)
+++ trunk/mailagent/agent/pl/header.pl 2008-07-02 21:59:34 UTC (rev 57)
@@ -220,8 +220,11 @@
$new .= "$tmp\n";
$field = substr($field, $kept, length $field);
}
- $new .= $cont if $new; # Add 8 chars if continuation
- $new .= $field; # Remaining information on one line
+ unless ($field =~ /^\s+$/) { # Not only spaces
+ $new .= $cont if $new; # Add 8 chars if continuation
+ $new .= $field; # Remaining information on one line
+ }
+ return $new;
}
# Same as format() but with extra magic for news articles: we must never
Modified: trunk/mailagent/agent/test/cmd/post.t
===================================================================
--- trunk/mailagent/agent/test/cmd/post.t 2008-07-01 07:33:24 UTC (rev 56)
+++ trunk/mailagent/agent/test/cmd/post.t 2008-07-02 21:59:34 UTC (rev 57)
@@ -46,6 +46,20 @@
&check_log('^Newsgroups: first.news,second.news,third.news', 13);
&check_log('^Distribution: local', 14);
+unlink 'send.news';
+&replace_header('X-Tag: post 1');
+# Subject with a trailing space
+my $subject = <<EOM;
+Subject: [perl #2783] Security of ARGV using 2-argument open - It's a feature
+EOM
+chop $subject;
+replace_header($subject);
+`$cmd`;
+$? == 0 || print "15\n";
+&get_log(16, 'send.news');
+# 1 EOH + 3 paragraphs in mail
+&check_log('^$', 17) == 4 or print "18\n";
+
&clear_mta;
unlink 'mail', 'list';
print "0\n";
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-07-01 07:33:24 UTC (rev 56)
+++ trunk/mailagent/revision.h 2008-07-02 21:59:34 UTC (rev 57)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 53
+#define REVISION 56
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-07-01 07:33:30
|
Revision: 56
http://mailagent.svn.sourceforge.net/mailagent/?rev=56&view=rev
Author: rmanfredi
Date: 2008-07-01 00:33:24 -0700 (Tue, 01 Jul 2008)
Log Message:
-----------
Workaround perl 5.10 bug whereby $1 is reset in a regexp using /e if the
routine called there is dataloaded. Made sure to_txt() is a one-liner to
avoid dataloading.
Modified Paths:
--------------
trunk/mailagent/agent/pl/biff.pl
trunk/mailagent/agent/test/cmd/biff.t
Modified: trunk/mailagent/agent/pl/biff.pl
===================================================================
--- trunk/mailagent/agent/pl/biff.pl 2008-06-30 11:33:35 UTC (rev 55)
+++ trunk/mailagent/agent/pl/biff.pl 2008-07-01 07:33:24 UTC (rev 56)
@@ -488,18 +488,18 @@
}
# One-liner quoted-printable decoder
-sub to_txt {
- my ($l) = @_;
- $l =~ s/=([\da-fA-F]{2})/pack('C', hex($1))/ge;
- return $l;
-}
+# MUST be on one line to not be dataloaded (would mess $1 in the regexp)
+sub to_txt { my $l = shift; $l =~ s/=([\da-fA-F]{2})/pack('C', hex($1))/ge; $l }
# Quick removal of quoted-printable escapes within the headers
# We do not care about the charset and hope the tty will be able to display
# the characters just fine.
sub unquote_printable {
my ($l) = @_;
- $l =~ s/^(.*?)=\?[\w-]+\?Q\?(.*)\?=/$1 . to_txt($2)/ieg && $l =~ s/_/ /g;
+ # The to_txt() routine being used MUST NOT be dataloaded or $1 would be
+ # reset to '' on the first invocation. It's a perl bug (seen in 5.10)
+ $l =~ s/=\?[\w-]+?\?Q\?(.*?)\?=\s*/to_txt($1)/sieg && $l =~ s/_/ /g;
+ &'add_log("unquoted '$_[0]' to '$l'") if $'loglvl > 19 && $_[0] ne $l;
return $l;
}
Modified: trunk/mailagent/agent/test/cmd/biff.t
===================================================================
--- trunk/mailagent/agent/test/cmd/biff.t 2008-06-30 11:33:35 UTC (rev 55)
+++ trunk/mailagent/agent/test/cmd/biff.t 2008-07-01 07:33:24 UTC (rev 56)
@@ -89,7 +89,23 @@
¬_log('--foo', 45);
&check_log('^Got mail in ~/ok', 46) == 1 || print "47\n";
&check_log('successfully decoded', 48) == 1 || print "49\n";
+&cleanup;
+cp_mail("../qp");
+my $subject = <<EOM;
+Subject: =?Cp1252?Q?Perl:_La_haute_tec?=
+ =?Cp1252?Q?hnicit=E9_au_service_des_professionnels?=
+EOM
+chop $subject;
+&replace_header($subject);
+&add_header('X-Tag: biff 3');
+&make_tty(0, 0777, 50); # 50 & 51
+`$cmd`;
+$? == 0 || print "52\n";
+&get_log(53, 'tty0');
+&check_log(
+ 'Subject: Perl: La haute technicit\xE9 au service des professionnels', 54);
&cleanup;
+
unlink 'mail';
print "0\n";
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-30 11:34:26
|
Revision: 55
http://mailagent.svn.sourceforge.net/mailagent/?rev=55&view=rev
Author: rmanfredi
Date: 2008-06-30 04:33:35 -0700 (Mon, 30 Jun 2008)
Log Message:
-----------
Also remove ESC chars from tty output to avoid problems with escape sequences.
Modified Paths:
--------------
trunk/mailagent/agent/pl/biff.pl
Modified: trunk/mailagent/agent/pl/biff.pl
===================================================================
--- trunk/mailagent/agent/pl/biff.pl 2008-06-27 19:34:02 UTC (rev 54)
+++ trunk/mailagent/agent/pl/biff.pl 2008-06-30 11:33:35 UTC (rev 55)
@@ -250,6 +250,7 @@
foreach $head (@head) {
next unless defined $'Header{$head};
local($line) = unquote_printable("$head: $'Header{$head}");
+ $line =~ s/[\x0-\x1f\x7f]//g;
$line = substr($line, 0, $width - 4) . '...' if length($line) >= $width;
$res .= "$line$n";
}
@@ -297,7 +298,7 @@
next if $skipnl && is_blank($_);
my $line_length = 0;
1 while s|\t|' ' x ($tl - length($`) % $tl)|e; # Expand tabs
- s/[\x0-\x1f]//g; # Remove all control chars
+ s/[\x0-\x1f\x7f]//g; # Remove all control chars
if ($reformat) {
local @tmp;
&format($_, $width, *tmp); # Format line into @tmp
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-27 19:34:51
|
Revision: 54
http://mailagent.svn.sourceforge.net/mailagent/?rev=54&view=rev
Author: rmanfredi
Date: 2008-06-27 12:34:02 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Improved perload to detect when the executable changes, to reset the offset
table from the new executable: since mailagent can wait in the background,
updating the script then could cause an unexpected failure should it need to
dataload something after waking up.
Modified Paths:
--------------
trunk/mailagent/agent/test/Makefile.SH
trunk/mailagent/agent/test/basic/mailagent.t
trunk/mailagent/bin/perload
trunk/mailagent/revision.h
Modified: trunk/mailagent/agent/test/Makefile.SH
===================================================================
--- trunk/mailagent/agent/test/Makefile.SH 2008-06-27 17:02:06 UTC (rev 53)
+++ trunk/mailagent/agent/test/Makefile.SH 2008-06-27 19:34:02 UTC (rev 54)
@@ -1,5 +1,5 @@
-: Makefile.SH generated from Jmake.tmpl and Jmakefile [jmake 3.0 PL48]
-: $X-Id: Jmake.tmpl,v 3.0.1.2 1995/01/11 14:50:21 ram Exp ram $
+: Makefile.SH generated from Jmake.tmpl and Jmakefile [jmake 3.5-25]
+: $X-Id: Jmake.tmpl 8 2006-08-25 22:27:18Z rmanfredi $
case $CONFIG in
'')
@@ -37,7 +37,7 @@
# Parameters set by Configure -- edit config.sh if changes are needed
CTAGS = ctags
-MAKE = make
+JCPPFLAGS = $cppflags
MV = $mv
RM = $rm -f
@@ -45,7 +45,7 @@
$spitshell >>Makefile <<'!NO!SUBS!'
########################################################################
# Jmake rules for building libraries, programs, scripts, and data files
-# $X-Id: Jmake.rules,v 3.0.1.2 1995/01/11 14:49:55 ram Exp ram $
+# $X-Id: Jmake.rules 18 2006-12-27 10:35:09Z rmanfredi $
########################################################################
# Start of Jmakefile
@@ -53,7 +53,7 @@
# $X-Id: Jmakefile,v 3.0 1993/11/29 13:49:20 ram Exp ram $
#
# Copyright (c) 1990-2006, Raphael Manfredi
-#
+#
# You may redistribute only under the terms of the Artistic License,
# as specified in the README file that comes with the distribution.
# You may reuse parts of this distribution only within the terms of
@@ -92,20 +92,32 @@
########################################################################
# Common rules for all Makefiles -- do not edit
-emptyrule::
+all::
clean: local_clean
realclean: local_realclean
clobber: local_clobber
local_clean::
- $(RM) core *~ *.o
+ if test -f core; then $(RM) core; fi
+ $(RM) *~ *.o
local_realclean:: local_clean
local_clobber:: local_realclean
$(RM) Makefile config.sh
+install:: local_install
+install.man:: maybe_install.man
+deinstall:: local_deinstall
+deinstall.man:: maybe_deinstall.man
+
+install.man-no:
+deinstall.man-no:
+
+maybe_install.man: install.man-no
+maybe_deinstall.man: deinstall.man-no
+
Makefile.SH: Jmakefile
-@if test -f $(TOP)/.package; then \
if test -f Makefile.SH; then \
@@ -114,7 +126,7 @@
fi; \
echo " $(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT)" ; \
$(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT) ; \
- else touch $@; exit 0; fi
+ else touch $@; fi
Makefile: Makefile.SH
/bin/sh Makefile.SH
@@ -129,16 +141,16 @@
########################################################################
# Empty rules for directories with no sub-directories -- do not edit
-install::
+local_install::
@echo "install in $(CURRENT) done."
-deinstall::
+local_deinstall::
@echo "deinstall in $(CURRENT) done."
-install.man::
+local_install.man::
@echo "install.man in $(CURRENT) done."
-deinstall.man::
+local_deinstall.man::
@echo "deinstall.man in $(CURRENT) done."
Makefiles::
Modified: trunk/mailagent/agent/test/basic/mailagent.t
===================================================================
--- trunk/mailagent/agent/test/basic/mailagent.t 2008-06-27 17:02:06 UTC (rev 53)
+++ trunk/mailagent/agent/test/basic/mailagent.t 2008-06-27 19:34:02 UTC (rev 54)
@@ -33,7 +33,7 @@
print RULES "{ DELETE };\n";
close RULES;
unlink <queue/qm*>;
-open(FILTER, "|$filter -t >/dev/null 2>&1") || print "3\n";
+open(FILTER, "|$filter -t >>.bak 2>&1") || print "3\n";
print FILTER <<EOF;
From: test
@@ -50,7 +50,7 @@
unlink 'agentlog', '.rules';
sleep 1 while -f "perl$lockext"; # Let background mailagent die
# Check empty rules...
-open(FILTER, "|$filter -t >/dev/null 2>&1") || print "10\n";
+open(FILTER, "|$filter -t >>.bak 2>&1") || print "10\n";
print FILTER <<EOF;
From: test
@@ -71,7 +71,7 @@
# Make sure file is correctly queued when another mailagent is running
`cp /dev/null perl$lockext`;
$? == 0 || print "19\n";
-open(FILTER, "|$filter -t >/dev/null 2>&1") || print "20\n";
+open(FILTER, "|$filter -t >>.bak 2>&1") || print "20\n";
print FILTER <<EOF;
Dummy mail
EOF
Modified: trunk/mailagent/bin/perload
===================================================================
--- trunk/mailagent/bin/perload 2008-06-27 17:02:06 UTC (rev 53)
+++ trunk/mailagent/bin/perload 2008-06-27 19:34:02 UTC (rev 54)
@@ -248,12 +248,19 @@
:# Load the calling function from DATA segment and call it. This function is
:# called only once per routine to be loaded.
:sub main'dataload {
+: package perload;
: local($__packname__) = (caller(1))[3];
: $__packname__ =~ s/::/'/;
: local($__rpackname__) = $__packname__;
: local($__at__) = $@;
: $__rpackname__ =~ s/^auto_//;
-: &perload'load_from_data($__rpackname__);
+: eval { load_from_data($__rpackname__, 0) };
+: if ($@ eq "RETRY\n") {
+: undef %Datapos;
+: load_from_data($__rpackname__, 1);
+: } else {
+: die $@ if $@;
+: }
: local($__fun__) = "$__rpackname__";
: $__fun__ =~ s/'/'load_/;
: eval "*$__packname__ = *$__fun__;"; # Change symbol table entry
@@ -265,17 +272,28 @@
:# Load function name given as argument, fatal error if not existent
:sub perload'load_from_data {
: package perload;
-: local($pos) = $Datapos{$_[0]}; # Offset within DATA
+: local ($name, $retried) = @_;
+: local($pos) = $Datapos{$name}; # Offset within DATA
: # Avoid side effects by protecting special variables which will be changed
: # by the dataloading operation.
-: local($., $_, $@);
-: $pos = &fetch_function_code unless $pos;
-: die "Function $_[0] not found in data section.\n" unless $pos;
+: local($., $_);
+: $pos = &fetch_function_code($name, $retried) unless $pos;
+: die "Function $name not found in data section.\n" unless $pos;
: die "Cannot seek to $pos into data section.\n"
: unless seek(main'DATA, $pos, 0);
: local($/) = "\n}";
: local($body) = scalar(<main'DATA>);
-: die "End of file found while loading $_[0].\n" unless $body =~ /^\}$/m;
+: local $loaded = $name;
+: $loaded =~ s/^(.*?)'(.*)/sub ${1}'load_$2 {/;;
+: unless ($body =~ /\n\}$/s && substr($body, 0, length $loaded) eq $loaded) {
+: if ($retried) {
+: die "End of file found while loading $name.\n"
+: unless $body =~ /\n\}$/s;
+: die "Offset table garbled or file changed whilst loading $name.\n";
+: }
+: die "RETRY\n";
+: }
+: local $@;
EOC
if ($opt_t) {
print &q(<<'EOC');
@@ -328,8 +346,20 @@
:# the offset of each of the dataloaded routines held in the data section.
:sub perload'fetch_function_code {
: package perload;
+: local ($name, $retried) = @_;
: local($start) = 0;
: local($., $_);
+: if ($retried) {
+: my $date = scalar localtime;
+: warn("$0 probably changed, reloading offset table on $date\n");
+: close(main'DATA);
+: open(main'DATA, $0) || die "Can't open $0 to reload offset table: $!\n";
+: my $found = 0;
+: while (<main'DATA>) {
+: if (/^__END__\s$/) { $found++; last }
+: }
+: die "Unable to find __END__ token in $0\n" unless $found;
+: }
: while (<main'DATA>) { # First move to start of offset table
: next if /^#/;
: last if /^$/ && ++$start > 2; # Skip two blank line after end token
@@ -341,7 +371,7 @@
: ($key, $value) = split(' ');
: $Datapos{$key} = $value + $start;
: }
-: $Datapos{$_[0]}; # All that pain to get this offset...
+: $Datapos{$name}; # All that pain to get this offset...
:}
:
EOC
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-27 17:02:06 UTC (rev 53)
+++ trunk/mailagent/revision.h 2008-06-27 19:34:02 UTC (rev 54)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 50
+#define REVISION 53
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-27 17:02:13
|
Revision: 53
http://mailagent.svn.sourceforge.net/mailagent/?rev=53&view=rev
Author: rmanfredi
Date: 2008-06-27 10:02:06 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Biffing now probes the terminal size using a termios ioctl.
Message is lined-wrapped cleanly on terminals, and long lines wrapping over
are accounted for when computing the limit of lines we have to show for a
message body.
Modified Paths:
--------------
trunk/mailagent/Configure
trunk/mailagent/MANIFEST
trunk/mailagent/agent/magent.sh
trunk/mailagent/agent/man/mailagent.SH
trunk/mailagent/agent/pl/Jmakefile
trunk/mailagent/agent/pl/Makefile.SH
trunk/mailagent/agent/pl/biff.pl
trunk/mailagent/config_h.SH
trunk/mailagent/revision.h
Added Paths:
-----------
trunk/mailagent/agent/pl/termios/
trunk/mailagent/agent/pl/termios/Jmakefile
trunk/mailagent/agent/pl/termios/Makefile.SH
trunk/mailagent/agent/pl/termios/termios_ph.c
trunk/mailagent/agent/pl/termios/termios_pl.sh
Modified: trunk/mailagent/Configure
===================================================================
--- trunk/mailagent/Configure 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/Configure 2008-06-27 17:02:06 UTC (rev 53)
@@ -18,7 +18,7 @@
# $Id: Head.U 25 2008-05-28 11:19:25Z rmanfredi $
#
-# Generated on Fri May 30 11:10:37 CEST 2008 [metaconfig 3.5-25]
+# Generated on Wed Jun 25 19:17:28 CEST 2008 [metaconfig 3.5-25]
cat >c1$$ <<EOF
ARGGGHHHH!!!!!
@@ -249,6 +249,7 @@
vi=''
zcat=''
zip=''
+libswanted=''
hint=''
myuname=''
osname=''
@@ -540,6 +541,7 @@
: full support for void wanted by default
defvoidused=15
+: private initializations
libswanted=''
: Find the basic shell for Bourne shell scripts
@@ -5837,7 +5839,7 @@
EOM
rp="Would you like to use flock style mail spool locking only?"
- . myread
+ . ./myread
case "$ans" in
y*|Y*) val="$define";;
*) val="$undef";;
@@ -7457,6 +7459,7 @@
libsfiles='$libsfiles'
libsfound='$libsfound'
libspath='$libspath'
+libswanted='$libswanted'
line='$line'
lint='$lint'
lkflags='$lkflags'
Modified: trunk/mailagent/MANIFEST
===================================================================
--- trunk/mailagent/MANIFEST 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/MANIFEST 2008-06-27 17:02:06 UTC (rev 53)
@@ -176,6 +176,10 @@
agent/pl/sendfile.pl Perl library to send files in shar / kit mode
agent/pl/signals.pl Installs emergency signal handlers
agent/pl/stats.pl Mailagent's statistics recording and printing
+agent/pl/termios/Jmakefile Generic Makefile for termios.pl
+agent/pl/termios/Makefile.SH Produces Makefile for termios.pl
+agent/pl/termios/termios_ph.c Generates a perl view of struct winsize
+agent/pl/termios/termios_pl.sh Produces termios.pl, to handle tty size
agent/pl/tilde.pl Perl library to perform ~name expansion
agent/pl/unpack.pl Perl library to unpack archive files
agent/pl/usrmac.pl User-defined macros
Modified: trunk/mailagent/agent/magent.sh
===================================================================
--- trunk/mailagent/agent/magent.sh 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/agent/magent.sh 2008-06-27 17:02:06 UTC (rev 53)
@@ -829,5 +829,6 @@
$grep -v '^;#' pl/install.pl >>magent
$grep -v '^;#' pl/base64.pl >>magent
$grep -v '^;#' pl/qp.pl >>magent
+$grep -v '^;#' pl/termios/termios.pl >>magent
chmod 755 magent
$eunicefix magent
Modified: trunk/mailagent/agent/man/mailagent.SH
===================================================================
--- trunk/mailagent/agent/man/mailagent.SH 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/agent/man/mailagent.SH 2008-06-27 17:02:06 UTC (rev 53)
@@ -364,8 +364,7 @@
a default hardwired format is used. Season to taste. (suggested: ~/.biffmsg).
.TP
.I biffnice
-When \fIbiffmh\fR is turned ON, this option controls whether the compacted
-message should be reformatted to nicely fit into 80 columns.
+Whether the message should be reformatted to nicely fit into the terminal.
(optional, defaults to OFF, suggested: ON when \fIbiffmh\fR is also ON).
.TP
.I biffnl
@@ -3460,7 +3459,9 @@
Same as writing %-H, new line, %-B
.TP
%-B
-The body part of the biffing message
+The body part of the biffing message, with content-transfer-encoding removed.
+If the message is a MIME multipart one, the text/plain part is shown. If only
+a text/html part is available, the HTML markup is stripped for biffing.
.TP
%-H
The header part of the biffing message. If shows only From:, To: Subject: and
@@ -3543,10 +3544,8 @@
----%b
.Ef
Note that the string \fI...more...\fR appears at the end of the body when
-it has not been completely printed out on the screen, regardless of the
-value of the remaining lines. This means you'll get the \fI...more...\fR
-string even if all the lines from now on are blank and \fIbiffnl\fR is OFF.
-And it's not possible to customize this bit, sorry.
+it has not been completely printed out on the screen and the remaining
+lines are not blank or similar.
.SS "Trimming Leading Quotation"
.PP
It is a standard practice, when replying to a message, to include an
@@ -3616,7 +3615,7 @@
Since this compacting is output verbatim on the tty, line breaks will occur
randomly and this may make reading difficult. You may request an automatic
reformatting of the compacted body by turning \fIbiffnice\fR to ON and the
-biff output will fit nicely within 80 columns.
+biff output will fit nicely within the terminal.
.PP
Unfortunately, it is not possible to customize the amount of columns that
should be used for formatting: since you may biff to any tty you are logged
Modified: trunk/mailagent/agent/pl/Jmakefile
===================================================================
--- trunk/mailagent/agent/pl/Jmakefile 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/agent/pl/Jmakefile 2008-06-27 17:02:06 UTC (rev 53)
@@ -17,5 +17,5 @@
;# patch20: created
;#
-SetSubdirs(utmp)
+SetSubdirs(termios utmp)
DependSubdirs()
Modified: trunk/mailagent/agent/pl/Makefile.SH
===================================================================
--- trunk/mailagent/agent/pl/Makefile.SH 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/agent/pl/Makefile.SH 2008-06-27 17:02:06 UTC (rev 53)
@@ -1,5 +1,5 @@
-: Makefile.SH generated from Jmake.tmpl and Jmakefile [jmake 3.0 PL48]
-: $X-Id: Jmake.tmpl,v 3.0.1.2 1995/01/11 14:50:21 ram Exp ram $
+: Makefile.SH generated from Jmake.tmpl and Jmakefile [jmake 3.5-25]
+: $X-Id: Jmake.tmpl 8 2006-08-25 22:27:18Z rmanfredi $
case $CONFIG in
'')
@@ -37,20 +37,20 @@
# Parameters set by Configure -- edit config.sh if changes are needed
CTAGS = ctags
-MAKE = make
+JCPPFLAGS = $cppflags
MV = $mv
RM = $rm -f
########################################################################
# Automatically generated parameters -- do not edit
-SUBDIRS = utmp
+SUBDIRS = termios utmp
!GROK!THIS!
$spitshell >>Makefile <<'!NO!SUBS!'
########################################################################
# Jmake rules for building libraries, programs, scripts, and data files
-# $X-Id: Jmake.rules,v 3.0.1.2 1995/01/11 14:49:55 ram Exp ram $
+# $X-Id: Jmake.rules 18 2006-12-27 10:35:09Z rmanfredi $
########################################################################
# Start of Jmakefile
@@ -58,7 +58,7 @@
# $X-Id: Jmakefile,v 3.0.1.1 1994/10/29 17:44:36 ram Exp ram $
#
# Copyright (c) 1990-2006, Raphael Manfredi
-#
+#
# You may redistribute only under the terms of the Artistic License,
# as specified in the README file that comes with the distribution.
# You may reuse parts of this distribution only within the terms of
@@ -75,26 +75,38 @@
for i in $(SUBDIRS) ;\
do \
(cd $$i ; echo "Depending" "in $(DIR)$$i..."; \
- $(MAKE) $(MFLAGS) depend); \
+ $(MAKE) $(MFLAGS) depend) || exit 1; \
done
########################################################################
# Common rules for all Makefiles -- do not edit
-emptyrule::
+all::
clean: sub_clean local_clean
realclean: sub_realclean local_realclean
clobber: sub_clobber local_clobber
local_clean::
- $(RM) core *~ *.o
+ if test -f core; then $(RM) core; fi
+ $(RM) *~ *.o
local_realclean:: local_clean
local_clobber:: local_realclean
$(RM) Makefile config.sh
+install:: local_install sub_install
+install.man:: maybe_install.man sub_install.man
+deinstall:: sub_deinstall local_deinstall
+deinstall.man:: sub_deinstall.man maybe_deinstall.man
+
+install.man-no:
+deinstall.man-no:
+
+maybe_install.man: install.man-no
+maybe_deinstall.man: deinstall.man-no
+
Makefile.SH: Jmakefile
-@if test -f $(TOP)/.package; then \
if test -f Makefile.SH; then \
@@ -103,7 +115,7 @@
fi; \
echo " $(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT)" ; \
$(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT) ; \
- else touch $@; exit 0; fi
+ else touch $@; fi
Makefile: Makefile.SH
/bin/sh Makefile.SH
@@ -123,20 +135,22 @@
for i in $(SUBDIRS) ;\
do \
(cd $$i ; echo $(VERB) "in $(DIR)$$i..."; \
- $(MAKE) $(MFLAGS) $(FLAGS) $(TARGET)); \
+ $(MAKE) $(MFLAGS) $(FLAGS) $(TARGET)) || exit 1; \
done
-install::
+sub_install::
@$(MAKE) subdirs TARGET=install VERB="Installing" FLAGS=
-deinstall::
+sub_deinstall::
@$(MAKE) subdirs TARGET=deinstall VERB="Deinstalling" FLAGS=
+ @echo "Back to $(CURRENT) for "deinstall...
-install.man::
+sub_install.man::
@$(MAKE) subdirs TARGET=install.man VERB="Installing man pages" FLAGS=
-deinstall.man::
+sub_deinstall.man::
@$(MAKE) subdirs TARGET=deinstall.man VERB="Deinstalling man pages" FLAGS=
+ @echo "Back to $(CURRENT) for "deinstall.man...
sub_clean::
@$(MAKE) subdirs TARGET=clean VERB="Cleaning" FLAGS=
@@ -155,7 +169,7 @@
for i in $(SUBDIRS) ;\
do \
(cd $$i ; echo "Tagging" "in $(DIR)$$i..."; \
- $(MAKE) $(MFLAGS) tag); \
+ $(MAKE) $(MFLAGS) tag) || exit 1; \
done
Makefiles::
@@ -165,7 +179,7 @@
echo "Making "Makefiles" in $(DIR)$$i..."; \
(cd $$i || exit 1; \
if test ! -f Makefile; then /bin/sh Makefile.SH; fi; \
- $(MAKE) $(MFLAGS) Makefiles) \
+ $(MAKE) $(MFLAGS) Makefiles) || exit 1;\
done
Makefiles.SH:: Makefile.SH
@@ -182,14 +196,23 @@
/*) newtop="$(TOP)" ;; \
esac; \
echo "Making Makefiles.SH in $(DIR)$$i..."; \
- (cd $$i || exit 1; $(MAKE) $(MFLAGS) -f ../Makefile \
- Makefile TOP=$$newtop CURRENT=$(DIR)$$i;\
- $(MAKE) $(MFLAGS) Makefiles.SH) \
+ (cd $$i || exit 1; \
+ if test -f Jmakefile; then \
+ $(MAKE) $(MFLAGS) -f ../Makefile \
+ Makefile TOP=$$newtop CURRENT=$(DIR)$$i && \
+ $(MAKE) $(MFLAGS) Makefiles.SH; \
+ fi; \
+ ) || exit 1; \
done
all::
@$(MAKE) subdirs TARGET=all VERB="Making all" FLAGS=
+local_install::
+local_deinstall::
+local_install.man::
+local_deinstall.man::
+
!NO!SUBS!
chmod 644 Makefile
$eunicefix Makefile
Modified: trunk/mailagent/agent/pl/biff.pl
===================================================================
--- trunk/mailagent/agent/pl/biff.pl 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/agent/pl/biff.pl 2008-06-27 17:02:06 UTC (rev 53)
@@ -35,7 +35,7 @@
;# mailagent-specific daemon on another host is not easy to set-up, and that
;# daemon is vaporware today anyway].
;#
-;# This package relies on pl/utmp/utmp.pl.
+;# This package relies on pl/utmp/utmp.pl and pl/termios/termios.pl.
#
# Local biff support
#
@@ -65,14 +65,29 @@
$tty = "/dev/$tty" unless $'test_mode; # Re-anchor name in file system
return unless -x $tty; # Return if no biffing wanted on that tty
- &'add_log("biffing $cf'user on $tty") if $'loglvl > 8;
+ my ($row, $col) = termios'size($tty);
+ &'add_log("WARNING cannot compute size of $tty: $row")
+ if defined($row) && !defined($col) && $'loglvl > 3;
+ my $assuming = "";
+ unless (defined $col) {
+ ($row, $col) = (24, 80);
+ $assuming = "assuming ";
+ }
+ &'add_log("biffing $cf'user on $tty ($assuming$row x $col)")
+ if $'loglvl > 8;
local($folder) = &'tilda($path); # Replace home directory with a ~
local($n) = "\n\r"; # Use \r in case tty is in raw mode
+ # Biffing context containing the amount of lines we can still emit before
+ # reaching the size of the window, and the amount of columns we have for
+ # displaying the text.
+ local @context = ($row, $col);
+
unless (open(TTY, ">$tty")) {
- &'add_log("ERROR cannot open $tty: $!") if $'loglvl;
- &'add_log("WARNING unable to biff for $folder ($type)") if $'loglvl > 5;
+ &'add_log("ERROR cannot write on $tty: $!") if $'loglvl;
+ &'add_log("WARNING unable to biff for $folder ($type) on $tty")
+ if $'loglvl > 5;
return;
}
@@ -107,7 +122,7 @@
local($format, $type) = @_;
unless (open(FORMAT, $format)) {
&'add_log("ERROR cannot open biff format $format: $!") if $'loglvl > 1;
- &default; # Use default format then
+ &default; # Use default format then
return;
}
@@ -174,9 +189,23 @@
: \02!
EOM
local($_);
+ my $reformat = $cf'biffnice =~ /^on/i;
+ my $width = $context[1];
while (<FORMAT>) {
chop;
- print TTY &'macros_subst(*_), $n;
+ my @lines = split($n, &'macros_subst(*_));
+ if (@lines) {
+ foreach my $l (@lines) {
+ if ($reformat) {
+ local @tmp;
+ &format($l, $width, *tmp); # Format line into @tmp
+ $l = join($n, @tmp);
+ }
+ print TTY $l, $n;
+ }
+ } else {
+ print TTY $n;
+ }
}
close FORMAT;
¯o'unload; # Release customized macros
@@ -188,8 +217,13 @@
# Default biffing
sub default {
- print TTY "$n\07New $mtype for $cf'user has arrived in $folder:$n";
+ my $header = "New $mtype for $cf'user has arrived in $folder:";
+ my $width = $context[1];
+ my $lines = int(length($header) / $width) + 1;
+ $lines-- if 0 == length($header) % $width;
+ print TTY "$n\07$header$n";
print TTY "----$n";
+ $context[0] -= $lines + 1; # Header line plus dashes
print TTY &all;
print TTY "$n----\07$n";
}
@@ -207,15 +241,16 @@
}
# Returns mail headers defined in @head, on the opened TTY
-# If the header length is greater than 79 characters, it is trimmed at 76 and
+# If the header length is greater than the tty width, it is trimmed and
# three dots '...' are emitted to show something was truncated.
# Also known as the %-H macro
sub headers {
local($res) = '';
+ my $width = $context[1]; # tty columns
foreach $head (@head) {
next unless defined $'Header{$head};
- local($line) = "$head: $'Header{$head}";
- $line = substr($line, 0, 76) . '...' if length($line) >= 80;
+ local($line) = unquote_printable("$head: $'Header{$head}");
+ $line = substr($line, 0, $width - 4) . '...' if length($line) >= $width;
$res .= "$line$n";
}
chop($res); # Remove final \n\r for macro substitution
@@ -223,6 +258,12 @@
$res;
}
+# Is line a blank one?
+sub is_blank {
+ my ($l) = @_;
+ return $l =~ /^[\W_]*$/; # Contains only non-words and underscores
+}
+
# Print first $cf'bifflines lines or $cf'bifflen charaters, whichever
# comes first. Assumes TTY already opened correctly
# Also known as the %-B macro if called body(0), or %-T if called body(1).
@@ -230,7 +271,7 @@
local($trim) = @_; # Whether top reply text should be trimmed
local($len) = defined $cf'bifflen ? $cf'bifflen : 560;
local($lines) = defined $cf'bifflines ? $cf'bifflines : 7;
- local(@body) = split(/\n/, ${$'Header{'=Body='}});
+ local(@body) = split(/\r?\n/, ${$'Header{'=Body='}});
local($skipnl) = $cf'biffnl =~ /OFF/i; # Skip blank lines?
local($_);
local($res) = '';
@@ -248,8 +289,29 @@
&trim(*body) if $trim; # Smart trim of leading reply text
&mh(*body, $len) if $cf'biffmh =~ /^on/i;
+ my $reformat = $cf'biffnice =~ /^on/i;
+ my $width = $context[1];
+ my $tl = 8; # tab length
+
while ($len > 0 && $lines > 0 && defined ($_ = shift(@body))) {
- next if /^\W*$/ && $skipnl;
+ next if $skipnl && is_blank($_);
+ my $line_length = 0;
+ 1 while s|\t|' ' x ($tl - length($`) % $tl)|e; # Expand tabs
+ s/[\x0-\x1f]//g; # Remove all control chars
+ if ($reformat) {
+ local @tmp;
+ &format($_, $width, *tmp); # Format line into @tmp
+ @tmp = grep(!is_blank($_), @tmp) if $skipnl;
+ foreach my $l (@tmp) {
+ $line_length += length $l; # Do not count newlines
+ $lines--;
+ }
+ $_ = join($n, @tmp);
+ } else {
+ $line_length = length $_;
+ $lines -= int($line_length / $width) + 1;
+ $lines++ if 0 == $line_length % $width;
+ }
# Check for overflow, in case we use mh-style biffing and no
# reformatting occurred: we may be facing a huge string!
if (length($_) > $len) {
@@ -257,8 +319,7 @@
} else {
$res .= $_ . $n;
}
- $len -= length($_); # Nobody will quibble over missing newline...
- $lines--;
+ $len -= $line_length;
}
$res .= "...more...$n" if @body > 0 || $len < 0;
chop($res); # Remove final \n\r for macro substitution
@@ -392,32 +453,26 @@
$line .= $_ . ' ';
}
chop($line); # Remove trailing extra space
- $ary[0] = $line; # Replace first body line with compacted string
+ $ary[0] = $line; # This is all we keep
# We stopped compating at index $i - 1, and indices start at 0. This means
# lines in the range [0, $i-1] are now all stored as $ary[0], and lines
# from [1, $i-1] must be removed from the array ($i-1 lines).
+ # We keep the extra lines so that a "...more..." indication can be given
+ # if needed.
splice(@ary, 1, $i - 1); # Remove lines that are now part of $ary[0]
-
- # Now optionally reformat the first line so that it fits into 80 columns.
- # The line is formatted into an array, and that array is spliced back
- # into @ary.
-
- return unless $cf'biffnice =~ /^on/i;
- local(@tmp);
- &format($line, *tmp); # Format line into @tmp
- splice(@ary, 0, 1, @tmp); # Insert formatted string back
}
-
-# Format body to fit into 78 columns by inserting the generated lines in an
+# Format body to fit into tty width by inserting the generated lines in an
# array, one line per item.
sub format {
- local($body, *ary) = @_; # Body to be formatted, array for result
+ # Body to be formatted, tty width, array for result
+ local($body, $width, *ary) = @_;
local($tmp); # Buffer for temporary formatting
local($kept); # Length of current line
- local($len) = 79; # Amount of characters kept
+ local($len) = $width - 1; # Amount of characters kept
+ $len = 1 if $len < 1; # Avoid infinite loop if bad parameter
# Format body, separating lines on [;,:.?!] or space.
while (length($body) > $len) {
$tmp = substr($body, 0, $len); # Keep first $len chars
@@ -426,11 +481,27 @@
$tmp =~ s/\s*$//; # Remove trailing spaces
$tmp =~ s/^\s*//; # Remove leading spaces
push(@ary, $tmp); # Create a new line
- $body = substr($body, $kept, 9999);
+ $body = substr($body, $kept, length $body);
}
push(@ary, $body); # Remaining information on one line
}
+# One-liner quoted-printable decoder
+sub to_txt {
+ my ($l) = @_;
+ $l =~ s/=([\da-fA-F]{2})/pack('C', hex($1))/ge;
+ return $l;
+}
+
+# Quick removal of quoted-printable escapes within the headers
+# We do not care about the charset and hope the tty will be able to display
+# the characters just fine.
+sub unquote_printable {
+ my ($l) = @_;
+ $l =~ s/^(.*?)=\?[\w-]+\?Q\?(.*)\?=/$1 . to_txt($2)/ieg && $l =~ s/_/ /g;
+ return $l;
+}
+
# Un-MIME the body by removing all the MIME headers and looking for the
# first text entity in the message.
# The supplied array is updated in-place and will contain on return the
@@ -586,7 +657,7 @@
$in_style-- while $l =~ s|</style>||;
next if $in_style;
$l =~ s/<[^\0]*?>//g;
- $l =~ s/&(\w)cedil;/$1/g;
+ $l =~ s/&(\w)cedil;/$1/g; # Transform into ASCII...
$l =~ s/&(\w)acute;/$1/g;
$l =~ s/&(\w)grave;/$1/g;
$l =~ s/&(\w)circ;/$1/g;
@@ -594,7 +665,8 @@
$l =~ s/"/'/g;
$l =~ s/ / /g;
$l =~ s/ / /g; # Same as
- $l =~ s/&#(\d+);/chr($1)/g; # Corect only for the ASCII part...
+ # Corect only for the ASCII part...
+ $l =~ s/&#(\d+);/($1 > 31 && $1 < 256) ? chr($1) : "?"/ge;
$l =~ s/&/&/g; # Must come last
$l =~ s/^\s*//;
$is_nl = 0 == length($l);
Added: trunk/mailagent/agent/pl/termios/Jmakefile
===================================================================
--- trunk/mailagent/agent/pl/termios/Jmakefile (rev 0)
+++ trunk/mailagent/agent/pl/termios/Jmakefile 2008-06-27 17:02:06 UTC (rev 53)
@@ -0,0 +1,30 @@
+/*
+ * Jmakefile for termios.pl
+ */
+
+;# $Id: Jmakefile,v 3.0.1.1 1994/10/29 18:12:18 ram Exp ram $
+;#
+;# Copyright (c) 1990-2006, Raphael Manfredi
+;#
+;# You may redistribute only under the terms of the Artistic License,
+;# as specified in the README file that comes with the distribution.
+;# You may reuse parts of this distribution only within the terms of
+;# that same Artistic License; a copy of which may be found at the root
+;# of the source tree for mailagent 3.0.
+;#
+;# $Log: Jmakefile,v $
+;# Revision 3.0.1.1 1994/10/29 18:12:18 ram
+;# patch20: created
+;#
+
+CFLAGS = -I$(TOP)
+DPFLAGS = -I$(TOP)
+
+DependTarget()
+SimpleProgramTarget(termios_ph)
+
+AllTarget(termios.pl)
+
+termios.pl: termios_pl.sh termios_ph
+ /bin/sh termios_pl.sh
+
Property changes on: trunk/mailagent/agent/pl/termios/Jmakefile
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/mailagent/agent/pl/termios/Makefile.SH
===================================================================
--- trunk/mailagent/agent/pl/termios/Makefile.SH (rev 0)
+++ trunk/mailagent/agent/pl/termios/Makefile.SH 2008-06-27 17:02:06 UTC (rev 53)
@@ -0,0 +1,211 @@
+: Makefile.SH generated from Jmake.tmpl and Jmakefile [jmake 3.5-25]
+: $X-Id: Jmake.tmpl 8 2006-08-25 22:27:18Z rmanfredi $
+
+case $CONFIG in
+'')
+ if test -f config.sh; then TOP=.;
+ elif test -f ../config.sh; then TOP=..;
+ elif test -f ../../config.sh; then TOP=../..;
+ elif test -f ../../../config.sh; then TOP=../../..;
+ elif test -f ../../../../config.sh; then TOP=../../../..;
+ else
+ echo "Can't find config.sh."; exit 1
+ fi
+ . $TOP/config.sh
+ ;;
+esac
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+CURRENT=agent/pl/termios
+DIR=`echo $CURRENT/ | sed -e 's/\.\///g'`
+echo "Extracting ${DIR}Makefile (with variable substitutions)"
+
+DATE=`date`
+
+$spitshell >Makefile <<!GROK!THIS!
+########################################################################
+# Makefile generated from Makefile.SH on $DATE
+
+SHELL = /bin/sh
+JMAKE = jmake
+TOP = ../../..
+CURRENT = $CURRENT
+DIR = $DIR
+
+########################################################################
+# Parameters set by Configure -- edit config.sh if changes are needed
+
+CC = $cc
+CTAGS = ctags
+_EXE = $_exe
+JCFLAGS = \$(CFLAGS) $optimize $ccflags $large
+JCPPFLAGS = $cppflags
+JLDFLAGS = \$(LDFLAGS) $optimize $ldflags
+LIBS = $libs
+MKDEP = $mkdep \$(DPFLAGS) \$(JCPPFLAGS) --
+MV = $mv
+RM = $rm -f
+SED = $sed
+
+########################################################################
+# Automatically generated parameters -- do not edit
+
+USRINC = $usrinc
+SOURCES = termios_ph.c
+OBJECTS = termios_ph.o
+
+########################################################################
+# New suffixes and associated building rules -- edit with care
+
+.c.o:
+ \$(CC) -c \$(JCFLAGS) \$<
+
+!GROK!THIS!
+$spitshell >>Makefile <<'!NO!SUBS!'
+########################################################################
+# Jmake rules for building libraries, programs, scripts, and data files
+# $X-Id: Jmake.rules 18 2006-12-27 10:35:09Z rmanfredi $
+
+########################################################################
+# Force 'make depend' to be performed first -- do not edit
+
+.FORCE_DEPEND::
+
+all:: .FORCE_DEPEND
+
+########################################################################
+# Start of Jmakefile
+
+# $X-Id: Jmakefile,v 3.0.1.1 1994/10/29 18:12:18 ram Exp ram $
+#
+# Copyright (c) 1990-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic License,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic License; a copy of which may be found at the root
+# of the source tree for mailagent 3.0.
+#
+# $X-Log: Jmakefile,v $
+# Revision 3.0.1.1 1994/10/29 18:12:18 ram
+# patch20: created
+#
+
+CFLAGS = -I$(TOP)
+DPFLAGS = -I$(TOP)
+
+depend:: ../../../mkdep
+
+../../../mkdep:
+ @echo "You have to run Configure in $(TOP) first."; exit 1
+
+depend::
+ ($(SED) '/^# DO NOT DELETE/q' Makefile && \
+ $(MKDEP) $(SOURCES) | \
+ $(SED) -e 's:/usr/lib[^ ]*::g; s:$(USRINC)[^ ]*::g; ' \
+ -e '/: / b print' -e '$$ b print' -e 'H; d; n; : print' \
+ -e 'x; s/\\$$//; s/\\\n//g; s/ */ /g; s/ :/:/;' -e '/: *$$/d' \
+ ) > Makefile.new
+ cp Makefile Makefile.bak
+ cp Makefile.new Makefile
+ $(RM) Makefile.new
+
+all:: termios_ph
+
+local_realclean::
+ $(RM) termios_ph
+
+termios_ph: termios_ph.o
+ $(RM) $@
+ if test -f $@$(_EXE); then \
+ $(MV) $@$(_EXE) $@~$(_EXE); fi
+ $(CC) -o $@ termios_ph.o $(JLDFLAGS) $(LIBS)
+
+all:: termios.pl
+
+local_realclean::
+ $(RM) termios.pl
+
+termios.pl: termios_pl.sh termios_ph
+ /bin/sh termios_pl.sh
+
+########################################################################
+# Common rules for all Makefiles -- do not edit
+
+all::
+
+clean: local_clean
+realclean: local_realclean
+clobber: local_clobber
+
+local_clean::
+ if test -f core; then $(RM) core; fi
+ $(RM) *~ *.o
+
+local_realclean:: local_clean
+
+local_clobber:: local_realclean
+ $(RM) Makefile config.sh
+
+install:: local_install
+install.man:: maybe_install.man
+deinstall:: local_deinstall
+deinstall.man:: maybe_deinstall.man
+
+install.man-no:
+deinstall.man-no:
+
+maybe_install.man: install.man-no
+maybe_deinstall.man: deinstall.man-no
+
+Makefile.SH: Jmakefile
+ -@if test -f $(TOP)/.package; then \
+ if test -f Makefile.SH; then \
+ echo " $(RM) Makefile.SH~; $(MV) Makefile.SH Makefile.SH~"; \
+ $(RM) Makefile.SH~; $(MV) Makefile.SH Makefile.SH~; \
+ fi; \
+ echo " $(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT)" ; \
+ $(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT) ; \
+ else touch $@; fi
+
+Makefile: Makefile.SH
+ /bin/sh Makefile.SH
+
+tags::
+ $(CTAGS) -w *.[ch]
+ $(CTAGS) -xw *.[ch] > tags
+
+local_clobber::
+ $(RM) tags
+
+########################################################################
+# Empty rules for directories with no sub-directories -- do not edit
+
+local_install::
+ @echo "install in $(CURRENT) done."
+
+local_deinstall::
+ @echo "deinstall in $(CURRENT) done."
+
+local_install.man::
+ @echo "install.man in $(CURRENT) done."
+
+local_deinstall.man::
+ @echo "deinstall.man in $(CURRENT) done."
+
+Makefiles::
+
+Makefiles.SH::
+
+########################################################################
+# Dependencies generated by make depend
+# DO NOT DELETE THIS LINE -- make depend relies on it
+
+# Put nothing here or make depend will gobble it up
+.FORCE_DEPEND::
+ @echo "You must run 'make depend' in $(TOP) first."; exit 1
+!NO!SUBS!
+chmod 644 Makefile
+$eunicefix Makefile
+
Property changes on: trunk/mailagent/agent/pl/termios/Makefile.SH
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Added: trunk/mailagent/agent/pl/termios/termios_ph.c
===================================================================
--- trunk/mailagent/agent/pl/termios/termios_ph.c (rev 0)
+++ trunk/mailagent/agent/pl/termios/termios_ph.c 2008-06-27 17:02:06 UTC (rev 53)
@@ -0,0 +1,156 @@
+/*
+ * termios_ph.c -- Generates perl configuration for termios.
+ */
+
+/*
+ * $Id$
+ *
+ * Copyright (c) 2008, Raphael Manfredi
+ *
+ * You may redistribute only under the terms of the Artistic License,
+ * as specified in the README file that comes with the distribution.
+ * You may reuse parts of this distribution only within the terms of
+ * that same Artistic License; a copy of which may be found at the root
+ * of the source tree for mailagent 3.0.
+ */
+
+/*
+ * Only two fields are of interest in struct winsize and need to be unpacked
+ * by perl:
+ *
+ * . ws_row The number of rows in the tty
+ * . ws_col The number of columns in the tty
+ *
+ * This program generates those perl lines:
+ *
+ * $TIOCGWINSZ = 0x1234; # The TIOCGWINSZ ioctl()
+ * $packfmt = 'SS'; # ws_row ws_col
+ * $length = 8; # sizeof(struct winsize)
+ * @fields = ('row', 'col', );
+ */
+
+#define MAX_LEN 1024 /* Max length for strings */
+#define PADSTR "..pad.. " /* Pad string, for comment */
+
+#include "config.h"
+
+#include <stdio.h>
+
+#ifdef I_STRING
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+
+#ifdef I_STDLIB
+#include <stdlib.h>
+#endif
+
+#ifdef I_TERMIOS
+#include <termios.h>
+#endif
+
+#ifdef I_SYS_IOCTL
+#include <sys/ioctl.h>
+#endif
+
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
+#include "confmagic.h"
+
+#define minimum(a,b) ((a) < (b) ? (a) : (b))
+#define maximum(a,b) ((a) < (b) ? (b) : (a))
+
+char *padstr = PADSTR;
+
+#define ADD_ROW \
+ strcat(comment, "ws_row "); \
+ sprintf(buf, "%c", 'S'); \
+ strcat(fields, "'row', "); \
+ last_off += row_len;
+
+#define ADD_COL \
+ strcat(comment, "ws_col "); \
+ sprintf(buf, "%c", 'S'); \
+ strcat(fields, "'col', "); \
+ last_off += col_len;
+
+int main()
+{
+#ifdef I_TERMIOS
+ struct winsize *win = (struct winsize *) 0;
+ char comment[MAX_LEN];
+ char pack[MAX_LEN];
+ char fields[MAX_LEN];
+ char buf[MAX_LEN];
+ int row_off = (int) &win->ws_row; /* Offset of ws_row */
+ int col_off = (int) &win->ws_col; /* Offset of ws_col */
+ int row_len = sizeof(win->ws_row); /* Size of ws_row */
+ int col_len = sizeof(win->ws_col); /* Size of ws_col */
+ int last_off = 0; /* Last offset in pack format */
+ int offset;
+
+ *comment = '\0'; /* So that we may strcat() later */
+ *pack = '\0';
+ sprintf(fields, "(");
+
+ /*
+ * In case none of ws_row and ws_col begins the structure...
+ */
+ if ((last_off = minimum(row_off, col_off)) != 0) {
+ strcat(comment, padstr);
+ sprintf(pack, "x%d", last_off);
+ strcat(fields, "'pad', ");
+ }
+
+ /*
+ * Find out which of ws_row and ws_col comes first...
+ */
+ if (row_off < col_off) { /* ws_row is first */
+ ADD_ROW;
+ } else {
+ ADD_COL;
+ }
+ strcat(pack, buf);
+
+ /*
+ * Possible padding between ws_row and ws_col.
+ */
+ offset = maximum(row_off, col_off) - last_off;
+ if (offset > 0) {
+ strcat(comment, padstr);
+ strcat(fields, "'pad', ");
+ sprintf(buf, "x%d", offset);
+ strcat(pack, buf);
+ last_off += offset;
+ }
+
+ /*
+ * Last field before final padding.
+ */
+ if (last_off == col_off) {
+ ADD_COL;
+ } else {
+ ADD_ROW;
+ }
+ strcat(pack, buf);
+
+ strcat(fields, ")");
+
+ /*
+ * Spit out perl definitions.
+ */
+ printf("$TIOCGWINSZ = 0x%x;\t# The TIOCGWINSZ ioctl()\n", TIOCGWINSZ);
+ printf("$packfmt = '%s';\t\t# %s\n", pack, comment);
+ printf("$length = %d;\t\t\t# sizeof(struct winsize)\n",
+ sizeof(struct winsize));
+ printf("@fields = %s;\n", fields);
+#else
+ printf("$TIOCGWINSZ = undef;\t# No termios\n");
+#endif /* I_TERMIOS */
+
+ exit(0);
+}
+
Property changes on: trunk/mailagent/agent/pl/termios/termios_ph.c
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Added: trunk/mailagent/agent/pl/termios/termios_pl.sh
===================================================================
--- trunk/mailagent/agent/pl/termios/termios_pl.sh (rev 0)
+++ trunk/mailagent/agent/pl/termios/termios_pl.sh 2008-06-27 17:02:06 UTC (rev 53)
@@ -0,0 +1,80 @@
+case $CONFIG in
+'')
+ if test -f config.sh; then TOP=.;
+ elif test -f ../config.sh; then TOP=..;
+ elif test -f ../../config.sh; then TOP=../..;
+ elif test -f ../../../config.sh; then TOP=../../..;
+ elif test -f ../../../../config.sh; then TOP=../../../..;
+ else
+ echo "Can't find config.sh."; exit 1
+ fi
+ . $TOP/config.sh
+ ;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting agent/pl/termios/termios.pl (with variable substitutions)"
+$cat >termios.pl <<!GROK!THIS!
+;# $Id: utmp_pl.sh,v 3.0.1.2 1995/01/03 18:18:48 ram Exp ram $
+;#
+;# Copyright (c) 2008, Raphael Manfredi
+;#
+;# You may redistribute only under the terms of the Artistic License,
+;# as specified in the README file that comes with the distribution.
+;# You may reuse parts of this distribution only within the terms of
+;# that same Artistic License; a copy of which may be found at the root
+;# of the source tree for mailagent 3.0.
+;#
+;# Primitives to acess the terminal through the POSIX termios interface
+;#
+#
+# termios primitives
+#
+
+package termios;
+
+# Initialize constants
+sub init {
+ # (configured and automatically generated section)
+!GROK!THIS!
+./termios_ph | $sed -e 's/^/ /' >>termios.pl
+$cat >>termios.pl <<'!NO!SUBS!'
+ # (end of configured section)
+
+ $inited = 1;
+}
+
+# Decompile the winsize structure, returning (row, col)
+sub decompile {
+ my ($buf) = @_;
+ my @f = unpack($packfmt, $buf);
+ my %win;
+ foreach my $field (@fields) {
+ next if $field eq 'pad'; # Padding just skipped over
+ $win{$field} = shift @f; # This field was decoded by unpack()
+ }
+ return ($win{'row'}, $win{'col'});
+}
+
+# Determine the tty size, returning (row, col).
+# Returns () if we cannot determine the size due to missing termios.
+# Returns an (error) if there was an error during size computation.
+sub size {
+ my ($tty) = @_;
+ &init unless $inited;
+ return () unless defined $TIOCGWINSZ; # No termios
+ local *TTY;
+ open(TTY, $tty) || return ("cannot open $tty: $!");
+ my $win = ' ' x $length;
+ my $res = ioctl(TTY, $TIOCGWINSZ, $win);
+ close TTY;
+ return ("ioctl(TIOCGWINSZ) on $tty failed: $!") unless defined $res;
+ return decompile($win);
+}
+
+package main;
+
+!NO!SUBS!
Modified: trunk/mailagent/config_h.SH
===================================================================
--- trunk/mailagent/config_h.SH 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/config_h.SH 2008-06-27 17:02:06 UTC (rev 53)
@@ -301,6 +301,14 @@
*/
#$i_syswait I_SYS_WAIT /**/
+/* I_TERMIOS:
+ * This symbol, if defined, indicates that the program should include
+ * the POSIX termios.h rather than sgtty.h or termio.h.
+ * There are also differences in the ioctl() calls that depend on the
+ * value of this symbol.
+ */
+#$i_termios I_TERMIOS /**/
+
/* I_TIME:
* This symbol, if defined, indicates to the C program that it should
* include <time.h>.
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-27 16:41:09 UTC (rev 52)
+++ trunk/mailagent/revision.h 2008-06-27 17:02:06 UTC (rev 53)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 44
+#define REVISION 50
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-27 16:41:13
|
Revision: 52
http://mailagent.svn.sourceforge.net/mailagent/?rev=52&view=rev
Author: rmanfredi
Date: 2008-06-27 09:41:09 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
A bug in header'news_fmt() was at the origin of the behaviour of INN regarding
References: lines. Now that it is fixed, restore regular calls to news_fmt()
for References and Subject headers.
Modified Paths:
--------------
trunk/mailagent/agent/pl/actions.pl
trunk/mailagent/agent/pl/header.pl
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-26 21:49:44 UTC (rev 51)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-27 16:41:09 UTC (rev 52)
@@ -823,9 +823,7 @@
} else {
my $subject = $Header{'Subject'};
$subject =~ tr/\n/ /; # Multiples instances collapsed
- # Avoid a Subject: line on its own for INN, even if it means a line
- # slightly longer than 80 chars.
- print NEWS "Subject: ", header'news_fmt($subject), "\n";
+ print NEWS header'news_fmt("Subject: $subject\n");
}
# If no proper Message-ID is present, generate one
@@ -953,7 +951,7 @@
# INN does not like an empty References: line, even if properly
# followed by continuations. Therefore, cheat to force the message
# to have at least one ref on the line.
- print NEWS "References: ", header'news_fmt($refs), "\n";
+ print NEWS header'news_fmt("References: $refs\n");
}
# Any address included withing "" means addresses are stored in a file
Modified: trunk/mailagent/agent/pl/header.pl
===================================================================
--- trunk/mailagent/agent/pl/header.pl 2008-06-26 21:49:44 UTC (rev 51)
+++ trunk/mailagent/agent/pl/header.pl 2008-06-27 16:41:09 UTC (rev 52)
@@ -218,7 +218,7 @@
$new .= $cont if $new; # Continuation starts with 8 spaces
$len = 70; # Account continuation for next line
$new .= "$tmp\n";
- $field = substr($field, $kept, 9999);
+ $field = substr($field, $kept, length $field);
}
$new .= $cont if $new; # Add 8 chars if continuation
$new .= $field; # Remaining information on one line
@@ -237,7 +237,7 @@
if ($continuation) {
$res = (' ' x 8) . $res; # Can be larger than 80 chars, but it's OK
} else {
- $res =~ s/^([\w-]+):(\S)/$1: $2/ || $res =~ s/^([\w-]+):$/$1: /;
+ $res =~ s/^([\w-]+):(\S)/$1: $2/s || $res =~ s/^([\w-]+):\n/$1: \n/s;
}
return $res;
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-26 21:49:46
|
Revision: 51
http://mailagent.svn.sourceforge.net/mailagent/?rev=51&view=rev
Author: rmanfredi
Date: 2008-06-26 14:49:44 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
POST: special-case the References: line and the Subject: line to avoid any
continuation right after the header name: INN chokes on References: and could
as well choke on Subject:, since it also validates its presence.
Modified Paths:
--------------
trunk/mailagent/agent/pl/actions.pl
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-26 20:25:30 UTC (rev 50)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-26 21:49:44 UTC (rev 51)
@@ -823,7 +823,9 @@
} else {
my $subject = $Header{'Subject'};
$subject =~ tr/\n/ /; # Multiples instances collapsed
- print NEWS header'news_fmt("Subject: $subject\n");
+ # Avoid a Subject: line on its own for INN, even if it means a line
+ # slightly longer than 80 chars.
+ print NEWS "Subject: ", header'news_fmt($subject), "\n";
}
# If no proper Message-ID is present, generate one
@@ -883,7 +885,8 @@
/^X-Trace:/i || # idem
/^Newsgroups:/i || # Reply from news reader
/^Return-Receipt-To:/i || # Sendmail's acknowledgment
- /^Received:/i || # We want to remove received
+ /^Received:/i || # We want to remove this MTA trace
+ /^Delivered-To:/i || # idem
/^Precedence:/i ||
/^X-Complaints-To:/i || # INN2 does not like this field
/^Errors-To:/i # Error report redirection
@@ -947,7 +950,10 @@
my $fixup = &header'msgid_cleanup(\$refs);
&add_log("WARNING fixed References line for news")
if $loglvl > 5 && $fixup;
- print NEWS header'news_fmt("References: $refs\n");
+ # INN does not like an empty References: line, even if properly
+ # followed by continuations. Therefore, cheat to force the message
+ # to have at least one ref on the line.
+ print NEWS "References: ", header'news_fmt($refs), "\n";
}
# Any address included withing "" means addresses are stored in a file
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-26 20:25:32
|
Revision: 50
http://mailagent.svn.sourceforge.net/mailagent/?rev=50&view=rev
Author: rmanfredi
Date: 2008-06-26 13:25:30 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
Added new header'news_fmt() routine which is similar to header'format() but
which takes special care of adding a space after the header name if the
continuation immediately follows.
Make sure POST uses only header'news_fmt() to reformat headers.
Fixed msgid_cleanup() to properly grok References with extra spaces between
two message IDs.
Modified Paths:
--------------
trunk/mailagent/agent/pl/actions.pl
trunk/mailagent/agent/pl/header.pl
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-26 19:19:43 UTC (rev 49)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-26 20:25:30 UTC (rev 50)
@@ -766,7 +766,7 @@
my ($faddr, $fcom) = &parse_address($Header{'From'});
$fcom = '"' . $fcom . '"' if $fcom =~ /[@.\(\)<>,:!\/=;]/;
if ($fcom ne '') {
- print NEWS header'format("From: $fcom <$faddr>\n");
+ print NEWS header'news_fmt("From: $fcom <$faddr>\n");
} else {
print NEWS "From: $faddr\n";
}
@@ -823,7 +823,7 @@
} else {
my $subject = $Header{'Subject'};
$subject =~ tr/\n/ /; # Multiples instances collapsed
- print NEWS header'format("Subject: $subject\n");
+ print NEWS header'news_fmt("Subject: $subject\n");
}
# If no proper Message-ID is present, generate one
@@ -922,7 +922,7 @@
&add_log("NOTICE added space after \"$header:\", for news")
if $loglvl > 5;
}
- print NEWS header'format($_), "\n";
+ print NEWS header'news_fmt($_), "\n";
}
# For correct threading, we need a References: line.
@@ -947,14 +947,14 @@
my $fixup = &header'msgid_cleanup(\$refs);
&add_log("WARNING fixed References line for news")
if $loglvl > 5 && $fixup;
- print NEWS header'format("References: $refs\n");
+ print NEWS header'news_fmt("References: $refs\n");
}
# Any address included withing "" means addresses are stored in a file
$newsgroups = &complete_list($newsgroups, 'newsgroup');
$newsgroups =~ s/\s/,/g; # Cannot have spaces between them
$newsgroups =~ tr/,/,/s; # Squash down consecutive ','
- print NEWS header'format("Newsgroups: $newsgroups\n");
+ print NEWS header'news_fmt("Newsgroups: $newsgroups\n");
print NEWS "Distribution: local\n" if $localdist;
print NEWS $FILTER, "\n"; # Avoid loops: inews may forward to sendmail
print NEWS "\n";
Modified: trunk/mailagent/agent/pl/header.pl
===================================================================
--- trunk/mailagent/agent/pl/header.pl 2008-06-26 19:19:43 UTC (rev 49)
+++ trunk/mailagent/agent/pl/header.pl 2008-06-26 20:25:30 UTC (rev 50)
@@ -175,7 +175,7 @@
# Regexps are written to work on both a single <id> as found in Message-ID
# lines, and on a space-separated list as found in References lines.
- s/>\s</>\01</g; # Protect spaces between IDs for References
+ s/>\s+</>\01</g; # Protect spaces between IDs for References
$fixup++ if s/\s/-/g; # No spaces
$fixup++ if s/_/-/g; # No _ in names
$fixup++ if s/[(){}]//g; # No () nor {} in names and ID
@@ -213,8 +213,8 @@
$tmp = substr($field, 0, $len); # Keep first $len chars
$tmp =~ s/^(.*)([,\s]).*/$1$2/; # Cut at last space or ,
$kept = length($tmp); # Amount of chars we kept
- $tmp =~ s/\s*$//; # Remove trailing spaces
- $tmp =~ s/^\s*//; # Remove leading spaces
+ $tmp =~ s/\s+$//; # Remove trailing spaces
+ $tmp =~ s/^\s+//; # Remove leading spaces
$new .= $cont if $new; # Continuation starts with 8 spaces
$len = 70; # Account continuation for next line
$new .= "$tmp\n";
@@ -224,6 +224,24 @@
$new .= $field; # Remaining information on one line
}
+# Same as format() but with extra magic for news articles: we must never
+# emit a continuation right after a header, there must be a single space
+# after the field name.
+# Also, this routine must work when called to format a continuation (field
+# stating with spaces).
+sub news_fmt {
+ my ($field) = @_; # Field to be formatted
+ my $continuation = 0;
+ $continuation++ if $field =~ s/^\s+//;
+ my $res = &format($field);
+ if ($continuation) {
+ $res = (' ' x 8) . $res; # Can be larger than 80 chars, but it's OK
+ } else {
+ $res =~ s/^([\w-]+):(\S)/$1: $2/ || $res =~ s/^([\w-]+):$/$1: /;
+ }
+ return $res;
+}
+
# Scan the head of a file and try to determine whether there is a mail
# header at the beginning or not. Return true if a header was found.
sub main'header_found {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-26 19:19:47
|
Revision: 49
http://mailagent.svn.sourceforge.net/mailagent/?rev=49&view=rev
Author: rmanfredi
Date: 2008-06-26 12:19:43 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
POST: use header'format() on header lines to avoid too long lines that would
be rejected by INN.
Modified Paths:
--------------
trunk/mailagent/agent/pl/actions.pl
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-26 19:18:44 UTC (rev 48)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-26 19:19:43 UTC (rev 49)
@@ -766,7 +766,7 @@
my ($faddr, $fcom) = &parse_address($Header{'From'});
$fcom = '"' . $fcom . '"' if $fcom =~ /[@.\(\)<>,:!\/=;]/;
if ($fcom ne '') {
- print NEWS "From: $fcom <$faddr>\n"; # One line
+ print NEWS header'format("From: $fcom <$faddr>\n");
} else {
print NEWS "From: $faddr\n";
}
@@ -823,7 +823,7 @@
} else {
my $subject = $Header{'Subject'};
$subject =~ tr/\n/ /; # Multiples instances collapsed
- print NEWS "Subject: $subject\n";
+ print NEWS header'format("Subject: $subject\n");
}
# If no proper Message-ID is present, generate one
@@ -922,7 +922,7 @@
&add_log("NOTICE added space after \"$header:\", for news")
if $loglvl > 5;
}
- print NEWS $_, "\n";
+ print NEWS header'format($_), "\n";
}
# For correct threading, we need a References: line.
@@ -947,14 +947,14 @@
my $fixup = &header'msgid_cleanup(\$refs);
&add_log("WARNING fixed References line for news")
if $loglvl > 5 && $fixup;
- print NEWS "References: $refs\n"; # One big happy line
+ print NEWS header'format("References: $refs\n");
}
# Any address included withing "" means addresses are stored in a file
$newsgroups = &complete_list($newsgroups, 'newsgroup');
$newsgroups =~ s/\s/,/g; # Cannot have spaces between them
$newsgroups =~ tr/,/,/s; # Squash down consecutive ','
- print NEWS "Newsgroups: $newsgroups\n";
+ print NEWS header'format("Newsgroups: $newsgroups\n");
print NEWS "Distribution: local\n" if $localdist;
print NEWS $FILTER, "\n"; # Avoid loops: inews may forward to sendmail
print NEWS "\n";
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-26 19:19:35
|
Revision: 48
http://mailagent.svn.sourceforge.net/mailagent/?rev=48&view=rev
Author: rmanfredi
Date: 2008-06-26 12:18:44 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
Fixed extraction from Configure, given we now always reference $TOP to
access revision.h.
Modified Paths:
--------------
trunk/mailagent/agent/mailpatch.SH
Modified: trunk/mailagent/agent/mailpatch.SH
===================================================================
--- trunk/mailagent/agent/mailpatch.SH 2008-06-26 19:18:00 UTC (rev 47)
+++ trunk/mailagent/agent/mailpatch.SH 2008-06-26 19:18:44 UTC (rev 48)
@@ -10,6 +10,8 @@
fi
. $TOP/config.sh
;;
+*)
+ TOP=..;;
esac
revision=`awk '/^#define[ ]*REVISION/ {print $3}' < $TOP/revision.h`
case "$0" in
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-26 19:18:21
|
Revision: 47
http://mailagent.svn.sourceforge.net/mailagent/?rev=47&view=rev
Author: rmanfredi
Date: 2008-06-26 12:18:00 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
Fixed extraction from Configure, given we now always reference $TOP to
access revision.h.
Modified Paths:
--------------
trunk/mailagent/agent/edusers.SH
trunk/mailagent/agent/maildist.SH
trunk/mailagent/agent/mailhelp.SH
trunk/mailagent/agent/maillist.SH
trunk/mailagent/agent/package.SH
Modified: trunk/mailagent/agent/edusers.SH
===================================================================
--- trunk/mailagent/agent/edusers.SH 2008-06-25 16:35:05 UTC (rev 46)
+++ trunk/mailagent/agent/edusers.SH 2008-06-26 19:18:00 UTC (rev 47)
@@ -10,6 +10,8 @@
fi
. $TOP/config.sh
;;
+*)
+ TOP=..;;
esac
revision=`awk '/^#define[ ]*REVISION/ {print $3}' < $TOP/revision.h`
case "$0" in
Modified: trunk/mailagent/agent/maildist.SH
===================================================================
--- trunk/mailagent/agent/maildist.SH 2008-06-25 16:35:05 UTC (rev 46)
+++ trunk/mailagent/agent/maildist.SH 2008-06-26 19:18:00 UTC (rev 47)
@@ -10,6 +10,8 @@
fi
. $TOP/config.sh
;;
+*)
+ TOP=..;;
esac
revision=`awk '/^#define[ ]*REVISION/ {print $3}' < $TOP/revision.h`
case "$0" in
Modified: trunk/mailagent/agent/mailhelp.SH
===================================================================
--- trunk/mailagent/agent/mailhelp.SH 2008-06-25 16:35:05 UTC (rev 46)
+++ trunk/mailagent/agent/mailhelp.SH 2008-06-26 19:18:00 UTC (rev 47)
@@ -10,6 +10,8 @@
fi
. $TOP/config.sh
;;
+*)
+ TOP=..;;
esac
revision=`awk '/^#define[ ]*REVISION/ {print $3}' < $TOP/revision.h`
case "$0" in
Modified: trunk/mailagent/agent/maillist.SH
===================================================================
--- trunk/mailagent/agent/maillist.SH 2008-06-25 16:35:05 UTC (rev 46)
+++ trunk/mailagent/agent/maillist.SH 2008-06-26 19:18:00 UTC (rev 47)
@@ -10,6 +10,8 @@
fi
. $TOP/config.sh
;;
+*)
+ TOP=..;;
esac
revision=`awk '/^#define[ ]*REVISION/ {print $3}' < $TOP/revision.h`
case "$0" in
Modified: trunk/mailagent/agent/package.SH
===================================================================
--- trunk/mailagent/agent/package.SH 2008-06-25 16:35:05 UTC (rev 46)
+++ trunk/mailagent/agent/package.SH 2008-06-26 19:18:00 UTC (rev 47)
@@ -10,6 +10,8 @@
fi
. $TOP/config.sh
;;
+*)
+ TOP=..;;
esac
revision=`awk '/^#define[ ]*REVISION/ {print $3}' < $TOP/revision.h`
case "$0" in
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-25 16:36:20
|
Revision: 46
http://mailagent.svn.sourceforge.net/mailagent/?rev=46&view=rev
Author: rmanfredi
Date: 2008-06-25 09:35:05 -0700 (Wed, 25 Jun 2008)
Log Message:
-----------
Added the -b switch to FEED and PIPE to remove any content-transfer-encoding
in the body.
Added the -e switch to FEED to let mailagent select the proper encoding for
the body we get back.
Modified Paths:
--------------
trunk/mailagent/agent/magent.sh
trunk/mailagent/agent/man/mailagent.SH
trunk/mailagent/agent/pl/actions.pl
trunk/mailagent/agent/pl/filter.pl
trunk/mailagent/agent/pl/macros.pl
trunk/mailagent/agent/pl/parse.pl
trunk/mailagent/agent/pl/runcmd.pl
trunk/mailagent/agent/test/actions
trunk/mailagent/agent/test/cmd/feed.t
trunk/mailagent/agent/test/cmd/pipe.t
Modified: trunk/mailagent/agent/magent.sh
===================================================================
--- trunk/mailagent/agent/magent.sh 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/magent.sh 2008-06-25 16:35:05 UTC (rev 46)
@@ -502,8 +502,10 @@
$BODY_INPUT = 1; # Give body of mail as stdin
$MAIL_INPUT = 2; # Pipe the whole mail
$HEADER_INPUT = 3; # Pipe the header only
+ $MAIL_INPUT_BINARY = 4; # Whole mail in binary (no transfer encoding)
$NO_FEEDBACK = 0; # No feedback wanted
$FEEDBACK = 1; # Feed result of command back into %Header
+ $FEEDBACK_ENCODING = 2; # Same as $FEEDBACK, but probe body for encoding
# The filter message
local($address) = &email_addr;
Modified: trunk/mailagent/agent/man/mailagent.SH
===================================================================
--- trunk/mailagent/agent/man/mailagent.SH 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/man/mailagent.SH 2008-06-25 16:35:05 UTC (rev 46)
@@ -17,7 +17,7 @@
echo "Extracting agent/man/mailagent.$manext (with variable substitutions)"
$rm -f mailagent.$manext
$spitshell >mailagent.$manext <<!GROK!THIS!
-.TH MAILAGENT $manext "Version $VERSION PL$PATCHLEVEL"
+.TH MAILAGENT $manext "Version $VERSION-$REVISION"
''' @(#) Manual page for mailagent's filter -- (c) ram February 1991
'''
''' $Id$
@@ -1570,6 +1570,13 @@
User who wrote the mail. If this line is missing, uses the address found in
the first From line.
.TP
+.I Length:
+The physical length of the body, in bytes, once content-transfer-encoding
+(if any) has been removed.
+.TP
+.I Lines:
+The amount of lines in the body (decoded, if necessary).
+.TP
.I To:
The main recipient(s) of the message. If this line is missing but a set of
\fIApparently-To:\fR lines is found, then those addresses are used instead. If
@@ -1906,7 +1913,7 @@
mail will never show up in the mailbox.
(Never fails)
.TP
-FEED \fIprogram\fR
+FEED [\fB-be\fR] \fIprogram\fR
Feed the whole message to a program and get the output back as the new
message. Hence the program appears as a filter for the whole
message. It does not tag the message as having been saved. A RESYNC
@@ -1915,7 +1922,41 @@
.sp
.B WARNING:
Your program must be able to properly parse a MIME message and must deal
-with transfer-encoded bodies by itself.
+with transfer-encoded bodies by itself. To make the program task simpler,
+you can supply the
+.B -b
+switch wich will let mailagent decode the whole body for you, suppressing
+any Content-Transfer-Encoding header (implying "binary"). This is an invalid
+message format for sending the message, but it makes processing easier.
+You still have to parse the MIME parts yourself though.
+.sp
+Using
+.B -b
+does not prevent your program from outputing a valid message back, one
+that can be possibly sent on the network so you have two options:
+either you do not supply any Content-Transfer-Encoding in the headers,
+and mailagent will recode the body for you using the initial transfer
+encoding present in the message (a relatively safe option if you make only
+changes in the body at well-defined spots without introducing 8-bit chars),
+or you can supply the Content-Transfer-Encoding yourself and perform the
+body encoding manually.
+.sp
+To be completely safe and minimize the work in your program, the
+.B -e
+switch will let mailagent analyse the message body you are returning and
+select the proper transfer encoding automatically. Since this
+will cause the whole body to be analysed, and it can be potentially huge,
+that behaviour must be explicitly asked for. If you need
+.B -e
+then you probably want
+.B -b
+as well (you can supply both by saying
+.B -be
+naturally).
+.sp
+If you do not supply any switch,
+mailagent will give you the message as-is and will get your message
+as-is without any additional magic.
.TP
FORWARD \fIaddress(es)\fR
Forward mail to the specified address(es). This acts as if a save had been
@@ -2037,7 +2078,7 @@
\fIRUN perl script\fR command. (Returns failure if the script did not compile
or returned a non-zero status).
.TP
-PIPE \fIprogram\fR
+PIPE [\fB-b\fR] \fIprogram\fR
Pipe the whole message to the specified program, but do not get anything
back. Any output is mailed to the user who runs the \fImailagent\fR.
The message is not tagged as having been saved in any case, so you must
@@ -2047,7 +2088,13 @@
.sp
.B WARNING:
Your program must be able to properly parse a MIME message and must deal
-with transfer-encoded bodies by itself.
+with transfer-encoded bodies by itself. To make the program task simpler,
+you can supply the
+.B -b
+switch wich will let mailagent decode the whole body for you, suppressing
+any Content-Transfer-Encoding header (implying "binary"). This is an invalid
+message format for sending the message, but it makes processing easier.
+You still have to parse the MIME parts yourself though.
.TP
POST [\fB\-lb\fR] \fInewsgroup(s)\fR
Post the message to the specified newsgroup(s) after having cleaned-up the
@@ -2526,6 +2573,8 @@
For instance, the SAVE command writes the \fIHead\fR, the \fIX-Filter:\fR line,
the end of header (a single newline) and then the \fIBody\fR (this is an
example only, not a documented feature :-).
+The \fI=Body=\fR key is special: it is a Perl reference to a scalar containing
+the body with any content transfer encoding removed.
.PP
Note that the \fI\$msgpath\fR variable holds only a snapshot of the folder path
at the time where the PERL escape
@@ -2596,7 +2645,7 @@
in \fIu@a.b.c\fR), converted to lower-case.
.TP
%L
-Length of the body part, in bytes
+Length of the body part, in bytes, with content-transfer-encoding removed.
.TP
%N
Full name of the sender (login name if none)
@@ -2659,7 +2708,7 @@
Message ID, if available (otherwise, this is a null string)
.TP
%l
-Number of lines in the message
+Number of lines in the message, once content-transfer-encoding has been removed
.TP
%m
Month of the year (01-12)
@@ -3939,11 +3988,15 @@
Run a shell command and return a failure status (0 for OK). The input parameter
may be one of the following constants (defined in the \fImain\fR package):
\$NO_INPUT to close standard input, \$BODY_INPUT to pipe the body of the
-current message, \$MAIL_INPUT to pipe the whole mail and \$HEADER_INPUT to
+current message, \$MAIL_INPUT to pipe the whole mail as-is,
+\$MAIL_INPUT_BINARY to pipe the whole mail after having removed any
+content transfer-encoding and \$HEADER_INPUT to
pipe the message header. The feedback parameter may be one of \$FEEDBACK or
\$NO_FEEDBACK depending whether or not you wish to use the standard output
to alter the corresponding part of the message. If no feedback is wanted, the
-output of the command is mailed back to the user.
+output of the command is mailed back to the user. The \$FEEDBACK_ENCODING
+is handled like \$FEEDBACK but will tell mailagent to look at the best
+suitable body encoding when the input is the whole message.
.TP
.I &main'parse_address(rfc822-address)
Parse an RFC822 e-mail address and return a two-elements array containing the
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-25 16:35:05 UTC (rev 46)
@@ -1216,6 +1216,24 @@
die "alarm call\n"; # Longjmp to shell_command
}
+# Print whole mail to supplied fd, without any Content-Transfer-Encoding.
+sub print_binary_mail {
+ my ($fd) = @_;
+ my $skip = 0;
+ foreach my $line (split(/\n/, $Header{'Head'})) {
+ if ($line =~ /^\s/) {
+ print $fd $line, "\n" unless $skip;
+ } else {
+ $skip = 0;
+ my ($field) = $line =~ /^([\w-]+):/;
+ $skip = lc($field) eq "content-transfer-encoding";
+ print $fd $line, "\n" unless $skip;
+ }
+ }
+ print $fd "\n";
+ print $fd ${$Header{'=Body='}}; # No content transfer-encoding
+}
+
# Execute the command, ran in an eval to protect against SIGPIPE signals
sub execute_command {
local($program, $input, $feedback) = @_;
@@ -1237,8 +1255,8 @@
close READ if $input == $NO_INPUT; # Close stdin if needed
unless (open(STDOUT, ">$trace")) { # Where output goes
&add_log("WARNING couldn't create $trace: $!") if $loglvl > 5;
- if ($feedback == $FEEDBACK) { # Need trace if feedback
- kill 'SIGPIPE', getppid; # Parent still waiting
+ if ($feedback != $NO_FEEDBACK) { # Need trace if feedback
+ kill 'SIGPIPE', getppid; # Parent still waiting
exit 1;
}
}
@@ -1264,6 +1282,8 @@
print WRITE ${$Header{'=Body='}};
} elsif ($input == $MAIL_INPUT) { # Pipes the whole mail
print WRITE $Header{'All'};
+ } elsif ($input == $MAIL_INPUT_BINARY) { # Remove any transfer encoding
+ print_binary_mail(\*WRITE);
} elsif ($input == $HEADER_INPUT) { # Pipes the header
print WRITE $Header{'Head'};
}
@@ -1275,7 +1295,7 @@
# Log execution failure and return to shell_command via die if some
# feedback was to be done.
&add_log("ERROR execution failed for '$program'") if $loglvl > 1;
- if ($feedback == $FEEDBACK) { # We wanted feedback
+ if ($feedback != $NO_FEEDBACK) { # We wanted feedback
&mail_back; # Mail back any output
unlink "$trace"; # Remove output of command
die "feedback\n"; # Longjmp to shell_command
@@ -1296,8 +1316,8 @@
sub handle_output {
if ($feedback == $NO_FEEDBACK) {
&mail_back; # Mail back any output
- } elsif ($feedback == $FEEDBACK) {
- &feed_back; # Feed result back into %Header
+ } else {
+ &feed_back($feedback); # Feed result back into %Header
}
}
@@ -1349,6 +1369,7 @@
# Feed back output of a command in the %Header data structure.
# Uses some local variables from execute_command
sub feed_back {
+ my ($feedback) = @_;
unless (open(TRACE, "$trace")) {
&add_log("ERROR couldn't feed back from $trace: $!") if $loglvl > 1;
unlink "$trace"; # Maybe I should leave it around
@@ -1390,19 +1411,47 @@
$Header{'Body'} = $temp unless $input == $HEADER_INPUT;
$Header{'All'} = $Header{'Head'} . "\n" . $Header{'Body'};
if ($input == $BODY_INPUT) {
- # Was fed *decoded* body, got at decoded body back.
+ # Was fed *decoded* body, got a decoded body back.
# Headers have not changed, recoding will happen as in the original
&body_recode;
- &header_update_size;
} elsif ($input == $MAIL_INPUT) {
# Headers could have changed and we need to reparse them in order
# to know how/whether we should decode the body.
&header_resync;
&body_check; # Update $Header{'=Body='} to point to *decoded* body
+ if ($feedback == $FEEDBACK_ENCODING) {
+ &header_resync if &body_recode_optimally;
+ }
} elsif ($input == $HEADER_INPUT) {
# Headers pertaining to body encoding could have changed.
&header_check_body_encoding; # Check and recode if possible
&header_resync; # Resynchronize %Header
+ } elsif ($input == $MAIL_INPUT_BINARY) {
+ # Was fed a *decoded* body, got at possibly decoded body back.
+ my $old_encoding = lc($Header{'Content-Transfer-Encoding'});
+ &header_resync;
+ &body_check; # Update $Header{'=Body='} to point to *decoded* body
+ if ($feedback == $FEEDBACK_ENCODING) {
+ # Scan the decoded body and determine the optimal content
+ # transfer encoding, recoding the body as needed and updating
+ # the headers should they change.
+ &header_resync if &body_recode_optimally;
+ } else {
+ # Adjust encoding if needed (they did not supply the -e to FEED)
+ my $current_encoding = lc($Header{'Content-Transfer-Encoding'});
+ my %encoded = map { $_ => 1 } qw(base64 quoted-printable);
+ # We need to recode if there is presently no encoding but there was
+ # one originally. They could have properly re-encoded the body,
+ # which is why we have to check for the current encoding.
+ if (!$encoded{$current_encoding} && $encoded{$old_encoding}) {
+ alter_header("Content-Transfer-Encoding", $HD_STRIP);
+ header_append(header'format(
+ "Content-Transfer-Encoding: $old_encoding\n"));
+ body_recode_with($old_encoding);
+ }
+ }
+ } else {
+ &add_log("ERROR BUG in feed_back: unknown input value \"$input\"");
}
}
Modified: trunk/mailagent/agent/pl/filter.pl
===================================================================
--- trunk/mailagent/agent/pl/filter.pl 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/pl/filter.pl 2008-06-25 16:35:05 UTC (rev 46)
@@ -327,7 +327,8 @@
# Run the PIPE command
sub run_pipe {
local($program) = @_; # Program to run
- local($failed) = &shell_command($program, $MAIL_INPUT, $NO_FEEDBACK);
+ my $mail = $opt'sw_b ? $MAIL_INPUT_BINARY : $MAIL_INPUT;
+ local($failed) = &shell_command($program, $mail, $NO_FEEDBACK);
unless ($failed) {
&add_log("PIPED [$mfile] to '$program'") if $loglvl > 4;
}
@@ -357,7 +358,9 @@
# Run the FEED command
sub run_feed {
local($program) = @_; # Program to run
- local($failed) = &shell_command($program, $MAIL_INPUT, $FEEDBACK);
+ my $mail = $opt'sw_b ? $MAIL_INPUT_BINARY : $MAIL_INPUT;
+ my $feedback = $opt'sw_e ? $FEEDBACK_ENCODING : $FEEDBACK;
+ local($failed) = &shell_command($program, $mail, $feedback);
unless ($failed) {
&add_log("FED [$mfile] through '$program'") if $loglvl > 4;
}
Modified: trunk/mailagent/agent/pl/macros.pl
===================================================================
--- trunk/mailagent/agent/pl/macros.pl 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/pl/macros.pl 2008-06-25 16:35:05 UTC (rev 46)
@@ -36,7 +36,7 @@
;# %D Day of the week (0-6)
;# %H Host name (name of the machine on which the mailagent runs)
;# %I Internet domain from sender (domain.ct in us...@ho...main.ct)
-;# %L Length of the message in bytes (without header)
+;# %L Length of the message in bytes (without header, no transfer encoding)
;# %N Full name of sender (login name if none)
;# %O Organization name from sender address (domain in us...@ho...main.ct)
;# %R Subject of orginal message with leading Re: suppressed
Modified: trunk/mailagent/agent/pl/parse.pl
===================================================================
--- trunk/mailagent/agent/pl/parse.pl 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/pl/parse.pl 2008-06-25 16:35:05 UTC (rev 46)
@@ -244,6 +244,16 @@
return $first_from;
}
+# Compute amount of lines listed in the header
+# We do NOT use $Header{'Lines'} here since this is a filtering value which
+# represents the number of lines in the *decoded* body, not the physical
+# number of lines in the message which the Lines header in the message is
+# supposed to represent.
+sub header_lines {
+ my ($lines) = $Header{'Head'} =~ /^Lines:\s*(\d+)/im;
+ return $lines;
+}
+
# Set number of Lines in body and body Length to reflect reality
# If the headers were physically present in the message, they are
# updated as well.
@@ -254,15 +264,19 @@
my $had_lines = $Header{'Head'} =~ /^Lines:/im;
my $had_length = $Header{'Head'} =~ /^Length:/im;
- my $lines = $Header{'Lines'} = ${$Header{'=Body='}} =~ tr/\n/\n/;
- my $length = $Header{'Length'} = length($Header{'Body'});
+ my $lines = $Header{'Body'} =~ tr/\n/\n/;
+ my $length = length($Header{'Body'});
my $is_mime = exists $Header{'Mime-Version'};
- if ($had_lines) {
+ if ($had_lines && $lines != &header_lines) {
alter_header("Lines", $HD_STRIP);
- header_append(header'format("Lines: $lines"));
+ header_append(header'format("Lines: $lines\n"));
}
+ # For filtering, use the *decoded* body!
+ $Header{'Lines'} = ${$Header{'=Body='}} =~ tr/\n/\n/;
+ $Header{'Length'} = length ${$Header{'=Body='}};
+
if ($had_length) {
alter_header("Length", $HD_STRIP);
&add_log("NOTICE stripped non-RFC822 Length header") if $loglvl > 5;
@@ -272,7 +286,7 @@
my $clen = $Header{'Content-Length'};
if ($clen != $length) {
alter_header("Content-Length", $HD_STRIP);
- header_append(header'format("Content-Length: $length"));
+ header_append(header'format("Content-Length: $length\n"));
$Header{'Content-Length'} = $length;
&add_log("NOTICE adjusted Content-Length from $clen to $length")
if $loglvl > 5;
@@ -375,12 +389,13 @@
} else {
if ($'loglvl > 9) {
my $len = length $$output;
- &'add_log("recoded $encoding body into $len bytes");
+ &'add_log("recoded $encoding body into $len bytes") if $'loglvl > 7;
}
delete $Header{'Body'}; # $Header{'=Body='} ref still points to it
$Header{'Body'} = $$output; # Transfer-Encoded version of the body
# The body changed, must update the "All" key...
$Header{'All'} = $Header{'Head'} . "\n" . $Header{'Body'};
+ &header_update_size;
}
}
@@ -402,6 +417,33 @@
body_recode_with($encoding);
}
+# When coming back from a FEED, check whether the content transfer encoding
+# is suitable and replace it with the optimal one if not.
+# Upon entry, we expect =Body= to point to the decoded versions and headers
+# of the message to have been parsed in %Header (read: properly resync-ed).
+# Both the header and the body of the message are updated if the encoding
+# is changed.
+# Return TRUE if body was recoded (implying caller should RESYNC the headers).
+sub body_recode_optimally {
+ my $encoding = lc($Header{'Content-Transfer-Encoding'}) || "none";
+ my $optimal = best_body_encoding($Header{'=Body='});
+ my %encoded = map { $_ => 1 } qw(base64 quoted-printable);
+ my $recoded = 0;
+ if ($optimal ne $encoding) {
+ &add_log("converting body encoded with $encoding to optimal $optimal")
+ if $'loglvl > 7;
+ if ($encoded{$optimal}) {
+ $Header{'Body'} = ${$Header{'=Body='}};
+ $Header{'=Body='} = \$Header{'Body'}; # The decoded version!
+ body_recode_with($optimal);
+ }
+ alter_header("Content-Transfer-Encoding", $HD_STRIP);
+ header_append(header'format("Content-Transfer-Encoding: $optimal\n"));
+ $recoded = 1;
+ }
+ return $recoded;
+}
+
# Whenever we got a new set of headers in $Header{'Head'} we need to ensure
# the new vision is consistent with the body encoding. If they strip the
# Content-Transfer-Encoding header for instance, we have to use the old
@@ -446,7 +488,7 @@
# Envelope: the actual sender of the message, empty if cannot compute
# From: the value of the From field
# To: to whom the mail was sent
-# Lines: number of lines in the message
+# Lines: number of lines in the message (*decoded* version)
# Length: number of bytes in the message body (*decoded* version)
# Relayed: the list of relaying hosts deduced from Received: lines
# Reply-To: the address we may use to reply
@@ -499,9 +541,10 @@
# parsing of the message we get.
my $length = $Header{'Content-Length'};
&header_update_size; # Update number of lines and length...
- my $count = $Header{'Lines'};
+ my $count = &header_lines;
&add_log("NOTICE adjusted number of lines from $lines to $count")
- if $loglvl > 5 && defined($lines) && $count != $lines;
+ if $loglvl > 5 &&
+ defined($lines) && defined($count) && $count != $lines;
$count = $Header{'Content-Length'};
&add_log("NOTICE adjusted Content-Length from $length to $count")
if $loglvl > 5 && defined($lines) && $count != $length;
@@ -772,3 +815,33 @@
$Header{'All'} = $hline . $Header{'All'};
}
+# Scan the supplied scalar reference (containing a mail body without any
+# content transfer encoding) and determine what is the proper encoding
+# for that body: "7bit", "quoted-printable" or "base64".
+sub best_body_encoding {
+ my ($body) = @_;
+ my $size = 0;
+ my $largest_line = 0;
+ my $qp_escaped = 0;
+ my $non_7bit = 0;
+
+ foreach my $l (split(/\r?\n/, $$body)) {
+ my $len = length($l);
+ $size += $len;
+ $largest_line = $len if $largest_line < $len;
+ $non_7bit += $l =~ tr/[\x80-\xff]/[\x80-\xff]/;
+ $non_7bit += $l =~ tr/[\x0]/[\x0]/; # NUL never allowed in "7bit"
+ $l =~ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])//g;
+ $qp_escaped = $len - length($l);
+ }
+
+ return "7bit" if $largest_line <= 998 && $non_7bit == 0;
+
+ my $size_qp = $size + 2 * $qp_escaped;
+ my $size_base64 = $size * 4 / 3;
+
+ return "base64" if $size_base64 <= $size_qp;
+ return "quoted-printable" if $qp_escaped * 8 < $size; # Less than 1/8th
+ return "base64";
+}
+
Modified: trunk/mailagent/agent/pl/runcmd.pl
===================================================================
--- trunk/mailagent/agent/pl/runcmd.pl 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/pl/runcmd.pl 2008-06-25 16:35:05 UTC (rev 46)
@@ -267,8 +267,10 @@
'BEEP', 'l',
'BEGIN', 'ft',
'BIFF', 'l',
+ 'FEED', 'be',
'MACRO', 'rdp',
'NOP', 'tf',
+ 'PIPE', 'b',
'POST', 'lb',
'PROTECT', 'lu',
'RECORD', 'acr',
Modified: trunk/mailagent/agent/test/actions
===================================================================
--- trunk/mailagent/agent/test/actions 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/test/actions 2008-06-25 16:35:05 UTC (rev 46)
@@ -163,14 +163,17 @@
};
<DO> { SAVE always.2; DO __foo__'perl_3; SAVE never; };
-X-Tag: /feed/
+X-Tag: /feed 1/
{
FEED grep -v To:;
SAVE ok;
REJECT;
}
-X-Tag: /feed/, !To: ram { SAVE resynced };
+X-Tag: /feed 1/, !To: ram { SAVE resynced };
+X-Tag: /feed 2/ { FEED tee output };
+X-Tag: /feed 3/ { FEED -b tee output };
+X-Tag: /feed 4/ { FEED -be tee output };
X-Tag: /forward 1/ { FORWARD nobody };
X-Tag: /forward 2/ { FORWARD "list" };
@@ -256,7 +259,9 @@
<PERL> { PERL perl.1; SAVE never };
<PERL> { PERL no_such_file; ABORT -f; SAVE never };
-X-Tag: /pipe/ { PIPE wc > output };
+X-Tag: /pipe 1/ { PIPE wc > output };
+X-Tag: /pipe 2/ { PIPE cat > output };
+X-Tag: /pipe 3/ { PIPE -b cat > output };
X-Tag: /post 1/ { POST alt.test comp.others };
X-Tag: /post 2/ { POST -l "list" };
Modified: trunk/mailagent/agent/test/cmd/feed.t
===================================================================
--- trunk/mailagent/agent/test/cmd/feed.t 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/test/cmd/feed.t 2008-06-25 16:35:05 UTC (rev 46)
@@ -18,14 +18,68 @@
do '../pl/cmd.pl';
unlink 'ok', 'resynced';
-&add_header('X-Tag: feed');
+&add_header('X-Tag: feed 1');
`$cmd`;
$? == 0 || print "1\n";
-f "$user" && print "2\n"; # Mail saved...
--f 'ok' || print "3\n"; # ...here
-&get_log(4, 'ok');
+&get_log(3, 'ok'); # ...here
+&check_log('^$', 4); # EOH present
¬_log('^To:', 5); # Make sure To: disappeared
-f 'resynced' || print "6\n"; # Ensure RESYNC was done under the hood
unlink 'ok', 'resynced', 'mail';
+
+# PIPE checks base64, FEED checks quoted-printable
+
+&cp_mail("../qp");
+&add_header('X-Tag: feed 2');
+`$cmd`;
+$? == 0 || print "7\n";
+get_log(8, 'output');
+check_log('Content-Transfer-Encoding: quoted-printable', 9);
+not_log('broken', 10);
+&check_log('^$', 11); # EOH present
+
+unlink 'output', "$user";
+
+&replace_header('X-Tag: feed 3');
+`$cmd`;
+$? == 0 || print "12\n";
+get_log(13, 'output');
+not_log('Content-Transfer-Encoding:', 14);
+check_log('broken', 15);
+&check_log('^$', 16); # EOH present
+get_log(17, $user);
+check_log('Content-Transfer-Encoding: quoted-printable', 18);
+not_log('broken', 19);
+
+unlink 'output', "$user";
+
+&replace_header('X-Tag: feed 4');
+`$cmd`;
+$? == 0 || print "20\n";
+get_log(21, 'output');
+not_log('Content-Transfer-Encoding:', 22);
+check_log('broken', 23);
+&check_log('^$', 24); # EOH present
+get_log(25, $user);
+check_log('Content-Transfer-Encoding: quoted-printable', 26);
+not_log('broken', 27);
+
+unlink 'output', "$user";
+
+# Check that message will be recoded optimally as 7bit
+&cp_mail("../base64");
+&add_header('X-Tag: feed 4');
+`$cmd`;
+$? == 0 || print "28\n";
+get_log(29, 'output');
+not_log('Content-Transfer-Encoding:', 30);
+check_log('successfully', 31);
+check_log('^$', 32); # EOH present
+get_log(33, $user);
+check_log('Content-Transfer-Encoding: 7bit', 34);
+check_log('successfully', 35);
+
+unlink 'output', 'mail', "$user";
print "0\n";
Modified: trunk/mailagent/agent/test/cmd/pipe.t
===================================================================
--- trunk/mailagent/agent/test/cmd/pipe.t 2008-06-14 20:58:05 UTC (rev 45)
+++ trunk/mailagent/agent/test/cmd/pipe.t 2008-06-25 16:35:05 UTC (rev 46)
@@ -18,13 +18,13 @@
do '../pl/cmd.pl';
unlink 'output';
-&add_header('X-Tag: pipe');
+&add_header('X-Tag: pipe 1');
`$cmd`;
$? == 0 || print "1\n";
-f 'output' || print "2\n"; # Where output is created
chop($output = `cat output 2>/dev/null`);
@output = split(' ', $output);
-@valid = (35, 229, 1632); # Output of wc on whole mail with X-Tag field
+@valid = (35, 230, 1634); # Output of wc on whole mail with X-Tag field
$ok = 1;
for ($i = 0; $i < 3; $i++) {
$ok = 0 if $valid[$i] != $output[$i];
@@ -33,4 +33,26 @@
-f "$user" || print "4\n"; # Default action applies
unlink 'output', 'mail', "$user";
+
+# PIPE checks base64, FEED checks quoted-printable
+
+&cp_mail("../base64");
+&add_header('X-Tag: pipe 2');
+`$cmd`;
+$? == 0 || print "5\n";
+get_log(6, 'output');
+check_log('Content-Transfer-Encoding: base64', 7);
+not_log('successfully', 8);
+check_log('^$', 9); # EOH present
+
+unlink 'output', "$user";
+
+&replace_header('X-Tag: pipe 3');
+`$cmd`;
+$? == 0 || print "10\n";
+get_log(11, 'output');
+not_log('Content-Transfer-Encoding:', 12);
+check_log('successfully', 13);
+
+unlink 'output', 'mail', "$user";
print "0\n";
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-14 20:58:10
|
Revision: 45
http://mailagent.svn.sourceforge.net/mailagent/?rev=45&view=rev
Author: rmanfredi
Date: 2008-06-14 13:58:05 -0700 (Sat, 14 Jun 2008)
Log Message:
-----------
Private unit fixing after running metalint.
Modified Paths:
--------------
trunk/mailagent/U/Myinit.U
trunk/mailagent/U/mboxlock.U
trunk/mailagent/revision.h
Modified: trunk/mailagent/U/Myinit.U
===================================================================
--- trunk/mailagent/U/Myinit.U 2008-06-13 21:41:39 UTC (rev 44)
+++ trunk/mailagent/U/Myinit.U 2008-06-14 20:58:05 UTC (rev 45)
@@ -18,7 +18,9 @@
?X: is included after variables are initialized but before any old
?X: config.sh file is read in.
?X:
-?MAKE:Myinit: Init
+?MAKE:libswanted Myinit: Init
?MAKE: -pick add $@ %<
+?LINT:describe libswanted
+: private initializations
libswanted=''
Modified: trunk/mailagent/U/mboxlock.U
===================================================================
--- trunk/mailagent/U/mboxlock.U 2008-06-13 21:41:39 UTC (rev 44)
+++ trunk/mailagent/U/mboxlock.U 2008-06-14 20:58:05 UTC (rev 45)
@@ -7,7 +7,7 @@
?RCS: Licence as specified in the README file that comes with dist.
?RCS:
?RCS: $Log
-?MAKE:d_lockflock d_flockonly lock_by_flock flock_only: cat contains d_flock Myread +usrinc Setvar Oldconfig
+?MAKE:d_lockflock d_flockonly lock_by_flock flock_only: cat contains d_flock Myread +usrinc Setvar Oldconfig package
?MAKE: -pick add $@ %<
?S:d_lockflock:
?S: This variable conditionally defines the LOCK_BY_FLOCK symbol, which
@@ -34,6 +34,8 @@
?C:.
?H:#$d_lockflock LOCK_BY_FLOCK /**/
?H:#$d_flockonly FLOCK_ONLY /**/
+?H:.
+?LINT:set d_lockflock d_flockonly
: see which mailbox locking should be used
echo " "
lock_by_flock=''
@@ -76,7 +78,7 @@
EOM
rp="Would you like to use flock style mail spool locking only?"
- . myread
+ . ./myread
case "$ans" in
y*|Y*) val="$define";;
*) val="$undef";;
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-13 21:41:39 UTC (rev 44)
+++ trunk/mailagent/revision.h 2008-06-14 20:58:05 UTC (rev 45)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 42
+#define REVISION 44
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 21:41:42
|
Revision: 44
http://mailagent.svn.sourceforge.net/mailagent/?rev=44&view=rev
Author: rmanfredi
Date: 2008-06-13 14:41:39 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Make sure we suggest the use of "-i" in mailopt when they use sendmail.
Automatically protect lines with a single "." when they did not supply -i
to avoid failure of FORWARD and BOUNCE commands.
Modified Paths:
--------------
trunk/mailagent/agent/files/mailagent.cf
trunk/mailagent/agent/man/mailagent.SH
trunk/mailagent/agent/pl/actions.pl
trunk/mailagent/agent/pl/read_conf.pl
Modified: trunk/mailagent/agent/files/mailagent.cf
===================================================================
--- trunk/mailagent/agent/files/mailagent.cf 2008-06-13 21:19:28 UTC (rev 43)
+++ trunk/mailagent/agent/files/mailagent.cf 2008-06-13 21:41:39 UTC (rev 44)
@@ -89,11 +89,12 @@
# Mail and news transport agents
# By default, values for sendmail and sendnews are determined at configuration
-# time. The default mailopt is -odq when sendmail is used. The -h option is
-# always added to the sendnews program to indicate headers are already present.
+# time. The default mailopt is "-odq -i" when sendmail is used.
+# The -h option is always added to the sendnews program to indicate headers
+# are already present.
sendmail : /usr/lib/sendmail
sendnews : /usr/lib/news/inews
-mailopt : -odq
+mailopt : -odq -i
newsopt :
Modified: trunk/mailagent/agent/man/mailagent.SH
===================================================================
--- trunk/mailagent/agent/man/mailagent.SH 2008-06-13 21:19:28 UTC (rev 43)
+++ trunk/mailagent/agent/man/mailagent.SH 2008-06-13 21:41:39 UTC (rev 44)
@@ -569,7 +569,7 @@
.TP
.I mailopt
Options to be passed to the mailer (see \fIsendmail\fR). (optional, suggested:
--odq, when using sendmail).
+-odq -i, when using sendmail).
.TP
.I maxcmds
Maximum number of commands that are allowed to be executed by a SERVER command
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-13 21:19:28 UTC (rev 43)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-13 21:41:39 UTC (rev 44)
@@ -684,7 +684,17 @@
}
print MAILER $FILTER, "\n";
print MAILER "\n";
- print MAILER $Header{'Body'};
+ # If sendmail is used and there is no -i flag in the options, we need to
+ # escape dots on a line by themselves.
+ if ($cf'sendmail =~ /\bsendmail\b/ && $cf'mailopt !~ /-i\b/) {
+ my $body = $Header{'Body'};
+ $body =~ s/^\./../gm;
+ print MAILER $body;
+ &add_log("WARNING sendmail used -- you should add -i to mailopt")
+ if $loglvl > 2;
+ } else {
+ print MAILER $Header{'Body'};
+ }
close MAILER;
local($failed) = $?; # Status of forwarding
if ($failed) {
@@ -716,7 +726,17 @@
}
print MAILER $FILTER, "\n";
print MAILER "\n";
- print MAILER $Header{'Body'};
+ # If sendmail is used and there is no -i flag in the options, we need to
+ # escape dots on a line by themselves.
+ if ($cf'sendmail =~ /\bsendmail\b/ && $cf'mailopt !~ /-i\b/) {
+ my $body = $Header{'Body'};
+ $body =~ s/^\./../gm;
+ print MAILER $body;
+ &add_log("WARNING sendmail used -- you should add -i to mailopt")
+ if $loglvl > 2;
+ } else {
+ print MAILER $Header{'Body'};
+ }
close MAILER;
local($failed) = $?; # Status of forwarding
if ($failed) {
Modified: trunk/mailagent/agent/pl/read_conf.pl
===================================================================
--- trunk/mailagent/agent/pl/read_conf.pl 2008-06-13 21:19:28 UTC (rev 43)
+++ trunk/mailagent/agent/pl/read_conf.pl 2008-06-13 21:41:39 UTC (rev 44)
@@ -139,7 +139,7 @@
$main'track_all = 1 if $track =~ /on/i; # Option -t set by config
$sendmail = $'mailer if $sendmail eq ''; # No sendmail program specified
$sendnews = $'inews if $sendnews eq ''; # No news posting program
- $mailopt = '-odq' if $mailopt eq '' && $sendmail =~ /sendmail/;
+ $mailopt = '-odq -i' if $mailopt eq '' && $sendmail =~ /sendmail/;
# Backward compatibility -- RAM, 25/04/94
$fromesc = 'ON' unless defined $fromesc; # If absent from ~/.mailagent
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 21:19:31
|
Revision: 43
http://mailagent.svn.sourceforge.net/mailagent/?rev=43&view=rev
Author: rmanfredi
Date: 2008-06-13 14:19:28 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Protect against SIGPIPE during BOUNCE and FORWARD, relying on the exit code
at close() time to detect failures. (closes Debian bug #267879)
Modified Paths:
--------------
trunk/mailagent/agent/pl/actions.pl
trunk/mailagent/agent/test/actions
trunk/mailagent/agent/test/cmd/bounce.t
trunk/mailagent/agent/test/cmd/forward.t
trunk/mailagent/revision.h
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-13 16:44:42 UTC (rev 42)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-13 21:19:28 UTC (rev 43)
@@ -670,6 +670,7 @@
if $loglvl;
return 1;
}
+ local $SIG{PIPE} = 'IGNORE'; # sendmail failure caught at close() time
local(@addr) = split(' ', $addresses);
print MAILER &header'format("Resent-From: $address"), "\n";
local($to) = "Resent-To: " . join(', ', @addr);
@@ -706,6 +707,7 @@
if $loglvl;
return 1;
}
+ local $SIG{PIPE} = 'IGNORE'; # sendmail failure caught at close() time
# Protect Sender: lines in the original message
foreach (split(/\n/, $Header{'Head'})) {
next if /^From\s+(\S+)/;
Modified: trunk/mailagent/agent/test/actions
===================================================================
--- trunk/mailagent/agent/test/actions 2008-06-13 16:44:42 UTC (rev 42)
+++ trunk/mailagent/agent/test/actions 2008-06-13 21:19:28 UTC (rev 43)
@@ -149,6 +149,8 @@
X-Tag: /bounce 1/ { BOUNCE nobody };
X-Tag: /bounce 2/ { BOUNCE "list" };
+X-Tag: /bounce 3/ { BOUNCE nobody; REJECT -f; DELETE };
+X-Tag: /bounce 3/ { SAVE ok };
X-Tag: /delete/ { DELETE };
@@ -172,6 +174,8 @@
X-Tag: /forward 1/ { FORWARD nobody };
X-Tag: /forward 2/ { FORWARD "list" };
+X-Tag: /forward 3/ { FORWARD nobody; REJECT -f; DELETE };
+X-Tag: /forward 3/ { SAVE ok };
X-Tag: /give 1/ { GIVE wc > output };
X-Tag: /give 2/ { GIVE cat > output };
Modified: trunk/mailagent/agent/test/cmd/bounce.t
===================================================================
--- trunk/mailagent/agent/test/cmd/bounce.t 2008-06-13 16:44:42 UTC (rev 42)
+++ trunk/mailagent/agent/test/cmd/bounce.t 2008-06-13 21:19:28 UTC (rev 43)
@@ -45,6 +45,20 @@
&check_log('^To: ram', 13) == 1 || print "14\n";
&check_log('^Recipients: first second third$', 15) == 1 || print "16\n";
+unlink 'send.mail', 'ok';
+
+&replace_header('X-Tag: bounce 3');
+open(MSEND, '>msend');
+print MSEND <<'EOM';
+#!/bin/sh
+exit 1
+EOM
+close MSEND;
+`$cmd`;
+$? == 0 || print "17\n";
+-f "$user" && print "18\n"; # Mail not saved
+-f 'ok' || print "19\n"; # Failure caught by "REJECT -f"
+
&clear_mta;
-unlink 'mail', 'list';
+unlink 'mail', 'list', 'ok';
print "0\n";
Modified: trunk/mailagent/agent/test/cmd/forward.t
===================================================================
--- trunk/mailagent/agent/test/cmd/forward.t 2008-06-13 16:44:42 UTC (rev 42)
+++ trunk/mailagent/agent/test/cmd/forward.t 2008-06-13 21:19:28 UTC (rev 43)
@@ -48,6 +48,20 @@
&check_log('^To: ram', 21) == 1 || print "22\n";
&check_log('^Recipients: first second third$', 23) == 1 || print "24\n";
+unlink 'send.mail', 'ok';
+
+&replace_header('X-Tag: forward 3');
+open(MSEND, '>msend');
+print MSEND <<'EOM';
+#!/bin/sh
+exit 1
+EOM
+close MSEND;
+`$cmd`;
+$? == 0 || print "25\n";
+-f "$user" && print "26\n"; # Mail not saved
+-f 'ok' || print "27\n"; # Failure caught by "REJECT -f"
+
&clear_mta;
-unlink 'mail', 'list';
+unlink 'mail', 'list', 'ok';
print "0\n";
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-13 16:44:42 UTC (rev 42)
+++ trunk/mailagent/revision.h 2008-06-13 21:19:28 UTC (rev 43)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 41
+#define REVISION 42
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 16:44:52
|
Revision: 42
http://mailagent.svn.sourceforge.net/mailagent/?rev=42&view=rev
Author: rmanfredi
Date: 2008-06-13 09:44:42 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Must not lowercase the whole Content-Type header or we alter the boundary!
Modified Paths:
--------------
trunk/mailagent/agent/pl/biff.pl
trunk/mailagent/revision.h
Modified: trunk/mailagent/agent/pl/biff.pl
===================================================================
--- trunk/mailagent/agent/pl/biff.pl 2008-06-13 14:05:31 UTC (rev 41)
+++ trunk/mailagent/agent/pl/biff.pl 2008-06-13 16:44:42 UTC (rev 42)
@@ -238,10 +238,11 @@
# Setting bifflen or bifflines to 0 means no body
return '' if $len == 0 || $lines == 0;
- my $content;
- $content = unmime(\@body) if $'Header{'Mime-Version'};
+ my ($content, $entity);
+ ($content, $entity) = unmime(\@body) if $'Header{'Mime-Version'};
- &'add_log("biffing entity is $content") if length($content) && $'loglvl > 8;
+ &'add_log("biffing $entity entity is $content")
+ if length($content) && $'loglvl > 8;
strip_html(\@body) if $content =~ /html\b/;
&trim(*body) if $trim; # Smart trim of leading reply text
@@ -434,15 +435,16 @@
# first text entity in the message.
# The supplied array is updated in-place and will contain on return the
# lines of the MIME entity that was retained.
-# Returns the type of the retained MIME entity.
+# Returns the type of the retained MIME entity and the number of the entity
+# for logging, saying "global" for the whole message.
# NB: if no text part is found, the array will be empty upon return.
sub unmime {
my ($aref) = @_;
- my $content = lc($'Header{'Content-Type'});
+ my $content = $'Header{'Content-Type'};
$content =~ s/\(.*?\)\s*//g; # Removed allowed RFC822 comments
&'add_log("global MIME content-type is $content") if $'loglvl > 16;
- return $content unless $content =~ m|^multipart/|;
+ return ($content, "global") unless $content =~ m|^multipart/|i;
my ($boundary) = $content =~ /boundary=(\S+);/;
($boundary) = $content =~ /boundary=(\S+)/ unless length $boundary;
@@ -458,6 +460,7 @@
my @entity;
my $grabbed = 0;
+ my $n = 0;
for (;;) {
unless ($grabbed) {
@@ -469,6 +472,7 @@
$entity_content =~ s/\(.*?\)\s*//g;
&'add_log("parsed entity header: content is $entity_content")
if $'loglvl > 19;
+ $n++;
if ($entity_content =~ m|^text/|) {
# We found (another) text part, collect it...
@entity = ();
@@ -479,8 +483,14 @@
}
}
- &'add_log("kept entity $entity_content for biffing") if $'loglvl > 18;
+ my $entity = "${n}th";
+ $entity =~ s/1th$/1st/;
+ $entity =~ s/2th$/2nd/;
+ $entity =~ s/3th$/3rd/;
+ &'add_log("kept $entity entity $entity_content for biffing")
+ if $'loglvl > 18;
+
# Maybe the entity bears a transfer encoding?
my $entity_encoding = $header->{'Content-Transfer-Encoding'};
$entity_encoding =~ s/\(.*?\)\s*//g;
@@ -507,7 +517,8 @@
$error = "no encoding";
}
- &'add_log("decoded entity ($entity_encoding), error=$error")
+ my $error_msg = length($error) ? $error : "none";
+ &'add_log("decoded $entity entity ($entity_encoding), error=$error_msg")
if $'loglvl > 18;
if (length $error) {
@@ -515,7 +526,7 @@
} else {
@$aref = split(/\r?\n/, $$output);
}
- return $entity_content;
+ return ($entity_content, $entity);
}
# Skip past named boundary in the supplied array
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-13 14:05:31 UTC (rev 41)
+++ trunk/mailagent/revision.h 2008-06-13 16:44:42 UTC (rev 42)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 40
+#define REVISION 41
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 14:05:52
|
Revision: 41
http://mailagent.svn.sourceforge.net/mailagent/?rev=41&view=rev
Author: rmanfredi
Date: 2008-06-13 07:05:31 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Fixed logging message and do not forget a charset can follow the content-type.
Modified Paths:
--------------
trunk/mailagent/agent/pl/biff.pl
trunk/mailagent/revision.h
Modified: trunk/mailagent/agent/pl/biff.pl
===================================================================
--- trunk/mailagent/agent/pl/biff.pl 2008-06-13 13:50:11 UTC (rev 40)
+++ trunk/mailagent/agent/pl/biff.pl 2008-06-13 14:05:31 UTC (rev 41)
@@ -241,8 +241,7 @@
my $content;
$content = unmime(\@body) if $'Header{'Mime-Version'};
- &'add_log("retained content for biffing is $content")
- if length($content) && $'loglvl > 8;
+ &'add_log("biffing entity is $content") if length($content) && $'loglvl > 8;
strip_html(\@body) if $content =~ /html\b/;
&trim(*body) if $trim; # Smart trim of leading reply text
@@ -475,7 +474,7 @@
@entity = ();
my $end = !skip_past($aref, $boundary, \@entity);
$grabbed = 1; # Avoid skipping at next loop iteration
- last if $entity_content eq "text/plain"; # We found the best one
+ last if $entity_content =~ m|^text/plain\b|; # Found the best one
last if $end;
}
}
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-13 13:50:11 UTC (rev 40)
+++ trunk/mailagent/revision.h 2008-06-13 14:05:31 UTC (rev 41)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 39
+#define REVISION 40
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 13:51:40
|
Revision: 40
http://mailagent.svn.sourceforge.net/mailagent/?rev=40&view=rev
Author: rmanfredi
Date: 2008-06-13 06:50:11 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Added minimal MIME handling for biffing to extract the text/plain part of
the message, if available. If only text/html is available, the HTML is
stripped for compact emission on the terminal.
Modified Paths:
--------------
trunk/mailagent/MANIFEST
trunk/mailagent/agent/pl/biff.pl
trunk/mailagent/agent/test/actions
trunk/mailagent/agent/test/cmd/biff.t
trunk/mailagent/revision.h
Added Paths:
-----------
trunk/mailagent/agent/test/mime
Modified: trunk/mailagent/MANIFEST
===================================================================
--- trunk/mailagent/MANIFEST 2008-06-13 09:43:39 UTC (rev 39)
+++ trunk/mailagent/MANIFEST 2008-06-13 13:50:11 UTC (rev 40)
@@ -267,6 +267,7 @@
agent/test/filter/status.t Action status updating tests
agent/test/level Default logging level for tests
agent/test/mail The mail used by testing routines
+agent/test/mime Sample MIME email with HTML and plain parts
agent/test/misc/ Directory for miscellaneous tests
agent/test/misc/compress.t Folder compression checks
agent/test/misc/mh.t MH-style folder checks
@@ -301,7 +302,7 @@
agent/test/pl/misc.pl Set up for miscellaneous tests
agent/test/pl/mta.pl Trivial MTA and NTA for tests
agent/test/qp Sample quoted-printable encoded email
-agent/test/rules Rules used by filtering tests
+agent/test/rules Rules used by filtering tests
bin/ Directory for uninstalled binaries
bin/perload The dataloading/autoloading perl translator
bin/svn-revision Updates the top "revision.h" file if needed
Modified: trunk/mailagent/agent/pl/biff.pl
===================================================================
--- trunk/mailagent/agent/pl/biff.pl 2008-06-13 09:43:39 UTC (rev 39)
+++ trunk/mailagent/agent/pl/biff.pl 2008-06-13 13:50:11 UTC (rev 40)
@@ -230,7 +230,7 @@
local($trim) = @_; # Whether top reply text should be trimmed
local($len) = defined $cf'bifflen ? $cf'bifflen : 560;
local($lines) = defined $cf'bifflines ? $cf'bifflines : 7;
- local(@body) = split(/\n/, $'Header{'Body'});
+ local(@body) = split(/\n/, ${$'Header{'=Body='}});
local($skipnl) = $cf'biffnl =~ /OFF/i; # Skip blank lines?
local($_);
local($res) = '';
@@ -238,6 +238,13 @@
# Setting bifflen or bifflines to 0 means no body
return '' if $len == 0 || $lines == 0;
+ my $content;
+ $content = unmime(\@body) if $'Header{'Mime-Version'};
+
+ &'add_log("retained content for biffing is $content")
+ if length($content) && $'loglvl > 8;
+
+ strip_html(\@body) if $content =~ /html\b/;
&trim(*body) if $trim; # Smart trim of leading reply text
&mh(*body, $len) if $cf'biffmh =~ /^on/i;
@@ -424,5 +431,170 @@
push(@ary, $body); # Remaining information on one line
}
+# Un-MIME the body by removing all the MIME headers and looking for the
+# first text entity in the message.
+# The supplied array is updated in-place and will contain on return the
+# lines of the MIME entity that was retained.
+# Returns the type of the retained MIME entity.
+# NB: if no text part is found, the array will be empty upon return.
+sub unmime {
+ my ($aref) = @_;
+ my $content = lc($'Header{'Content-Type'});
+ $content =~ s/\(.*?\)\s*//g; # Removed allowed RFC822 comments
+
+ &'add_log("global MIME content-type is $content") if $'loglvl > 16;
+ return $content unless $content =~ m|^multipart/|;
+
+ my ($boundary) = $content =~ /boundary=(\S+);/;
+ ($boundary) = $content =~ /boundary=(\S+)/ unless length $boundary;
+ $boundary = $1 if $boundary =~ /^"(.*)"/ || $boundary =~ /^'(.*)'/;
+
+ # We do not perform a recursive MIME parsing here
+
+ my $entity_content;
+ my $header;
+
+ &'add_log("searching text part for biffing, boundary=$boundary")
+ if $'loglvl > 16;
+
+ my @entity;
+ my $grabbed = 0;
+
+ for (;;) {
+ unless ($grabbed) {
+ return undef unless skip_past($aref, $boundary);
+ }
+ $grabbed = 0;
+ $header = parse_header($aref);
+ $entity_content = lc($header->{'Content-Type'});
+ $entity_content =~ s/\(.*?\)\s*//g;
+ &'add_log("parsed entity header: content is $entity_content")
+ if $'loglvl > 19;
+ if ($entity_content =~ m|^text/|) {
+ # We found (another) text part, collect it...
+ @entity = ();
+ my $end = !skip_past($aref, $boundary, \@entity);
+ $grabbed = 1; # Avoid skipping at next loop iteration
+ last if $entity_content eq "text/plain"; # We found the best one
+ last if $end;
+ }
+ }
+
+ &'add_log("kept entity $entity_content for biffing") if $'loglvl > 18;
+
+ # Maybe the entity bears a transfer encoding?
+ my $entity_encoding = $header->{'Content-Transfer-Encoding'};
+ $entity_encoding =~ s/\(.*?\)\s*//g;
+
+ # XXX code duplication with body_check(), factorize some day...
+ my $output;
+ my $error;
+
+ if ($entity_encoding =~ /^base64\s*$/i) {
+ base64'reset(length $'Header{'Body'});
+ foreach my $d (@entity) {
+ base64'decode($d);
+ }
+ $error = base64'error_msg();
+ $output = base64'output();
+ } elsif ($entity_encoding =~ /^quoted-printable\s*$/i) {
+ qp'reset(length $'Header{'Body'});
+ foreach my $d (@entity) {
+ qp'decode($d);
+ }
+ $error = qp'error_msg();
+ $output = qp'output();
+ } else {
+ $error = "no encoding";
+ }
+
+ &'add_log("decoded entity ($entity_encoding), error=$error")
+ if $'loglvl > 18;
+
+ if (length $error) {
+ @$aref = @entity;
+ } else {
+ @$aref = split(/\r?\n/, $$output);
+ }
+ return $entity_content;
+}
+
+# Skip past named boundary in the supplied array
+# If $collect is a defined ARRAY ref, push there all the lines we see until
+# the next boundary.
+# Return false when we see the LAST boundary in the message, meaning there
+# are no more parts to consider.
+sub skip_past {
+ my ($aref, $boundary, $collect) = @_;
+ my $l;
+ while (defined ($l = shift @$aref)) {
+ return 0 if $l eq "--$boundary--";
+ return 1 if $l eq "--$boundary";
+ push(@$collect, $l) if defined $collect;
+ }
+ return undef; # Not found
+}
+
+# Parse embedded MIME headers, returning hash ref
+sub parse_header {
+ my ($aref) = @_;
+ my %header;
+ my $val;
+ my $last_header;
+ my $l;
+ my $saw_something = 0;
+ while (defined ($l = shift @$aref)) {
+ last if $l =~ /^$/ && $saw_something;
+ $saw_something++;
+ if ($l =~ /^\s/) {
+ $l =~ s/^\s+/ /;
+ $header{$last_header} .= $l if length $last_header;
+ } elsif (my ($field, $value) = $l =~ /^([!-9;-~\w-]+):\s*(.*)/) {
+ $last_header = header'normalize($field);
+ if ($header{$last_header} ne '') {
+ $header{$last_header} .= "\n" . $value;
+ } else {
+ $header{$last_header} = $value;
+ }
+ }
+ }
+ return \%header;
+}
+
+# Strip HTML in-place and remove spurious blank lines
+# This is done only on a best-effort basis to make the biff output nice
+sub strip_html {
+ my ($aref) = @_;
+ my @out;
+ my $in_style = 0;
+ my $is_nl;
+ my $last_was_nl = 0;
+ my $l;
+
+ while (defined ($l = shift @$aref)) {
+ $in_style++ while $l =~ s/<style\b.*?>//;
+ $in_style-- while $l =~ s|</style>||;
+ next if $in_style;
+ $l =~ s/<[^\0]*?>//g;
+ $l =~ s/&(\w)cedil;/$1/g;
+ $l =~ s/&(\w)acute;/$1/g;
+ $l =~ s/&(\w)grave;/$1/g;
+ $l =~ s/&(\w)circ;/$1/g;
+ $l =~ s/&(\w)uml;/$1/g;
+ $l =~ s/"/'/g;
+ $l =~ s/ / /g;
+ $l =~ s/ / /g; # Same as
+ $l =~ s/&#(\d+);/chr($1)/g; # Corect only for the ASCII part...
+ $l =~ s/&/&/g; # Must come last
+ $l =~ s/^\s*//;
+ $is_nl = 0 == length($l);
+ next if $last_was_nl && $is_nl;
+ $last_was_nl = $is_nl;
+ push(@out, $l);
+ }
+
+ @$aref = @out;
+}
+
package main;
Modified: trunk/mailagent/agent/test/actions
===================================================================
--- trunk/mailagent/agent/test/actions 2008-06-13 09:43:39 UTC (rev 39)
+++ trunk/mailagent/agent/test/actions 2008-06-13 13:50:11 UTC (rev 40)
@@ -145,6 +145,7 @@
X-Tag: /biff 1/ { BIFF off; LEAVE; BIFF on; SAVE ok };
X-Tag: /biff 2/ { BIFF bfmt; SAVE ok; BIFF -l off; LEAVE };
+X-Tag: /biff 3/ { BIFF bfmt; SAVE ok; };
X-Tag: /bounce 1/ { BOUNCE nobody };
X-Tag: /bounce 2/ { BOUNCE "list" };
Modified: trunk/mailagent/agent/test/cmd/biff.t
===================================================================
--- trunk/mailagent/agent/test/cmd/biff.t 2008-06-13 09:43:39 UTC (rev 39)
+++ trunk/mailagent/agent/test/cmd/biff.t 2008-06-13 13:50:11 UTC (rev 40)
@@ -74,8 +74,22 @@
&check_log('^\rTo: ram', 31) == 1 || print "32\n";
&check_log('^Got mail in ~/ok', 33) == 1 || print "34\n";
&check_log('^\r####', 35) == 1 || print "36\n";
-¬_log('^\r----', 37);
+&check_log('moderated usenet', 37) == 1 || print "38\n";
+¬_log('^\r----', 39);
+&cleanup;
+cp_mail("../mime");
+&add_header('X-Tag: biff 3');
+&make_tty(0, 0777, 40); # 40 & 41
+`$cmd`;
+$? == 0 || print "41\n";
+-f 'ok' || print "42\n";
+-s 'tty0' || print "43\n";
+&get_log(44, 'tty0');
+¬_log('--foo', 45);
+&check_log('^Got mail in ~/ok', 46) == 1 || print "47\n";
+&check_log('successfully decoded', 48) == 1 || print "49\n";
+
&cleanup;
unlink 'mail';
print "0\n";
Added: trunk/mailagent/agent/test/mime
===================================================================
--- trunk/mailagent/agent/test/mime (rev 0)
+++ trunk/mailagent/agent/test/mime 2008-06-13 13:50:11 UTC (rev 40)
@@ -0,0 +1,38 @@
+From rap...@po... Tue Jun 10 17:44:12 2008
+Received: from tours.ram.loc (fetchmail@localhost [127.0.0.1])
+ by tours.ram.loc (8.14.3/8.13.8/Debian-3) with ESMTP id m5AFiCJq002957
+ for <ram@localhost>; Tue, 10 Jun 2008 17:44:12 +0200
+From: "Raphael Manfredi" <Rap...@po...>
+To: "Raphael Manfredi" <Rap...@po...>
+Date: Tue, 10 Jun 2008 15:35:21 +0000
+Subject: Sample MIME message
+Message-ID: <D42...@GV...>
+MIME-Version: 1.0
+Content-Type: multipart/alternative; boundary="foo"
+Status: RO
+Content-Length: 609
+Lines: 22
+
+--foo
+Content-Type: text/html; charset="iso8859-1"
+
+<html>
+<head>
+ <title>Sample HTML part</title>
+</head>
+<body>
+ <p>Sole paragraph</p>
+</body>
+</html>
+
+--foo
+Content-Type: text/plain; charset="utf-8"
+Content-Transfer-Encoding: base64
+Content-Length: 346
+
+VGhpcyBtZXNzYWdlIGlzIG9uZSBiaWcgTUlNRSBwYXJ0IHRoYXQgaGFzIGJlZW4gYmFzZTY0LWVu
+Y29kZWQuDQoNClRoZSBtYWlsYWdlbnQgdGVzdCBzdWl0ZSBpcyBnb2luZyB0byBsb29rIGZvciB0
+aGUgZm9sbG93aW5nIGxpbmU6DQoNCiAgICAgICAgKioqIFlFUywgc3VjY2Vzc2Z1bGx5IGRlY29k
+ZWQgKioqDQoNCmluIHRoZSBkZWNvZGVkIGJvZHkgYXMgcHJvb2YgdGhhdCB0aGUgYmFzZTY0IGRl
+Y29kaW5nIGxvZ2ljIGlzIHdvcmtpbmcuDQo=
+--foo--
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-13 09:43:39 UTC (rev 39)
+++ trunk/mailagent/revision.h 2008-06-13 13:50:11 UTC (rev 40)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 37
+#define REVISION 39
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 09:43:45
|
Revision: 39
http://mailagent.svn.sourceforge.net/mailagent/?rev=39&view=rev
Author: rmanfredi
Date: 2008-06-13 02:43:39 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Emit the FILTERED line before trying to unlink the queued message or we won't
be able to stat() it to show the file size in the logs...
Modified Paths:
--------------
trunk/mailagent/agent/pl/pqueue.pl
Modified: trunk/mailagent/agent/pl/pqueue.pl
===================================================================
--- trunk/mailagent/agent/pl/pqueue.pl 2008-06-13 09:32:24 UTC (rev 38)
+++ trunk/mailagent/agent/pl/pqueue.pl 2008-06-13 09:43:39 UTC (rev 39)
@@ -127,6 +127,12 @@
local($result) = &analyze_mail($filename); # Analyze & filter message
+ if ($result == 0) {
+ local($len) = $Header{'Length'};
+ my $msize = mail_logsize($filename);
+ &add_log("FILTERED [$file]$msize ($len bytes)") if $loglvl > 4;
+ }
+
# If message was not from stdin and was processed successfully, unlink it
unless ($file eq '<stdin>') {
if ($result == 0 && $can_unlink && !unlink($filename)) {
@@ -140,12 +146,6 @@
}
}
- if ($result == 0) {
- local($len) = $Header{'Length'};
- my $msize = mail_logsize($filename);
- &add_log("FILTERED [$file]$msize ($len bytes)") if $loglvl > 4;
- }
-
return $result; # 0 if OK, 1 for analyze errors
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 09:32:28
|
Revision: 38
http://mailagent.svn.sourceforge.net/mailagent/?rev=38&view=rev
Author: rmanfredi
Date: 2008-06-13 02:32:24 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Added support for transfer-encoded bodies: mailagent will now decode these
bodies before giving them to PASS and GIVE, and will transparently recode
the body when the Content-Transfer-Encoding header is changed (at RESYNC time).
Also added automatic RESYNC when coming back from a command that requires
feedback (such as FEED or PURIFY).
The supported encodings are: base64 and quoted-printable.
Modified Paths:
--------------
trunk/mailagent/MANIFEST
trunk/mailagent/agent/magent.sh
trunk/mailagent/agent/man/mailagent.SH
trunk/mailagent/agent/pl/actions.pl
trunk/mailagent/agent/pl/analyze.pl
trunk/mailagent/agent/pl/builtins.pl
trunk/mailagent/agent/pl/filter.pl
trunk/mailagent/agent/pl/matching.pl
trunk/mailagent/agent/pl/parse.pl
trunk/mailagent/agent/pl/pqueue.pl
trunk/mailagent/agent/pl/runcmd.pl
trunk/mailagent/agent/test/actions
trunk/mailagent/agent/test/cmd/feed.t
trunk/mailagent/agent/test/cmd/give.t
trunk/mailagent/agent/test/cmd/pass.t
trunk/mailagent/agent/test/cmd/purify.t
trunk/mailagent/agent/test/pl/mail.pl
trunk/mailagent/agent/test/rules
trunk/mailagent/revision.h
Added Paths:
-----------
trunk/mailagent/agent/pl/base64.pl
trunk/mailagent/agent/pl/qp.pl
trunk/mailagent/agent/test/base64
trunk/mailagent/agent/test/filter/base64.t
trunk/mailagent/agent/test/filter/qp.t
trunk/mailagent/agent/test/qp
Modified: trunk/mailagent/MANIFEST
===================================================================
--- trunk/mailagent/MANIFEST 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/MANIFEST 2008-06-13 09:32:24 UTC (rev 38)
@@ -113,6 +113,7 @@
agent/pl/add_log.pl Perl library to add logs to logfile
agent/pl/addr.pl Approximate address matching and validation
agent/pl/analyze.pl Perl library analyzing the incoming mail
+agent/pl/base64.pl Simple base64 encoder/decoder
agent/pl/biff.pl Built-in biffing support
agent/pl/builtins.pl Perl library dealing with builtins
agent/pl/callout.pl Perl library to handle callout queue
@@ -163,6 +164,7 @@
agent/pl/power.pl Power management for mail server
agent/pl/pqueue.pl Processing the queued mails
agent/pl/q.pl Quote removal function
+agent/pl/qp.pl Simple quoted-printable encoder/decoder
agent/pl/queue_mail.pl Queuing mails
agent/pl/rangeargs.pl Perl library to expand a list of patches
agent/pl/read_conf.pl Perl library to read configuration file
@@ -188,6 +190,7 @@
agent/test/TEST Runs the full test suite
agent/test/actions Rule file for cmd tests
agent/test/atail Active monitoring of the out/agentlog file
+agent/test/base64 Sample base64 encoded email
agent/test/basic/ Basic tests
agent/test/basic/config.t Main test initialization and sanity checks
agent/test/basic/filter.t Make sure C filter works
@@ -246,6 +249,7 @@
agent/test/filter/ Testing the filtering capabilities
agent/test/filter/address.t Test various match patterns on address fields
agent/test/filter/backref.t Check backreferences
+agent/test/filter/base64.t Check base64 decoding of mail body
agent/test/filter/case.t Normalized header case tests
agent/test/filter/default.t Check default behaviour when mail not saved
agent/test/filter/escape.t Escape sequences within actions
@@ -258,6 +262,7 @@
agent/test/filter/multiple.t Check multiple selectors
agent/test/filter/not.t Negated pattern tests
agent/test/filter/pattern.t Check patterns specification and loading
+agent/test/filter/qp.t Check quoted-printable decoding of mail body
agent/test/filter/range.t Selector range tests
agent/test/filter/status.t Action status updating tests
agent/test/level Default logging level for tests
@@ -272,8 +277,8 @@
agent/test/option/F.t Test -F option
agent/test/option/I.t Test -I option
agent/test/option/L.t Test -L option
+agent/test/option/U.t Test -U option
agent/test/option/V.t Test -V option
-agent/test/option/U.t Test -U option
agent/test/option/c.t Test -c option
agent/test/option/d.t Test -d option
agent/test/option/e.t Test -e option
@@ -295,6 +300,7 @@
agent/test/pl/mail.pl Modifies mail components
agent/test/pl/misc.pl Set up for miscellaneous tests
agent/test/pl/mta.pl Trivial MTA and NTA for tests
+agent/test/qp Sample quoted-printable encoded email
agent/test/rules Rules used by filtering tests
bin/ Directory for uninstalled binaries
bin/perload The dataloading/autoloading perl translator
Modified: trunk/mailagent/agent/magent.sh
===================================================================
--- trunk/mailagent/agent/magent.sh 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/magent.sh 2008-06-13 09:32:24 UTC (rev 38)
@@ -546,9 +546,10 @@
# List of special header keys which do not represent a true header field.
sub init_pseudokey {
%Pseudokey = (
- 'Body', 1,
- 'Head', 1,
- 'All', 1
+ 'Body', 1, # Body of message
+ 'Head', 1, # Header of message
+ 'All', 1, # Concatenation of Header, "\n", Body
+ '=Body=', 1, # Reference to body with decoded transfer encoding
);
}
@@ -824,5 +825,7 @@
$grep -v '^;#' pl/rulenv.pl >>magent
$grep -v '^;#' pl/options.pl >>magent
$grep -v '^;#' pl/install.pl >>magent
+$grep -v '^;#' pl/base64.pl >>magent
+$grep -v '^;#' pl/qp.pl >>magent
chmod 755 magent
$eunicefix magent
Modified: trunk/mailagent/agent/man/mailagent.SH
===================================================================
--- trunk/mailagent/agent/man/mailagent.SH 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/man/mailagent.SH 2008-06-13 09:32:24 UTC (rev 38)
@@ -1908,10 +1908,14 @@
.TP
FEED \fIprogram\fR
Feed the whole message to a program and get the output back as the new
-message. The header structure used by the rules is not updated: an explicit
-RESYNC is necessary. Hence the program appears as a filter for the whole
-message. It does not tag the message as having been saved.
+message. Hence the program appears as a filter for the whole
+message. It does not tag the message as having been saved. A RESYNC
+is automatically done upon return.
(Returns the status of \fIprogram\fR)
+.sp
+.B WARNING:
+Your program must be able to properly parse a MIME message and must deal
+with transfer-encoded bodies by itself.
.TP
FORWARD \fIaddress(es)\fR
Forward mail to the specified address(es). This acts as if a save had been
@@ -1926,6 +1930,18 @@
input. Any output is mailed to the user who runs the \fImailagent\fR.
Note that the message is not tagged as having been saved.
(Returns the status of \fIprogram\fR)
+.sp
+.B NOTE:
+If the message had a body that was encoded for transport (using one of
+the base64 or quoted-printable transfer encoding), mailagent will
+transparently decode it and supply a version that can be properly handled.
+In other words, the program does not need to care about the body being
+encoded in the message, as it will get a plain one. (Since no headers
+are supplied, this is the only possible option).
+.sp
+Caution though for MIME messages: you should use PIPE for them to give a
+chance to the program to properly handle the body, but then it needs to be
+fully MIME-aware.
.TP
KEEP \fIheader_fields_list\fR
Keeps only the corresponding lines in the header of the mail. For instance,
@@ -2003,6 +2019,17 @@
back from the output of the program.
Note that the message is not tagged as having been saved.
(Returns the status of \fIprogram\fR)
+.sp
+.B NOTE:
+If the message had a body that was encoded for transport (using one of
+the base64 or quoted-printable transfer encoding), mailagent will
+transparently decode it and supply a version that can be properly handled.
+The body generated by the program will then be automatically encoded back
+using the same transfer encoding.
+.sp
+Caution though for MIME messages: you should use FEED for them to give a
+chance to the program to properly handle the body, but then it needs to be
+fully MIME-aware.
.TP
PERL \fIscript\fR [\fIarguments\fR]
Escape to a perl \fIscript\fR to perform some actions on the message. This
@@ -2017,6 +2044,10 @@
explicitly DELETE it if piping was enough and it did not fail: "REJECT -f"
is your friend here to avoid unwanted deletion.
(Returns the status of \fIprogram\fR)
+.sp
+.B WARNING:
+Your program must be able to properly parse a MIME message and must deal
+with transfer-encoded bodies by itself.
.TP
POST [\fB\-lb\fR] \fInewsgroup(s)\fR
Post the message to the specified newsgroup(s) after having cleaned-up the
@@ -2066,11 +2097,18 @@
(Does not alter execution status)
.TP
PURIFY \fIprogram\fR
-Feed the header into a program and get new header back. No RESYNC is done.
+Feed the header into a program and get new header back. RESYNC is done
+automatically upon return.
This may be used to indeed purify the header by removing all the verbose
stuff added by so many mail transport agents (X-400 like lines for instance).
Obviously, this does not flag the message as having been saved.
(Returns the status of \fIprogram\fR)
+.sp
+If your program removes the Content-Transfer-Encoding header in a MIME message,
+mailagent will properly transform the message to have a non-encoded body.
+If you change the value of the Content-Transfer-Encoding header, mailagent
+will also correctly recode the body for you. The only supported encodings
+are base64 and quoted-printable.
.TP
QUEUE
Queue mail again. A successful queuing counts as if mail has been saved.
@@ -2123,8 +2161,17 @@
.TP
RESYNC
Re-synchronize header used for matching with the header of the mail. This is
-probably useful only when a FEED command was run.
+probably useful only when a SUBST or ANNOTATE command was run.
(Does not alter execution status)
+.sp
+.B NOTE:
+At RESYNC time, mailagent will check whether the Content-Transfer-Encoding
+header was changed and will transparently recode the body if required, so
+that the whole message remains valid despite header mangling. It will also
+take care of updating Content-Length if required. Whenever you do change
+these important headers via SUBST or ANNOTATE, be sure to call RESYNC before
+disposing of the message or you run the risk of saving a corrupted version
+that will not be properly understood by your mail user agent.
.TP
RUN \fIprogram\fR
Run the specified program and mail any output to the user who runs
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -1238,8 +1238,8 @@
select(STDOUT);
# Now feed the program with the mail
- if ($input == $BODY_INPUT) { # Pipes body
- print WRITE $Header{'Body'};
+ if ($input == $BODY_INPUT) { # Pipes *decoded* body
+ print WRITE ${$Header{'=Body='}};
} elsif ($input == $MAIL_INPUT) { # Pipes the whole mail
print WRITE $Header{'All'};
} elsif ($input == $HEADER_INPUT) { # Pipes the header
@@ -1367,6 +1367,21 @@
close TRACE;
$Header{'Body'} = $temp unless $input == $HEADER_INPUT;
$Header{'All'} = $Header{'Head'} . "\n" . $Header{'Body'};
+ if ($input == $BODY_INPUT) {
+ # Was fed *decoded* body, got at decoded body back.
+ # Headers have not changed, recoding will happen as in the original
+ &body_recode;
+ &header_update_size;
+ } elsif ($input == $MAIL_INPUT) {
+ # Headers could have changed and we need to reparse them in order
+ # to know how/whether we should decode the body.
+ &header_resync;
+ &body_check; # Update $Header{'=Body='} to point to *decoded* body
+ } elsif ($input == $HEADER_INPUT) {
+ # Headers pertaining to body encoding could have changed.
+ &header_check_body_encoding; # Check and recode if possible
+ &header_resync; # Resynchronize %Header
+ }
}
# Feed output back into $Back variable (used by BACK command). Typically, the
@@ -1390,60 +1405,15 @@
}
# The "RESYNC" command
-# Resynchronizes the %Header entries by reparsing the 'All' entry
+# Resynchronizes the %Header entries by reparsing the 'Head' entry
sub header_resync {
# Clean up all the non-special entries
foreach $key (keys %Header) {
next if $Pseudokey{$key}; # Skip pseudo-header entries
delete $Header{$key};
}
- # There is some code duplication with parse_mail()
- local($lines) = 0;
- local($first_from); # First From line records sender
- local($last_header); # Current normalized header field
- local($in_header) = 1; # Bug in the range operator
- local($value); # Value of current field
- my $missing_warned = 0;
- foreach (split(/\n/, $Header{'All'})) {
- if ($in_header) { # Still in header of message
- if (/^$/) { # End of header
- $in_header = 0;
- next;
- }
- if (/^\s/) { # It is a continuation line
- s/^\s+/ /; # Swallow multiple spaces
- $Header{$last_header} .= $_ if $last_header ne '';
- } elsif (/^([!-9;-~\w-]+):\s*(.*)/) { # We found a new header
- $value = $2; # Bug in perl 4.0 PL19
- $last_header = &header'normalize($1);
- $missing_warned = 0;
- # Multiple headers like 'Received' are separated by a new-
- # line character. All headers end on a non new-line.
- if ($Header{$last_header} ne '') {
- $Header{$last_header} .= "\n$value";
- } else {
- $Header{$last_header} .= $value;
- }
- } elsif (/^From\s+(\S+)/) { # The very first From line
- $first_from = $1;
- } else {
- # Did not identify a header field nor a continuation
- # Maybe there was a wrong header split somewhere?
- if ($last_header eq '') {
- &add_log("ERROR ignoring leading header garbage: $_")
- if $loglvl > 1;
- } else {
- &add_log("ERROR missing continuation for $last_header: $_")
- if !$missing_warned && $loglvl > 1;
- $Header{$last_header} .= " " . $_;
- $missing_warned++;
- }
- }
- } else {
- $lines++; # One more line in body
- }
- }
- &header_check($first_from, $lines); # Sanity checks
+ my $first_from = header_parse($Header{'Head'}, \%Header, 0);
+ &header_check($first_from, undef); # Sanity checks
}
# The "STRIP" and "KEEP" commands (case insensitive)
@@ -1471,7 +1441,7 @@
}
$line = $_; # Save original
# Make sure header field name is normalized before attempting a match
- s/^([\w-]+):/&header'normalize($1).':'/e;
+ s/^([!-9;-~\w-]+):/&header'normalize($1).':'/e;
unless (/^\s/) { # If not a continuation line
$last_was_altered = 0; # Reset header alteration flag
$matched = 0; # Assume no match
@@ -1494,6 +1464,9 @@
}
$Header{'Head'} = join("\n", @newhead) . "\n";
$Header{'All'} = $Header{'Head'} . "\n" . $Header{'Body'};
+
+ # Headers pertaining to body encoding could have changed.
+ &header_check_body_encoding; # Check, but no resync
}
# The "ANNOTATE" command
Modified: trunk/mailagent/agent/pl/analyze.pl
===================================================================
--- trunk/mailagent/agent/pl/analyze.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/analyze.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -66,6 +66,26 @@
);
}
+# Compute shorthand file name for logging based on the processed file
+sub mail_logname {
+ my ($file) = @_;
+ my ($mfile) = $file =~ m|.*/(.*)|; # Basename of mail file
+ $mfile = $file unless $mfile; # There was no / in name
+ $mfile = '<stdin>' unless $mfile; # No $file_name if from STDIN
+ return $mfile;
+}
+
+# Compute file size for logging, if possible (i.e. not reading from STDIN)
+sub mail_logsize {
+ my ($file) = @_;
+ return "" unless length $file;
+ my $msize = (stat($file))[7];
+ my $size = "";
+ my $s = $msize == 1 ? "" : "s";
+ $size = " $msize byte$s" if defined $msize;
+ return $size;
+}
+
# Parse mail message and apply the filtering rules on it
sub analyze_mail {
local($file) = shift(@_); # Mail file to be parsed
@@ -91,6 +111,11 @@
&env'setup;
umask($env'umask);
+ # Log start of processing
+ my $mfile = mail_logname($file);
+ my $msize = mail_logsize($file);
+ add_log("-- HANDLING [$mfile]$msize --") if $loglvl > 8;
+
# Parse the mail message in file
&parse_mail($file); # Parse the mail and fill-in H tables
return 1 unless defined $Header{'All'}; # Mail not parsed correctly
Added: trunk/mailagent/agent/pl/base64.pl
===================================================================
--- trunk/mailagent/agent/pl/base64.pl (rev 0)
+++ trunk/mailagent/agent/pl/base64.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -0,0 +1,222 @@
+;# $Id$
+;#
+;# Copyright (c) 2008, Raphael Manfredi
+;#
+;# You may redistribute only under the terms of the Artistic License,
+;# as specified in the README file that comes with the distribution.
+;# You may reuse parts of this distribution only within the terms of
+;# that same Artistic License; a copy of which may be found at the root
+;# of the source tree for mailagent 3.0.
+;#
+package base64;
+
+#
+# Simple base64 encoder/decoder.
+#
+
+# Initialialize the base64 decoding values
+sub init {
+ @values = (
+ # 0 1 2 3 4 5 6 7 8 9 0123456789
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 00 -> 09
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 10 -> 19
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 20 -> 29
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 30 -> 39
+
+ -1,-1,-1,62,-1,-1,-1,63, # ()*+'-./ - 40 -> 47
+ 52,53,54,55,56,57,58,59,60,61, # 0123456789 - 48 -> 57
+ -1,-1,-1,-1,-1,-1,-1, 0, 1, 2, # :;<=>?@ABC - 58 -> 67
+ 3, 4, 5, 6, 7, 8, 9,10,11,12, # DEFGHIJKLM - 68 -> 77
+ 13,14,15,16,17,18,19,20,21,22, # NOPQRSTUVW - 78 -> 87
+ 23,24,25,-1,-1,-1,-1,-1,-1,26, # XYZ[\]^_`a - 88 -> 97
+ 27,28,29,30,31,32,33,34,35,36, # bcdefghijk - 98 -> 107
+ 37,38,39,40,41,42,43,44,45,46, # lmnopqrstu - 108 -> 117
+ 47,48,49,50,51, # vwxyz - 118 -> 122
+
+ -1,-1,-1,-1,-1,-1,-1,-1, # - 123 -> 130
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 131 -> 140
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 141 -> 150
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 151 -> 160
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 161 -> 170
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 171 -> 180
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 181 -> 190
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 191 -> 200
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 201 -> 210
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 211 -> 220
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 221 -> 230
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 231 -> 240
+ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1, # - 241 -> 250
+ -1,-1,-1,-1,-1 # - 251 -> 255
+ );
+ $alphabet =
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+}
+
+# Reset the encoder/decoder
+# Must be called before invoking encode() or decode().
+# Once called, one must ONLY invoke encode() or decode() but never intermix
+# calls to these two routines. To switch, one must invoke reset() again.
+sub reset {
+ my ($len) = @_;
+ &init unless $init_done++;
+ my $data = " " x ($len || 64 * 1024); # pre-extend
+ $data = "";
+ $output = \$data;
+ $input = 0;
+ $pad = 0;
+ @byte = ();
+ $offset = 0;
+ undef $error;
+ undef $op;
+}
+
+# Decode new data from the base64 stream
+# Invoke as many times as necessary, until the end of the stream is reached.
+# Call output() to actually fetch the decoded string.
+sub decode {
+ my ($data) = @_;
+ return if defined $error; # Stop as soon as an error occurred
+ $op = "d" unless defined $op;
+ if ($op ne "d") {
+ $error = "mixed decode() within encode() calls";
+ return;
+ }
+ my $len = length $data;
+ for (my $i = 0; $i < $len; $i++) {
+ my $c = substr($data, $i, 1);
+ my $v;
+ if ($c eq '=') {
+ $v = 0;
+ if ($pad++ >= 2) {
+ $error = "too much padding";
+ return;
+ }
+ } else {
+ $v = $values[ord($c)];
+ if ($v < 0) {
+ $error = "invalid character '$c'";
+ return;
+ }
+ }
+
+ # In the following picture, we represent how the 4 bytes of input,
+ # each consisting of only 6 bits of information forming a base64 digit,
+ # are concatenated back into 3 bytes of binary information.
+ #
+ # input digit 0 1 2 3
+ # <----><-----><-----><---->
+ # +--------+--------+--------+
+ # |01234501|23450123|45012345|
+ # +--------+--------+--------+
+ # output byte 0 1 2
+
+ if ($input == 0) {
+ $byte[0] = $v << 2;
+ } elsif ($input == 1) {
+ $byte[1] = ($v & 0x0f) << 4;
+ $byte[0] |= $v >> 4;
+ } elsif ($input == 2) {
+ $byte[2] = ($v & 0x03) << 6;
+ $byte[1] |= $v >> 2;
+ } else {
+ $byte[2] |= $v;
+ $input = -1;
+ $$output .= chr($byte[0]) . chr($byte[1]) . chr($byte[2]);
+ }
+ $input++;
+ $offset++;
+ }
+}
+
+# Encode new data into the base64 stream
+# Invoke as many times as necessary, until the end of the stream is reached.
+# Call output() to actually fetch the encoded string.
+sub encode {
+ my ($data) = @_;
+ return if defined $error; # Stop as soon as an error occurred
+ $op = "e" unless defined $op;
+ if ($op ne "e") {
+ $error = "mixed encode() within decode() calls";
+ return;
+ }
+ my $len = length $data;
+ for (my $i = 0; $i < $len; $i++) {
+ my $c = substr($data, $i, 1);
+ my $v = unpack("C", $c);
+
+ # In the following picture, we represent how the 3 bytes of input
+ # are split into groups of 6 bits, each group being encoded as a
+ # single base64 digit.
+ #
+ # input byte 0 1 2
+ # +--------+--------+--------+
+ # |01234501|23450123|45012345|
+ # +--------+--------+--------+
+ # <----><-----><-----><---->
+ # output digit 0 1 2 3
+ #
+ # Every times we have 16 blocks of 4 chars, we emit a "\n" to avoid
+ # too long lines.
+
+ if ($input == 0) {
+ $byte[0] = $v >> 2;
+ $byte[1] = ($v & 0x3) << 4;
+ $$output .= "\n" if $offset && 0 == $offset % 57;
+ } elsif ($input == 1) {
+ $byte[1] |= $v >> 4;
+ $byte[2] |= ($v & 0xf) << 2;
+ } else {
+ $byte[2] |= $v >> 6;
+ $byte[3] = $v & 0x3f;
+ $input = -1;
+ $$output .=
+ substr($alphabet, $byte[0], 1) .
+ substr($alphabet, $byte[1], 1) .
+ substr($alphabet, $byte[2], 1) .
+ substr($alphabet, $byte[3], 1);
+ @byte = ();
+ }
+ $input++;
+ $offset++;
+ }
+}
+
+# Return a reference to the output of the encoded/decoded base64 stream
+sub output {
+ return $output unless defined $op; # Neither encode() nor decode() called
+ if ($op eq 'd') {
+ &'add_log("WARNING truncated base64 input (length = $offset)")
+ if $input && $'loglvl > 2;
+ $$output =~ s/\0*$//;
+ } elsif ($op eq 'e') {
+ my $pad = $offset % 3;
+ if ($pad == 1) {
+ $$output .=
+ substr($alphabet, $byte[0], 1) .
+ substr($alphabet, $byte[1], 1) . "==";
+ } elsif ($pad == 2) {
+ $$output .=
+ substr($alphabet, $byte[0], 1) .
+ substr($alphabet, $byte[1], 1) .
+ substr($alphabet, $byte[2], 1) . "=";
+ }
+ $$output .= "\n";
+ } else {
+ &'add_log("ERROR unknown base64 operation '$op'") if $'loglvl;
+ }
+ return $output;
+}
+
+# Check whether output is valid so far
+sub is_valid {
+ return defined($error) ? 0 : 1;
+}
+
+# Generate error message for non-valid base64
+sub error_msg {
+ return "" unless defined $error;
+ return "$error at offset $offset";
+}
+
+package main;
+
Property changes on: trunk/mailagent/agent/pl/base64.pl
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Modified: trunk/mailagent/agent/pl/builtins.pl
===================================================================
--- trunk/mailagent/agent/pl/builtins.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/builtins.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -118,7 +118,8 @@
sub run_builtins {
undef @Builtcode;
# Lookup for builtins. Code moved out of &parse_mail.
- foreach $line (split(/\n/, $Header{'Body'})) {
+ # We scan the *decoded* body, not the original one
+ foreach $line (split(/\n/, ${$Header{'=Body='}})) {
if ($line =~ s/^@(\w+)\s*//) { # A builtin command ?
local($subroutine) = $Builtin{$1};
&$subroutine($line) if $subroutine; # Record it if known
Modified: trunk/mailagent/agent/pl/filter.pl
===================================================================
--- trunk/mailagent/agent/pl/filter.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/filter.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -225,7 +225,9 @@
# Run the RESYNC command
sub run_resync {
- &header_resync; # Resynchronize the %Header array
+ # Headers pertaining to body encoding could have changed.
+ &header_check_body_encoding; # Check and recode if possible
+ &header_resync; # Resynchronize the %Header array
&add_log("RESYNCED [$mfile]") if $loglvl > 4;
0;
}
Modified: trunk/mailagent/agent/pl/matching.pl
===================================================================
--- trunk/mailagent/agent/pl/matching.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/matching.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -348,31 +348,33 @@
sub match_var {
local($selector, $pattern, $range) = @_;
local($lines) = 0; # Number of lines in matching buffer
+ my $target = \$Header{$selector};
+ # Need to special-case Body to use the *decoded* version
+ $target = $Header{'=Body='} if $selector eq 'Body';
if ($range ne '<1,->') { # Optimize: count lines only if needed
- $lines = $Header{$selector} =~ tr/\n/\n/;
+ $lines = $$target =~ tr/\n/\n/;
}
local($min, $max) = &mrange($range, $lines);
return 0 unless $min; # No matching possible if null range
- local($buffer); # Buffer on which matching is attempted
+ my $buffer; # Buffer on which matching is attempted
local(@buffer); # Same, whith range line selected
local(@matched);
$pattern = &make_pattern($pattern);
# Optimize, since range selection is the exception and not the rule.
# Most likely, we use the default selection, i.e. we take everything...
if ($min != 1 || $max != 9_999_999) {
- @buffer = split(/\n/, $Header{$selector});
+ @buffer = split(/\n/, $$target);
@buffer = @buffer[$min - 1 .. ($max > $#buffer ? $#buffer : $max - 1)];
$buffer = join("\n", @buffer); # Keep only selected lines
undef @buffer; # May be big, so free ASAP
- } else {
- $buffer = $Header{$selector};
+ $target = \$buffer;
}
# Ensure multi-line matching by adding trailing "m" option to pattern
- @matched = eval '($buffer =~ ' . $pattern . 'm);';
+ @matched = eval '($$target =~ ' . $pattern . 'm);';
# If buffer is empty, we have to recheck the pattern in a non array context
# to see if there is a match. Otherwise, /(.*)/ does not seem to match an
# empty string as it returns an empty string in $matched[0]...
- $matched[0] = eval '$buffer =~ ' . $pattern . 'm' if $buffer eq '';
+ $matched[0] = eval '$$target =~ ' . $pattern . 'm' unless length $$target;
&eval_error; # Make sure eval worked
&update_backref(*matched); # Record non-null backreferences
$matched[0]; # Return matching status
Modified: trunk/mailagent/agent/pl/parse.pl
===================================================================
--- trunk/mailagent/agent/pl/parse.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/parse.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -114,7 +114,7 @@
$Header{'Body'} = '';
$Header{'Head'} = '';
- &add_log ("parsing mail") if $loglvl > 18;
+ &add_log ("parsing mail" . ($head_only ? " header" : "")) if $loglvl > 18;
while (<$fd>) {
$added += length($_);
@@ -196,25 +196,265 @@
}
close MAIL if $file_name ne '';
&header_prepend("$FAKE_FROM\n") unless $first_from;
+ &body_check unless $head_only;
&header_check($first_from, $lines); # Sanity checks
}
+# Parse given header string into the supplied hash ref.
+# Do that silently if told to do so via $silent.
+# Returns: the value of the first From line, and fills %$href.
+sub header_parse {
+ my ($headers, $href, $silent) = @_;
+ # There is some code duplication with parse_mail() above
+ local($first_from); # First From line records sender
+ local($last_header); # Current normalized header field
+ local($value); # Value of current field
+ my $missing_warned = 0;
+ foreach (split(/\n/, $headers)) {
+ if (/^\s/) { # It is a continuation line
+ s/^\s+/ /; # Swallow multiple spaces
+ $href->{$last_header} .= $_ if $last_header ne '';
+ } elsif (/^([!-9;-~\w-]+):\s*(.*)/) { # We found a new header
+ $value = $2; # Bug in perl 4.0 PL19
+ $last_header = &header'normalize($1);
+ $missing_warned = 0;
+ # Multiple headers like 'Received' are separated by a new-
+ # line character. All headers end on a non new-line.
+ if ($href->{$last_header} ne '') {
+ $href->{$last_header} .= "\n$value";
+ } else {
+ $href->{$last_header} .= $value;
+ }
+ } elsif (/^From\s+(\S+)/) { # The very first From line
+ $first_from = $1;
+ } else {
+ # Did not identify a header field nor a continuation
+ # Maybe there was a wrong header split somewhere?
+ if ($last_header eq '') {
+ &add_log("ERROR ignoring leading header garbage: $_")
+ if $loglvl > 1 && !$silent;
+ } else {
+ &add_log("ERROR missing continuation for $last_header: $_")
+ if !$missing_warned && $loglvl > 1 && !$silent;
+ $href->{$last_header} .= " " . $_;
+ $missing_warned++;
+ }
+ }
+ }
+ return $first_from;
+}
+
+# Set number of Lines in body and body Length to reflect reality
+# If the headers were physically present in the message, they are
+# updated as well.
+sub header_update_size {
+ # Cannot trust %Header to indicate whether the headers were present
+ # since we add these entries in any case... Use a crude way to detect
+ # presence then...
+ my $had_lines = $Header{'Head'} =~ /^Lines:/im;
+ my $had_length = $Header{'Head'} =~ /^Length:/im;
+
+ my $lines = $Header{'Lines'} = ${$Header{'=Body='}} =~ tr/\n/\n/;
+ my $length = $Header{'Length'} = length($Header{'Body'});
+ my $is_mime = exists $Header{'Mime-Version'};
+
+ if ($had_lines) {
+ alter_header("Lines", $HD_STRIP);
+ header_append(header'format("Lines: $lines"));
+ }
+
+ if ($had_length) {
+ alter_header("Length", $HD_STRIP);
+ &add_log("NOTICE stripped non-RFC822 Length header") if $loglvl > 5;
+ }
+
+ if ($is_mime && exists $Header{'Content-Length'}) {
+ my $clen = $Header{'Content-Length'};
+ if ($clen != $length) {
+ alter_header("Content-Length", $HD_STRIP);
+ header_append(header'format("Content-Length: $length"));
+ $Header{'Content-Length'} = $length;
+ &add_log("NOTICE adjusted Content-Length from $clen to $length")
+ if $loglvl > 5;
+ }
+ }
+
+ if (!$is_mime && exists $Header{'Content-Length'}) {
+ alter_header("Content-Length", $HD_STRIP);
+ delete $Header{'Content-Length'};
+ &add_log("NOTICE stripped Content-Length header in non-MIME message")
+ if $loglvl > 5;
+ }
+}
+
+# Check whether the body we got back has received a transfer encoding.
+# If it has and we know about that transfer encoding, decode it.
+# We make sure the "=Body=" header key is a reference to the decoded body:
+# it is either a reference to $Header{'Body'} when we leave it as-is, or
+# a reference to a newly allocated scalar.
+sub body_check {
+ $Header{'=Body='} = \$Header{'Body'};
+ my $encoding = lc($Header{'Content-Transfer-Encoding'});
+ my %decode = map { $_ => 1 } qw(base64 quoted-printable);
+ unless (exists $Header{'Mime-Version'}) {
+ return unless length $encoding;
+ if ($decode{$encoding}) {
+ &add_log("WARNING ignoring $encoding body transfer encoding")
+ if $loglvl > 3;
+ } else {
+ alter_header("Content-Transfer-Encoding", $HD_STRIP);
+ delete $Header{'Content-Transfer-Encoding'};
+ &add_log("NOTICE stripped $encoding encoding in non-MIME message")
+ if $loglvl > 6;
+ }
+ return;
+ }
+ my %enc = map { $_ => 1 } qw(7bit 8bit binary base64 quoted-printable);
+ if (length $encoding) {
+ &'add_log("WARNING unknown content transfer encoding \"$encoding\"")
+ if $'loglvl > 5 && !$enc{$encoding};
+ }
+ return unless $decode{$encoding};
+ my @data = split(/\r?\n/, $Header{'Body'});
+ my $error;
+ my $output;
+ if ($encoding eq "base64") {
+ base64'reset(length $Header{'Body'});
+ foreach my $d (@data) {
+ base64'decode($d);
+ }
+ $error = base64'error_msg();
+ $output = base64'output();
+ } elsif ($encoding eq "quoted-printable") {
+ qp'reset(length $Header{'Body'});
+ foreach my $d (@data) {
+ qp'decode($d);
+ }
+ $error = qp'error_msg();
+ $output = qp'output();
+ }
+ if (length $error) {
+ &'add_log("WARNING could not decode $encoding body: $error")
+ if $'loglvl > 5;
+ } else {
+ if ($'loglvl > 9) {
+ my $len = length $$output;
+ &'add_log("decoded $encoding body into $len bytes");
+ }
+ $Header{'=Body='} = $output; # Reference
+ }
+ &header_update_size;
+}
+
+# Force recoding of the body to a new encoding.
+# The $Header{'Body'} variable is supposed to hold the decoded version.
+sub body_recode_with {
+ my ($encoding) = @_;
+ $Header{'=Body='} = \$Header{'Body'}; # The decoded version!
+ my @data = split(/\r?\n/, $Header{'Body'});
+ my $error;
+ my $output;
+ if ($encoding eq "base64") {
+ base64'reset(length($Header{'Body'}) * 4/3);
+ foreach my $d (@data) {
+ base64'encode($d);
+ }
+ $error = base64'error_msg();
+ $output = base64'output();
+ } elsif ($encoding eq "quoted-printable") {
+ qp'reset(length $Header{'Body'} * 1.1);
+ foreach my $d (@data) {
+ qp'encode($d);
+ }
+ $error = qp'error_msg();
+ $output = qp'output();
+ }
+ if (length $error) {
+ &'add_log("WARNING could not recode $encoding body: $error")
+ if $'loglvl > 5;
+ } else {
+ if ($'loglvl > 9) {
+ my $len = length $$output;
+ &'add_log("recoded $encoding body into $len bytes");
+ }
+ delete $Header{'Body'}; # $Header{'=Body='} ref still points to it
+ $Header{'Body'} = $$output; # Transfer-Encoded version of the body
+ # The body changed, must update the "All" key...
+ $Header{'All'} = $Header{'Head'} . "\n" . $Header{'Body'};
+ }
+}
+
+# When coming from a feeback routine such as PASS, we have a new body that
+# maybe we need to recode to match the original encoding...
+sub body_recode {
+ $Header{'=Body='} = \$Header{'Body'}; # The decoded version!
+ my $encoding = lc($Header{'Content-Transfer-Encoding'});
+ return unless length $encoding;
+ unless (exists $Header{'Mime-Version'}) {
+ &add_log("WARNING not recoding body in $encoding: no MIME header")
+ if $loglvl > 3;
+ alter_header("Content-Transfer-Encoding", $HD_STRIP);
+ delete $Header{'Content-Transfer-Encoding'};
+ return;
+ }
+ my %recode = map { $_ => 1 } qw(base64 quoted-printable);
+ return unless $recode{$encoding};
+ body_recode_with($encoding);
+}
+
+# Whenever we got a new set of headers in $Header{'Head'} we need to ensure
+# the new vision is consistent with the body encoding. If they strip the
+# Content-Transfer-Encoding header for instance, we have to use the old
+# decoded version we had instead of the original body.
+# If they add a Content-Transfer-Encoding header, we have to recode the body!
+sub header_check_body_encoding {
+ my $plain = \$Header{'Body'} == $Header{'=Body='}; # No encoding
+ if ($plain && $Header{'Head'} !~ /^Content-Transfer-Encoding:/mi) {
+ # No encoding and no header indicating a transfer encodig...
+ return; # Nothing to change
+ }
+ my %new;
+ header_parse($Header{'Head'}, \%new, 1); # Silently parse new headers
+ my $encoding = $Header{'Content-Transfer-Encoding'} || "none";
+ my $new_encoding = lc($new{'Content-Transfer-Encoding'}) || "none";
+ return if lc($encoding) eq $new_encoding; # No change occurred
+
+ &add_log(
+ "WARNING body transfer encoding changed from $encoding to $new_encoding"
+ ) if $loglvl > 3;
+
+
+ $Header{'Body'} = ${$Header{'=Body='}}; # Restore decoded version
+ my %encode = map { $_ => 1 } qw(base64 quoted-printable);
+ unless ($encode{$new_encoding}) {
+ $Header{'=Body='} = \$Header{'Body'};
+ return;
+ }
+ body_recode_with($new_encoding); # Then re-encode it
+
+ # At some point a RESYNC will be needed, caller will decide when it is
+ # necessary to do it.
+}
+
# Now do some sanity checks:
# - if there is no From: header, fill it in with the first From
# - if there is no To: but an Apparently-To:, copy it also as a To:
# - if an Envelope field was defined in the header, override it (sorry)
# - likewise for Relayed, which is the list of relaying hosts, first one first.
#
-# We guarantee the following header entries:
+# We guarantee the following header entries (to select on in rules):
# Envelope: the actual sender of the message, empty if cannot compute
# From: the value of the From field
# To: to whom the mail was sent
# Lines: number of lines in the message
-# Length: number of bytes in the message
+# Length: number of bytes in the message body (*decoded* version)
# Relayed: the list of relaying hosts deduced from Received: lines
# Reply-To: the address we may use to reply
# Sender: the value of the Sender field, same as From usually
#
+# NB: When the $lines parameter is set, we parsed the whole message initially.
+# When it is undef, we're resyncing, possibly after an external messaging of
+# the message.
sub header_check {
local($first_from, $lines) = @_; # First From line, number of lines
unless (defined $Header{'From'}) {
@@ -254,11 +494,17 @@
}
}
- # Set number of lines in body, unless there is already a Lines:
- # header in which case we trust it. Same for Length.
- $Header{'Lines'} = $lines unless defined($Header{'Lines'});
- $Header{'Length'} = length($Header{'Head'}) + length($Header{'Body'}) + 1
- unless defined($Header{'Length'});
+ # Update length information
+ # No warning is emitted unless $lines was defined, indicating initial
+ # parsing of the message we get.
+ my $length = $Header{'Content-Length'};
+ &header_update_size; # Update number of lines and length...
+ my $count = $Header{'Lines'};
+ &add_log("NOTICE adjusted number of lines from $lines to $count")
+ if $loglvl > 5 && defined($lines) && $count != $lines;
+ $count = $Header{'Content-Length'};
+ &add_log("NOTICE adjusted Content-Length from $length to $count")
+ if $loglvl > 5 && defined($lines) && $count != $length;
# If there is no Reply-To: line, then take the address in From, if any.
# Otherwise use the address found in the return-path
@@ -287,7 +533,7 @@
# the mail) coming last.
unless ($Header{'Relayed'} = &relay_list) {
- &add_log("WARNING no valid Received: indication") if $loglvl > 4;
+ &add_log("NOTICE no valid Received: indication") if $loglvl > 6;
}
}
@@ -330,7 +576,7 @@
local($_);
# All the known top-level domains as of 2006-08-15
- # with the addition of "loc" and "private".
+ # with the addition of "loc", "localdomain" and "private".
# See http://data.iana.org/TLD/tlds-alpha-by-domain.txt
my $tlds_re = qr/
a(?:ero|rpa|[c-gil-oq-uwxz])|
@@ -344,7 +590,7 @@
i(?:n(?:fo|t)|[del-oq-t])|
j(?:obs|[emop])|
k[eghimnrwyz]|
- l(?:[abcikr-vy]|oc)|
+ l(?:[abcikr-vy]|o(?:c|caldomain))|
m(?:il|obi|useum|[acdghk-z])|
n(?:ame|et|[acefgilopruz])|
o(?:m|rg)|
@@ -510,7 +756,6 @@
return join(', ', reverse @unique);
}
-
# Append given field to the header structure, updating the whole mail
# text at the same time, hence keeping the %Header table.
# The argument must be a valid formatted RFC-822 mail header field.
Modified: trunk/mailagent/agent/pl/pqueue.pl
===================================================================
--- trunk/mailagent/agent/pl/pqueue.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/pqueue.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -142,7 +142,8 @@
if ($result == 0) {
local($len) = $Header{'Length'};
- &add_log("FILTERED [$file] $len bytes") if $loglvl > 4;
+ my $msize = mail_logsize($filename);
+ &add_log("FILTERED [$file]$msize ($len bytes)") if $loglvl > 4;
}
return $result; # 0 if OK, 1 for analyze errors
Added: trunk/mailagent/agent/pl/qp.pl
===================================================================
--- trunk/mailagent/agent/pl/qp.pl (rev 0)
+++ trunk/mailagent/agent/pl/qp.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -0,0 +1,111 @@
+;# $Id$
+;#
+;# Copyright (c) 2008, Raphael Manfredi
+;#
+;# You may redistribute only under the terms of the Artistic License,
+;# as specified in the README file that comes with the distribution.
+;# You may reuse parts of this distribution only within the terms of
+;# that same Artistic License; a copy of which may be found at the root
+;# of the source tree for mailagent 3.0.
+;#
+package qp;
+
+#
+# Simple quoted-printable encoder/decoder.
+#
+
+# Reset the encoder/decoder
+# Must be called before invoking encode() or decode().
+# Once called, one must ONLY invoke encode() or decode() but never intermix
+# calls to these two routines. To switch, one must invoke reset() again.
+sub reset {
+ my ($len) = @_;
+ my $data = " " x ($len || 64 * 1024); # pre-extend
+ $data = "";
+ $output = \$data;
+ $offset = 0;
+ undef $error;
+ undef $op;
+}
+
+# Decode new line from the quoted-printable stream
+# Invoke as many times as necessary, until the end of the stream is reached.
+# Call output() to actually fetch the decoded string.
+sub decode {
+ local ($_) = @_;
+ return if defined $error; # Stop as soon as an error occurred
+ $op = "d" unless defined $op;
+ if ($op ne "d") {
+ $error = "mixed decode() within encode() calls";
+ return;
+ }
+ my $soft = 0;
+ s/[ \t]+$//; # Trailing white spaces
+ $soft = 1 if s/^=$//; # Soft line break
+ $soft = 1 if s/([^=])=$/$1/; # Soft line break, but not for trailing ==
+ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
+ $$output .= $_;
+ $$output .= "\n" unless $soft;
+ $offset += length($_);
+}
+
+# Encode new line into the base64 stream
+# Invoke as many times as necessary, until the end of the stream is reached.
+# Call output() to actually fetch the encoded string.
+sub encode {
+ local ($_) = @_;
+ return if defined $error; # Stop as soon as an error occurred
+ $op = "e" unless defined $op;
+ if ($op ne "e") {
+ $error = "mixed encode() within decode() calls";
+ return;
+ }
+ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/
+ sprintf("=%02X", ord($1))/eg;
+ # Trailing white space must be encoded or will be stripped at decode time
+ s/([ \t]+)$/join('', map { sprintf("=%02X", ord($_)) } split('', $1))/egm;
+
+ # Ensure lines are smaller than 76 chars
+ # No one-liner here as we cannot break up =xx escapes!
+ # The trick is to break after 73 chars (76 - 3) and then add 1 or 2 chars
+ # if they are not '=', thereby ensuring we're not breaking up in the
+ # middle of a sequence.
+
+ while (length($_) >= 76) {
+ my $str = substr($_, 0, 73);
+ s/^.{73}//;
+ $str .= $1 if substr($_, 0, 1) ne "=" && s/^(.)//;
+ $str .= $1 if substr($_, 0, 1) ne "=" && s/^(.)//;
+ $$output .= "$str=\n";
+ }
+ $$output .= $_ . "\n" if length $_;
+
+ $offset += length $_;
+}
+
+# Return a reference to the output of the encoded/decoded base64 stream
+sub output {
+ return $output unless defined $op; # Neither encode() nor decode() called
+ if ($op eq 'd') {
+ # Nothing to be done
+ } elsif ($op eq 'e') {
+ $$output .= "\n" unless $$output =~ /\n$/s;
+ } else {
+ &'add_log("ERROR unknown quoted-printable operation '$op'") if $'loglvl;
+ }
+ return $output;
+}
+
+# Check whether output is valid so far
+sub is_valid {
+ return defined($error) ? 0 : 1;
+}
+
+# Generate error message for non-valid base64
+sub error_msg {
+ return "" unless defined $error;
+ return "$error at offset $offset";
+}
+
+package main;
+
Property changes on: trunk/mailagent/agent/pl/qp.pl
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Modified: trunk/mailagent/agent/pl/runcmd.pl
===================================================================
--- trunk/mailagent/agent/pl/runcmd.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/pl/runcmd.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -138,9 +138,7 @@
local($cmd) = @_; # Command to be run (passed to subroutines)
local($cmd_name); # Command name
local($cont) = $FT_CONT; # Continue by default
- local($mfile) = $file_name =~ m|.*/(.*)|; # Basename of mail file
- $mfile = $file_name unless $mfile; # There was no / in name
- $mfile = '<stdin>' unless $mfile; # No $file_name if from STDIN
+ local($mfile) = mail_logname($file_name);
¯os_subst(*cmd); # Macros substitutions
$cmd =~ s/^\s*//; # Remove leading spaces
$cmd =~ s/\s*$//; # And trailing ones
Modified: trunk/mailagent/agent/test/actions
===================================================================
--- trunk/mailagent/agent/test/actions 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/test/actions 2008-06-13 09:32:24 UTC (rev 38)
@@ -167,12 +167,13 @@
REJECT;
}
-X-Tag: /feed/, To: ram { SAVE no_resync };
+X-Tag: /feed/, !To: ram { SAVE resynced };
X-Tag: /forward 1/ { FORWARD nobody };
X-Tag: /forward 2/ { FORWARD "list" };
-X-Tag: /give/ { GIVE wc > output };
+X-Tag: /give 1/ { GIVE wc > output };
+X-Tag: /give 2/ { GIVE cat > output };
X-Tag: /keep/
{
@@ -229,12 +230,19 @@
ONCE (other,tag,0m) SAVE four;
}
-X-Tag: /pass/
+X-Tag: /pass 1/
{
PASS grep -v and;
PASS perl -p -e 's/^\>From /From /';
SAVE output;
}
+X-Tag: /pass 2/
+{
+ PASS grep -v successfully;
+ STRIP Content-Transfer-Encoding;
+ SAVE output;
+}
+X-Tag: /pass 3/ { PASS grep -v broken; SAVE output; }
X-Tag: /perl/ { REJECT PERL };
<PERL> { PERL perl.2 exit_1; REJECT -t; SAVE exit_ok; REJECT };
@@ -248,11 +256,8 @@
X-Tag: /post 1/ { POST alt.test comp.others };
X-Tag: /post 2/ { POST -l "list" };
-X-Tag: /purify/
-{
- PURIFY grep -v Subject:;
- SAVE output;
-};
+X-Tag: /purify 1/ { PURIFY grep -v Subject:; SAVE output; };
+X-Tag: /purify 2/ { PURIFY grep -v Transfer-Encoding:; SAVE output; };
X-Tag: /protect/
{
Added: trunk/mailagent/agent/test/base64
===================================================================
--- trunk/mailagent/agent/test/base64 (rev 0)
+++ trunk/mailagent/agent/test/base64 2008-06-13 09:32:24 UTC (rev 38)
@@ -0,0 +1,21 @@
+From rap...@po... Tue Jun 10 17:44:12 2008
+Received: from tours.ram.loc (fetchmail@localhost [127.0.0.1])
+ by tours.ram.loc (8.14.3/8.13.8/Debian-3) with ESMTP id m5AFiCJq002957
+ for <ram@localhost>; Tue, 10 Jun 2008 17:44:12 +0200
+From: "Raphael Manfredi" <Rap...@po...>
+To: "Raphael Manfredi" <Rap...@po...>
+Date: Tue, 10 Jun 2008 15:35:21 +0000
+Subject: Sample base64 encoding
+Message-ID: <D32...@GV...>
+Content-Type: text/plain; charset="utf-8"
+Content-Transfer-Encoding: base64
+MIME-Version: 1.0
+Content-Length: 346
+Lines: 6
+
+VGhpcyBtZXNzYWdlIGlzIG9uZSBiaWcgTUlNRSBwYXJ0IHRoYXQgaGFzIGJlZW4gYmFzZTY0LWVu
+Y29kZWQuDQoNClRoZSBtYWlsYWdlbnQgdGVzdCBzdWl0ZSBpcyBnb2luZyB0byBsb29rIGZvciB0
+aGUgZm9sbG93aW5nIGxpbmU6DQoNCiAgICAgICAgKioqIFlFUywgc3VjY2Vzc2Z1bGx5IGRlY29k
+ZWQgKioqDQoNCmluIHRoZSBkZWNvZGVkIGJvZHkgYXMgcHJvb2YgdGhhdCB0aGUgYmFzZTY0IGRl
+Y29kaW5nIGxvZ2ljIGlzIHdvcmtpbmcuDQo=
+
Modified: trunk/mailagent/agent/test/cmd/feed.t
===================================================================
--- trunk/mailagent/agent/test/cmd/feed.t 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/test/cmd/feed.t 2008-06-13 09:32:24 UTC (rev 38)
@@ -16,7 +16,7 @@
#
do '../pl/cmd.pl';
-unlink 'ok', 'no_resync';
+unlink 'ok', 'resynced';
&add_header('X-Tag: feed');
`$cmd`;
@@ -25,7 +25,7 @@
-f 'ok' || print "3\n"; # ...here
&get_log(4, 'ok');
¬_log('^To:', 5); # Make sure To: disappeared
--f 'no_resync' || print "6\n"; # Ensure header not disturbed
+-f 'resynced' || print "6\n"; # Ensure RESYNC was done under the hood
-unlink 'ok', 'no_resync', 'mail';
+unlink 'ok', 'resynced', 'mail';
print "0\n";
Modified: trunk/mailagent/agent/test/cmd/give.t
===================================================================
--- trunk/mailagent/agent/test/cmd/give.t 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/test/cmd/give.t 2008-06-13 09:32:24 UTC (rev 38)
@@ -18,7 +18,7 @@
do '../pl/cmd.pl';
unlink 'output';
-&add_header('X-Tag: give');
+&add_header('X-Tag: give 1');
`$cmd`;
$? == 0 || print "1\n";
-f 'output' || print "2\n"; # Where output is created
@@ -33,4 +33,23 @@
-f "$user" || print "4\n"; # Default action applies
unlink 'output', 'mail', "$user";
+
+&cp_mail("../base64");
+&add_header('X-Tag: give 2');
+`$cmd`;
+$? == 0 || print "5\n";
+&get_log(6, 'output');
+&check_log('successfully decoded', 7) == 1 || print "8\n";
+
+unlink 'output', 'mail', "$user";
+
+&cp_mail("../qp");
+&add_header('X-Tag: give 2');
+`$cmd`;
+$? == 0 || print "9\n";
+&get_log(10, 'output');
+&check_log('broken', 11) == 1 || print "12\n";
+&check_log('Rapha\xEBl', 13) == 1 || print "14\n";
+
+unlink 'output', 'mail', "$user";
print "0\n";
Modified: trunk/mailagent/agent/test/cmd/pass.t
===================================================================
--- trunk/mailagent/agent/test/cmd/pass.t 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/test/cmd/pass.t 2008-06-13 09:32:24 UTC (rev 38)
@@ -24,7 +24,7 @@
do '../pl/misc.pl';
unlink 'output';
-&add_header('X-Tag: pass');
+&add_header('X-Tag: pass 1');
&add_option("-o 'fromesc: OFF'");
open(MAIL, '>>mail');
print MAIL <<EOM;
@@ -45,4 +45,25 @@
&check_log('^From test bug', 7) == 1 || print "8\n";
unlink 'output', 'mail', 'ok', 'comp';
+
+cp_mail("../base64");
+add_header('X-Tag: pass 2');
+`$cmd`;
+$? == 0 || print "9\n";
+&get_log(10, 'output');
+¬_log('successfully', 11);
+&check_log('base64-encoded', 12);
+
+unlink 'output', 'mail';
+
+cp_mail("../qp");
+add_header('X-Tag: pass 3');
+`$cmd`;
+$? == 0 || print "13\n";
+&get_log(14, 'output');
+¬_log('brok=', 15); # Line was passed decoded, so this was stripped
+&check_log("char '=3D'!", 16); # Still encoded in quoted-printable
+
+unlink 'output', 'mail';
+
print "0\n";
Modified: trunk/mailagent/agent/test/cmd/purify.t
===================================================================
--- trunk/mailagent/agent/test/cmd/purify.t 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/test/cmd/purify.t 2008-06-13 09:32:24 UTC (rev 38)
@@ -18,7 +18,7 @@
do '../pl/cmd.pl';
unlink 'output';
-&add_header('X-Tag: purify');
+&add_header('X-Tag: purify 1');
`$cmd`;
$? == 0 || print "1\n";
-f 'output' || print "2\n"; # Where mail is saved
@@ -29,4 +29,24 @@
-s 'comp' != -s 'output' || print "5\n"; # Casually check X-Filter was there
unlink 'output', 'mail', 'ok', 'comp';
+
+cp_mail("../base64");
+add_header('X-Tag: purify 2');
+`$cmd`;
+$? == 0 || print "6\n";
+&get_log(7, 'output');
+&check_log('successfully', 8);
+
+unlink 'output', 'mail';
+
+cp_mail("../qp");
+add_header('X-Tag: purify 2');
+`$cmd`;
+$? == 0 || print "9\n";
+&get_log(10, 'output');
+¬_log('brok=', 11); # Body must have been recoded
+¬_log("char '=3D'!", 12);
+&check_log("broken", 13);
+
+unlink 'output', 'mail';
print "0\n";
Added: trunk/mailagent/agent/test/filter/base64.t
===================================================================
--- trunk/mailagent/agent/test/filter/base64.t (rev 0)
+++ trunk/mailagent/agent/test/filter/base64.t 2008-06-13 09:32:24 UTC (rev 38)
@@ -0,0 +1,29 @@
+# Check base64 body decoding for matching
+
+# $Id$
+#
+# Copyright (c) 2008, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic License,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic License; a copy of which may be found at the root
+# of the source tree for mailagent 3.0.
+
+do '../pl/filter.pl';
+do '../pl/logfile.pl';
+unlink 'always';
+&cp_mail("../base64");
+
+&add_header('x-tag: base64');
+`$cmd`;
+$? == 0 || print "1\n";
+-f "$user" && print "2\n"; # No default action
+-f 'always' || print "3\n"; # Recognized both X-Tag and Body
+
+&get_log(4, 'always');
+¬_log('YES, successfully decoded', 5); # Body NOT decoded
+&check_log('Y29kaW5nIGxvZ2ljIGlzIHdvcmtpbmcuDQo=', 6);
+
+unlink 'always', "$user";
+print "0\n";
Property changes on: trunk/mailagent/agent/test/filter/base64.t
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Added: trunk/mailagent/agent/test/filter/qp.t
===================================================================
--- trunk/mailagent/agent/test/filter/qp.t (rev 0)
+++ trunk/mailagent/agent/test/filter/qp.t 2008-06-13 09:32:24 UTC (rev 38)
@@ -0,0 +1,29 @@
+# Check quoted-printable body decoding for matching
+
+# $Id$
+#
+# Copyright (c) 2008, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic License,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic License; a copy of which may be found at the root
+# of the source tree for mailagent 3.0.
+
+do '../pl/filter.pl';
+do '../pl/logfile.pl';
+unlink 'always';
+&cp_mail("../qp");
+
+&add_header('x-tag: qp');
+`$cmd`;
+$? == 0 || print "1\n";
+-f "$user" && print "2\n"; # No default action
+-f 'always' || print "3\n"; # Recognized both X-Tag and Body
+
+&get_log(4, 'always');
+¬_log('broken', 5); # Body NOT decoded
+&check_log('brok=', 6);
+
+unlink 'always', "$user";
+print "0\n";
Property changes on: trunk/mailagent/agent/test/filter/qp.t
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Revision
Name: svn:eol-style
+ native
Modified: trunk/mailagent/agent/test/pl/mail.pl
===================================================================
--- trunk/mailagent/agent/test/pl/mail.pl 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/test/pl/mail.pl 2008-06-13 09:32:24 UTC (rev 38)
@@ -76,8 +76,10 @@
# Copy mail in out/
sub cp_mail {
+ my ($file) = @_;
+ $file = "../mail" unless defined $file;
local($_);
- open(MAIL, '../mail');
+ open(MAIL, $file) || die "Can't open $file: $!";
open(HERE, '>mail');
print HERE while <MAIL>;
close MAIL;
Added: trunk/mailagent/agent/test/qp
===================================================================
--- trunk/mailagent/agent/test/qp (rev 0)
+++ trunk/mailagent/agent/test/qp 2008-06-13 09:32:24 UTC (rev 38)
@@ -0,0 +1,21 @@
+From rap...@po... Tue Jun 10 17:44:12 2008
+Received: from tours.ram.loc (fetchmail@localhost [127.0.0.1])
+ by tours.ram.loc (8.14.3/8.13.8/Debian-3) with ESMTP id m5AFiCJq002957
+ for <ram@localhost>; Tue, 10 Jun 2008 17:44:12 +0200
+From: "Raphael Manfredi" <Rap...@po...>
+To: "Raphael Manfredi" <Rap...@po...>
+Date: Tue, 10 Jun 2008 15:35:21 +0000
+Subject: Sample quoted-printable encoding
+Message-ID: <D32...@ma...>
+Content-Type: text/plain; charset="iso8859-1"
+Content-Transfer-Encoding: quoted-printable
+MIME-Version: 1.0
+Lines: 7
+
+This is a first line of pure ASCII text
+This second line contains the word 'Rapha=EBl'
+This third line is much longer than 76 chars and therefore needs to be brok=
+en up smartly
+This fourth line contains the naughty char '=3D'!
+This fifth line is unreadable: =E0=E9=F4=EA=E8=E0=E9=F4=EA=E8=E0=E9=F4=EA=
+=E8=E0=E9=F4=EA=E8=E0=E9=F4=EA=E8=E0=E9=F4=EA=E8=E0=E9=F4=EA=E8, yeah!
Modified: trunk/mailagent/agent/test/rules
===================================================================
--- trunk/mailagent/agent/test/rules 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/agent/test/rules 2008-06-13 09:32:24 UTC (rev 38)
@@ -161,6 +161,14 @@
# filter/case
X-Tag: case, Cc: root { STRIP Cc; SAVE always };
+# filter/base64
+X-Tag: base64,
+Body: /successfully/ { SAVE always };
+
+# filter/qp
+X-Tag: qp,
+Body: /broken/ { SAVE always };
+
# filter/status
X-Tag: /status/ { REJECT -t STATUS };
<STATUS> { RUN ../no/such/file; REJECT -t; SAVE always; REJECT -t; SAVE never };
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-13 09:24:10 UTC (rev 37)
+++ trunk/mailagent/revision.h 2008-06-13 09:32:24 UTC (rev 38)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 33
+#define REVISION 37
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-13 09:24:21
|
Revision: 37
http://mailagent.svn.sourceforge.net/mailagent/?rev=37&view=rev
Author: rmanfredi
Date: 2008-06-13 02:24:10 -0700 (Fri, 13 Jun 2008)
Log Message:
-----------
Fail when encountering a duplicate routine.
Modified Paths:
--------------
trunk/mailagent/bin/perload
Modified: trunk/mailagent/bin/perload
===================================================================
--- trunk/mailagent/bin/perload 2008-06-11 10:42:08 UTC (rev 36)
+++ trunk/mailagent/bin/perload 2008-06-13 09:24:10 UTC (rev 37)
@@ -117,6 +117,8 @@
$fn_package = $current_package;
$fn_basename = $function;
}
+ die "line $.: duplicate routine ${fn_package}::$fn_basename\n"
+ if $Seen{"${fn_package}::$fn_basename"}++;
# Keep leading function comment
foreach (@Comment) {
push(@Data, $_) unless $autoload;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-11 10:42:29
|
Revision: 36
http://mailagent.svn.sourceforge.net/mailagent/?rev=36&view=rev
Author: rmanfredi
Date: 2008-06-11 03:42:08 -0700 (Wed, 11 Jun 2008)
Log Message:
-----------
Ensure fatal() works when mailagent called interactively with no config file.
Modified Paths:
--------------
trunk/mailagent/agent/pl/add_log.pl
trunk/mailagent/agent/pl/emergency.pl
Modified: trunk/mailagent/agent/pl/add_log.pl
===================================================================
--- trunk/mailagent/agent/pl/add_log.pl 2008-06-06 13:02:56 UTC (rev 35)
+++ trunk/mailagent/agent/pl/add_log.pl 2008-06-11 10:42:08 UTC (rev 36)
@@ -120,6 +120,8 @@
local($date);
local($log);
+ return unless length $file;
+
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$date = sprintf("%.2d/%.2d/%.2d %.2d:%.2d:%.2d",
Modified: trunk/mailagent/agent/pl/emergency.pl
===================================================================
--- trunk/mailagent/agent/pl/emergency.pl 2008-06-06 13:02:56 UTC (rev 35)
+++ trunk/mailagent/agent/pl/emergency.pl 2008-06-11 10:42:08 UTC (rev 36)
@@ -92,10 +92,8 @@
}
# It can happen that we get here before configuration file was read
- if (defined $loglvl) {
- &add_log("FATAL $reason") if $loglvl;
- -t STDIN && print STDERR "$prog_name: $reason\n";
- }
+ &add_log("FATAL $reason") if defined $loglvl;
+ -t STDIN && print STDERR "$prog_name: $reason\n";
# Try an emergency save, if mail is not empty
if ($Header{'All'} ne '' && 0 == &emergency_save) {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-06 13:03:11
|
Revision: 35
http://mailagent.svn.sourceforge.net/mailagent/?rev=35&view=rev
Author: rmanfredi
Date: 2008-06-06 06:02:56 -0700 (Fri, 06 Jun 2008)
Log Message:
-----------
Do not hardwire ~/.bak as the error log file, extract it from ~/.forward.
Modified Paths:
--------------
trunk/mailagent/agent/files/chkagent.sh
Modified: trunk/mailagent/agent/files/chkagent.sh
===================================================================
--- trunk/mailagent/agent/files/chkagent.sh 2008-06-06 12:00:59 UTC (rev 34)
+++ trunk/mailagent/agent/files/chkagent.sh 2008-06-06 13:02:56 UTC (rev 35)
@@ -66,13 +66,20 @@
echo "Cannot find $logfile" > $report
fi
-# ~/.bak is the output from .forward
-if test -s "$HOME/.bak"; then
+# Determine where they redirect the output from .forward
+fw=$HOME/.forward
+if test -f $fw; then
+ errors=`perl -ne 's/^"(.*)"$/$1/; /(-o|>>)\s*(\S+)/ && print "$2\n"' $fw`
+fi
+case "$errors" in
+'') errors=/dev/null ;;
+esac
+if test -s $errors; then
echo " " >> $report
- echo "*** Errors from ~/.bak:" >> $report
+ echo "*** Errors from $errors:" >> $report
echo " " >> $report
- cat $HOME/.bak >> $report
- cp /dev/null $HOME/.bak
+ cat $errors >> $report
+ cp /dev/null $errors
fi
# Look for mails in the emergency directory
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-06 12:01:12
|
Revision: 34
http://mailagent.svn.sourceforge.net/mailagent/?rev=34&view=rev
Author: rmanfredi
Date: 2008-06-06 05:00:59 -0700 (Fri, 06 Jun 2008)
Log Message:
-----------
Fixed earlier commit mistake in new state logging.
Modified Paths:
--------------
trunk/mailagent/agent/pl/actions.pl
trunk/mailagent/revision.h
Modified: trunk/mailagent/agent/pl/actions.pl
===================================================================
--- trunk/mailagent/agent/pl/actions.pl 2008-06-06 11:49:48 UTC (rev 33)
+++ trunk/mailagent/agent/pl/actions.pl 2008-06-06 12:00:59 UTC (rev 34)
@@ -1826,7 +1826,7 @@
return 0 if $opt'sw_t && $lastcmd != 0;
return 0 if $opt'sw_f && $lastcmd == 0;
if ($mode ne '') {
- &add_log("entering new state $wmode") if $loglvl > 6 && $mode ne $wmode;
+ &add_log("entering new state $mode") if $loglvl > 6 && $mode ne $wmode;
$wmode = $mode;
}
&perform; # This was dynamically bound
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-06 11:49:48 UTC (rev 33)
+++ trunk/mailagent/revision.h 2008-06-06 12:00:59 UTC (rev 34)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 32
+#define REVISION 33
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rma...@us...> - 2008-06-06 11:49:55
|
Revision: 33
http://mailagent.svn.sourceforge.net/mailagent/?rev=33&view=rev
Author: rmanfredi
Date: 2008-06-06 04:49:48 -0700 (Fri, 06 Jun 2008)
Log Message:
-----------
Fixed logging messages for BEGIN and for entering new states.
Modified Paths:
--------------
trunk/mailagent/agent/pl/filter.pl
trunk/mailagent/revision.h
Modified: trunk/mailagent/agent/pl/filter.pl
===================================================================
--- trunk/mailagent/agent/pl/filter.pl 2008-06-06 11:18:20 UTC (rev 32)
+++ trunk/mailagent/agent/pl/filter.pl 2008-06-06 11:49:48 UTC (rev 33)
@@ -237,7 +237,7 @@
return 0 if $opt'sw_f && !$lastcmd; # -f means change only if false
$newstate = 'INITIAL' unless $newstate;
$wmode = $newstate; # $wmode comes from analyze_mail
- &add_log("BEGUN new state $newstate") if $loglvl > 4;
+ &add_log("BEGUN [$mfile] state $newstate") if $loglvl > 4;
0;
}
@@ -248,8 +248,12 @@
$mode =~ s|^(\w*)\s*\(([^()]*)\).*|$1| && ($tags = $2);
local($failed) = 0;
if (&history_tag($tags)) { # Message already seen
- $wmode = '_SEEN_'; # Enter special mode ($wmode from analyze_mail)
- &add_log("NOTICE entering seen mode") if $loglvl > 5;
+ if ($mode eq '') {
+ &add_log("NOTICE entering seen mode")
+ if $loglvl > 5 && $wmode ne '_SEEN_';
+ # Enter special mode ($wmode from analyze_mail)
+ $wmode = '_SEEN_';
+ }
&alter_execution('x', $mode);
$failed = 1; # Make sure it "fails"
}
@@ -866,7 +870,7 @@
sub alter_execution {
local($option, $mode) = @_; # Option, mode we have to change to
if ($mode ne '') {
- &add_log("entering new state $wmode") if $loglvl > 6 && $wmode ne $mode;
+ &add_log("entering new state $mode") if $loglvl > 6 && $wmode ne $mode;
$wmode = $mode;
}
if ($option eq 'x') { # Backward compatibility at 3.0 PL24
Modified: trunk/mailagent/revision.h
===================================================================
--- trunk/mailagent/revision.h 2008-06-06 11:18:20 UTC (rev 32)
+++ trunk/mailagent/revision.h 2008-06-06 11:49:48 UTC (rev 33)
@@ -4,4 +4,4 @@
* Generated by ./bin/svn-revision.
*/
-#define REVISION 29
+#define REVISION 32
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
