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