spectool

   1 #!/usr/bin/perl -w
   2
   3 ################################################################
   4 #
   5 # Copyright (c) 1995-2014 SUSE Linux Products GmbH
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License version 2 or 3 as
   9 # published by the Free Software Foundation.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program (see the file COPYING); if not, write to the
  18 # Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  20 #
  21 ################################################################
  22
  23 =head1 spectool
  24
  25 spectool - tool to work with rpm spec files
  26
  27 =head1 SYNOPSIS
  28
  29 spectool [options] specfiles...
  30
  31 =head1 OPTIONS
  32
  33 =over 4
  34
  35 =item B<--help>
  36
  37 display help as manpage
  38
  39 =item B<--dist>=I<STRING>
  40
  41 set distribution, e.g. "11.1-i586" or path to config
  42
  43 =item B<--archpath>=I<STRING>
  44
  45 compatible architecture separated by colon, e.g. C<i586:i486:i386>.
  46 Autotected if missing.
  47
  48 =item B<--configdir>=I<STRING>
  49
  50 path to config files if B<--dist> didn't specify a full path
  51
  52 =item B<--define>=I<STRING>
  53
  54 =item B<--with>=I<STRING>
  55
  56 =item B<--without>=I<STRING>
  57
  58 same meaning as in rpmbuild
  59
  60 =item B<--tag>=I<STRING>
  61
  62 print tag from spec file, e.g. C<version>. Regexp is also possible,
  63 e.g. C</source[01]/>
  64
  65 =item B<--sources>
  66
  67 print package source files. If a file C<sources> or
  68 C<I<packagename>.sources> is present verify the checksums against
  69 that.
  70
  71 =over 4
  72
  73 =item B<--update>
  74
  75 update the checksums
  76
  77 =item B<--download>
  78
  79 download missing sources
  80
  81 =back
  82
  83 =back
  84
  85 =head1 DESCRIPTION
  86
  87 The B<--sources> option allows to manage a sources file in a way
  88 similar to Fedora. The sources file lists the check sums and file
  89 names of the binary files specified in the spec file.
  90
  91 B<--sources> without further options compares the check sums of all
  92 files and prints a report consisting of a character that describes
  93 the status of the file and the file name. Meaning of the characters
  94 is as follows:
  95
  96 =over 4
  97
  98 =item B<.> check sum matches
  99
 100 =item B<!> check sum broken
 101
 102 =item B<d> file is missing, checksum known. Can be verified after download
 103
 104 =item B<-> file is missing and checksum unknown
 105
 106 =item B<_> file is present but checksum unknown
 107
 108 =item B<t> text file, will be skipped for check sums
 109
 110 =item B<?> check sum known but not referenced from spec file
 111
 112 =back
 113
 114 Additionally specifying B<--update> recomputes all check sums and
 115 updates the sources file.
 116
 117 With B<--download> all missing files are downloaded if the spec file
 118 has an http or ftp url.
 119
 120 =head2 FORMAT OF THE SOURCES FILE
 121
 122 Lines of the form
 123 <checksum> <whitespace> <filename>
 124
 125 =head2 NAME OF THE SOURCES FILE
 126
 127 A file named C<sources> is preferred if present for compatibility
 128 with Fedora. It only contains md5 sums. If that file is not present
 129 the C<.spec> suffix of the spec file is replaced with C<.sources>
 130 and the this name used as sources file (e.g. C<foo.spec> ->
 131 C<foo.sources>). In this file sha1 is preferred. Also, the name of
 132 the algorithm is prepended with colon to the check sum.
 133
 134 =cut
 135
 136 my $builddir;
 137
 138 BEGIN {
 139   $builddir = ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
 140   unshift @INC, $builddir;
 141 }
 142
 143 use strict;
 144
 145 use Build;
 146 use Pod::Usage;
 147 use Getopt::Long;
 148 Getopt::Long::Configure("no_ignore_case");
 149
 150 my (@opt_showtag, $opt_sources, $opt_update, $opt_download);
 151
 152 sub parse_depfile;
 153
 154 my ($dist, $rpmdeps, $archs, $configdir, $useusedforbuild);
 155 my %options;
 156
 157 GetOptions (
 158   \%options,
 159   "help" => sub { pod2usage(-exitstatus => 0, -verbose => 2) },
 160
 161   "dist=s" => \$dist,
 162   "archpath=s" => \$archs,
 163   "configdir=s" => \$configdir,
 164   "define=s" => sub { Build::define($_[1]) },
 165   "with=s" => sub { Build::define("_with_".$_[1]." --with-".$_[1]) },
 166   "without=s" => sub { Build::define("_without_".$_[1]." --without-".$_[1]) },
 167
 168   "tag=s" => \@opt_showtag,
 169   "sources" => \$opt_sources,
 170   "update" => \$opt_update,
 171   "download" => \$opt_download,
 172   "download-force",
 173   "download-recompress=s",
 174   "download-outdir=s",
 175   "download-compare=s",
 176   "download-delete-identical",
 177 ) or pod2usage(1);
 178
 179 pod2usage(1) unless @ARGV;
 180
 181 my $ua;
 182
 183 my @specs = @ARGV;
 184
 185 die "--download must be used together with --sources\n" if ($opt_download && !$opt_sources);
 186 die "--update must be used together with --sources\n" if ($opt_update && !$opt_sources);
 187
 188 $options{'download-recompress'} ||= 'auto';
 189 $options{'download-outdir'}.='/' if ($options{'download-outdir'} && $options{'download-outdir'} !~ /\/$/);
 190 $options{'download-outdir'} ||= '';
 191 $options{'download-compare'}.='/' if ($options{'download-compare'} && $options{'download-compare'} !~ /\/$/);
 192 $options{'download-compare'} ||= '';
 193
 194 my @archs;
 195 if (!defined $archs) {
 196   use POSIX qw/uname/;
 197   my %archmap = qw/x86_64 i686 i686 i586 i586 i486 i486 i386/;
 198   my @a = uname();
 199   push @archs, $a[4];
 200   while(exists $archmap{$archs[-1]}) {
 201     push @archs, $archmap{$archs[-1]};
 202   }
 203 } else {
 204   @archs = split(':', $archs);
 205 }
 206 push @archs, 'noarch' unless grep {$_ eq 'noarch'} @archs;
 207
 208 unless ($dist) {
 209     $dist = 'spectool';
 210 #    $dist = `rpm -q --qf '%{DISTRIBUTION}' rpm 2>/dev/null`;
 211 #    $dist = Build::dist_canon($dist||'', $archs[0]);
 212 }
 213
 214 if($dist !~ /\// && !defined $configdir) {
 215   if($0 =~ /^\//) {
 216     use File::Basename qw/dirname/;
 217     $configdir = dirname($0).'/configs';
 218     undef $configdir unless -e $configdir.'/sl11.3.conf';
 219   } else {
 220     $configdir = $builddir.'/configs';
 221     undef $configdir unless -e $configdir.'/sl11.3.conf';
 222   }
 223   if(!defined $configdir) {
 224     print STDERR "please specify config dir\n";
 225   }
 226 }
 227
 228 #######################################################################
 229
 230 # param: array to fill, spec file
 231 # return: file name
 232 sub read_sources_digests($$)
 233 {
 234   my $files = shift;
 235   my $spec = shift;
 236   my $srcfile = 'sources';
 237   if (! -r $srcfile) {
 238     $srcfile = $spec;
 239     $srcfile =~ s/spec$/sources/;
 240   }
 241   if (open (F, '<', $srcfile)) {
 242     while(<F>) {
 243       chomp;
 244       my ($sum, $file) = split(/ +/, $_, 2);
 245       $files->{$file} = $sum;
 246     }
 247     close F;
 248   }
 249   return $srcfile;
 250 }
 251
 252 # param: file, oldsum
 253 # return: newsum or undef if match
 254 sub check_sum($$)
 255 {
 256   my $file = shift;
 257   my $oldsum = shift || 'sha1:';
 258   my $sum;
 259   my $type = 'md5:';
 260   if($oldsum =~ /^(\S+:)/) {
 261     $type = $1;
 262   } else {
 263     $oldsum = $type.$oldsum;
 264   }
 265   if ($type eq 'md5:') {
 266     $sum = $type.`md5sum $file` || die "md5sum failed\n";
 267   } elsif ($type eq 'sha1:') {
 268     $sum = $type.`sha1sum $file` || die "sha1sum failed\n";
 269   } else {
 270     die "unsupported digest type '$type'\n";
 271   }
 272   $sum =~ s/ .*//s;
 273   if($sum ne $oldsum) {
 274     return $sum;
 275   }
 276   return undef;
 277 }
 278
 279 sub download($$)
 280 {
 281   my ($url, $dest) = @_;
 282   my $retry = 3;
 283   while ($retry--) {
 284     my $res = $ua->mirror($url, $dest);
 285     last if $res->is_success;
 286     # if it's a redirect we probably got a bad mirror and should just retry
 287     return 0 unless $retry && $res->previous;
 288     warn "retrying $url\n";
 289   }
 290   return 1;
 291 }
 292
 293 #######################################################################
 294
 295 my $ret = 0;
 296 for my $spec (@specs) {
 297   my $cf = Build::read_config_dist($dist, $archs[0], $configdir);
 298   my $parsed = Build::parse($cf, $spec);
 299
 300   if (!defined $parsed) {
 301     die "can't parse $spec\n";
 302   }
 303
 304   for my $tag (@opt_showtag) {
 305     if($tag =~ /^\/(.+)\/$/) {
 306       my $expr = $1;
 307       for my $t (keys %$parsed) {
 308         if ($t =~ $expr) {
 309           push @opt_showtag, $t;
 310         }
 311       }
 312     } else {
 313       if(exists $parsed->{lc $tag}) {
 314         print $tag, ": ";
 315         my $v = $parsed->{lc $tag};
 316         $v = join(' ', @$v) if (ref $v eq 'ARRAY');
 317         print $v, "\n";
 318       } else {
 319         print STDERR "$tag does not exist\n";
 320       }
 321     }
 322   }
 323
 324   if ($opt_sources) {
 325     my $files = {};
 326     my $srcfile = read_sources_digests($files, $spec);
 327     if ($opt_download) {
 328       unless ($ua) {
 329         use LWP::UserAgent;
 330         $ua = LWP::UserAgent->new(
 331           agent => "openSUSE build service",
 332           env_proxy => 1,
 333           timeout => 42);
 334       }
 335
 336       for my $t (keys %$parsed) {
 337         next unless ($t =~ /^(?:source|patch)\d*/);
 338         my $url = $parsed->{$t};
 339         next unless $url =~ /^(?:https?|ftp):\/\//;
 340         my $file = $url;
 341         $file =~ s/.*\///;
 342         my $src = $options{'download-compare'}.$file;
 343         next if -e $src && !($options{'download-force'} || $options{'download-delete-identical'});
 344         print "Downloading $file...\n";
 345         my $dest = $options{'download-outdir'}.$file;
 346         print "$url -> $dest\n";
 347
 348         if(!download($url, $dest) && $options{'download-recompress'} ne 'no') {
 349           # TODO
 350           # let's see if the file was recompressed
 351           if($url =~ s/\.bz2$/.gz/ && $file =~ s/\.bz2$/.gz/
 352             && !download($url, $dest)) {
 353             if(system('bznew', $dest) == 0) {
 354               print STDERR "Used $file and recompressed to bz2 instead\n";
 355             } else {
 356               unlink $dest;
 357             }
 358           } else {
 359             print STDERR "Downloading $file failed\n";
 360           }
 361         }
 362         if ($options{'download-delete-identical'} && $options{'download-outdir'}
 363         && system('cmp', '-s', $dest, $src) == 0) {
 364           unlink($dest);
 365         }
 366       }
 367     }
 368     if ($opt_update) {
 369       my $changed;
 370       for my $t (keys %$parsed) {
 371         next unless ($t =~ /^(?:source|patch)\d*/);
 372         my $file = $parsed->{$t};
 373         $file =~ s/.*\///;
 374         next unless -B $file;
 375         my $sum = check_sum($file, ($files->{$file} || ($srcfile eq 'sources'?'md5:':'sha1:')));
 376         if($sum) {
 377           print STDERR "update $file\n";
 378           $files->{$file} = $sum;
 379           $changed = 1;
 380         }
 381       }
 382       if($changed) {
 383         if(open(F, '>', $srcfile)) {
 384           for my $file (keys %$files) {
 385             $files->{$file} =~ s/^md5:// if $srcfile eq 'sources';
 386             print F $files->{$file}, ' ', $file, "\n";
 387           }
 388           close F;
 389         }
 390       }
 391     } else {
 392       for my $t (keys %$parsed) {
 393         next unless ($t =~ /^(?:source|patch)\d*/);
 394         my $file = $parsed->{$t};
 395         $file =~ s/.*\///;
 396         if (!exists $files->{$file}) {
 397           if (! -e $file) {
 398             print '- ';
 399           } elsif (-B $file) {
 400             print '_ ';
 401           } else {
 402             print 't ';
 403           }
 404         } elsif (! -e $file) {
 405             print 'd ';
 406             delete $files->{$file};
 407         } else {
 408           my $sum = check_sum($file, $files->{$file});
 409           if($sum) {
 410             print '! ';
 411             $ret = 1;
 412           } else {
 413             print '. ';
 414           }
 415           delete $files->{$file};
 416         }
 417         print $parsed->{$t}, "\n";
 418       }
 419       for my $file (keys %$files) {
 420         print "? $file\n";
 421       }
 422     }
 423   }
 424 }
 425
 426 exit $ret;