1*e0c4386eSCy Schubert#! /usr/bin/env perl 2*e0c4386eSCy Schubert# Copyright 2015-2018 The OpenSSL Project Authors. All Rights Reserved. 3*e0c4386eSCy Schubert# 4*e0c4386eSCy Schubert# Licensed under the Apache License 2.0 (the "License"). You may not use 5*e0c4386eSCy Schubert# this file except in compliance with the License. You can obtain a copy 6*e0c4386eSCy Schubert# in the file LICENSE in the source distribution or at 7*e0c4386eSCy Schubert# https://www.openssl.org/source/license.html 8*e0c4386eSCy Schubert 9*e0c4386eSCy Schubert 10*e0c4386eSCy Schubertuse strict; 11*e0c4386eSCy Schubertuse warnings; 12*e0c4386eSCy Schubert 13*e0c4386eSCy Schubertuse File::Spec::Functions; 14*e0c4386eSCy Schubertuse File::Copy; 15*e0c4386eSCy Schubertuse File::Basename; 16*e0c4386eSCy Schubertuse OpenSSL::Glob; 17*e0c4386eSCy Schubertuse OpenSSL::Test qw/:DEFAULT srctop_file/; 18*e0c4386eSCy Schubert 19*e0c4386eSCy Schubertsetup("test_rehash"); 20*e0c4386eSCy Schubert 21*e0c4386eSCy Schubert#If "openssl rehash -help" fails it's most likely because we're on a platform 22*e0c4386eSCy Schubert#that doesn't support the rehash command (e.g. Windows) 23*e0c4386eSCy Schubertplan skip_all => "test_rehash is not available on this platform" 24*e0c4386eSCy Schubert unless run(app(["openssl", "rehash", "-help"])); 25*e0c4386eSCy Schubert 26*e0c4386eSCy Schubertplan tests => 4; 27*e0c4386eSCy Schubert 28*e0c4386eSCy Schubertindir "rehash.$$" => sub { 29*e0c4386eSCy Schubert prepare(); 30*e0c4386eSCy Schubert ok(run(app(["openssl", "rehash", curdir()])), 31*e0c4386eSCy Schubert 'Testing normal rehash operations'); 32*e0c4386eSCy Schubert}, create => 1, cleanup => 1; 33*e0c4386eSCy Schubert 34*e0c4386eSCy Schubertindir "rehash.$$" => sub { 35*e0c4386eSCy Schubert prepare(sub { chmod 400, $_ foreach (@_); }); 36*e0c4386eSCy Schubert ok(run(app(["openssl", "rehash", curdir()])), 37*e0c4386eSCy Schubert 'Testing rehash operations on readonly files'); 38*e0c4386eSCy Schubert}, create => 1, cleanup => 1; 39*e0c4386eSCy Schubert 40*e0c4386eSCy Schubertindir "rehash.$$" => sub { 41*e0c4386eSCy Schubert ok(run(app(["openssl", "rehash", curdir()])), 42*e0c4386eSCy Schubert 'Testing rehash operations on empty directory'); 43*e0c4386eSCy Schubert}, create => 1, cleanup => 1; 44*e0c4386eSCy Schubert 45*e0c4386eSCy Schubertindir "rehash.$$" => sub { 46*e0c4386eSCy Schubert prepare(); 47*e0c4386eSCy Schubert chmod 0500, curdir(); 48*e0c4386eSCy Schubert SKIP: { 49*e0c4386eSCy Schubert if (open(FOO, ">unwritable.txt")) { 50*e0c4386eSCy Schubert close FOO; 51*e0c4386eSCy Schubert skip "It's pointless to run the next test as root", 1; 52*e0c4386eSCy Schubert } 53*e0c4386eSCy Schubert isnt(run(app(["openssl", "rehash", curdir()])), 1, 54*e0c4386eSCy Schubert 'Testing rehash operations on readonly directory'); 55*e0c4386eSCy Schubert } 56*e0c4386eSCy Schubert chmod 0700, curdir(); # make it writable again, so cleanup works 57*e0c4386eSCy Schubert}, create => 1, cleanup => 1; 58*e0c4386eSCy Schubert 59*e0c4386eSCy Schubertsub prepare { 60*e0c4386eSCy Schubert my @pemsourcefiles = sort glob(srctop_file('test', "*.pem")); 61*e0c4386eSCy Schubert my @destfiles = (); 62*e0c4386eSCy Schubert 63*e0c4386eSCy Schubert die "There are no source files\n" if scalar @pemsourcefiles == 0; 64*e0c4386eSCy Schubert 65*e0c4386eSCy Schubert my $cnt = 0; 66*e0c4386eSCy Schubert foreach (@pemsourcefiles) { 67*e0c4386eSCy Schubert my $basename = basename($_, ".pem"); 68*e0c4386eSCy Schubert my $writing = 0; 69*e0c4386eSCy Schubert 70*e0c4386eSCy Schubert open PEM, $_ or die "Can't read $_: $!\n"; 71*e0c4386eSCy Schubert while (my $line = <PEM>) { 72*e0c4386eSCy Schubert if ($line =~ m{^-----BEGIN (?:CERTIFICATE|X509 CRL)-----}) { 73*e0c4386eSCy Schubert die "New start in a PEM blob?\n" if $writing; 74*e0c4386eSCy Schubert $cnt++; 75*e0c4386eSCy Schubert my $destfile = 76*e0c4386eSCy Schubert catfile(curdir(), 77*e0c4386eSCy Schubert $basename . sprintf("-%02d", $cnt) . ".pem"); 78*e0c4386eSCy Schubert push @destfiles, $destfile; 79*e0c4386eSCy Schubert open OUT, '>', $destfile 80*e0c4386eSCy Schubert or die "Can't write $destfile\n"; 81*e0c4386eSCy Schubert $writing = 1; 82*e0c4386eSCy Schubert } 83*e0c4386eSCy Schubert print OUT $line if $writing; 84*e0c4386eSCy Schubert if ($line =~ m|^-----END |) { 85*e0c4386eSCy Schubert close OUT if $writing; 86*e0c4386eSCy Schubert $writing = 0; 87*e0c4386eSCy Schubert } 88*e0c4386eSCy Schubert } 89*e0c4386eSCy Schubert die "No end marker in $basename\n" if $writing; 90*e0c4386eSCy Schubert } 91*e0c4386eSCy Schubert die "No test PEM files produced\n" if $cnt == 0; 92*e0c4386eSCy Schubert 93*e0c4386eSCy Schubert foreach (@_) { 94*e0c4386eSCy Schubert die "Internal error, argument is not CODE" 95*e0c4386eSCy Schubert unless (ref($_) eq 'CODE'); 96*e0c4386eSCy Schubert $_->(@destfiles); 97*e0c4386eSCy Schubert } 98*e0c4386eSCy Schubert} 99