Item12952: many changes for new confgure architecture

foswiki · Aug 27, 2014 · 4fd70c6 · 4fd70c6
1 parent 159e2bd
commit 4fd70c6
Show file tree

Hide file tree

Showing 2 changed files with 51 additions and 53 deletions.
diff --git a/core/lib/Foswiki/Configure/Checkers/Email/SSLCaPath.pm b/core/lib/Foswiki/Configure/Checkers/Email/SSLCaPath.pm
@@ -1,5 +1,4 @@
 # See bottom of file for license and copyright information
-
 package Foswiki::Configure::Checkers::Email::SSLCaPath;
 
 use strict;
@@ -9,64 +8,18 @@ require Foswiki::Configure::Checker;
 our @ISA = qw/Foswiki::Configure::Checker/;
 
 sub check_current_value {
-    my ($this, $reporter) = @_;
+    my ( $this, $reporter ) = @_;
 
     return ''
       unless ( $Foswiki::cfg{Email}{MailMethod} =~ /^Net::SMTP/
         && $Foswiki::cfg{Email}{SSLVerifyServer} );
 
-    # This is quite similar to CaFile, but we recompute
-    # the defaults in case they depended on Path, but
-    # path has been cleared.
-
-    my $value = $this->getCfg;
-
-    unless ( $value || $Foswiki::cfg{Email}{SSLCaFile} ) {
-
-        # See if we can use LWP or Crypt::SSLEay's defaults
-
-        my ( $file, $path ) =
-          @ENV{qw/PERL_LWP_SSL_CA_FILE PERL_LWP_SSL_CA_PATH/};
-        my $guessed = 0;
-        if ( $file || $path ) {
-            $reporter->NOTE("Guessed from LWP settings");
-            $guessed = 1;
-        }
-        else {
-            ( $file, $path ) = @ENV{qw/HTTPS_CA_FILE HTTPS_CA_DIR/};
-            if ( $file || $path ) {
-                $reporter->NOTE("Guessed from Crypt::SSLEay's settings");
-                $guessed = 1;
-            }
-            else {
-                if ( eval 'require Mozilla::CA;' ) {
-                    $file = Mozilla::CA::SSL_ca_file();
-                    if ($file) {
-                        $reporter->NOTE("Obtained from Mozilla::CA");
-                        $guessed = 1;
-                    }
-                    else {
-                        $reporter->ERROR(
-                            "Mozilla::CA is installed but has no file");
-                    }
-                }
-            }
-        }
-        if ($guessed) {
-            $this->WARN(Foswiki::Configure::Checker::GUESSED_MESSAGE);
-            $file = '' unless ( defined $file );
-            $path = '' unless ( defined $path );
-            $this->setItemValue($path);
-            $this->setItemValue( $file, '{Email}{SSLCaFile}' );
-        }
-    }
-
     my $file = $this->getCfg('{Email}{SSLCaFile}');
 
     if ( $file && !-r $file ) {
         $reporter->ERROR("Unable to read $file");
     }
-    my $path = $this->getCfg('{Email}{SSLCaPath}');
+    my $path = $this->getCfg();
     if ($path) {
         if ( !( -d $path && -r _ ) ) {
             $reporter->ERROR(
@@ -95,7 +48,6 @@ sub check_current_value {
 1;
 
 __END__
-
 Foswiki - The Free and Open Source Wiki, http://foswiki.org/
 
 Copyright (C) 2008-2010 Foswiki Contributors. Foswiki Contributors

diff --git a/core/lib/Foswiki/Configure/Checkers/Email/SSLCrlFile.pm b/core/lib/Foswiki/Configure/Checkers/Email/SSLCrlFile.pm
@@ -9,7 +9,7 @@ require Foswiki::Configure::Checker;
 our @ISA = qw/Foswiki::Configure::Checker/;
 
 sub check_current_value {
-    my ($this, $reporter) = @_;
+    my ( $this, $reporter ) = @_;
 
     return '' unless ( $Foswiki::cfg{Email}{SSLCheckCRL} );
 
@@ -34,7 +34,7 @@ sub check_current_value {
             elsif ( $this->getCfg( $Foswiki::cfg{Email}{SSLCaFile} ) ) {
                 $reporter->NOTE(
                     "Guessed {Email}{SSLCaFile} may also contain CRLs");
-                $file = '$Foswiki::cfg{Email}{SSLCaFile}';
+                $file    = '$Foswiki::cfg{Email}{SSLCaFile}';
                 $guessed = 1;
             }
         }
@@ -51,9 +51,14 @@ sub check_current_value {
     my $file = $this->getCfg;
 
     if ($file) {
+        return $reporter->ERROR("Invalid characters in $file")
+          unless $file =~ m,^([\w_./]+)$,;
+        $file = $1;
+
         if ( -r $file ) {
             $reporter->NOTE( "File was last modified "
                   . ( scalar localtime( ( stat _ )[9] ) ) );
+            _checkCRLFile( $file, $reporter );
         }
         else {
             $reporter->ERROR("Unable to read $file");
@@ -67,14 +72,55 @@ sub check_current_value {
         $reporter->ERROR(
             -d $path ? "$path is not readable" : "$path is not a directory" );
     }
-    
+
     if ( !( $file || $path ) ) {
         $reporter->ERROR(
 "Either or both {Email}{SSLCrlFile} and {Email}{SSLCaPath} must be set for server verification.  CRLs are more dynamic than CA root certificates, and must be updated frequently to be useful.  Be sure that any method you choose satisfies your site's security policies.  Alternatively, your OS distribution may also provide a file or directory."
         );
     }
 }
 
+sub _checkCRLFile {
+    my ( $path, $reporter ) = @_;
+
+    my $certs = 0;
+    my $crls  = 0;
+
+    open( my $fh, '<', $path )
+      or return $reporter->ERROR("Unable to open $path: $!");
+    while (<$fh>) {
+        if (/^-----BEGIN (.*)-----/) {
+            my $hdr = $1;
+            if ( $hdr =~ /^(X509 |TRUSTED |)CERTIFICATE$/ ) {
+                $certs++;
+            }
+            elsif ( $hdr eq 'X509 CRL' ) {
+                $crls++;
+            }
+        }
+    }
+    close($fh);
+
+    if ($crls) {
+        my $m = "File contains $crls CRL";
+        $m .= 's' if ( $crls != 1 );
+        $reporter->NOTE($m);
+    }
+    elsif ( $Foswiki::cfg{Email}{SSLCaPath} ) {
+        $reporter->NOTE("File contains no CRLs, but {Email}{SSLCaPath} may.");
+    }
+    else {
+        $reporter->ERROR("File contains no CRLs");
+    }
+    if ($certs) {
+        my $m = "File ";
+        $m .= 'also ' if ($crls);
+        $m .= "contains $certs certificate";
+        $m .= 's'     if ( $certs != 1 );
+        $reporter->NOTE($m);
+    }
+}
+
 1;
 
 __END__