summaryrefslogtreecommitdiff
path: root/spectool
diff options
context:
space:
mode:
Diffstat (limited to 'spectool')
-rwxr-xr-xspectool426
1 files changed, 0 insertions, 426 deletions
diff --git a/spectool b/spectool
deleted file mode 100755
index bdb897c..0000000
--- a/spectool
+++ /dev/null
@@ -1,426 +0,0 @@
-#!/usr/bin/perl -w
-
-################################################################
-#
-# Copyright (c) 1995-2014 SUSE Linux Products GmbH
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2 or 3 as
-# published by the Free Software Foundation.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program (see the file COPYING); if not, write to the
-# Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-################################################################
-
-=head1 spectool
-
-spectool - tool to work with rpm spec files
-
-=head1 SYNOPSIS
-
-spectool [options] specfiles...
-
-=head1 OPTIONS
-
-=over 4
-
-=item B<--help>
-
-display help as manpage
-
-=item B<--dist>=I<STRING>
-
-set distribution, e.g. "11.1-i586" or path to config
-
-=item B<--archpath>=I<STRING>
-
-compatible architecture separated by colon, e.g. C<i586:i486:i386>.
-Autotected if missing.
-
-=item B<--configdir>=I<STRING>
-
-path to config files if B<--dist> didn't specify a full path
-
-=item B<--define>=I<STRING>
-
-=item B<--with>=I<STRING>
-
-=item B<--without>=I<STRING>
-
-same meaning as in rpmbuild
-
-=item B<--tag>=I<STRING>
-
-print tag from spec file, e.g. C<version>. Regexp is also possible,
-e.g. C</source[01]/>
-
-=item B<--sources>
-
-print package source files. If a file C<sources> or
-C<I<packagename>.sources> is present verify the checksums against
-that.
-
-=over 4
-
-=item B<--update>
-
-update the checksums
-
-=item B<--download>
-
-download missing sources
-
-=back
-
-=back
-
-=head1 DESCRIPTION
-
-The B<--sources> option allows to manage a sources file in a way
-similar to Fedora. The sources file lists the check sums and file
-names of the binary files specified in the spec file.
-
-B<--sources> without further options compares the check sums of all
-files and prints a report consisting of a character that describes
-the status of the file and the file name. Meaning of the characters
-is as follows:
-
-=over 4
-
-=item B<.> check sum matches
-
-=item B<!> check sum broken
-
-=item B<d> file is missing, checksum known. Can be verified after download
-
-=item B<-> file is missing and checksum unknown
-
-=item B<_> file is present but checksum unknown
-
-=item B<t> text file, will be skipped for check sums
-
-=item B<?> check sum known but not referenced from spec file
-
-=back
-
-Additionally specifying B<--update> recomputes all check sums and
-updates the sources file.
-
-With B<--download> all missing files are downloaded if the spec file
-has an http or ftp url.
-
-=head2 FORMAT OF THE SOURCES FILE
-
-Lines of the form
-<checksum> <whitespace> <filename>
-
-=head2 NAME OF THE SOURCES FILE
-
-A file named C<sources> is preferred if present for compatibility
-with Fedora. It only contains md5 sums. If that file is not present
-the C<.spec> suffix of the spec file is replaced with C<.sources>
-and the this name used as sources file (e.g. C<foo.spec> ->
-C<foo.sources>). In this file sha1 is preferred. Also, the name of
-the algorithm is prepended with colon to the check sum.
-
-=cut
-
-my $builddir;
-
-BEGIN {
- $builddir = ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
- unshift @INC, $builddir;
-}
-
-use strict;
-
-use Build;
-use Pod::Usage;
-use Getopt::Long;
-Getopt::Long::Configure("no_ignore_case");
-
-my (@opt_showtag, $opt_sources, $opt_update, $opt_download);
-
-sub parse_depfile;
-
-my ($dist, $rpmdeps, $archs, $configdir, $useusedforbuild);
-my %options;
-
-GetOptions (
- \%options,
- "help" => sub { pod2usage(-exitstatus => 0, -verbose => 2) },
-
- "dist=s" => \$dist,
- "archpath=s" => \$archs,
- "configdir=s" => \$configdir,
- "define=s" => sub { Build::define($_[1]) },
- "with=s" => sub { Build::define("_with_".$_[1]." --with-".$_[1]) },
- "without=s" => sub { Build::define("_without_".$_[1]." --without-".$_[1]) },
-
- "tag=s" => \@opt_showtag,
- "sources" => \$opt_sources,
- "update" => \$opt_update,
- "download" => \$opt_download,
- "download-force",
- "download-recompress=s",
- "download-outdir=s",
- "download-compare=s",
- "download-delete-identical",
-) or pod2usage(1);
-
-pod2usage(1) unless @ARGV;
-
-my $ua;
-
-my @specs = @ARGV;
-
-die "--download must be used together with --sources\n" if ($opt_download && !$opt_sources);
-die "--update must be used together with --sources\n" if ($opt_update && !$opt_sources);
-
-$options{'download-recompress'} ||= 'auto';
-$options{'download-outdir'}.='/' if ($options{'download-outdir'} && $options{'download-outdir'} !~ /\/$/);
-$options{'download-outdir'} ||= '';
-$options{'download-compare'}.='/' if ($options{'download-compare'} && $options{'download-compare'} !~ /\/$/);
-$options{'download-compare'} ||= '';
-
-my @archs;
-if (!defined $archs) {
- use POSIX qw/uname/;
- my %archmap = qw/x86_64 i686 i686 i586 i586 i486 i486 i386/;
- my @a = uname();
- push @archs, $a[4];
- while(exists $archmap{$archs[-1]}) {
- push @archs, $archmap{$archs[-1]};
- }
-} else {
- @archs = split(':', $archs);
-}
-push @archs, 'noarch' unless grep {$_ eq 'noarch'} @archs;
-
-unless ($dist) {
- $dist = 'spectool';
-# $dist = `rpm -q --qf '%{DISTRIBUTION}' rpm 2>/dev/null`;
-# $dist = Build::dist_canon($dist||'', $archs[0]);
-}
-
-if($dist !~ /\// && !defined $configdir) {
- if($0 =~ /^\//) {
- use File::Basename qw/dirname/;
- $configdir = dirname($0).'/configs';
- undef $configdir unless -e $configdir.'/sl11.3.conf';
- } else {
- $configdir = $builddir.'/configs';
- undef $configdir unless -e $configdir.'/sl11.3.conf';
- }
- if(!defined $configdir) {
- print STDERR "please specify config dir\n";
- }
-}
-
-#######################################################################
-
-# param: array to fill, spec file
-# return: file name
-sub read_sources_digests($$)
-{
- my $files = shift;
- my $spec = shift;
- my $srcfile = 'sources';
- if (! -r $srcfile) {
- $srcfile = $spec;
- $srcfile =~ s/spec$/sources/;
- }
- if (open (F, '<', $srcfile)) {
- while(<F>) {
- chomp;
- my ($sum, $file) = split(/ +/, $_, 2);
- $files->{$file} = $sum;
- }
- close F;
- }
- return $srcfile;
-}
-
-# param: file, oldsum
-# return: newsum or undef if match
-sub check_sum($$)
-{
- my $file = shift;
- my $oldsum = shift || 'sha1:';
- my $sum;
- my $type = 'md5:';
- if($oldsum =~ /^(\S+:)/) {
- $type = $1;
- } else {
- $oldsum = $type.$oldsum;
- }
- if ($type eq 'md5:') {
- $sum = $type.`md5sum $file` || die "md5sum failed\n";
- } elsif ($type eq 'sha1:') {
- $sum = $type.`sha1sum $file` || die "sha1sum failed\n";
- } else {
- die "unsupported digest type '$type'\n";
- }
- $sum =~ s/ .*//s;
- if($sum ne $oldsum) {
- return $sum;
- }
- return undef;
-}
-
-sub download($$)
-{
- my ($url, $dest) = @_;
- my $retry = 3;
- while ($retry--) {
- my $res = $ua->mirror($url, $dest);
- last if $res->is_success;
- # if it's a redirect we probably got a bad mirror and should just retry
- return 0 unless $retry && $res->previous;
- warn "retrying $url\n";
- }
- return 1;
-}
-
-#######################################################################
-
-my $ret = 0;
-for my $spec (@specs) {
- my $cf = Build::read_config_dist($dist, $archs[0], $configdir);
- my $parsed = Build::parse($cf, $spec);
-
- if (!defined $parsed) {
- die "can't parse $spec\n";
- }
-
- for my $tag (@opt_showtag) {
- if($tag =~ /^\/(.+)\/$/) {
- my $expr = $1;
- for my $t (keys %$parsed) {
- if ($t =~ $expr) {
- push @opt_showtag, $t;
- }
- }
- } else {
- if(exists $parsed->{lc $tag}) {
- print $tag, ": ";
- my $v = $parsed->{lc $tag};
- $v = join(' ', @$v) if (ref $v eq 'ARRAY');
- print $v, "\n";
- } else {
- print STDERR "$tag does not exist\n";
- }
- }
- }
-
- if ($opt_sources) {
- my $files = {};
- my $srcfile = read_sources_digests($files, $spec);
- if ($opt_download) {
- unless ($ua) {
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new(
- agent => "openSUSE build service",
- env_proxy => 1,
- timeout => 42);
- }
-
- for my $t (keys %$parsed) {
- next unless ($t =~ /^(?:source|patch)\d*/);
- my $url = $parsed->{$t};
- next unless $url =~ /^(?:https?|ftp):\/\//;
- my $file = $url;
- $file =~ s/.*\///;
- my $src = $options{'download-compare'}.$file;
- next if -e $src && !($options{'download-force'} || $options{'download-delete-identical'});
- print "Downloading $file...\n";
- my $dest = $options{'download-outdir'}.$file;
- print "$url -> $dest\n";
-
- if(!download($url, $dest) && $options{'download-recompress'} ne 'no') {
- # TODO
- # let's see if the file was recompressed
- if($url =~ s/\.bz2$/.gz/ && $file =~ s/\.bz2$/.gz/
- && !download($url, $dest)) {
- if(system('bznew', $dest) == 0) {
- print STDERR "Used $file and recompressed to bz2 instead\n";
- } else {
- unlink $dest;
- }
- } else {
- print STDERR "Downloading $file failed\n";
- }
- }
- if ($options{'download-delete-identical'} && $options{'download-outdir'}
- && system('cmp', '-s', $dest, $src) == 0) {
- unlink($dest);
- }
- }
- }
- if ($opt_update) {
- my $changed;
- for my $t (keys %$parsed) {
- next unless ($t =~ /^(?:source|patch)\d*/);
- my $file = $parsed->{$t};
- $file =~ s/.*\///;
- next unless -B $file;
- my $sum = check_sum($file, ($files->{$file} || ($srcfile eq 'sources'?'md5:':'sha1:')));
- if($sum) {
- print STDERR "update $file\n";
- $files->{$file} = $sum;
- $changed = 1;
- }
- }
- if($changed) {
- if(open(F, '>', $srcfile)) {
- for my $file (keys %$files) {
- $files->{$file} =~ s/^md5:// if $srcfile eq 'sources';
- print F $files->{$file}, ' ', $file, "\n";
- }
- close F;
- }
- }
- } else {
- for my $t (keys %$parsed) {
- next unless ($t =~ /^(?:source|patch)\d*/);
- my $file = $parsed->{$t};
- $file =~ s/.*\///;
- if (!exists $files->{$file}) {
- if (! -e $file) {
- print '- ';
- } elsif (-B $file) {
- print '_ ';
- } else {
- print 't ';
- }
- } elsif (! -e $file) {
- print 'd ';
- delete $files->{$file};
- } else {
- my $sum = check_sum($file, $files->{$file});
- if($sum) {
- print '! ';
- $ret = 1;
- } else {
- print '. ';
- }
- delete $files->{$file};
- }
- print $parsed->{$t}, "\n";
- }
- for my $file (keys %$files) {
- print "? $file\n";
- }
- }
- }
-}
-
-exit $ret;