spectool

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