host1:~lace/src/PerlMail/ update.

[PerlMail.git] / perlmail-accept

diff --git a/perlmail-accept b/perlmail-accept
index 2f7df60..4feb8ec 100755 (executable)
--- 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;
@@ -435,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"};
 }
 
@@ -701,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]);
@@ -715,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; }
@@ -752,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;