Fix invalid handling of verify errors in libssl

[openssl.git] / configdata.pm.in

diff --git a/configdata.pm.in b/configdata.pm.in
index 666d1f36d8de373c90b9f8582424cdbf946b7fe8..14da489cd38fd92f59e41e827abbd818d05ae08a 100644 (file)
--- a/configdata.pm.in
+++ b/configdata.pm.in
@@ -4,15 +4,39 @@
  # We must make sourcedir() return an absolute path, because configdata.pm
  # may be loaded as a module from any script in any directory, making
  # relative paths untrustable.  Because the result is used with 'use lib',
- # we must ensure that it returns a Unix style path.  Cwd::abs_path does
- # that (File::Spec::Functions::rel2abs return O/S specific paths)
- use File::Spec::Functions;
+ # we must ensure that it returns a Unix style path.  Mixing File::Spec
+ # and File::Spec::Unix does just that.
+ use File::Spec::Unix;
+ use File::Spec;
  use Cwd qw(abs_path);
+ sub _fixup_path {
+     my $path = shift;
+
+     # Make the path absolute at all times
+     $path = abs_path($path);
+
+     if ($^O eq 'VMS') {
+         # Convert any path of the VMS form VOLUME:[DIR1.DIR2]FILE to the
+         # Unix form /VOLUME/DIR1/DIR2/FILE, which is what VMS perl supports
+         # for 'use lib'.
+
+         # Start with spliting the native path
+         (my $vol, my $dirs, my $file) = File::Spec->splitpath($path);
+         my @dirs = File::Spec->splitdir($dirs);
+
+         # Reassemble it as a Unix path
+         $vol =~ s|:$||;
+         $dirs = File::Spec::Unix->catdir('', $vol, @dirs);
+         $path = File::Spec::Unix->catpath('', $dirs, $file);
+     }
+
+     return $path;
+ }
  sub sourcedir {
-     return abs_path(catdir($config{sourcedir}, @_));
+     return _fixup_path(File::Spec->catdir($config{sourcedir}, @_))
  }
  sub sourcefile {
-     return abs_path(catfile($config{sourcedir}, @_));
+     return _fixup_path(File::Spec->catfile($config{sourcedir}, @_))
  }
  use lib sourcedir('util', 'perl');
  use OpenSSL::Util;
@@ -53,6 +77,7 @@ unless (caller) {
     use Getopt::Long;
     use File::Spec::Functions;
     use File::Basename;
+    use File::Copy;
     use Pod::Usage;
 
     use lib '{- sourcedir('util', 'perl') -}';
@@ -62,6 +87,39 @@ unless (caller) {
 
     if (scalar @ARGV == 0) {
         # With no arguments, re-create the build file
+        # We do that in two steps, where the first step emits perl
+        # snipets.
+
+        my $buildfile = $target{build_file};
+        my $buildfile_template = "$buildfile.in";
+        my @autowarntext = (
+            'WARNING: do not edit!',
+            "Generated by configdata.pm from "
+            .join(", ", @{$config{build_file_templates}}),
+            "via $buildfile_template"
+        );
+        my %gendata = (
+            config => \%config,
+            target => \%target,
+            disabled => \%disabled,
+            withargs => \%withargs,
+            unified_info => \%unified_info,
+            autowarntext => \@autowarntext,
+            );
+
+        use lib '.';
+        use lib '{- sourcedir('Configurations') -}';
+        use gentemplate;
+
+        print 'Creating ',$buildfile_template,"\n";
+        open my $buildfile_template_fh, ">$buildfile_template"
+            or die "Trying to create $buildfile_template: $!";
+        foreach (@{$config{build_file_templates}}) {
+            copy($_, $buildfile_template_fh)
+                or die "Trying to copy $_ into $buildfile_template: $!";
+        }
+        gentemplate(output => $buildfile_template_fh, %gendata);
+        close $buildfile_template_fh;
 
         use OpenSSL::Template;
 
@@ -73,36 +131,23 @@ use lib '{- $config{builddir} -}';
 use platform;
 _____
 
-        my @autowarntext = (
-            'WARNING: do not edit!',
-            "Generated by configdata.pm from "
-            .join(", ", @{$config{build_file_templates}})
-        );
-
-        print 'Creating ',$target{build_file},"\n";
-        open BUILDFILE, ">$target{build_file}.new"
-            or die "Trying to create $target{build_file}.new: $!";
-        foreach (@{$config{build_file_templates}}) {
-            my $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
-                                              SOURCE => $_);
-            $tmpl->fill_in(FILENAME => $_,
-                           OUTPUT => \*BUILDFILE,
-                           HASH => { config => \%config,
-                                     target => \%target,
-                                     disabled => \%disabled,
-                                     withargs => \%withargs,
-                                     unified_info => \%unified_info,
-                                     autowarntext => \@autowarntext },
-                           PREPEND => $prepend,
-                           # To ensure that global variables and functions
-                           # defined in one template stick around for the
-                           # next, making them combinable
-                           PACKAGE => 'OpenSSL::safe')
-                or die $Text::Template::ERROR;
-        }
+        print 'Creating ',$buildfile,"\n";
+        open BUILDFILE, ">$buildfile.new"
+            or die "Trying to create $buildfile.new: $!";
+        my $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
+                                          SOURCE => $buildfile_template);
+        $tmpl->fill_in(FILENAME => $_,
+                       OUTPUT => \*BUILDFILE,
+                       HASH => \%gendata,
+                       PREPEND => $prepend,
+                       # To ensure that global variables and functions
+                       # defined in one template stick around for the
+                       # next, making them combinable
+                       PACKAGE => 'OpenSSL::safe')
+            or die $Text::Template::ERROR;
         close BUILDFILE;
-        rename("$target{build_file}.new", $target{build_file})
-            or die "Trying to rename $target{build_file}.new to $target{build_file}: $!";
+        rename("$buildfile.new", $buildfile)
+            or die "Trying to rename $buildfile.new to $buildfile: $!";
 
         exit(0);
     }
@@ -133,7 +178,10 @@ _____
                'man'                    => \$man)
         or die "Errors in command line arguments\n";
 
-    if (scalar @ARGV > 0) {
+    # We allow extra arguments with --query.  That allows constructs like
+    # this:
+    # ./configdata.pm --query 'get_sources(@ARGV)' file1 file2 file3
+    if (!$query && scalar @ARGV > 0) {
         print STDERR <<"_____";
 Unrecognised arguments.
 For more information, do '$0 --help'