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