|
|
@@ -0,0 +1,620 @@
|
|
|
+##
|
|
|
+## rpmx -- RPM eXtension (Perl program)
|
|
|
+## Copyright (c) 2001 Ralf S. Engelschall <rse@engelschall.com>
|
|
|
+##
|
|
|
+## list all files in the hierarchy which are not listed in RPM database
|
|
|
+## $ rpm --stowaway
|
|
|
+##
|
|
|
+## generate repository information (on server only)
|
|
|
+## $ rpm --makeindex <pkgdir>
|
|
|
+##
|
|
|
+## update local database with latest repository information
|
|
|
+## $ rpm --update
|
|
|
+##
|
|
|
+## update the package sources by downloading missing files
|
|
|
+## $ rpm --fetch <spec-file>
|
|
|
+##
|
|
|
+## query repository information
|
|
|
+## $ rpm -rqa
|
|
|
+## $ rpm -rqai
|
|
|
+## $ rpm -rqal
|
|
|
+## $ rpm -rqalv
|
|
|
+## $ rpm -rqi package
|
|
|
+## $ rpm -rql package
|
|
|
+## $ rpm -rqlv package
|
|
|
+##
|
|
|
+## update already installed packages
|
|
|
+## $ rpm -Uvhs '*'
|
|
|
+##
|
|
|
+## install/update a particular package and its dependencies
|
|
|
+## $ rpm -Uvhs file-pattern
|
|
|
+##
|
|
|
+## erase a particular package and its dependencies
|
|
|
+## $ rpm -es file-pattern
|
|
|
+##
|
|
|
+
|
|
|
+require 5.000;
|
|
|
+
|
|
|
+use IO::File;
|
|
|
+use IO::Handle;
|
|
|
+use Data::Dumper;
|
|
|
+
|
|
|
+$|++;
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Determine Configuration and Run-Time Information
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+my $CFG = {
|
|
|
+ 'PRG' => {},
|
|
|
+ 'RC' => {},
|
|
|
+ 'OPT' => [],
|
|
|
+ 'OPT_OPT' => {},
|
|
|
+ 'OPT_ARG' => {},
|
|
|
+ 'ARG' => [],
|
|
|
+};
|
|
|
+
|
|
|
+# determine path to executables
|
|
|
+my $prefix = shift(@ARGV);
|
|
|
+$CFG->{PRG}->{"rpm"} = $prefix."/bin/rpm";
|
|
|
+$CFG->{PRG}->{"curl"} = $prefix."/lib/openpkg/curl";
|
|
|
+$CFG->{PRG}->{"bzip2"} = $prefix."/lib/openpkg/bzip2";
|
|
|
+$CFG->{PRG}->{"gzip"} = $prefix."/lib/openpkg/gzip";
|
|
|
+
|
|
|
+# determine a few RPM rc-file configuration variables
|
|
|
+my $var;
|
|
|
+my $vars = '';
|
|
|
+foreach $var (qw(
|
|
|
+ _dbpath _rpmdir _srcrpmdir _tmppath
|
|
|
+ _target
|
|
|
+ l_prefix
|
|
|
+ l_repo_cache
|
|
|
+ l_repo_0 l_repo_1 l_repo_2 l_repo_3 l_repo_4
|
|
|
+ l_repo_5 l_repo_6 l_repo_7 l_repo_8 l_repo_9
|
|
|
+)) {
|
|
|
+ $vars .= "${var}=\%{${var}};";
|
|
|
+}
|
|
|
+my @assign = split(/;/, `$CFG->{PRG}->{"rpm"} --eval '$vars'`);
|
|
|
+foreach $assign (@assign) {
|
|
|
+ if ($assign =~ m|^(\S+)=(.*)$|s) {
|
|
|
+ $CFG->{RC}->{$1} = $2;
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+# parse argument line
|
|
|
+#foreach my $arg (@ARGV) {
|
|
|
+# print "<$arg>";
|
|
|
+#}
|
|
|
+#print "\n";
|
|
|
+my $op = 'pass';
|
|
|
+my $isopt = 1;
|
|
|
+my $optname = '';
|
|
|
+my $arg;
|
|
|
+foreach $arg (@ARGV) {
|
|
|
+ if ($arg =~ m/^--(stowaway|makeindex|update|fetch|repo|smart)$/) {
|
|
|
+ $op = $1;
|
|
|
+ next;
|
|
|
+ }
|
|
|
+ if ($arg eq '--') {
|
|
|
+ $isopt = 0;
|
|
|
+ next;
|
|
|
+ }
|
|
|
+ if ($isopt) {
|
|
|
+ push(@{$CFG->{OPT}}, $arg);
|
|
|
+ if ($arg =~ m|^-.|) {
|
|
|
+ $optname = $arg;
|
|
|
+ $CFG->{OPT_OPT}->{$optname} = 1;
|
|
|
+ $CFG->{OPT_ARG}->{$optname} = '--';
|
|
|
+ }
|
|
|
+ else {
|
|
|
+ $CFG->{OPT_ARG}->{$optname} = $arg;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ else {
|
|
|
+ push(@{$CFG->{ARG}}, $arg);
|
|
|
+ }
|
|
|
+}
|
|
|
+#print Data::Dumper->Dump([$CFG]);
|
|
|
+if ($op eq 'pass') {
|
|
|
+ # exec $CFG->{PRG}->{"rpm"} (@{$CFG->{OPT}}, @{$CFG->{ARG}});
|
|
|
+}
|
|
|
+else {
|
|
|
+ my $rc;
|
|
|
+ #eval "\$rc = \&op_${op}(\$CFG);";
|
|
|
+ if ($op eq 'stowaway') {
|
|
|
+ $rc = &op_stowaway($CFG);
|
|
|
+ }
|
|
|
+ elsif ($op eq 'makeindex') {
|
|
|
+ $rc = &op_makeindex($CFG);
|
|
|
+ }
|
|
|
+ elsif ($op eq 'update') {
|
|
|
+ $rc = &op_update($CFG);
|
|
|
+ }
|
|
|
+ elsif ($op eq 'fetch') {
|
|
|
+ $rc = &op_fetch($CFG);
|
|
|
+ }
|
|
|
+ elsif ($op eq 'repo') {
|
|
|
+ $rc = &op_repo($CFG);
|
|
|
+ }
|
|
|
+ elsif ($op eq 'smart') {
|
|
|
+ $rc = &op_smart($CFG);
|
|
|
+ }
|
|
|
+ exit($rc);
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Database Handling
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+# read database file from disk
|
|
|
+sub db_load {
|
|
|
+ my ($dbfile) = @_;
|
|
|
+
|
|
|
+ if (not -f $dbfile) {
|
|
|
+ my $DB = {};
|
|
|
+ return $DB;
|
|
|
+ }
|
|
|
+ my $fp = new IO::File ("<$dbfile") || die "cannot read from Database file `$dbfile'";
|
|
|
+ my $db = '';
|
|
|
+ my $buf;
|
|
|
+ $db .= $buf while ($fp->read($buf, 128*1024));
|
|
|
+ $fp->close;
|
|
|
+
|
|
|
+ my $DB = {};
|
|
|
+ $db =~ s|<rpm\s+(\S+)>\n(.+?)</rpm>|&load_rpm($DB, $2, $1), ''|isge;
|
|
|
+ sub load_rpm {
|
|
|
+ my ($DB, $db, $rpm) = @_;
|
|
|
+ $DB->{$rpm} = {};
|
|
|
+ $db =~ s/<(repos|info|files|requires)>\n(.+?)<\/\1>/$DB->{$rpm}->{uc($1)} = $2, ''/isge;
|
|
|
+ }
|
|
|
+ return $DB;
|
|
|
+}
|
|
|
+
|
|
|
+# write database file to disk
|
|
|
+sub db_store {
|
|
|
+ my ($dbfile, $DB) = @_;
|
|
|
+
|
|
|
+ my $fp = new IO::File (">$dbfile") || die "cannot store to Database file `$dbfile'";
|
|
|
+ my $rpm;
|
|
|
+ foreach $rpm (sort(keys(%{$DB}))) {
|
|
|
+ print $fp "<rpm $rpm>\n" .
|
|
|
+ "<repos>\n" .
|
|
|
+ $DB->{$rpm}->{REPOS} .
|
|
|
+ "</repos>\n" .
|
|
|
+ "<requires>\n" .
|
|
|
+ $DB->{$rpm}->{REQUIRES} .
|
|
|
+ "</requires>\n" .
|
|
|
+ "<info>\n" .
|
|
|
+ $DB->{$rpm}->{INFO} .
|
|
|
+ "</info>\n" .
|
|
|
+ "<files>\n" .
|
|
|
+ $DB->{$rpm}->{FILES} .
|
|
|
+ "</files>\n" .
|
|
|
+ "</rpm>\n";
|
|
|
+ }
|
|
|
+ $fp->close;
|
|
|
+ return;
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Fetch an URL
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+sub fetch_url {
|
|
|
+ my ($CFG, $src, $dst) = @_;
|
|
|
+
|
|
|
+ # make sure file URLs have a fully-qualified scheme.
|
|
|
+ if ($src =~ m|^/.+|) {
|
|
|
+ $src = "file://$src"
|
|
|
+ }
|
|
|
+
|
|
|
+ # make sure only schemes curl(1) supports are used.
|
|
|
+ if ($src !~ m;^(file|http|ftp)://.+;) {
|
|
|
+ return "invalid URL - only file, http and ftp schemes supported";
|
|
|
+ }
|
|
|
+
|
|
|
+ # try to fetch the URL
|
|
|
+ unlink("$dst.err");
|
|
|
+ unlink("$dst.hdr");
|
|
|
+ $rc = system($CFG->{PRG}->{"curl"}.
|
|
|
+ " --location" .
|
|
|
+ " --max-time 120" .
|
|
|
+ " --stderr $dst.err" .
|
|
|
+ " --dump-header $dst.hdr" .
|
|
|
+ " --output $dst '$src'");
|
|
|
+
|
|
|
+ # check whether command failed
|
|
|
+ if ($rc != 0) {
|
|
|
+ open(FP, "<$dst.err");
|
|
|
+ my $err = <FP>;
|
|
|
+ close(FP);
|
|
|
+ $err =~ s|\n$||;
|
|
|
+ return $err;
|
|
|
+ }
|
|
|
+
|
|
|
+ # check whether remote sites failed
|
|
|
+ if (-s "$dst.hdr") {
|
|
|
+ open(FP, "<$dst.hdr");
|
|
|
+ my $response = <FP>;
|
|
|
+ close(FP);
|
|
|
+ if ($response =~ m|^HTTP/[\d.]+\s+(\d+)|) {
|
|
|
+ if ($1 ne 200) {
|
|
|
+ $response =~ s|\n$||;
|
|
|
+ return $response;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # cleanup
|
|
|
+ unlink("$dst.err");
|
|
|
+ unlink("$dst.hdr");
|
|
|
+
|
|
|
+ return '';
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## List all files which are not known to RPM
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+sub op_stowaway {
|
|
|
+ my ($CFG) = @_;
|
|
|
+ my $file;
|
|
|
+
|
|
|
+ my $prefix = $CFG->{RC}->{"l_prefix"};
|
|
|
+ my $rpm = $CFG->{PRG}->{"rpm"};
|
|
|
+ print "OpenPKG Hierarchy $prefix\n";
|
|
|
+ my @known = `$rpm -qla`;
|
|
|
+ my %known = ();
|
|
|
+ foreach $file (@known) {
|
|
|
+ $file =~ s|\n$||s;
|
|
|
+ $known{$file} = 1;
|
|
|
+ }
|
|
|
+ my @exist = `cd $prefix && find . -print 2>/dev/null`;
|
|
|
+ foreach $file (sort(@exist)) {
|
|
|
+ $file =~ s|^\./|$prefix/|s;
|
|
|
+ $file =~ s|\n$||s;
|
|
|
+ next if ($file eq '.');
|
|
|
+ if (not $known{$file}) {
|
|
|
+ next if ($file =~ m|^$prefix/RPM/?|);
|
|
|
+ print "$file\n";
|
|
|
+ }
|
|
|
+ }
|
|
|
+ return 0;
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Generate Repository Index
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+sub op_makeindex {
|
|
|
+ my ($CFG) = @_;
|
|
|
+
|
|
|
+ if ($#{$CFG->{ARG}} ne 0) {
|
|
|
+ print STDERR "rpm: option --makeindex requires an argument\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my $dir = $CFG->{ARG}->[0];
|
|
|
+ if (not -d $dir) {
|
|
|
+ print STDERR "rpm: --makeindex argument `$dir' is not a directory\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my $index = '';
|
|
|
+ my $file;
|
|
|
+ my $rpm = $CFG->{PRG}->{"rpm"};
|
|
|
+ foreach $file (sort(glob("$dir/*.rpm"))) {
|
|
|
+ $file =~ s|^$dir/*||;
|
|
|
+ $index .= "<rpm $file>\n";
|
|
|
+ $index .= "<requires>\n";
|
|
|
+ $index .= `$rpm -qp --qf '[%{REQUIRENAME} %{REQUIREFLAGS:depflags} %{REQUIREVERSION}\n]' $dir/$file`;
|
|
|
+ $index .= "</requires>\n";
|
|
|
+ $index .= "<info>\n";
|
|
|
+ $index .= `$rpm -qpi $dir/$file`;
|
|
|
+ $index .= "</info>\n";
|
|
|
+ $index .= "<files>\n";
|
|
|
+ $index .= `$rpm -qplv $dir/$file`;
|
|
|
+ $index .= "</files>\n";
|
|
|
+ $index .= "</rpm>\n";
|
|
|
+ }
|
|
|
+ open(FP, "|".$CFG->{PRG}->{"bzip2"}.">$dir/INDEX.bz2");
|
|
|
+ print FP $index;
|
|
|
+ close(FP);
|
|
|
+ return 0;
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Fetch Repository Indices
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+sub op_update {
|
|
|
+ my ($CFG) = @_;
|
|
|
+
|
|
|
+ my $DB = {};
|
|
|
+ my $tmpfile = $CFG->{RC}->{_tmppath}."/rpm.update.tmp.".$$;
|
|
|
+
|
|
|
+ for ($i = 9; $i >= 0; $i--) {
|
|
|
+ my $repo = $CFG->{RC}->{"l_repo_$i"};
|
|
|
+ next if (not defined($repo) or $repo eq '' or $repo eq '-');
|
|
|
+ $repo =~ s|([^/])$|$1/|;
|
|
|
+
|
|
|
+ my $src = $repo."INDEX.bz2";
|
|
|
+
|
|
|
+ my $prefix = $src;
|
|
|
+ $prefix = substr($prefix, 0, 37)."..." if (length($prefix) > 40);
|
|
|
+ printf(STDOUT "%-40s ", $prefix);
|
|
|
+
|
|
|
+ if (($err = &fetch_url($CFG, $src, $tmpfile))) {
|
|
|
+ $err = substr($err, 0, 37)."..." if (length($err) > 40);
|
|
|
+ print STDOUT "FAILED: $err\n";
|
|
|
+ next;
|
|
|
+ }
|
|
|
+
|
|
|
+ my $size = (stat($tmpfile))[7];
|
|
|
+ print STDOUT "OK: $size bytes\n";
|
|
|
+
|
|
|
+ my $fh = new IO::Handle;
|
|
|
+ open($fh, $CFG->{PRG}->{"bzip2"}." -d -c $tmpfile|");
|
|
|
+ my $db = '';
|
|
|
+ my $buf;
|
|
|
+ $db .= $buf while ($fh->read($buf, 128*1024));
|
|
|
+ $fh->close;
|
|
|
+
|
|
|
+ unlink($tmpfile);
|
|
|
+
|
|
|
+ $db =~ s|<rpm\s+(\S+)>\n(.+?)</rpm>|&load_rpm2($DB, $repo, $2, $1), ''|isge;
|
|
|
+ sub load_rpm2 {
|
|
|
+ my ($DB, $repo, $db, $rpm) = @_;
|
|
|
+ my $target = $CFG->{RC}->{_target};
|
|
|
+ return if ($rpm !~ m|\.src\.rpm$| and $rpm !~ m|\.$target\.rpm$|);
|
|
|
+ my $repos = '';
|
|
|
+ if (defined($DB->{$rpm})) {
|
|
|
+ $repos = $DB->{$rpm}->{REPOS};
|
|
|
+ }
|
|
|
+ $repos = $repo."\n".$repos;
|
|
|
+ $DB->{$rpm} = {};
|
|
|
+ $DB->{$rpm}->{REPOS} = $repos;
|
|
|
+ $db =~ s/<(info|files|requires)>\n(.+?)<\/\1>/$DB->{$rpm}->{uc($1)} = $2, ''/isge;
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ my $dbfile = $CFG->{RC}->{_dbpath}."/Repository";
|
|
|
+ &db_store($dbfile, $DB);
|
|
|
+
|
|
|
+ return 0;
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Repository Queries
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+sub op_repo {
|
|
|
+ my ($CFG) = @_;
|
|
|
+
|
|
|
+ # argument line consistency check
|
|
|
+ if (not defined($CFG->{OPT_OPT}->{"-q"})) {
|
|
|
+ print STDERR "rpm: option --repo always requires option -q\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my @optok = (qw(--rcfile -q --all -i --list --verbose));
|
|
|
+ my $opt;
|
|
|
+ my $check;
|
|
|
+ foreach $opt (keys(%{$CFG->{OPT_OPT}})) {
|
|
|
+ my $ok = 0;
|
|
|
+ foreach $check (@optok) {
|
|
|
+ if ($check eq $opt) {
|
|
|
+ $ok = 1;
|
|
|
+ last;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ if (not $ok) {
|
|
|
+ print STDERR "rpm: option $opt not supported in conjunction with option --repo\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # load database
|
|
|
+ my $dbfile = $CFG->{RC}->{_dbpath}."/Repository";
|
|
|
+ if (not -f $dbfile) {
|
|
|
+ print STDERR "rpm: option --repo requires local repository index.\n";
|
|
|
+ print STDERR "rpm: run \"rpm --update\", first.\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my $DB = &db_load($dbfile);
|
|
|
+
|
|
|
+ # perform query operation
|
|
|
+ my $target = $CFG->{RC}->{_target};
|
|
|
+ my $rpm;
|
|
|
+ my $rpms = {};
|
|
|
+ foreach $rpm (sort(keys(%{$DB}))) {
|
|
|
+ my $name = $rpm;
|
|
|
+ $name =~ s|\.src\.rpm$||;
|
|
|
+ $name =~ s|\.${target}\.rpm$||;
|
|
|
+ next if (defined($rpms->{$name}));
|
|
|
+ $rpms->{$name} = 1;
|
|
|
+ if ((defined($CFG->{ARG}->[0]) and $rpm =~ m|^$CFG->{ARG}->[0]|)
|
|
|
+ or defined($CFG->{OPT_OPT}->{"--all"})) {
|
|
|
+ if (not defined($CFG->{OPT_OPT}->{"--list"}) and not defined($CFG->{OPT_OPT}->{"-i"})) {
|
|
|
+ print "$name\n";
|
|
|
+ }
|
|
|
+ if (defined($CFG->{OPT_OPT}->{"-i"})) {
|
|
|
+ print $DB->{$rpm}->{INFO};
|
|
|
+ }
|
|
|
+ if (defined($CFG->{OPT_OPT}->{"--list"})) {
|
|
|
+ my $files = $DB->{$rpm}->{FILES};
|
|
|
+ if (not defined($CFG->{OPT_OPT}->{"--verbose"})) {
|
|
|
+ if (not ($files =~ s|^.*\s+(\S+\s+->\s+\S+)\s*$|$1|mg)) {
|
|
|
+ $files =~ s|^.*\s+(\S+)\s*$|$1|mg;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ print "$files";
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Fetch Operation
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+sub op_fetch {
|
|
|
+ my ($CFG) = @_;
|
|
|
+
|
|
|
+ if ($#{$CFG->{ARG}} ne 0) {
|
|
|
+ print STDERR "rpm: option --fetch requires an argument\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my $spec = $CFG->{ARG}->[0];
|
|
|
+ if (not -f $spec) {
|
|
|
+ print STDERR "rpm: spec file `$spec' not found\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+
|
|
|
+ # determine package name and source directory
|
|
|
+ my $name = $spec;
|
|
|
+ $name =~ s|\.[^.]+$||;
|
|
|
+ $name =~ s|^.+/([^/]+)$|$1|;
|
|
|
+ my $srcdir = `$CFG->{PRG}->{"rpm"} --define 'name $name' --eval '%_sourcedir'`;
|
|
|
+ $srcdir =~ s|\n+$||s;
|
|
|
+
|
|
|
+ # parse spec file
|
|
|
+ my $DEF = {};
|
|
|
+ my $SRC = {};
|
|
|
+ open(SPEC, "<$spec");
|
|
|
+ while (<SPEC>) {
|
|
|
+ s|\n+$||s;
|
|
|
+ if (m/^([a-zA-Z_][a-zA-Z0-9_]*):\s*(.+?)\s*$/) {
|
|
|
+ $DEF->{lc($1)} = $2;
|
|
|
+ }
|
|
|
+ if (m/^%define\s+([a-zA-Z_][a-zA-Z0-9_]*)\s+(.+?)\s*$/) {
|
|
|
+ $DEF->{lc($1)} = $2;
|
|
|
+ }
|
|
|
+ if (m/^((Source|Patch)[0-9]+?):\s*(.+)\s*$/i) {
|
|
|
+ my ($srcid, $srcurl) = ($1, $3);
|
|
|
+ 1 while ($srcurl =~ s|%{?([a-zA-Z_][a-zA-Z0-9_]*)}?|$DEF->{lc($1)}|sge);
|
|
|
+ my $srcfile = $srcurl;
|
|
|
+ $srcfile =~ s|^.*/([^/]+)$|$1|;
|
|
|
+ my $file = $srcfile;
|
|
|
+ $file = substr($file, 0, 40) if (length($file) > 40);
|
|
|
+ printf(STDERR "%-9s %-40s ", "$srcid:", $file);
|
|
|
+ if (-f "$srcdir/$srcfile") {
|
|
|
+ my $size = (stat("$srcdir/$srcfile"))[7];
|
|
|
+ if ($size > 1024*1024) {
|
|
|
+ $size = sprintf("%.1fMB", $size / (1024*1024));
|
|
|
+ }
|
|
|
+ elsif ($size > 1024) {
|
|
|
+ $size = sprintf("%.0fKB", $size / 1024);
|
|
|
+ }
|
|
|
+ else {
|
|
|
+ $size = sprintf("%d", $size);
|
|
|
+ }
|
|
|
+ print STDERR "...OK [$size]\n";
|
|
|
+ }
|
|
|
+ else {
|
|
|
+ print STDERR "...MISSING\n";
|
|
|
+ print STDERR "rpm: Fetching $srcurl\n";
|
|
|
+ my $cmd = $CFG->{PRG}->{"curl"}.
|
|
|
+ " --location" .
|
|
|
+ " --output $srcdir/$srcfile" .
|
|
|
+ " $srcurl";
|
|
|
+ my $rc = system($cmd);
|
|
|
+ if ($rc != 0) {
|
|
|
+ print STDERR "rpm: Failed to fetch source file `$srcfile'\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ close(SPEC);
|
|
|
+
|
|
|
+ return 0;
|
|
|
+}
|
|
|
+
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+## Smart Operations
|
|
|
+## ______________________________________________________________________
|
|
|
+##
|
|
|
+
|
|
|
+sub op_smart {
|
|
|
+ my ($CFG) = @_;
|
|
|
+
|
|
|
+ if ($#{$CFG->{ARG}} ne 0) {
|
|
|
+ print STDERR "rpm: option --smart requires one argument\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my $package = $CFG->{ARG}->[0];
|
|
|
+
|
|
|
+ # load database
|
|
|
+ my $dbfile = $CFG->{RC}->{_dbpath}."/Repository";
|
|
|
+ if (not -f $dbfile) {
|
|
|
+ print STDERR "rpm: option --smart requires local repository index.\n";
|
|
|
+ print STDERR "rpm: run \"rpm --update\", first.\n";
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my $DB = &db_load($dbfile);
|
|
|
+
|
|
|
+ my $deps = [];
|
|
|
+ &find_deps($CFG, $DB, $deps, $package, '=', 'ANY');
|
|
|
+ sub find_deps {
|
|
|
+ my ($CFG, $DB, $deps, $pkg, $op, $ver) = @_;
|
|
|
+ push(@{$deps}, "$pkg $op $ver");
|
|
|
+ my $rpm;
|
|
|
+ foreach $rpm (keys(%{$DB})) {
|
|
|
+ if (&match_rpm($CFG, $rpm, $pkg, $op, $ver)) {
|
|
|
+ my $req;
|
|
|
+ foreach $req (split(/\n/, $DB->{$rpm}->{REQUIRES})) {
|
|
|
+ $req =~ s|^\s+||sg;
|
|
|
+ $req =~ s|\s+$||sg;
|
|
|
+ if ($req =~ m|^OpenPKG$| or
|
|
|
+ $req =~ m|^rpmlib\(.+\)|) {
|
|
|
+ next;
|
|
|
+ }
|
|
|
+ if ($req =~ m|^(\S+)$|) {
|
|
|
+ $req .= " = ANY";
|
|
|
+ }
|
|
|
+ if ($req =~ m|^(\S+)\s+([=><]+)\s+(\S+)$|) {
|
|
|
+ &find_deps($CFG, $DB, $deps, $1, $2, $3);
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ sub match_rpm {
|
|
|
+ my ($CFG, $rpm, $name, $op, $ver) = @_;
|
|
|
+ my $rc = 0;
|
|
|
+ my $target = $CFG->{RC}->{_target};
|
|
|
+ $rpm =~ s|\.src\.rpm$||;
|
|
|
+ $rpm =~ s|\.${target}\.rpm$||;
|
|
|
+ if ($rpm =~ m|^(\S+)-([^-]+-[^-]+)$|) {
|
|
|
+ my ($tname, $tver) = ($1, $2);
|
|
|
+ if ($name eq $tname and &match_version($ver, $op, $tver)) {
|
|
|
+ $rc = 1;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ return $rc;
|
|
|
+ }
|
|
|
+ sub match_version {
|
|
|
+ my ($ver, $op, $tver) = @_;
|
|
|
+ return 1;
|
|
|
+ }
|
|
|
+ my $dep;
|
|
|
+ foreach $dep (@{$deps}) {
|
|
|
+ print "$dep\n";
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
