Move My-Audit to PerlMail::Config.

[PerlMail.git] / perlmail-sendmail

diff --git a/perlmail-sendmail b/perlmail-sendmail
index 900dded..f819bcc 100755 (executable)
--- a/perlmail-sendmail
+++ b/perlmail-sendmail
@@ -7,74 +7,20 @@ $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
 use strict;
 use warnings;
 
+use File::Basename;
+BEGIN {
+       use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0);
+       use PerlMail::Config;
+       }
+
 require Getopt::Long;
 use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG);
 require MIME::Head;    # inherits Mail::Header
 require Mail::Address;
-require File::Basename;
-require Mail::Alias;
-
-my $sendmail_orig=(-x ($_="/usr/sbin/sendmail-orig") ? $_ : "/usr/sbin/sendmail");
-my $HOME="/home/short";
-# Mail-Alias-1.12 defaults to "/etc/mail/aliases" which does not exist on RedHat sendmail-8.12.5-7
-# Mail-Alias-1.12 will clutter $_ !
-my @addr_addon=(Mail::Alias->new("/etc/aliases")->exists("sentout") ? ("sentout") : ());
-my $opt_F;
-my $is_pgp;
-sub FromAddress
-{
-my($rcpt,$iserror)=@_;
-
-       my $phrase=(defined $opt_F ? $opt_F : "Jan Kratochvil");
-       {
-               last if !$is_pgp;
-               last if $iserror;
-               local *F;
-               local $_;
-               my $filename="$HOME/.gnupg/options";
-               open F,$filename or do { warn "Open \"$filename\": $!"; last; };
-               local $/="\n";
-               my @keys=map((/^\s*default-key\s+(\S+)\s*$/),<F>);
-               @keys==1 or do { warn "Found ".scalar(@keys)." 'default-key's in your \"$filename\", ignoring"; last; };
-               close F or warn "Close \"$filename\": $!";
-               my $default_key=$keys[0];
-               $default_key=~/^[[:xdigit:]]{8}$/ or do { warn "Invalid 'default-key', ignoring: $default_key"; last; };
-               return Mail::Address->new(
-                               $phrase,
-                               'pgp-'.uc($default_key).'@jankratochvil.net',
-                               );
-               }
-       # !$is_pgp or fallback
-       return Mail::Address->new(
-                       $phrase,
-                       (!$iserror ? 'rcpt' : 'rcpterr')
-                                       .'-'
-                                       .(defined($rcpt->user()) ? $rcpt->user() : "NOUSER")
-                                       .".AT."
-                                       .(defined($rcpt->host()) ? $rcpt->host() : "LOCAL")
-                                       .'@jankratochvil.net',
-                       );
-}
 
-# RedHat sendmail-8.9.3-20/src/conf.c/HdrInfo[]/\Q/* destination fields */\E
-# FIXME: Recognize "Resent-$_" headers for -t but when we are in 'resent' mode?
-my @h_rcpt=(   # case in-sensitive!
-               "To",
-               "Cc",
-               "Bcc",
-               "Apparently-To",
-               );
 
-# ordering matters; first header found is substituted
-# last header is subsituted if no one is found
-my @h_from=(
-               "Resent-From",
-               "From",
-               );
-
-
-# FIXME: modularized unification with 'lacemail-accept'
-# BEGIN lacemail-accept
+# FIXME: modularized unification with 'perlmail-accept'
+# BEGIN perlmail-accept
 our %muttrc_pending=();
 sub muttrc
 {
@@ -143,7 +89,7 @@ my(@headers)=@_;
                }
        return wantarray() ? %r : $r{$r[0]};
 }
-# END lacemail-accept
+# END perlmail-accept
 
 
 sub sendmail_show { return "\"$sendmail_orig\" ".join(",",map("\"$_\"",@ARGV)); }
@@ -170,8 +116,8 @@ my $opt_Q;
 my $opt_q;
 my $opt_t;
 our $opt_f;
-#my $opt_F;    # declared before &FromAddress already
-my $opt_lacemail_dry_run;
+our $opt_F;    # from PerlMail::Config;
+my $opt_perlmail_dry_run;
 my @ARGV_save=@ARGV;   # for non-bm mode
 die if !Getopt::Long::GetOptions(
                "b=s"              ,\$opt_b,
@@ -180,7 +126,7 @@ die if !Getopt::Long::GetOptions(
                "t"                ,\$opt_t,
                "f=s"              ,\$opt_f,
                "F=s"              ,\$opt_F,
-               "lacemail-dry-run+",\$opt_lacemail_dry_run,
+               "perlmail-dry-run+",\$opt_perlmail_dry_run,
                );
 if (0
                # RedHat sendmail-8.12.5-7/sendmail/main.c/\QDo a quick prescan of the argument list.\E
@@ -199,11 +145,6 @@ if (0
 #   for $opt_F is implemented by Mail::Address in our &FromAddress
 
 my $head=MIME::Head->new(\*STDIN);
-# We may (=will) change the contents and send it multiple times
-if (defined(my $msgid=$head->get("Message-ID"))) {
-       $head->delete("Message-ID");
-       $head->replace("X-LaceMail-sendmail-Message-ID",$msgid);
-       }
 # options leave in @ARGV, addresses to @addr:
 my @args=@ARGV;        # temporary
 @ARGV=();      # options
@@ -252,6 +193,7 @@ my $from_headername;
        }
 
 # to be utilized later by &FromAddress
+our $is_pgp;   # from PerlMail::Config;
 $is_pgp=(1
                && do { local $_=$head->mime_attr("Content-Type");          $_ && ~m#^multipart/(?:signed|encrypted)$#; }
                && do { local $_=$head->mime_attr("Content-Type.protocol"); $_ && ~m#^application/pgp\b#; }
@@ -294,7 +236,7 @@ for my $rcpt (@rcpts) {
 
        local $SIG{"PIPE"}=sub { die "Got SIGPIPE from ".sendmail_show(); };
        local *SENDMAIL;
-       if ($opt_lacemail_dry_run) {
+       if ($opt_perlmail_dry_run) {
                print sendmail_show()."\n";
                *SENDMAIL=\*STDOUT;
                }
@@ -314,7 +256,7 @@ for my $rcpt (@rcpts) {
                        }
                }
 
-       next if $opt_lacemail_dry_run;  # don't close our STDOUT as it is aliased to *SENDMAIL
+       next if $opt_perlmail_dry_run;  # don't close our STDOUT as it is aliased to *SENDMAIL
        close SENDMAIL or warn "close(".sendmail_show()."): $?=".join(",",
                        (!WIFEXITED($?)   ? () : ("EXITSTATUS(".WEXITSTATUS($?).")")),
                        (!WIFSIGNALED($?) ? () : ("TERMSIG("   .WTERMSIG($?)   .")")),