| OLD | NEW |
|---|
| (Empty) |
| 1 # Copyright © 2008 Frank Lichtenheld <djpig@debian.org> | |
| 2 # Copyright © 2010 Raphaël Hertzog <hertzog@debian.org> | |
| 3 # | |
| 4 # This program is free software; you can redistribute it and/or modify | |
| 5 # it under the terms of the GNU General Public License as published by | |
| 6 # the Free Software Foundation; either version 2 of the License, or | |
| 7 # (at your option) any later version. | |
| 8 # | |
| 9 # This program is distributed in the hope that it will be useful, | |
| 10 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 12 # GNU General Public License for more details. | |
| 13 # | |
| 14 # You should have received a copy of the GNU General Public License | |
| 15 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
| 16 | |
| 17 package Dpkg::Checksums; | |
| 18 | |
| 19 use strict; | |
| 20 use warnings; | |
| 21 | |
| 22 our $VERSION = '1.00'; | |
| 23 | |
| 24 use Dpkg; | |
| 25 use Dpkg::Gettext; | |
| 26 use Dpkg::ErrorHandling; | |
| 27 use Dpkg::IPC; | |
| 28 | |
| 29 use Exporter qw(import); | |
| 30 our @EXPORT = qw(checksums_get_list checksums_is_supported | |
| 31 checksums_get_property); | |
| 32 | |
| 33 =encoding utf8 | |
| 34 | |
| 35 =head1 NAME | |
| 36 | |
| 37 Dpkg::Checksums - generate and manipulate file checksums | |
| 38 | |
| 39 =head1 DESCRIPTION | |
| 40 | |
| 41 This module provides an object that can generate and manipulate | |
| 42 various file checksums as well as some methods to query information | |
| 43 about supported checksums. | |
| 44 | |
| 45 =head1 EXPORTED FUNCTIONS | |
| 46 | |
| 47 =over 4 | |
| 48 | |
| 49 =cut | |
| 50 | |
| 51 my $CHECKSUMS = { | |
| 52 md5 => { | |
| 53 program => [ 'md5sum' ], | |
| 54 regex => qr/[0-9a-f]{32}/, | |
| 55 }, | |
| 56 sha1 => { | |
| 57 program => [ 'sha1sum' ], | |
| 58 regex => qr/[0-9a-f]{40}/, | |
| 59 }, | |
| 60 sha256 => { | |
| 61 program => [ 'sha256sum' ], | |
| 62 regex => qr/[0-9a-f]{64}/, | |
| 63 }, | |
| 64 }; | |
| 65 | |
| 66 =item @list = checksums_get_list() | |
| 67 | |
| 68 Returns the list of supported checksums algorithms. | |
| 69 | |
| 70 =cut | |
| 71 | |
| 72 sub checksums_get_list() { | |
| 73 my @list = sort keys %{$CHECKSUMS}; | |
| 74 return @list; | |
| 75 } | |
| 76 | |
| 77 =item $bool = checksums_is_supported($alg) | |
| 78 | |
| 79 Returns a boolean indicating whether the given checksum algorithm is | |
| 80 supported. The checksum algorithm is case-insensitive. | |
| 81 | |
| 82 =cut | |
| 83 | |
| 84 sub checksums_is_supported($) { | |
| 85 my ($alg) = @_; | |
| 86 return exists $CHECKSUMS->{lc($alg)}; | |
| 87 } | |
| 88 | |
| 89 =item $value = checksums_get_property($alg, $property) | |
| 90 | |
| 91 Returns the requested property of the checksum algorithm. Returns undef if | |
| 92 either the property or the checksum algorithm doesn't exist. Valid | |
| 93 properties currently include "program" (returns an array reference with | |
| 94 a program name and parameters required to compute the checksum of the | |
| 95 filename given as last parameter) and "regex" for the regular expression | |
| 96 describing the common string representation of the checksum (as output | |
| 97 by the program that generates it). | |
| 98 | |
| 99 =cut | |
| 100 | |
| 101 sub checksums_get_property($$) { | |
| 102 my ($alg, $property) = @_; | |
| 103 return unless checksums_is_supported($alg); | |
| 104 return $CHECKSUMS->{lc($alg)}{$property}; | |
| 105 } | |
| 106 | |
| 107 =back | |
| 108 | |
| 109 =head1 OBJECT METHODS | |
| 110 | |
| 111 =over 4 | |
| 112 | |
| 113 =item my $ck = Dpkg::Checksums->new() | |
| 114 | |
| 115 Create a new Dpkg::Checksums object. This object is able to store | |
| 116 the checksums of several files to later export them or verify them. | |
| 117 | |
| 118 =cut | |
| 119 | |
| 120 sub new { | |
| 121 my ($this, %opts) = @_; | |
| 122 my $class = ref($this) || $this; | |
| 123 | |
| 124 my $self = {}; | |
| 125 bless $self, $class; | |
| 126 $self->reset(); | |
| 127 | |
| 128 return $self; | |
| 129 } | |
| 130 | |
| 131 =item $ck->reset() | |
| 132 | |
| 133 Forget about all checksums stored. The object is again in the same state | |
| 134 as if it was newly created. | |
| 135 | |
| 136 =cut | |
| 137 | |
| 138 sub reset { | |
| 139 my ($self) = @_; | |
| 140 $self->{files} = []; | |
| 141 $self->{checksums} = {}; | |
| 142 $self->{size} = {}; | |
| 143 } | |
| 144 | |
| 145 =item $ck->add_from_file($filename, %opts) | |
| 146 | |
| 147 Add checksums information for the file $filename. The file must exists | |
| 148 for the call to succeed. If you don't want the given filename to appear | |
| 149 when you later export the checksums you might want to set the "key" | |
| 150 option with the public name that you want to use. Also if you don't want | |
| 151 to generate all the checksums, you can pass an array reference of the | |
| 152 wanted checksums in the "checksums" option. | |
| 153 | |
| 154 It the object already contains checksums information associated the | |
| 155 filename (or key), it will error out if the newly computed information | |
| 156 does not match what's stored. | |
| 157 | |
| 158 =cut | |
| 159 | |
| 160 sub add_from_file { | |
| 161 my ($self, $file, %opts) = @_; | |
| 162 my $key = exists $opts{key} ? $opts{key} : $file; | |
| 163 my @alg; | |
| 164 if (exists $opts{checksums}) { | |
| 165 push @alg, map { lc($_) } @{$opts{checksums}}; | |
| 166 } else { | |
| 167 push @alg, checksums_get_list(); | |
| 168 } | |
| 169 | |
| 170 push @{$self->{files}}, $key unless exists $self->{size}{$key}; | |
| 171 (my @s = stat($file)) or syserr(_g('cannot fstat file %s'), $file); | |
| 172 if (exists $self->{size}{$key} and $self->{size}{$key} != $s[7]) { | |
| 173 error(_g('file %s has size %u instead of expected %u'), | |
| 174 $file, $s[7], $self->{size}{$key}); | |
| 175 } | |
| 176 $self->{size}{$key} = $s[7]; | |
| 177 | |
| 178 foreach my $alg (@alg) { | |
| 179 my @exec = (@{$CHECKSUMS->{$alg}{program}}, $file); | |
| 180 my $regex = $CHECKSUMS->{$alg}{regex}; | |
| 181 my $output; | |
| 182 spawn(exec => \@exec, to_string => \$output); | |
| 183 if ($output =~ /^($regex)(\s|$)/m) { | |
| 184 my $newsum = $1; | |
| 185 if (exists $self->{checksums}{$key}{$alg} and | |
| 186 $self->{checksums}{$key}{$alg} ne $newsum) { | |
| 187 error(_g('file %s has checksum %s instead of expected %s (algori
thm %s)'), | |
| 188 $file, $newsum, $self->{checksums}{$key}{$alg}, $alg); | |
| 189 } | |
| 190 $self->{checksums}{$key}{$alg} = $newsum; | |
| 191 } else { | |
| 192 error(_g("checksum program gave bogus output `%s'"), $output); | |
| 193 } | |
| 194 } | |
| 195 } | |
| 196 | |
| 197 =item $ck->add_from_string($alg, $value) | |
| 198 | |
| 199 Add checksums of type $alg that are stored in the $value variable. | |
| 200 $value can be multi-lines, each line should be a space separated list | |
| 201 of checksum, file size and filename. Leading or trailing spaces are | |
| 202 not allowed. | |
| 203 | |
| 204 It the object already contains checksums information associated to the | |
| 205 filenames, it will error out if the newly read information does not match | |
| 206 what's stored. | |
| 207 | |
| 208 =cut | |
| 209 | |
| 210 sub add_from_string { | |
| 211 my ($self, $alg, $fieldtext) = @_; | |
| 212 $alg = lc($alg); | |
| 213 my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/; | |
| 214 my $regex = checksums_get_property($alg, 'regex'); | |
| 215 my $checksums = $self->{checksums}; | |
| 216 | |
| 217 for my $checksum (split /\n */, $fieldtext) { | |
| 218 next if $checksum eq ''; | |
| 219 unless ($checksum =~ m/^($regex)\s+(\d+)\s+($rx_fname)$/) { | |
| 220 error(_g('invalid line in %s checksums string: %s'), | |
| 221 $alg, $checksum); | |
| 222 } | |
| 223 my ($sum, $size, $file) = ($1, $2, $3); | |
| 224 if (exists($checksums->{$file}{$alg}) | |
| 225 and $checksums->{$file}{$alg} ne $sum) { | |
| 226 error(_g("conflicting checksums '%s' and '%s' for file '%s'"), | |
| 227 $checksums->{$file}{$alg}, $sum, $file); | |
| 228 } | |
| 229 if (exists $self->{size}{$file} and $self->{size}{$file} != $size) { | |
| 230 error(_g("conflicting file sizes '%u' and '%u' for file '%s'"), | |
| 231 $self->{size}{$file}, $size, $file); | |
| 232 } | |
| 233 push @{$self->{files}}, $file unless exists $self->{size}{$file}; | |
| 234 $checksums->{$file}{$alg} = $sum; | |
| 235 $self->{size}{$file} = $size; | |
| 236 } | |
| 237 } | |
| 238 | |
| 239 =item $ck->add_from_control($control, %opts) | |
| 240 | |
| 241 Read checksums from Checksums-* fields stored in the Dpkg::Control object | |
| 242 $control. It uses $self->add_from_string() on the field values to do the | |
| 243 actual work. | |
| 244 | |
| 245 If the option "use_files_for_md5" evaluates to true, then the "Files" | |
| 246 field is used in place of the "Checksums-Md5" field. By default the option | |
| 247 is false. | |
| 248 | |
| 249 =cut | |
| 250 | |
| 251 sub add_from_control { | |
| 252 my ($self, $control, %opts) = @_; | |
| 253 $opts{use_files_for_md5} = 0 unless exists $opts{use_files_for_md5}; | |
| 254 foreach my $alg (checksums_get_list()) { | |
| 255 my $key = "Checksums-$alg"; | |
| 256 $key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5'); | |
| 257 if (exists $control->{$key}) { | |
| 258 $self->add_from_string($alg, $control->{$key}); | |
| 259 } | |
| 260 } | |
| 261 } | |
| 262 | |
| 263 =item @files = $ck->get_files() | |
| 264 | |
| 265 Return the list of files whose checksums are stored in the object. | |
| 266 | |
| 267 =cut | |
| 268 | |
| 269 sub get_files { | |
| 270 my ($self) = @_; | |
| 271 return @{$self->{files}}; | |
| 272 } | |
| 273 | |
| 274 =item $bool = $ck->has_file($file) | |
| 275 | |
| 276 Return true if we have checksums for the given file. Returns false | |
| 277 otherwise. | |
| 278 | |
| 279 =cut | |
| 280 | |
| 281 sub has_file { | |
| 282 my ($self, $file) = @_; | |
| 283 return exists $self->{size}{$file}; | |
| 284 } | |
| 285 | |
| 286 =item $ck->remove_file($file) | |
| 287 | |
| 288 Remove all checksums of the given file. | |
| 289 | |
| 290 =cut | |
| 291 | |
| 292 sub remove_file { | |
| 293 my ($self, $file) = @_; | |
| 294 return unless $self->has_file($file); | |
| 295 delete $self->{checksums}{$file}; | |
| 296 delete $self->{size}{$file}; | |
| 297 @{$self->{files}} = grep { $_ ne $file } $self->get_files(); | |
| 298 } | |
| 299 | |
| 300 =item $checksum = $ck->get_checksum($file, $alg) | |
| 301 | |
| 302 Return the checksum of type $alg for the requested $file. This will not | |
| 303 compute the checksum but only return the checksum stored in the object, if | |
| 304 any. | |
| 305 | |
| 306 If $alg is not defined, it returns a reference to a hash: keys are | |
| 307 the checksum algorithms and values are the checksums themselves. The | |
| 308 hash returned must not be modified, it's internal to the object. | |
| 309 | |
| 310 =cut | |
| 311 | |
| 312 sub get_checksum { | |
| 313 my ($self, $file, $alg) = @_; | |
| 314 $alg = lc($alg) if defined $alg; | |
| 315 if (exists $self->{checksums}{$file}) { | |
| 316 return $self->{checksums}{$file} unless defined $alg; | |
| 317 return $self->{checksums}{$file}{$alg}; | |
| 318 } | |
| 319 return; | |
| 320 } | |
| 321 | |
| 322 =item $size = $ck->get_size($file) | |
| 323 | |
| 324 Return the size of the requested file if it's available in the object. | |
| 325 | |
| 326 =cut | |
| 327 | |
| 328 sub get_size { | |
| 329 my ($self, $file) = @_; | |
| 330 return $self->{size}{$file}; | |
| 331 } | |
| 332 | |
| 333 =item $ck->export_to_string($alg, %opts) | |
| 334 | |
| 335 Return a multi-line string containing the checksums of type $alg. The | |
| 336 string can be stored as-is in a Checksum-* field of a Dpkg::Control | |
| 337 object. | |
| 338 | |
| 339 =cut | |
| 340 | |
| 341 sub export_to_string { | |
| 342 my ($self, $alg, %opts) = @_; | |
| 343 my $res = ''; | |
| 344 foreach my $file ($self->get_files()) { | |
| 345 my $sum = $self->get_checksum($file, $alg); | |
| 346 my $size = $self->get_size($file); | |
| 347 next unless defined $sum and defined $size; | |
| 348 $res .= "\n$sum $size $file"; | |
| 349 } | |
| 350 return $res; | |
| 351 } | |
| 352 | |
| 353 =item $ck->export_to_control($control, %opts) | |
| 354 | |
| 355 Export the checksums in the Checksums-* fields of the Dpkg::Control | |
| 356 $control object. | |
| 357 | |
| 358 =cut | |
| 359 | |
| 360 sub export_to_control { | |
| 361 my ($self, $control, %opts) = @_; | |
| 362 $opts{use_files_for_md5} = 0 unless exists $opts{use_files_for_md5}; | |
| 363 foreach my $alg (checksums_get_list()) { | |
| 364 my $key = "Checksums-$alg"; | |
| 365 $key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5'); | |
| 366 $control->{$key} = $self->export_to_string($alg, %opts); | |
| 367 } | |
| 368 } | |
| 369 | |
| 370 =back | |
| 371 | |
| 372 =head1 AUTHOR | |
| 373 | |
| 374 Raphaël Hertzog <hertzog@debian.org>. | |
| 375 | |
| 376 =cut | |
| 377 | |
| 378 1; | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2425693003:
Revert of Linux build: Use sysroot when calculating dependencies (Closed)
