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