X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=perlmail-accept;h=e704077bce8d6a163b0e5cf34e23e6578c0d1fea;hp=20b5b2068d2cf7ca3219d203676180e94cfa09be;hb=refs%2Fheads%2Fmaster;hpb=bdb57ec197e5b173fc0a0331964ccf0c50cabf5b

diff --git a/perlmail-accept b/perlmail-accept
index 20b5b20..4feb8ec 100755
--- a/perlmail-accept
+++ b/perlmail-accept
@@ -1,6 +1,6 @@
 #! /usr/bin/perl
 # 
-#	$Id$
+#	$Id: perlmail-accept,v 1.40 2010/07/16 07:19:36 lace Exp $
 # Copyright (C) 2002-2003 Jan Kratochvil <project-PerlMail@jankratochvil.net>
 # 
 # This program is free software; you can redistribute it and/or modify
@@ -19,7 +19,7 @@
 
 
 use vars qw($VERSION);
-$VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
+$VERSION=do { my @r=(q$Revision: 1.40 $=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
 use strict;
 use warnings;
 
@@ -48,8 +48,7 @@ BEGIN {
 	use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0);
 
 	# FIXME:
-	use lib "/home/lace/lib/perl5/site_perl/5.10.0";
-	use lib "/home/lace/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi";
+#	use lib split /:/,$ENV{"PERL5LIB"};
 
 	use PerlMail::Config;
 	use PerlMail::Lib;
@@ -129,8 +128,9 @@ sub inetd
 
 	while (1) {
 		local $/="\n";
+		$!=undef();
 		my $length=<STDIN>;
-		confess "Unexpected EOF" if !defined $length;
+		confess "Unexpected EOF: $!" if !defined $length;
 		confess "Missing EOL" if $length!~s/\n$//s;
 		exit 0 if $length eq "BYE";
 		confess "Unrecognized length: $length" if $length!~/^\d+$/;
@@ -434,11 +434,17 @@ my($folder,$profile,%args)=@_;
 					)
 			if $do{"syslog"} || $Dry;
 	$folder=~s/;.*$//s;
-	$folder="$Mail/".$' if $folder=~/^=/;
 	push @AuditStored,$folder if $do{"did"};
 	return if $store_ignore || $Dry;
 	$DoBell++ if $do{"bell"};
-	write_message($folder) or die;
+	my $folder1="$Mail/".$' if $folder=~/^=/;
+	write_message($folder1) or die $folder1;
+	if ($Mail2) {
+	  my $folder2="$Mail2/".$' if $folder=~/^=/;
+	  my $old=umask 0117;
+	  write_message($folder2) or die $folder2;
+	  umask $old;
+	}
 	smssend_tryall $store_ignorenewmail,$do{"sms"},%args if $do{"sms"};
 }
 
@@ -456,6 +462,17 @@ my($funcref,@funcargs)=@_;
 	return @AuditStored!=$did_last;
 }
 
