#! /usr/bin/env perl

#    Program: send_auth_smtp
#    Description
#      Transport. Sends the report by e-mail directly to an SMTP server, with
#      optional authentication and TLS. Intended as the fallback after
#      send_local_smtp, so hosts that can use their local mail system never need
#      the SMTP credentials in their configuration.
#
#      Needs Net::SMTP (core Perl). For TLS it also needs IO::Socket::SSL, and
#      for smtpUser/smtpPass it needs Authen::SASL. A missing module is not
#      worked around: doit dies, naming the module.
#
#      Parameters: mailServer (host or host:port, default port 25; required),
#      mailTo (required), mailFrom, mailCC, mailBCC, mailSubject, attachment,
#      smtpUser, smtpPass, tls.
#      tls: 'auto' (default) = implicit TLS on port 465, otherwise STARTTLS when
#      the server offers it; 'yes' = TLS required; 'no' = never. Credentials are
#      never sent over an unencrypted connection unless tls is 'no'.
#
#      Returns 1 on success, otherwise:
#        2 - mailServer or mailTo missing
#        3 - could not connect
#        4 - TLS required but not available
#        5 - authentication failed
#        6 - server rejected sender, recipient or message
#        7 - attachment unreadable
#      Dies (loudly) when a needed Perl module is not installed.
#
#    Revision History
#      2026-10-27 Claude v1.0.0 Bug 213: new

use warnings;
use strict;

our $VERSION = '1.0.0';

# helper names are prefixed because transports are all loaded into package main

sub sendAuth_clean {
   my $value = shift;
   $value = '' unless defined $value;
   $value =~ s/[\r\n]+/ /g;
   return $value;
}

sub sendAuth_list {
   my $value = shift;
   return grep { length } split /[\s,;]+/, ( defined $value ? $value : '' );
}

sub sendAuth_requireModule {
   my ( $module, $why ) = @_;
   ( my $file = "$module.pm" ) =~ s{::}{/}g;
   return if eval { require $file; 1 };
   die "send_auth_smtp: required Perl module $module is not installed ($why)\n";
}

sub sendAuth_buildMessage {
   my ( $parameters, $report ) = @_;
   my @headers;
   push @headers, 'From: ' . sendAuth_clean( $$parameters{'mailFrom'} ) if $$parameters{'mailFrom'};
   push @headers, 'To: ' . join( ', ', sendAuth_list( $$parameters{'mailTo'} ) );
   push @headers, 'Cc: ' . join( ', ', sendAuth_list( $$parameters{'mailCC'} ) ) if $$parameters{'mailCC'};
   push @headers, 'Subject: ' . sendAuth_clean( $$parameters{'mailSubject'} || 'sysinfo-client report' );
   push @headers, 'Date: ' . do { my @t = gmtime; sprintf( '%s, %02d %s %04d %02d:%02d:%02d +0000',
      (qw(Sun Mon Tue Wed Thu Fri Sat))[$t[6]], $t[3], (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$t[4]],
      $t[5] + 1900, $t[2], $t[1], $t[0] ) };
   push @headers, 'MIME-Version: 1.0';

   my $attachment = $$parameters{'attachment'};
   if ( $attachment ) {
      open my $in, '<:raw', $attachment or return ( undef, "cannot read attachment $attachment: $!" );
      local $/;
      my $data = <$in>;
      close $in;
      require MIME::Base64;
      ( my $name = $attachment ) =~ s{.*/}{};
      $name =~ s/[^\w.\-]/_/g;
      my $boundary = '=_sysinfo_' . time . '_' . $$;
      push @headers, qq{Content-Type: multipart/mixed; boundary="$boundary"};
      my $body = "--$boundary\nContent-Type: text/plain; charset=UTF-8\nContent-Transfer-Encoding: 8bit\n\n$report\n"
         . "--$boundary\nContent-Type: application/octet-stream; name=\"$name\"\n"
         . "Content-Transfer-Encoding: base64\nContent-Disposition: attachment; filename=\"$name\"\n\n"
         . MIME::Base64::encode_base64( $data ) . "--$boundary--\n";
      return ( join( "\n", @headers ) . "\n\n" . $body, '' );
   }
   push @headers, 'Content-Type: text/plain; charset=UTF-8', 'Content-Transfer-Encoding: 8bit';
   return ( join( "\n", @headers ) . "\n\n" . $report, '' );
}

sub doit {
   my ( $parameters, $report ) = @_;
   my @to = sendAuth_list( $$parameters{'mailTo'} );
   my ( $host, $port ) = split /:/, ( $$parameters{'mailServer'} || '' ), 2;
   unless ( $host && @to ) {
      print "send_auth_smtp: mailServer and mailTo are required\n";
      return 2;
   }
   $port ||= 25;
   my $tls = lc( defined $$parameters{'tls'} && length $$parameters{'tls'} ? $$parameters{'tls'} : 'auto' );
   $tls = 'yes' if $tls =~ /^(1|true|on)$/;
   $tls = 'no'  if $tls =~ /^(0|false|off)$/;
   my $implicit = $tls ne 'no' && $port == 465;
   my $user = $$parameters{'smtpUser'};

   # fail loudly, before connecting, when a needed module is missing
   sendAuth_requireModule( 'Net::SMTP', 'part of core Perl; reinstall perl' );
   sendAuth_requireModule( 'IO::Socket::SSL', 'needed for TLS; set tls: no to send unencrypted' ) if $tls ne 'no';
   sendAuth_requireModule( 'Authen::SASL', 'needed for smtpUser/smtpPass' ) if $user;

   my ( $message, $error ) = sendAuth_buildMessage( $parameters, $report );
   unless ( defined $message ) {
      print "send_auth_smtp: $error\n";
      return 7;
   }

   my $smtp = Net::SMTP->new( $host, Port => $port, Timeout => 30, ( $implicit ? ( SSL => 1 ) : () ) );
   unless ( $smtp ) {
      print "send_auth_smtp: could not connect to $host:$port\n";
      return 3;
   }
   my $encrypted = $implicit;
   if ( !$encrypted && $tls ne 'no' && $smtp->supports( 'STARTTLS' ) ) {
      $encrypted = $smtp->starttls ? 1 : 0;
   }
   if ( $tls eq 'yes' && !$encrypted ) {
      print "send_auth_smtp: tls required but $host:$port did not provide it\n";
      $smtp->quit;
      return 4;
   }
   if ( $user ) {
      unless ( $encrypted || $tls eq 'no' ) {
         print "send_auth_smtp: refusing to send credentials to $host:$port without TLS (set tls: no to allow)\n";
         $smtp->quit;
         return 4;
      }
      unless ( $smtp->auth( $user, $$parameters{'smtpPass'} ) ) {
         print "send_auth_smtp: authentication as $user failed: " . $smtp->message;
         $smtp->quit;
         return 5;
      }
   }
   my $from = $$parameters{'mailFrom'} ? sendAuth_clean( $$parameters{'mailFrom'} ) : ( $user || 'sysinfo' );
   my @recipients = ( @to, sendAuth_list( $$parameters{'mailCC'} ), sendAuth_list( $$parameters{'mailBCC'} ) );
   unless ( $smtp->mail( $from ) && $smtp->to( @recipients ) && $smtp->data
         && $smtp->datasend( $message ) && $smtp->dataend ) {
      print "send_auth_smtp: server rejected the message: " . $smtp->message;
      $smtp->quit;
      return 6;
   }
   $smtp->quit;
   return 1;
}

1;