projtool.pl: do not attempt to check unset error codes
[girocco.git] / bin / sendmail.pl
blobab8d2a5dc19a8e07389fdcae7884ddad659b6eb3
1 #!/usr/bin/perl
3 # sendmail.pl - sendmail to SMTP bridge
4 # Copyright (C) 2014,2015,2018,2021 Kyle J. McKay.
5 # All rights reserved.
7 # This program is free software: you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation, either version 2 of the License, or
10 # (at your option) any later version.
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program. If not, see <http://www.gnu.org/licenses/>.
20 use strict;
21 use warnings;
22 use bytes;
24 use IPC::Open2;
25 use Net::Domain qw();
27 exit(&main()||0);
29 our $VERSION;
30 my $VERSIONMSG;
31 my $HELP;
32 my $USAGE;
34 BEGIN {
35 *VERSION = \'1.0.4';
36 $VERSIONMSG = "sendmail.pl version $VERSION\n" .
37 "Copyright (C) 2014,2015,2018,2021 Kyle J. McKay. All rights reserved.\n" .
38 "License GPLv2+: GNU GPL version 2 or later.\n" .
39 "http://gnu.org/licenses/gpl.html\n" .
40 "This is free software: you are free to change and redistribute it.\n" .
41 "There is NO WARRANTY, to the extent permitted by law.\n";
42 my @a; /^(.*)$/s && push(@a, $1) foreach @ARGV; @ARGV=@a;
43 $USAGE = <<USAGE;
44 Usage: sendmail.pl [-V] [-v] [-h] [-i] [-f addr] [-t] [recipient ...]
45 (Use sendmail.pl -v -h for extended help)
46 USAGE
47 $HELP = <<HELP;
48 NAME
49 sendmail.pl -- sendmail to SMTP bridge
51 SYNOPSIS
52 sendmail.pl [-V] [-v] [-h] [-i] [-f addr] [-t] [recipient ...]
54 DESCRIPTION
55 sendmail.pl provides semantics similar to the common sendmail executable
56 and reads an incoming message to be delivered and then connects to
57 the specified SMTP server to deliver it with the help of netcat.
59 Only the most basic sendmail options are supported along with the most
60 basic header support (when -t is given).
62 The nc (netcat) executable used and options passed to it can be
63 controlled via environment variables.
65 OPTIONS
67 Show the sendmail.pl version.
70 Verbose output. If given before -h this help will be shown.
73 Show basic usage help.
76 Do not treat a line consisting of a single '.' as ending the
77 input.
79 -f addr
80 Set the envelope header address. This is the address that will
81 be passed to the SMTP "MAIL FROM:" command. If this option is
82 not specified then the value of the LOGNAME environment variable
83 will be used instead. Some SMTP servers may perform validation
84 on this address requiring a specific value here for the mail
85 delivery to be successful.
88 Read the list of recipients from the message's To:, Cc: and Bcc:
89 headers. If a Bcc: header is found, it's removed after picking
90 up the destination addresses.
93 Ignored for compatibility.
96 Signals the end of the options. Anything following will be taken
97 as a recipient address even if it starts with a '-'.
99 recipient ...
100 Zero or more recipient addresses to deliver the message to. Each
101 of these addresses will be passed to an SMTP "RCPT TO:" command.
102 If both '-t' and one or more recipient addresses are given then
103 the '-t' addresses will be added after the explicitly listed
104 recipients. Multiple recipients concatenated together using ','s
105 and passed as a single recipient argument will be handled
106 correctly. At least one recipient must be given either
107 explicitly or via the '-t' option.
109 ENVIRONMENT
110 SENDMAIL_PL_NCBIN
111 The netcat binary to use. Must understand the -w secs option.
112 If this is not set then "nc" is expected to be in the PATH.
114 SENDMAIL_PL_NCOPT
115 Additional options to pass to nc (netcat). No other options
116 besides -w are passed by default. Should be a space-separated
117 list of options complete with leading '-'. For example:
118 export SENDMAIL_PL_NCOPT='-4'
119 to force use of IPv4 addresses.
121 SENDMAIL_PL_HOST
122 The SMTP host to connect to. If not set then "localhost" will
123 be used.
125 SENDMAIL_PL_PORT
126 The SMTP host port to connect to. If not set then 25 will be
127 used.
129 BUGS
130 The header parsing provided by the '-t' option may fail to pick up the
131 correct recipient addresses if they use anything more than basic address
132 syntax and/or any of the header lines are wrapped.
134 Using environment variables to configure some of the settings may be a
135 less common technique for tools of this sort.
137 VERSION
138 sendmail.pl version $VERSION
139 Copyright (c) 2014 Kyle J. McKay. All rights reserved.
140 License GPLv2+: GNU GPL version 2 or later.
141 http://gnu.org/licenses/gpl.html
142 This is free software: you are free to change and redistribute it.
143 There is NO WARRANTY, to the extent permitted by law.
145 HELP
148 sub protect($)
150 my $line = shift;
151 return $line unless $line && $line =~ /^[.]/;
152 return '.' . $line;
155 sub cleanup($)
157 my $line = shift;
158 defined($line) or $line = '';
159 $line =~ s/(?:\r\n|\r|\n)$//os;
160 return $line;
163 sub sanehost()
165 my $tryhost = Net::Domain::hostname;
166 $tryhost =~ s/\.$//;
167 $tryhost =~ tr/A-Z/a-z/;
168 return $tryhost if $tryhost =~ /[^.]\.local$/;
169 $tryhost = Net::Domain::hostfqdn;
170 $tryhost =~ s/\.$//;
171 return $tryhost
174 sub main
176 $ENV{'PATH'} =~ /^(.*)$/ and $ENV{'PATH'} = $1;
177 my $done = 0;
178 my $opt_v = 0;
179 my $opt_i = 0;
180 my $opt_t = 0;
181 my $opt_f = $ENV{'LOGNAME'} || 'nobody';
182 $opt_f =~ /^(.*)$/ and $opt_f = $1;
183 my $hn = sanehost;
184 my @rcpts = ();
185 while (@ARGV && $ARGV[0] =~ /^-/) {
186 my $opt = shift @ARGV;
187 last if $opt eq '--';
188 next if $opt eq '-m' || $opt eq '-om';
189 print($VERSIONMSG), exit 0 if $opt eq '-V' || $opt eq '--version';
190 $opt_v = 1, next if $opt eq '-v' || $opt eq '--verbose';
191 print(($opt_v?$HELP:$USAGE),"\n"), exit 0 if $opt eq '-h' || $opt eq '--help';
192 die "$USAGE\n" if $opt eq '-f' && !@ARGV;
193 $opt_f = shift @ARGV, next if $opt eq '-f';
194 $opt_f = $1, next if $opt =~ /^-f(.+)$/;
195 $opt_i = 1, next if $opt eq '-i' || $opt eq '-oi' || $opt eq '-oitrue';
196 $opt_t = 1, next if $opt eq '-t';
197 $opt_i = $opt_t = 1, next if $opt eq '-ti' || $opt eq '-it';
198 die "Unknown option: $opt\n$USAGE\n";
200 $opt_f =~ s/^[ \t]*<//; $opt_f =~ s/>[ \t]*$//;
201 $opt_f =~ s/^[ \t]+//; $opt_f =~ s/[ \t]+$//;
202 $opt_f .= '@'.$hn if $opt_f && $opt_f !~ /\@/; # some servers require @domain
203 $opt_f = '<' . $opt_f . '>';
204 foreach my $rcpt (split(/,/, join(',', @ARGV))) {
205 $rcpt =~ s/^[ \t]*<//; $rcpt =~ s/>[ \t]*$//;
206 $rcpt =~ s/^[ \t]+//; $rcpt =~ s/[ \t]+$//;
207 $rcpt .= '@'.$hn if $rcpt && $rcpt !~ /\@/; # some servers require @domain
208 push(@rcpts, '<' . $rcpt . '>') if $rcpt;
210 @ARGV = ();
212 die "sendmail.pl: error: no recipients specified\n$USAGE\n"
213 unless @rcpts || $opt_t;
215 my @headers = ();
216 my $lasthdr = '';
217 my $extraline = '';
218 for (;;) {
219 my $line = <>;
220 $line = undef if !$opt_i && $line =~ /^[.][\r\n]*$/;
221 $done = 1, last unless defined($line);
222 $line =~ s/(?:\r\n|\r|\n)$//os;
223 $line =~ s/[ \t]+$//;
224 if ($lasthdr && $line =~ /^[ \t]+(.*)$/) {
225 # Unfold
226 $lasthdr .= ' ' . $1;
227 next;
229 push(@headers, $lasthdr) if $lasthdr;
230 $lasthdr = '';
231 if ($line =~ /^[\x21-\x39\x3b-\x7e]+:/) {
232 $lasthdr = $line;
233 next;
235 $extraline = $line;
236 last;
238 push(@headers, $lasthdr) if $lasthdr;
240 if ($opt_t) {
241 foreach my $hdr (@headers) {
242 if ($hdr =~ /^(?:To|Cc|Bcc):[ \t]*(.*)$/osi) {
243 my $alist = $1;
244 # Very crude parsing here
245 $alist =~ s/[(].*?[)]//go; # Dump comments
246 $alist =~ s/["].*?["]//go; # Dump quoted
247 $alist =~ s/[ \t]+,/,/go; # Kill extra
248 $alist =~ s/,[ \t]+/,/go; # spaces
249 foreach my $adr (split(/,/, $alist)) {
250 my $rcpt = '';
251 if ($adr =~ /<([^ \t>]+)>/) {
252 $rcpt = $1;
253 } elsif ($adr =~ /^([^ \t]+)$/) {
254 $rcpt = $1;
256 $rcpt .= '@'.$hn if $rcpt && $rcpt !~ /\@/; # some servers require @domain
257 push(@rcpts, '<' . $rcpt . '>') if $rcpt;
263 my $ncbin = $ENV{'SENDMAIL_PL_NCBIN'} || 'nc';
264 $ncbin =~ /^(.*)$/ and $ncbin = $1;
265 my $ncopt = $ENV{'SENDMAIL_PL_NCOPT'} || '';
266 $ncopt =~ /^(.*)$/ and $ncopt = $1;
267 my @ncopts = ();
268 @ncopts = split(' ', $ncopt) if $ncopt;
269 my $nchost = $ENV{'SENDMAIL_PL_HOST'} || 'localhost';
270 $nchost =~ /^(.*)$/ and $nchost = $1;
271 my $ncport = $ENV{'SENDMAIL_PL_PORT'} || '25';
272 $ncport =~ /^(.*)$/ and $ncport = $1;
273 my @cmd = ();
274 push(@cmd, $ncbin, '-w', '30', @ncopts, $nchost, $ncport);
276 die "sendmail.pl: error: no recipients specified\n" unless @rcpts;
278 my ($send, $recv);
279 (my $pid = open2($recv, $send, @cmd))
280 or die "sendmail.pl: error: nc failed: $!\n";
282 my $resp;
283 defined($resp = <$recv>) && $resp =~ /^220 /
284 or die "sendmail.pl: error: failed to receive initial SMTP 220 response\n";
285 print $send "HELO localhost\r\n";
286 defined($resp = <$recv>) && $resp =~ /^250 /
287 or die "sendmail.pl: error: failed to receive SMTP HELO 250 response\n";
289 print $send "MAIL FROM: $opt_f\r\n";
290 defined($resp = <$recv>) && $resp =~ /^250 /
291 or die "sendmail.pl: error: SMTP MAIL FROM: $opt_f failed\n";
292 foreach my $rcpt (@rcpts) {
293 print $send "RCPT TO: $rcpt\r\n";
294 defined($resp = <$recv>) && $resp =~ /^250 /
295 or die "sendmail.pl: error: SMTP RCPT TO: $rcpt failed\n";
298 print $send "DATA\r\n";
299 defined($resp = <$recv>) && $resp =~ /^354 /
300 or die "sendmail.pl: error: SMTP DATA failed\n";
301 foreach my $hdr (@headers) {
302 print $send "$hdr\r\n" unless $opt_t && $hdr =~ /^Bcc:/i;
304 print $send "\r\n";
305 print $send protect($extraline), "\r\n" if $extraline;
307 if (!$done) {
308 while (my $line = <>) {
309 $line =~ s/(?:\r\n|\r|\n)$//os;
310 last if !$opt_i && $line =~ /^[.]$/;
311 print $send protect($line), "\r\n";
315 print $send ".\r\n";
316 defined($resp = <$recv>) && $resp =~ /^250 /
317 or die "sendmail.pl: error: SMTP message not accepted (@{[cleanup($resp)]})\n";
319 print $send "QUIT\r\n";
320 $resp = <$recv>; # Should be /^221 / for goodbye, but we don't really care
321 close $send;
322 close $recv;
323 exit 0;