]>
Commit | Line | Data |
---|---|---|
abe256e7 | 1 | #!{- $config{HASHBANGPERL} -} |
da51dc5f | 2 | {- use OpenSSL::Util; -} |
9ab6fc59 | 3 | # {- join("\n# ", @autowarntext) -} |
fecb3aae | 4 | # Copyright 1999-2022 The OpenSSL Project Authors. All Rights Reserved. |
44c8a5e2 | 5 | # |
9059ab42 | 6 | # Licensed under the Apache License 2.0 (the "License"). You may not use |
44c8a5e2 RS |
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 | |
9ab6fc59 | 10 | |
439df508 DSH |
11 | # Perl c_rehash script, scan all files in a directory |
12 | # and add symbolic links to their hash values. | |
13 | ||
291e94df RL |
14 | my $dir = {- quotify1($config{openssldir}) -}; |
15 | my $prefix = {- quotify1($config{prefix}) -}; | |
439df508 | 16 | |
4c7103a5 | 17 | my $errorcount = 0; |
a787c259 MA |
18 | my $openssl = $ENV{OPENSSL} || "openssl"; |
19 | my $pwd; | |
20 | my $x509hash = "-subject_hash"; | |
21 | my $crlhash = "-hash"; | |
22 | my $verbose = 0; | |
23 | my $symlink_exists=eval {symlink("",""); 1}; | |
24 | my $removelinks = 1; | |
25 | ||
26 | ## Parse flags. | |
8846adbd | 27 | while ( $ARGV[0] =~ /^-/ ) { |
a787c259 MA |
28 | my $flag = shift @ARGV; |
29 | last if ( $flag eq '--'); | |
8846adbd | 30 | if ( $flag eq '-old') { |
ea0d79db VS |
31 | $x509hash = "-subject_hash_old"; |
32 | $crlhash = "-hash_old"; | |
7d959c35 | 33 | } elsif ( $flag eq '-h' || $flag eq '-help' ) { |
ea0d79db | 34 | help(); |
a787c259 | 35 | } elsif ( $flag eq '-n' ) { |
ea0d79db | 36 | $removelinks = 0; |
a787c259 | 37 | } elsif ( $flag eq '-v' ) { |
ea0d79db | 38 | $verbose++; |
a787c259 MA |
39 | } |
40 | else { | |
ea0d79db VS |
41 | print STDERR "Usage error; try -h.\n"; |
42 | exit 1; | |
a787c259 MA |
43 | } |
44 | } | |
45 | ||
46 | sub help { | |
ea0d79db VS |
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; | |
439df508 DSH |
52 | } |
53 | ||
a2688c87 AP |
54 | eval "require Cwd"; |
55 | if (defined(&Cwd::getcwd)) { | |
ea0d79db | 56 | $pwd=Cwd::getcwd(); |
a2688c87 | 57 | } else { |
ea0d79db VS |
58 | $pwd=`pwd`; |
59 | chomp($pwd); | |
a2688c87 | 60 | } |
d8cdd156 | 61 | |
a787c259 MA |
62 | # DOS/Win32 or Unix delimiter? Prefix our installdir, then search. |
63 | my $path_delim = ($pwd =~ /^[a-z]\:/i) ? ';' : ':'; | |
64 | $ENV{PATH} = "$prefix/bin" . ($ENV{PATH} ? $path_delim . $ENV{PATH} : ""); | |
439df508 | 65 | |
ff2f6bb0 | 66 | if (! -x $openssl) { |
ea0d79db VS |
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 | } | |
439df508 DSH |
79 | } |
80 | ||
ff2f6bb0 | 81 | if (@ARGV) { |
ea0d79db | 82 | @dirlist = @ARGV; |
ff2f6bb0 | 83 | } elsif ($ENV{SSL_CERT_DIR}) { |
ea0d79db | 84 | @dirlist = split /$path_delim/, $ENV{SSL_CERT_DIR}; |
439df508 | 85 | } else { |
ea0d79db | 86 | $dirlist[0] = "$dir/certs"; |
439df508 DSH |
87 | } |
88 | ||
d8cdd156 | 89 | if (-d $dirlist[0]) { |
ea0d79db VS |
90 | chdir $dirlist[0]; |
91 | $openssl="$pwd/$openssl" if (!-x $openssl); | |
92 | chdir $pwd; | |
d8cdd156 | 93 | } |
439df508 DSH |
94 | |
95 | foreach (@dirlist) { | |
ea0d79db VS |
96 | if (-d $_ ) { |
97 | if ( -w $_) { | |
98 | hash_dir($_); | |
99 | } else { | |
100 | print "Skipping $_, can't write\n"; | |
101 | $errorcount++; | |
102 | } | |
103 | } | |
439df508 | 104 | } |
4c7103a5 | 105 | exit($errorcount); |
439df508 DSH |
106 | |
107 | sub hash_dir { | |
ea0d79db VS |
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 | } | |
439df508 DSH |
133 | } |
134 | ||
135 | sub check_file { | |
ea0d79db VS |
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); | |
439df508 DSH |
153 | } |
154 | ||
7c332707 TM |
155 | sub compute_hash { |
156 | my $fh; | |
157 | if ( $^O eq "VMS" ) { | |
158 | # VMS uses the open through shell | |
159 | # The file names are safe there and list form is unsupported | |
160 | if (!open($fh, "-|", join(' ', @_))) { | |
161 | print STDERR "Cannot compute hash on '$fname'\n"; | |
162 | return; | |
163 | } | |
164 | } else { | |
165 | if (!open($fh, "-|", @_)) { | |
166 | print STDERR "Cannot compute hash on '$fname'\n"; | |
167 | return; | |
168 | } | |
169 | } | |
170 | return (<$fh>, <$fh>); | |
171 | } | |
439df508 DSH |
172 | |
173 | # Link a certificate to its subject name hash value, each hash is of | |
174 | # the form <hash>.<n> where n is an integer. If the hash value already exists | |
175 | # then we need to up the value of n, unless its a duplicate in which | |
176 | # case we skip the link. We check for duplicates by comparing the | |
177 | # certificate fingerprints | |
178 | ||
179 | sub link_hash_cert { | |
ea0d79db | 180 | my $fname = $_[0]; |
7c332707 TM |
181 | my ($hash, $fprint) = compute_hash($openssl, "x509", $x509hash, |
182 | "-fingerprint", "-noout", | |
183 | "-in", $fname); | |
ea0d79db VS |
184 | chomp $hash; |
185 | chomp $fprint; | |
7c332707 | 186 | return if !$hash; |
ea0d79db VS |
187 | $fprint =~ s/^.*=//; |
188 | $fprint =~ tr/://d; | |
189 | my $suffix = 0; | |
190 | # Search for an unused hash filename | |
191 | while(exists $hashlist{"$hash.$suffix"}) { | |
192 | # Hash matches: if fingerprint matches its a duplicate cert | |
193 | if ($hashlist{"$hash.$suffix"} eq $fprint) { | |
194 | print STDERR "WARNING: Skipping duplicate certificate $fname\n"; | |
195 | return; | |
196 | } | |
197 | $suffix++; | |
198 | } | |
199 | $hash .= ".$suffix"; | |
200 | if ($symlink_exists) { | |
201 | print "link $fname -> $hash\n" if $verbose; | |
202 | symlink $fname, $hash || warn "Can't symlink, $!"; | |
203 | } else { | |
204 | print "copy $fname -> $hash\n" if $verbose; | |
205 | if (open($in, "<", $fname)) { | |
206 | if (open($out,">", $hash)) { | |
207 | print $out $_ while (<$in>); | |
208 | close $out; | |
209 | } else { | |
210 | warn "can't open $hash for write, $!"; | |
211 | } | |
212 | close $in; | |
213 | } else { | |
214 | warn "can't open $fname for read, $!"; | |
215 | } | |
216 | } | |
217 | $hashlist{$hash} = $fprint; | |
439df508 DSH |
218 | } |
219 | ||
220 | # Same as above except for a CRL. CRL links are of the form <hash>.r<n> | |
221 | ||
222 | sub link_hash_crl { | |
ea0d79db | 223 | my $fname = $_[0]; |
7c332707 TM |
224 | my ($hash, $fprint) = compute_hash($openssl, "crl", $crlhash, |
225 | "-fingerprint", "-noout", | |
226 | "-in", $fname); | |
ea0d79db VS |
227 | chomp $hash; |
228 | chomp $fprint; | |
7c332707 | 229 | return if !$hash; |
ea0d79db VS |
230 | $fprint =~ s/^.*=//; |
231 | $fprint =~ tr/://d; | |
232 | my $suffix = 0; | |
233 | # Search for an unused hash filename | |
234 | while(exists $hashlist{"$hash.r$suffix"}) { | |
235 | # Hash matches: if fingerprint matches its a duplicate cert | |
236 | if ($hashlist{"$hash.r$suffix"} eq $fprint) { | |
237 | print STDERR "WARNING: Skipping duplicate CRL $fname\n"; | |
238 | return; | |
239 | } | |
240 | $suffix++; | |
241 | } | |
242 | $hash .= ".r$suffix"; | |
243 | if ($symlink_exists) { | |
244 | print "link $fname -> $hash\n" if $verbose; | |
245 | symlink $fname, $hash || warn "Can't symlink, $!"; | |
246 | } else { | |
247 | print "cp $fname -> $hash\n" if $verbose; | |
248 | system ("cp", $fname, $hash); | |
249 | warn "Can't copy, $!" if ($? >> 8) != 0; | |
250 | } | |
251 | $hashlist{$hash} = $fprint; | |
439df508 | 252 | } |