Home | History | Annotate | Line # | Download | only in recipes
      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