+sub writeto
+{
+my($filename)=@_;
+
+	local *F;
+	open F,$filename or confess "open $filename: $!";
+	print F $Message or confess "write $filename: $!";
+	close F or confess "close $filename: $!";
+	return 1;
+}
+
 # Never use Mail::Audit->store() as it will reformat MIME bodies and possibly corrupt OpenPGP!
 sub write_message
 {
@@ -534,7 +551,11 @@ my($cmd)=@_;
 	# prevent Razor2's: Can't call method "log" on unblessed reference at Razor2/Client/Agent.pm line 212.
 	local $ENV{"HOME"}=$HOME;
 	# 2>/dev/null to prevent error messages to corrupt inetd() output of perlmail-accept(1)
-	open CHILD,"|$cmd >/dev/null 2>/dev/null"
+	open CHILD,"|$cmd &>/dev/null"
+					# Workaround: spamassassin-3.1.3-1.fc5
+					#.q{|awk '/^X-Spam-Flag: YES$/{if (!body) exit 1;}/^$/{body=1;}'}
+					# Original:
+					#." >/dev/null 2>/dev/null"
 			or return 0;
 	print CHILD $Message;
 	close CHILD;
@@ -685,9 +706,12 @@ my($re,$justone,$header,$maybeaddress)=@_;
 	if (ref $header) {
 		$header=join(",",&$header());
 		}
-	else {
+	elsif ($justone) {
 		$header=$Audit->get($header);
 		}
+	else {
+		$header=join(",",$Audit->get($header));
+	}
 	return 0 if !$header;
 	return $header=~/$maybeaddress/i if "Regexp" eq ref $maybeaddress;
 	return $header=~/$re/i if !defined(my $want=($maybeaddress=~/^\<(.*)\>$/)[0]);
@@ -699,7 +723,7 @@ my($re,$justone,$header,$maybeaddress)=@_;
 				{ $_->address()=~/$'/i; }
 			elsif ($want=~/\@$/)
 				{ $_->user()   =~/^(?:\Qmailto:\E)?\Q$`\E/i; }
-			elsif ($want=~/^\@/)
+			elsif ($want=~/^\@/&&defined $')
 				{ $_->host()   =~/^\Q$'\E/i; }
 			else
 				{ $_->address()=~/^(?:\Qmailto:\E)?\Q$want\E/i; }
@@ -736,64 +760,6 @@ my($header,$map)=@_;
 	$Audit->replace_header($header,$text);
 }
 
-# LMTP engine:
-use Net::Cmd qw(CMD_OK CMD_MORE);
-{
-	package My::Net::SMTP::LMTP;
-	require Net::SMTP;
-	our @ISA=qw(Net::SMTP);
-	use Net::SMTP;
-	use Net::Cmd qw(CMD_OK);
-	use Carp qw(confess cluck);
-
-	# Do not: sub _HELO
-	# as it would not set {'net_smtp_esmtp'}
-	sub _EHLO { shift->command("LHLO", @_)->response()  == CMD_OK }
-
-	sub clucked
-	{
-	my($self,$func,@args)=@_;
-
-		do { return $_ if defined $_; } for $self->$func(@args);
-		cluck $func;
-		return;
-	}
-}
-
-
-sub lmtp_deliver
-{
-my($admin_user,$admin_pwd,$user_from,$user_to)=@_;
-
-	my $lmtp=My::Net::SMTP::LMTP->clucked("new","localhost","Port"=>"lmtp",
-#			"Debug"=>1,
-			) or return;
-	bless $lmtp,"My::Net::SMTP::LMTP";
-# Prevent:
-# due to:
-#	$lmtp->auth(Authen::SASL->new(
-#			"mechanism"=>"PLAIN",
-#			"callback"=>{
-#					"user"=>$admin_user,
-#					"pass"=>$admin_pwd,
-#					# Prevent: "authname"=>$admin_user
-#					# as it causes: DIE: Unknown callback: 'authname'. (user|auth|language|pass)
-#					}));
-	# FIXME: Authentication hack:
-	$lmtp->command("AUTH PLAIN")->response()==CMD_MORE
-			or do { cluck "auth announce"; return; };
-	$lmtp->clucked("command",encode_base64($user_from."\x00".$admin_user."\x00".$admin_pwd)) or return;
-	$lmtp->clucked("mail",$user_from) or return;
-	$lmtp->clucked("to",$user_to) or return;
-	$lmtp->clucked("data");	# Do not: or return;
-	# Prevent: 554 5.6.0 Message contains invalid header
-	(my $data=$Message)=~s/\AFrom .*\r?\n//;
-	$lmtp->clucked("datasend",$data) or return;
-	$lmtp->clucked("dataend") or return;
-	$lmtp->clucked("quit") or return;
-}
-
-
 # MAIN
 
 $Getopt::Long::ignorecase=0;