[24016] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use Mail::ExpandAliases; |
---|
[24401] | 4 | use File::Basename; |
---|
| 5 | use POSIX qw(getgroups); |
---|
[24016] | 6 | |
---|
[24415] | 7 | use strict; |
---|
[24416] | 8 | use warnings; |
---|
[24016] | 9 | |
---|
[24458] | 10 | sub debug { |
---|
| 11 | if (defined($ENV{'DEBATHENA_SENDMAIL_DEBUG'}) && |
---|
| 12 | ($ENV{'DEBATHENA_SENDMAIL_DEBUG'} eq 'yes')) { |
---|
| 13 | print STDERR "DEBUG: " . join(' ', @_) . "\n"; |
---|
| 14 | } |
---|
| 15 | } |
---|
| 16 | |
---|
[24491] | 17 | my $kuser; |
---|
[25651] | 18 | my $want_auth = $ENV{'DEBATHENA_SENDMAIL_AUTH'} || 'yes'; |
---|
[24491] | 19 | |
---|
| 20 | system(qw(klist -s)); |
---|
[24415] | 21 | if (($? == 0) && |
---|
| 22 | (`klist 2>/dev/null` =~ /Default principal: (.*?)\@ATHENA.MIT.EDU/)) { |
---|
| 23 | $kuser = $1; |
---|
[25065] | 24 | # Remove any instances |
---|
| 25 | $kuser =~ s|/.*||g; |
---|
[24415] | 26 | } |
---|
[24401] | 27 | |
---|
[24415] | 28 | my $parser = Mail::ExpandAliases->new; |
---|
| 29 | |
---|
[24401] | 30 | if (basename($0) eq 'newaliases') { |
---|
| 31 | my $root = join(', ', @{$parser->expand('root')}); |
---|
| 32 | if ($root !~ /@/) { |
---|
| 33 | print STDERR <<EOF |
---|
| 34 | NOTE: root expands to: $root |
---|
| 35 | This does not appear to contain a remote address. Since debathena-msmtp |
---|
| 36 | does not support local delivery, you may wish to send root's mail |
---|
| 37 | somewhere useful (e.g. your MIT account). |
---|
| 38 | EOF |
---|
| 39 | } |
---|
| 40 | exit 0; |
---|
| 41 | } |
---|
| 42 | |
---|
| 43 | sub from_address { |
---|
| 44 | # If we have tickets, use them |
---|
[25651] | 45 | if ($ENV{'DEBATHENA_SENDMAIL_FROM'}) { |
---|
| 46 | return "--from=" . $ENV{'DEBATHENA_SENDMAIL_FROM'}; |
---|
| 47 | } |
---|
[24401] | 48 | if ($kuser) { |
---|
| 49 | return "--from=" . join('@', $kuser, 'mit.edu'); |
---|
| 50 | } |
---|
[24490] | 51 | # Note that ATHENA_USER is explicitly not checked here. We've |
---|
| 52 | # already checked to see if you have Kerberos tickets, and |
---|
| 53 | # semantically, if you don't have Kerberos tickets, you're not |
---|
| 54 | # sending as an Athena user. |
---|
[24489] | 55 | my $uname = $ENV{'USER'} || $ENV{'LOGNAME'} || getpwuid($<); |
---|
[24456] | 56 | # Otherwise, assume user@fqdn ... |
---|
| 57 | chomp(my $maildomain = `hostname --fqdn`); |
---|
| 58 | # ... except that nss-nonlocal-users are @mit.edu |
---|
[24416] | 59 | if (getgrnam('nss-nonlocal-users')) { |
---|
| 60 | my $nssnonlocalgid = (getgrnam('nss-nonlocal-users'))[2]; |
---|
| 61 | if (grep(/^$nssnonlocalgid$/, getgroups())) { |
---|
[24458] | 62 | debug("Assuming \@mit.edu for nss-nonlocal-user $uname"); |
---|
[24456] | 63 | $maildomain = 'mit.edu'; |
---|
[24416] | 64 | } |
---|
[24401] | 65 | } |
---|
[24456] | 66 | return "--from=" . join('@', $uname, $maildomain); |
---|
[24401] | 67 | } |
---|
| 68 | |
---|
[24415] | 69 | my @aliases = (); |
---|
| 70 | foreach my $arg (@ARGV) { |
---|
[24016] | 71 | push @aliases, $parser->expand($arg); |
---|
| 72 | } |
---|
| 73 | |
---|
[25651] | 74 | if ($kuser) { |
---|
[24016] | 75 | #send auth |
---|
[24458] | 76 | debug(qw{msmtp --host=outgoing.mit.edu --port=587 --auth=gssapi}, "--user=$kuser", from_address(), @aliases); |
---|
[24401] | 77 | exec(qw{msmtp --host=outgoing.mit.edu --port=587 --auth=gssapi}, "--user=$kuser", from_address(), @aliases); |
---|
[24016] | 78 | } |
---|
[25651] | 79 | elsif ($want_auth ne 'fallback') { |
---|
[24016] | 80 | $! = 1; |
---|
[25714] | 81 | die "Could not find valid ATHENA.MIT.EDU Kerberos tickets.\n(Do you need to run 'renew'?)\n"; |
---|
[24016] | 82 | } |
---|
| 83 | else { |
---|
| 84 | #send unauth |
---|
[24458] | 85 | debug(qw{msmtp --host=outgoing.mit.edu --port=25 --auth=off}, from_address(), @aliases); |
---|
[24401] | 86 | exec(qw{msmtp --host=outgoing.mit.edu --port=25 --auth=off}, from_address(), @aliases); |
---|
[24016] | 87 | } |
---|