1#!{- $config{HASHBANGPERL} -} 2{- use OpenSSL::Util; -} 3# {- join("\n# ", @autowarntext) -} 4# Copyright 1999-2021 The OpenSSL Project Authors. All Rights Reserved. 5# 6# Licensed under the Apache License 2.0 (the "License"). You may not use 7# this file except in compliance with the License. You can obtain a copy 8# in the file LICENSE in the source distribution or at 9# https://www.openssl.org/source/license.html 10 11# Perl c_rehash script, scan all files in a directory 12# and add symbolic links to their hash values. 13 14my $dir = {- quotify1($config{openssldir}) -}; 15my $prefix = {- quotify1($config{prefix}) -}; 16 17my $errorcount = 0; 18my $openssl = $ENV{OPENSSL} || "openssl"; 19my $pwd; 20my $x509hash = "-subject_hash"; 21my $crlhash = "-hash"; 22my $verbose = 0; 23my $symlink_exists=eval {symlink("",""); 1}; 24my $removelinks = 1; 25 26## Parse flags. 27while ( $ARGV[0] =~ /^-/ ) { 28 my $flag = shift @ARGV; 29 last if ( $flag eq '--'); 30 if ( $flag eq '-old') { 31 $x509hash = "-subject_hash_old"; 32 $crlhash = "-hash_old"; 33 } elsif ( $flag eq '-h' || $flag eq '-help' ) { 34 help(); 35 } elsif ( $flag eq '-n' ) { 36 $removelinks = 0; 37 } elsif ( $flag eq '-v' ) { 38 $verbose++; 39 } 40 else { 41 print STDERR "Usage error; try -h.\n"; 42 exit 1; 43 } 44} 45 46sub help { 47 print "Usage: c_rehash [-old] [-h] [-help] [-v] [dirs...]\n"; 48 print " -old use old-style digest\n"; 49 print " -h or -help print this help text\n"; 50 print " -v print files removed and linked\n"; 51 exit 0; 52} 53 54eval "require Cwd"; 55if (defined(&Cwd::getcwd)) { 56 $pwd=Cwd::getcwd(); 57} else { 58 $pwd=`pwd`; 59 chomp($pwd); 60} 61 62# DOS/Win32 or Unix delimiter? Prefix our installdir, then search. 63my $path_delim = ($pwd =~ /^[a-z]\:/i) ? ';' : ':'; 64$ENV{PATH} = "$prefix/bin" . ($ENV{PATH} ? $path_delim . $ENV{PATH} : ""); 65 66if (! -x $openssl) { 67 my $found = 0; 68 foreach (split /$path_delim/, $ENV{PATH}) { 69 if (-x "$_/$openssl") { 70 $found = 1; 71 $openssl = "$_/$openssl"; 72 last; 73 } 74 } 75 if ($found == 0) { 76 print STDERR "c_rehash: rehashing skipped ('openssl' program not available)\n"; 77 exit 0; 78 } 79} 80 81if (@ARGV) { 82 @dirlist = @ARGV; 83} elsif ($ENV{SSL_CERT_DIR}) { 84 @dirlist = split /$path_delim/, $ENV{SSL_CERT_DIR}; 85} else { 86 $dirlist[0] = "$dir/certs"; 87} 88 89if (-d $dirlist[0]) { 90 chdir $dirlist[0]; 91 $openssl="$pwd/$openssl" if (!-x $openssl); 92 chdir $pwd; 93} 94 95foreach (@dirlist) { 96 if (-d $_ ) { 97 if ( -w $_) { 98 hash_dir($_); 99 } else { 100 print "Skipping $_, can't write\n"; 101 $errorcount++; 102 } 103 } 104} 105exit($errorcount); 106 107sub hash_dir { 108 my %hashlist; 109 print "Doing $_[0]\n"; 110 chdir $_[0]; 111 opendir(DIR, "."); 112 my @flist = sort readdir(DIR); 113 closedir DIR; 114 if ( $removelinks ) { 115 # Delete any existing symbolic links 116 foreach (grep {/^[\da-f]+\.r{0,1}\d+$/} @flist) { 117 if (-l $_) { 118 print "unlink $_" if $verbose; 119 unlink $_ || warn "Can't unlink $_, $!\n"; 120 } 121 } 122 } 123 FILE: foreach $fname (grep {/\.(pem)|(crt)|(cer)|(crl)$/} @flist) { 124 # Check to see if certificates and/or CRLs present. 125 my ($cert, $crl) = check_file($fname); 126 if (!$cert && !$crl) { 127 print STDERR "WARNING: $fname does not contain a certificate or CRL: skipping\n"; 128 next; 129 } 130 link_hash_cert($fname) if ($cert); 131 link_hash_crl($fname) if ($crl); 132 } 133} 134 135sub check_file { 136 my ($is_cert, $is_crl) = (0,0); 137 my $fname = $_[0]; 138 open IN, $fname; 139 while(<IN>) { 140 if (/^-----BEGIN (.*)-----/) { 141 my $hdr = $1; 142 if ($hdr =~ /^(X509 |TRUSTED |)CERTIFICATE$/) { 143 $is_cert = 1; 144 last if ($is_crl); 145 } elsif ($hdr eq "X509 CRL") { 146 $is_crl = 1; 147 last if ($is_cert); 148 } 149 } 150 } 151 close IN; 152 return ($is_cert, $is_crl); 153} 154 155 156# Link a certificate to its subject name hash value, each hash is of 157# the form <hash>.<n> where n is an integer. If the hash value already exists 158# then we need to up the value of n, unless its a duplicate in which 159# case we skip the link. We check for duplicates by comparing the 160# certificate fingerprints 161 162sub link_hash_cert { 163 my $fname = $_[0]; 164 $fname =~ s/\"/\\\"/g; 165 my ($hash, $fprint) = `"$openssl" x509 $x509hash -fingerprint -noout -in "$fname"`; 166 chomp $hash; 167 chomp $fprint; 168 $fprint =~ s/^.*=//; 169 $fprint =~ tr/://d; 170 my $suffix = 0; 171 # Search for an unused hash filename 172 while(exists $hashlist{"$hash.$suffix"}) { 173 # Hash matches: if fingerprint matches its a duplicate cert 174 if ($hashlist{"$hash.$suffix"} eq $fprint) { 175 print STDERR "WARNING: Skipping duplicate certificate $fname\n"; 176 return; 177 } 178 $suffix++; 179 } 180 $hash .= ".$suffix"; 181 if ($symlink_exists) { 182 print "link $fname -> $hash\n" if $verbose; 183 symlink $fname, $hash || warn "Can't symlink, $!"; 184 } else { 185 print "copy $fname -> $hash\n" if $verbose; 186 if (open($in, "<", $fname)) { 187 if (open($out,">", $hash)) { 188 print $out $_ while (<$in>); 189 close $out; 190 } else { 191 warn "can't open $hash for write, $!"; 192 } 193 close $in; 194 } else { 195 warn "can't open $fname for read, $!"; 196 } 197 } 198 $hashlist{$hash} = $fprint; 199} 200 201# Same as above except for a CRL. CRL links are of the form <hash>.r<n> 202 203sub link_hash_crl { 204 my $fname = $_[0]; 205 $fname =~ s/'/'\\''/g; 206 my ($hash, $fprint) = `"$openssl" crl $crlhash -fingerprint -noout -in '$fname'`; 207 chomp $hash; 208 chomp $fprint; 209 $fprint =~ s/^.*=//; 210 $fprint =~ tr/://d; 211 my $suffix = 0; 212 # Search for an unused hash filename 213 while(exists $hashlist{"$hash.r$suffix"}) { 214 # Hash matches: if fingerprint matches its a duplicate cert 215 if ($hashlist{"$hash.r$suffix"} eq $fprint) { 216 print STDERR "WARNING: Skipping duplicate CRL $fname\n"; 217 return; 218 } 219 $suffix++; 220 } 221 $hash .= ".r$suffix"; 222 if ($symlink_exists) { 223 print "link $fname -> $hash\n" if $verbose; 224 symlink $fname, $hash || warn "Can't symlink, $!"; 225 } else { 226 print "cp $fname -> $hash\n" if $verbose; 227 system ("cp", $fname, $hash); 228 warn "Can't copy, $!" if ($? >> 8) != 0; 229 } 230 $hashlist{$hash} = $fprint; 231} 232