X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=perlmail-accept;h=e704077bce8d6a163b0e5cf34e23e6578c0d1fea;hp=2f7df60cc825b5465df6055227b7b4eda449fe3c;hb=refs%2Fheads%2Fmaster;hpb=d270dc779e33822c84d5d43c22d1f4493284628d diff --git a/perlmail-accept b/perlmail-accept index 2f7df60..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 # # 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;