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