Skip to content

Commit

Permalink
Item14205: Issues with Email and Cert wizards
Browse files Browse the repository at this point in the history
This needs some review / validation before merge.
  • Loading branch information
gac410 committed Nov 7, 2016
1 parent 830a54f commit a5aef45
Show file tree
Hide file tree
Showing 4 changed files with 302 additions and 100 deletions.
5 changes: 3 additions & 2 deletions core/lib/Foswiki/Configure/Checkers/Email/SSLCaFile.pm
Expand Up @@ -17,8 +17,9 @@ sub check_current_value {

my $file = $this->checkExpandedValue($reporter);
if ($file) {
unless ( $file =~ m,^([\w_./]+)$, ) {
return $this->ERROR("Invalid characters in $file");
unless ( $file =~ m,^([\w_./-]+)$, ) {
$reporter->ERROR("Invalid characters in $file");
return;
}
$file = $1;

Expand Down
286 changes: 216 additions & 70 deletions core/lib/Foswiki/Configure/Wizards/AutoConfigureEmail.pm
@@ -1,4 +1,78 @@
# See bottom of file for license and copyright information
package Foswiki::Configure::Wizards::AutoConfigureEmail::MuteOut;
use strict;
use warnings;
use File::Temp;
use File::Spec;

sub new {
my $class = shift;
my %params = @_;

$class = ref($class) || $class;

my ( $oldOut, $oldErr, $rc );

my $outFile = $params{outFile} || File::Spec->devnull;
my $errFile = $params{errFile} || File::Spec->devnull;
my $reporter = $params{reporter};

unless ( open $oldOut, ">&", STDOUT ) {
$reporter->ERROR( "Cannot dup STDOUT: " . $! );
return undef;
}
unless ( open $oldErr, ">&", STDERR ) {
$reporter->ERROR( "Cannot dup STDERR: " . $! );
return undef;
}
unless ( open STDOUT, ">", $outFile ) {
$reporter->ERROR( "Failed to redirect STDOUT: " . $! );
}
unless ( open STDERR, ">", $errFile ) {
$reporter->ERROR( "Failed to redirect STDERR: " . $! );
}

my $obj = bless {
oldOut => $oldOut,
oldErr => $oldErr,
outFile => $outFile,
errFile => $errFile,
reporter => $reporter,
}, $class;

return $obj;
}

sub exec {
my $this = shift;
my ($sub) = shift;

my @rc;
my $wantarray = wantarray;
if ($wantarray) {
@rc = $sub->(@_);
}
elsif ( defined $wantarray ) {
$rc[0] = $sub->(@_);
}
else {
$sub->(@_);
}

return $wantarray ? @rc : $rc[0];
}

sub DESTROY {
my $this = shift;

unless ( open STDOUT, ">&", $this->{oldOut} ) {
$this->reporter->ERROR( "Failed to restore STDOUT: " . $! );
}
unless ( open STDERR, ">&", $this->{oldErr} ) {
$this->reporter->ERROR( "Failed to restore STDOUT: " . $! );
}
}

package Foswiki::Configure::Wizards::AutoConfigureEmail;

=begin TML
Expand Down Expand Up @@ -88,6 +162,63 @@ my %mtas = (
use constant ACCEPTMSG =>
"> Configuration accepted. Next step: Send a test email to {WebMasterEmail}.";

# Execute a function capturing all output.

sub _muteExec {
my $sub = shift;
my $reporter = $_[0];

my $rc;
my ( $fh1, $outFile ) = File::Temp::tempfile(
"STDOUT.$$.XXXXXXXXXX",
DIR => File::Spec->tmpdir(),
UNLINK => 0
);
close $fh1;
my ( $fh2, $errFile ) = File::Temp::tempfile(
"STDERR.$$.XXXXXXXXXX",
DIR => File::Spec->tmpdir(),
UNLINK => 0
);
close $fh2;

{
my $muter =
Foswiki::Configure::Wizards::AutoConfigureEmail::MuteOut->new(
outFile => $outFile,
errFile => $errFile,
reporter => $reporter,
);

$rc = $muter->exec( $sub, @_ );
}

my $out = _slurpFile( $outFile, $reporter );
my $err = _slurpFile( $errFile, $reporter );

unlink $outFile;
unlink $errFile;

return wantarray ? ( $rc, $out, $err ) : $rc;
}

sub _slurpFile {
my ( $file, $reporter ) = @_;

my $fh;
unless ( open $fh, "<", $file ) {
$reporter->WARN( "Cannot open capture file '$file': " . $! );
return undef;
}

local $/;
my $data = <$fh>;
$reporter->WARN( "Read from capture file '$file' failed: " . $! )
unless defined $data;
close $fh;
return $data;
}

# WIZARD
sub autoconfigure {
my ( $this, $reporter ) = @_;
Expand Down Expand Up @@ -119,8 +250,11 @@ NOCERT
}

my $ok = 0;
my $out;
my $err;

if ( $Foswiki::cfg{SMTP}{MAILHOST} ) {
$ok = _autoconfigSMTP($reporter);
( $ok, $out, $err ) = _muteExec( \&_autoconfigSMTP, $reporter );
unless ($ok) {
$reporter->WARN(
"SMTP configuration using $Foswiki::cfg{SMTP}{MAILHOST} failed. Falling back to mail program"
Expand All @@ -133,6 +267,19 @@ NOCERT
);
}

$reporter->NOTE($out);
if ($err) {

# Double-space the debug output so that it doesn't wrap.
$err =~ s/\n/\n\n/sg;
$err =~ s/\n$//g;

$reporter->NOTE( <<OUT );
======= DEBUG MESSAGES ====
$err
OUT
}

if ( !$ok && _autoconfigProgram($reporter) ) {
$ok = 1;
}
Expand Down Expand Up @@ -334,7 +481,7 @@ sub _autoconfigSMTP {
my ($reporter) = @_;

$SIG{__DIE__} = sub {
Carp::confess($@);
Carp::confess(@_);
};

$host = $Foswiki::cfg{SMTP}{MAILHOST};
Expand All @@ -360,7 +507,19 @@ sub _autoconfigSMTP {
}
}

IO::Socket::SSL->import('debug2') if ( $trySSL && DEBUG_SSL );
if ( $trySSL
&& !( $Foswiki::cfg{Email}{SSLCaFile}
|| $Foswiki::cfg{Email}{SSLCaPath} ) )
{
$reporter->NOTE(
"No SSL CA certificate path set. Running SSLCertificates wizard to guess ={SSLCaFile}= and ={SSLCaPath}=."
);
require Foswiki::Configure::Wizards::SSLCertificates;
my $certWiz = Foswiki::Configure::Wizards::SSLCertificates->new;
$certWiz->guess_locations($reporter);
}

IO::Socket::SSL->import('debug3') if ( $trySSL && DEBUG_SSL );

# If Dependencies for IPv6 are available, This changes the ISA of Net::SMTP to IO::Socket::IP
# which supports both IPv6 and IP V4
Expand Down Expand Up @@ -405,7 +564,11 @@ sub _autoconfigSMTP {

my @options = (
Debug => 1,
Host => [@addrs],

# SMELL: Code used to pass [@addrs} here to be able to log IP addresses
# But that breaks certificate validation. Always need to use hostname!
#Host => [@addrs],
Host => $hInfo->{name},

# Shorten timeout if > 2 Addresses to test
Timeout => ( @addrs >= 2 ? 10 : 30 ),
Expand Down Expand Up @@ -545,22 +708,8 @@ sub _autoconfigSMTP {
my $password = $Foswiki::cfg{SMTP}{Password};
$password = '' unless ( defined $password );

# SSL logging -- N.B. fd 2 is NOT STDERR from here down

open( my $stderr, ">&STDERR" ) or die "STDERR: $!\n";
close STDERR;
open( my $fd2, ">/dev/null" ) or die "fd2: $!\n";
$tlog = '';

#SMELL: Does not work under FCGI
# at ../foswiki/distro/core/lib/Foswiki/Configure/Wizards/AutoConfigureEmail.pm line 302.
# Foswiki::Configure::Wizards::AutoConfigureEmail::__ANON__("Operation 'OPEN' not supported on FCGI::Stream handle

unless ( $Foswiki::cfg{Engine} =~ m/FastCGI/ ) {
open( STDERR, '+>>', \$tlog ) or die "SSL logging: $!\n";
STDERR->autoflush(1);
}

# Loop over methods - output %use if one succeeds

# This code loops over the @methods list. It configures each method
Expand Down Expand Up @@ -621,14 +770,19 @@ sub _autoconfigSMTP {
@Foswiki::Configure::Wizards::AutoConfigureEmail::SSL::ISA =
@{ $cfg->{isa} };

$tlog =
$tlog = '' unless (DEBUG_SSL); # Reset log so only report last test.
my $testmsg =
"${pad}Testing "
. ( $cfg->{id} || uc($method) ) . " on "
. (
$port =~ m/^\d+$/ ? "port $port\n"
: $port =~ m/^(.*)\((\d+)\)$/ ? "$1 port ($2)\n"
: "$port port\n"
);

$tlog .= $testmsg;
print STDERR $testmsg;

$verified = $cfg->{verify} || -1;

my $smtp =
Expand Down Expand Up @@ -664,12 +818,6 @@ sub _autoconfigSMTP {
%use = ();
}
}
unless ( $Foswiki::cfg{Engine} =~ m/FastCGI/ ) {
close STDERR;
close $fd2;
open( STDERR, '>&', $stderr ) or die "stderr:$!\n";
close $stderr;
}
$tlog =~ s/AUTH\s([^\s]+)\s.*$/AUTH $1 xxxxxxxxxxxxxxxx/mg;
$reporter->NOTE("<verbatim>$tlog</verbatim>");

Expand Down Expand Up @@ -710,8 +858,8 @@ sub _autoconfigSMTP {
_setConfig( $reporter, '{SMTP}{Username}', $username );
_setConfig( $reporter, '{SMTP}{Password}', $password );
_setConfig( $reporter, '{SMTP}{MAILHOST}', $host . ':' . $use{port} );
_setConfig( $reporter, '{Email}{SSLVerifyServer}', ( $cfg->{verify} || 0 ) )
if ( $cfg->{ssl} );
_setConfig( $reporter, '{Email}{SSLVerifyServer}',
( $cfg->{verify} || 0 ) );

return 1;
}
Expand Down Expand Up @@ -837,55 +985,53 @@ sub _setupSSLoptions {

my ( @sslVerify, @sslNoVerify );
@sslNoVerify =
( @sslCommon, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE() );

if ( $Foswiki::cfg{Email}{SSLVerifyServer} ) {
my ( $file, $path ) =
( $Foswiki::cfg{Email}{SSLCaFile}, $Foswiki::cfg{Email}{SSLCaPath} );
Foswiki::Configure::Load::expandValue($file);
Foswiki::Configure::Load::expandValue($path);

if ( $file || $path ) {
push @sslVerify, (
@sslCommon,
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
SSL_verify_scheme => undef,
SSL_verify_callback => sub {
my ( $ok, $ctx, $names, $errs, $peerCert ) = @_;

return
Foswiki::Configure::Wizards::AutoConfigureEmail::SSL::sslVerifyCert(
$log, $ok, $ctx, $peerCert );
},
SSL_ca_file => $file || undef,
SSL_ca_path => $path || undef,
);
( @sslCommon, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(), );

my ( $file, $path ) =
( $Foswiki::cfg{Email}{SSLCaFile}, $Foswiki::cfg{Email}{SSLCaPath} );
Foswiki::Configure::Load::expandValue($file);
Foswiki::Configure::Load::expandValue($path);

if ( $file || $path ) {
push @sslVerify, (
@sslCommon,
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
SSL_verify_scheme => undef,
SSL_verify_callback => sub {
my ( $ok, $ctx, $names, $errs, $peerCert ) = @_;

return
Foswiki::Configure::Wizards::AutoConfigureEmail::SSL::sslVerifyCert(
$log, $ok, $ctx, $peerCert );
},
SSL_ca_file => $file || undef,
SSL_ca_path => $path || undef,
);

if ( $Foswiki::cfg{Email}{SSLCheckCRL} ) {
( $file, $path ) = (
$Foswiki::cfg{Email}{SSLCrlFile},
$Foswiki::cfg{Email}{SSLCaPath}
);
Foswiki::Configure::Load::expandValue($file);
Foswiki::Configure::Load::expandValue($path);
if ( $Foswiki::cfg{Email}{SSLCheckCRL} ) {
( $file, $path ) = (
$Foswiki::cfg{Email}{SSLCrlFile},
$Foswiki::cfg{Email}{SSLCaPath}
);
Foswiki::Configure::Load::expandValue($file);
Foswiki::Configure::Load::expandValue($path);

if ( $file || $path ) {
push @sslVerify, SSL_check_crl => 1;
push @sslVerify, SSL_crl_file => $file
if ($file);
}
else {
$reporter->WARN(
if ( $file || $path ) {
push @sslVerify, SSL_check_crl => 1;
push @sslVerify, SSL_crl_file => $file
if ($file);
}
else {
$reporter->WARN(
"{Email}{SSLCheckCRL} requires CRL verification but neither {Email}{SSLCrlFile} nor {Email}{SSLCaPath} is set."
);
}
);
}
}
else {
$reporter->WARN(
}
else {
$reporter->WARN(
"{Email}{SSLVerifyServer} requires host verification but neither {Email}{SSLCaFile} nor {Email}{SSLCaPath} is set."
);
}
);
}

return ( [@sslNoVerify], [@sslVerify] );
Expand Down

0 comments on commit a5aef45

Please sign in to comment.