40-test_rehash.t 3.0 KB

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