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
 136 GetOptions (
 137   "help" => sub { pod2usage(-exitstatus => 0, -verbose => 2) },
 138
 139   "dist=s" => \$dist,
 140   "archpath=s" => \$archs,
 141   "configdir=s" => \$configdir,
 142   "define=s" => sub { Build::define($_[1]) },
 143   "with=s" => sub { Build::define("_with_".$_[1]." --with-".$_[1]) },
 144   "without=s" => sub { Build::define("_without_".$_[1]." --without-".$_[1]) },
 145
 146   "tag=s" => \@opt_showtag,
 147   "sources" => \$opt_sources,
 148   "update" => \$opt_update,
 149   "download" => \$opt_download,
 150 ) or pod2usage(1);
 151
 152 pod2usage(1) unless @ARGV;
 153
 154 my @specs = @ARGV;
 155
 156 die "--download must be used together with --sources\n" if ($opt_download && !$opt_sources);
 157 die "--update must be used together with --sources\n" if ($opt_update && !$opt_sources);
 158
 159 my @archs;
 160 if (!defined $archs) {
 161   use POSIX qw/uname/;
 162   my %archmap = qw/x86_64 i686 i686 i586 i586 i486 i486 i386/;
 163   my @a = uname();
 164   push @archs, $a[4];
 165   while(exists $archmap{$archs[-1]}) {
 166     push @archs, $archmap{$archs[-1]};
 167   }
 168 } else {
 169   @archs = split(':', $archs);
 170 }
 171 push @archs, 'noarch' unless grep {$_ eq 'noarch'} @archs;
 172
 173 unless ($dist) {
 174     $dist = `rpm -q --qf '%{DISTRIBUTION}' rpm 2>/dev/null`;
 175     $dist = Build::dist_canon($dist||'', $archs[0]);
 176 }
 177
 178 if($dist !~ /\// && !defined $configdir) {
 179   if($0 =~ /^\//) {
 180     use File::Basename qw/dirname/;
 181     $configdir = dirname($0).'/configs';
 182     undef $configdir unless -e $configdir.'/sl11.3.conf';
 183   } else {
 184     $configdir = $builddir.'/configs';
 185     undef $configdir unless -e $configdir.'/sl11.3.conf';
 186   }
 187   if(!defined $configdir) {
 188     print STDERR "please specify config dir\n";
 189   }
 190 }
 191
 192 #######################################################################
 193
 194 # param: array to fill, spec file
 195 # return: file name
 196 sub read_sources_digests($$)
 197 {
 198   my $files = shift;
 199   my $spec = shift;
 200   my $srcfile = 'sources';
 201   if (! -r $srcfile) {
 202     $srcfile = $spec;
 203     $srcfile =~ s/spec$/sources/;
 204   }
 205   if (open (F, '<', $srcfile)) {
 206     while(<F>) {
 207       chomp;
 208       my ($sum, $file) = split(/ +/, $_, 2);
 209       $files->{$file} = $sum;
 210     }
 211     close F;
 212   }
 213   return $srcfile;
 214 }
 215
 216 # param: file, oldsum
 217 # return: newsum or undef if match
 218 sub check_sum($$)
 219 {
 220   my $file = shift;
 221   my $oldsum = shift || 'sha1:';
 222   my $sum;
 223   my $type = 'md5:';
 224   if($oldsum =~ /^(\S+:)/) {
 225     $type = $1;
 226   } else {
 227     $oldsum = $type.$oldsum;
 228   }
 229   if ($type eq 'md5:') {
 230     $sum = $type.`md5sum $file` || die "md5sum failed\n";
 231   } elsif ($type eq 'sha1:') {
 232     $sum = $type.`sha1sum $file` || die "sha1sum failed\n";
 233   } else {
 234     die "unsupported digest type '$type'\n";
 235   }
 236   $sum =~ s/ .*//s;
 237   if($sum ne $oldsum) {
 238     return $sum;
 239   }
 240   return undef;
 241 }
 242
 243 #######################################################################
 244
 245 for my $spec (@specs) {
 246   my $cf = Build::read_config_dist($dist, $archs[0], $configdir);
 247   my $parsed = Build::parse($cf, $spec);
 248
 249   if (!defined $parsed) {
 250     die "can't parse $spec\n";
 251   }
 252
 253   for my $tag (@opt_showtag) {
 254     if($tag =~ /^\/(.+)\/$/) {
 255       my $expr = $1;
 256       for my $t (keys %$parsed) {
 257         if ($t =~ $expr) {
 258           push @opt_showtag, $t;
 259         }
 260       }
 261     } else {
 262       if(exists $parsed->{lc $tag}) {
 263         print $tag, ": ";
 264         my $v = $parsed->{lc $tag};
 265         $v = join(' ', @$v) if (ref $v eq 'ARRAY');
 266         print $v, "\n";
 267       } else {
 268         print STDERR "$tag does not exist\n";
 269       }
 270     }
 271   }
 272
 273   if ($opt_sources) {
 274     my $files = {};
 275     my $srcfile = read_sources_digests($files, $spec);
 276     if ($opt_download) {
 277       for my $t (keys %$parsed) {
 278         next unless ($t =~ /^(?:source|patch)\d*/);
 279         my $url = $parsed->{$t};
 280         next unless $url =~ /^(?:https?|ftp):\/\//;
 281         my $file = $url;
 282         $file =~ s/.*\///;
 283         next if -e $file;
 284         print "Downloading $file...\n";
 285         if(system('curl', '-f', '-L', '-#', '-o', $file, $url) != 0) {
 286           # let's see if the file was recompressed
 287           if($url =~ s/\.bz2$/.gz/ && $file =~ s/\.bz2$/.gz/
 288             && system('curl', '-f', '-L', '-#', '-o', $file, $url) == 0) {
 289             if(system('bznew', $file) == 0) {
 290               print STDERR "Used $file and recompressed to bz2 instead\n";
 291             } else {
 292               unlink $file;
 293             }
 294           } else {
 295             print STDERR "Downloading $file failed\n";
 296           }
 297         }
 298       }
 299     }
 300     if ($opt_update) {
 301       my $changed;
 302       for my $t (keys %$parsed) {
 303         next unless ($t =~ /^(?:source|patch)\d*/);
 304         my $file = $parsed->{$t};
 305         $file =~ s/.*\///;
 306         next unless -B $file;
 307         my $sum = check_sum($file, ($files->{$file} || ($srcfile eq 'sources'?'md5:':'sha1:')));
 308         if($sum) {
 309           print STDERR "update $file\n";
 310           $files->{$file} = $sum;
 311           $changed = 1;
 312         }
 313       }
 314       if($changed) {
 315         if(open(F, '>', $srcfile)) {
 316           for my $file (keys %$files) {
 317             $files->{$file} =~ s/^md5:// if $srcfile eq 'sources';
 318             print F $files->{$file}, ' ', $file, "\n";
 319           }
 320           close F;
 321         }
 322       }
 323     } else {
 324       for my $t (keys %$parsed) {
 325         next unless ($t =~ /^(?:source|patch)\d*/);
 326         my $file = $parsed->{$t};
 327         $file =~ s/.*\///;
 328         if (!exists $files->{$file}) {
 329           if (! -e $file) {
 330             print '- ';
 331           } elsif (-B $file) {
 332             print '_ ';
 333           } else {
 334             print 't ';
 335           }
 336         } elsif (! -e $file) {
 337             print 'd ';
 338             delete $files->{$file};
 339         } else {
 340           my $sum = check_sum($file, $files->{$file});
 341           if($sum) {
 342             print '! ';
 343           } else {
 344             print '. ';
 345           }
 346           delete $files->{$file};
 347         }
 348         print $parsed->{$t}, "\n";
 349       }
 350       for my $file (keys %$files) {
 351         print "? $file\n";
 352       }
 353     }
 354   }
 355 }