examples/p5solv

   1 #!/usr/bin/perl
   2
   3 use POSIX;
   4 use Config::IniFiles;
   5 use File::FnMatch;
   6 use Data::Dumper;
   7 use solv;
   8 use strict;
   9
  10 package Repo::generic;
  11
  12 sub new {
  13   my ($class, $attr) = @_;
  14   my $r = { %$attr };
  15   return bless $r, $class;
  16 }
  17
  18 sub cachepath {
  19   my ($self, $ext) = @_;
  20   my $path = $self->{'alias'};
  21   $path =~ s/^\./_/s;
  22   $path .= $ext ? "_$ext.solvx" : '.solv';
  23   $path =~ s/\//_/gs;
  24   return "/var/cache/solv/$path";
  25 }
  26
  27 sub load {
  28   my ($self, $pool) = @_;
  29   $self->{'handle'} = $pool->add_repo($self->{'alias'});
  30   $self->{'handle'}->{'appdata'} = $self;
  31   $self->{'handle'}->{'priority'} = 99 - $self->{'priority'};
  32   $self->{'cookie'} = '';
  33   $self->usecachedrepo();
  34 }
  35
  36 sub usecachedrepo {
  37   my ($self, $ext, $mark) = @_;
  38   my $cookie = $ext ? $self->{'extcookie'} : $self->{'cookie'};
  39   my $handle = $self->{'handle'};
  40   my $cachepath = $self->cachepath();
  41   if (sysopen(my $f, $cachepath, POSIX::O_RDONLY)) {
  42     $f = solv::xfopen_fd('', POSIX::dup(fileno($f)));
  43     my $flags = $ext ? $solv::Repo::REPO_USE_LOADING|$solv::Repo::REPO_EXTEND_SOLVABLES : 0;
  44     $flags |= $solv::Repo::REPO_LOCALPOOL if $ext && $ext ne 'DL';
  45     if (!$self->{'handle'}->add_solv($f, $flags)) {
  46       solv::xfclose($f);
  47       return undef;
  48     }
  49     return 1;
  50   }
  51   return undef;
  52 }
  53
  54 package Repo::rpmmd;
  55
  56 our @ISA = ('Repo::generic');
  57
  58 package Repo::system;
  59
  60 our @ISA = ('Repo::generic');
  61
  62 sub calc_cookie_file {
  63   my ($self, $filename) = @_;
  64   my $chksum = solv::Chksum->new($solv::REPOKEY_TYPE_SHA256);
  65   $chksum->add("1.1");
  66   $chksum->add_stat($filename);
  67   return $chksum->raw();
  68 }
  69
  70 sub load {
  71   my ($self, $pool) = @_;
  72
  73   $self->{'handle'} = $pool->add_repo($self->{'alias'});
  74   $self->{'handle'}->{'appdata'} = $self;
  75   $pool->{'installed'} = $self->{'handle'};
  76   print "rpm database: ";
  77   $self->{'cookie'} = $self->calc_cookie_file('/var/lib/rpm/Packages');
  78   if ($self->usecachedrepo()) {
  79     print "cached\n";
  80     return 1;
  81   }
  82   return undef;
  83 }
  84
  85 package main;
  86
  87 sub validarch {
  88   my ($pool, $arch) = @_;
  89   return undef unless $arch;
  90   my $id = $pool->str2id($arch, 0);
  91   return $id && $pool->isknownarch($id) ? 1 : undef;
  92 }
  93
  94 sub depglob {
  95   my ($pool, $name, $globname, $globdep) = @_;
  96   my $id = $pool->str2id($name, 0);
  97   if ($id) {
  98     my $match;
  99     for my $s ($pool->providers($id)) {
 100       return $pool->Job($solv::Job::SOLVER_SOLVABLE_NAME, $id) if $globname && $s->{'nameid'} == $id;
 101       $match = 1;
 102     }
 103     if ($match) {
 104       print "[using capability match for '$name']\n" if $globname && $globdep;
 105       my @j = $pool->Job($solv::Job::SOLVER_SOLVABLE_PROVIDES, $id);
 106       return $pool->Job($solv::Job::SOLVER_SOLVABLE_PROVIDES, $id);
 107     }
 108   }
 109   return unless $name =~ /[[*?]/;
 110   if ($globname) {
 111     my %idmatches;
 112     for my $s (@{$pool->{'solvables_iter'}}) {
 113       $idmatches{$s->{'nameid'}} = 1 if $s->installable() && File::FnMatch::fnmatch($name, $s->{'name'}, 0);
 114     }
 115     if (%idmatches) {
 116       return map {$pool->Job($solv::Job::SOLVER_SOLVABLE_NAME, $_)} sort(keys %idmatches);
 117     }
 118   }
 119   if ($globdep) {
 120     my %idmatches;
 121     for $id (@{$pool->allprovidingids()}) {
 122       $idmatches{$id} = 1 if File::FnMatch::fnmatch($name, $pool->id2str($id), 0);
 123     }
 124     if (%idmatches) {
 125       print "[using capability match for '$name']\n";
 126       return map {$pool->Job($solv::Job::SOLVER_SOLVABLE_PROVIDES, $_)} sort(keys %idmatches);
 127     }
 128   }
 129   return;
 130 }
 131
 132 sub limitjobs {
 133   my ($pool, $jobs, $flags, $evr) = @_;
 134   my @jobs;
 135   for my $j (@$jobs) {
 136     my $how = $j->{'how'};
 137     my $sel = $how & $solv::Job::SOLVER_SELECTMASK;
 138     my $what = $pool->rel2id($j->{'what'}, $evr, $flags);
 139     if ($flags == $solv::REL_ARCH) {
 140       $how |= $solv::Job::SOLVER_SETARCH;
 141     } elsif ($flags == $solv::REL_EQ && $sel == $solv::Job::SOLVER_SOLVABLE_NAME) {
 142       $how |= $pool->id2str($evr) =~ /-/ ? $solv::Job::SOLVER_SETEVR : $solv::Job::SOLVER_SETEV;
 143     }
 144     push @jobs, $pool->Job($how, $what);
 145   }
 146   return @jobs;
 147 }
 148
 149 sub limitjobs_arch {
 150   my ($pool, $jobs, $flags, $evrstr) = @_;
 151   if ($evrstr =~ /^(.+)\.(.+?)$/ && validarch($pool, $2)) {
 152     my $evr = $pool->str2id($1);
 153     my @jobs = limitjobs($pool, $jobs, $solv::solv::REL_ARCH, $pool->str2id($2));
 154     return limitjobs($pool, \@jobs, $flags, $evr);
 155   }
 156   return limitjobs($pool, $jobs, $flags, $pool->str2id($evrstr));
 157 }
 158
 159 sub mkjobs_rel {
 160   my ($pool, $cmd, $name, $rel, $evr) = @_;
 161   my $flags = 0;
 162   $flags |= $solv::REL_LT if $rel =~ /</;
 163   $flags |= $solv::REL_EQ if $rel =~ /=/;
 164   $flags |= $solv::REL_GT if $rel =~ />/;
 165   my @jobs = depglob($pool, $name, 1, 1);
 166   return limitjobs($pool, \@jobs, $flags, $pool->str2id($evr)) if @jobs;
 167   if (($name =~ /^(.+)\.(.+?)$/s) && validarch($pool, $2)) {
 168     my $arch = $2;
 169     @jobs = depglob($pool, $1, 1, 1);
 170     if (@jobs) {
 171       @jobs = limitjobs($pool, \@jobs, $solv::solv::REL_ARCH, $pool->str2id($arch));
 172       return limitjobs($pool, \@jobs, $flags, $pool->str2id($evr));
 173     }
 174   }
 175   return ();
 176 }
 177
 178 sub mkjobs_nevra {
 179   my ($pool, $cmd, $arg) = @_;
 180   my @jobs = depglob($pool, $arg, 1, 1);
 181   return @jobs if @jobs;
 182   if (($arg =~ /^(.+)\.(.+?)$/s) && validarch($pool, $2)) {
 183     my $arch = $2;
 184     @jobs = depglob($pool, $1, 1, 1);
 185     return limitjobs($pool, \@jobs, $solv::REL_ARCH, $pool->str2id($arch)) if @jobs;
 186   }
 187   if ($arg =~ /^(.+)-(.+?)$/s) {
 188     my $evr = $2;
 189     @jobs = depglob($pool, $1, 1, 0);
 190     return limitjobs_arch($pool, \@jobs, $solv::REL_EQ, $evr) if @jobs;
 191   }
 192   if ($arg =~ /^(.+)-(.+?-.+?)$/s) {
 193     my $evr = $2;
 194     @jobs = depglob($pool, $1, 1, 0);
 195     return limitjobs_arch($pool, \@jobs, $solv::REL_EQ, $evr) if @jobs;
 196   }
 197   return ();
 198 }
 199
 200 sub mkjobs_filelist {
 201   my ($pool, $cmd, $arg) = @_;
 202   my $type = ($arg =~ /[[*?]/) ? $solv::Dataiterator::SEARCH_GLOB : $solv::Dataiterator::SEARCH_STRING;
 203   $type |= $solv::Dataiterator::SEARCH_FILES | $solv::Dataiterator::SEARCH_COMPLETE_FILELIST;
 204   my $di;
 205   if ($cmd eq 'erase') {
 206     $di = $pool->{'installed'}->dataiterator_new(0, $solv::SOLVABLE_FILELIST, $arg, $type);
 207   } else {
 208     $di = $pool->dataiterator_new(0, $solv::SOLVABLE_FILELIST, $arg, $type);
 209   }
 210   my @matches;
 211   for my $d (@$di) {
 212     my $s = $d->{'solvable'};
 213     next unless $s && $s->installable();
 214     push @matches, $s->{'id'};
 215     tied(@$di)->iter()->skip_solvable();
 216   }
 217   return () unless @matches;
 218   print "[using file list match for '$arg']\n";
 219   if (@matches > 1) {
 220     return $pool->Job($solv::Job::SOLVER_SOLVABLE_ONE_OF, $pool->towhatprovides(\@matches));
 221   } else {
 222     return $pool->Job($solv::Job::SOLVER_SOLVABLE | $solv::Job::NOAUTOSET, $matches[0]);
 223   }
 224 }
 225
 226 sub mkjobs {
 227   my ($pool, $cmd, $arg) = @_;
 228   if ($arg && $arg =~ /^\//) {
 229     my @jobs = mkjobs_filelist($pool, $cmd, $arg);
 230     return @jobs if @jobs;
 231   }
 232   if ($arg =~ /^(.+?)\s*([<=>]+)\s*(.+?)$/s) {
 233     return mkjobs_rel($pool, $cmd, $1, $2, $3);
 234   } else {
 235     return mkjobs_nevra($pool, $cmd, $arg);
 236   }
 237 }
 238
 239 die("Usage: p5solv COMMAND [ARGS]\n") unless @ARGV;
 240 my $cmd = shift @ARGV;
 241 $cmd = 'list' if $cmd eq 'li';
 242 $cmd = 'install' if $cmd eq 'in';
 243 $cmd = 'erase' if $cmd eq 'rm';
 244 $cmd = 'verify' if $cmd eq 've';
 245 $cmd = 'search' if $cmd eq 'se';
 246
 247 my $pool = solv::Pool->new();
 248 $pool->setarch((POSIX::uname())[4]);
 249 my @repos;
 250 for my $reposdir ('/etc/zypp/repos.d') {
 251   next unless -d $reposdir;
 252   next unless opendir(DIR, $reposdir);
 253   for my $reponame (sort(grep {/\.repo$/} readdir(DIR))) {
 254     my $cfg = new Config::IniFiles('-file' => "$reposdir/$reponame");
 255     for my $alias ($cfg->Sections()) {
 256       my $repoattr = {'alias' => $alias, 'enabled' => 0, 'priority' => 99, 'autorefresh' => 1, 'type' => 'rpm-md', 'metadata_expire' => 900};
 257       for my $p ($cfg->Parameters($alias)) {
 258         $repoattr->{$p} = $cfg->val($alias, $p);
 259       }
 260       my $repo;
 261       if ($repoattr->{'type'} == 'rpm-md') {
 262         $repo = Repo::rpmmd->new($repoattr);
 263       }
 264       push @repos, $repo;
 265     }
 266   }
 267 }
 268
 269 my $sysrepo = Repo::system->new({'alias' => '@System', 'type' => 'system'});
 270 $sysrepo->load($pool);
 271 for my $repo (@repos) {
 272   $repo->load($pool) if $repo->{'enabled'};
 273 }
 274
 275 if ($cmd eq 'search') {
 276   my %matches;
 277   my $di = $pool->dataiterator_new(0, $solv::SOLVABLE_NAME, $ARGV[0], $solv::Dataiterator::SEARCH_SUBSTRING | $solv::Dataiterator::SEARCH_NOCASE);
 278   for my $d (@$di) {
 279     $matches{$d->{'solvid'}} = 1;
 280   }
 281   for my $solvid (sort keys %matches) {
 282     my $s = $pool->{'solvables'}->[$solvid];
 283     print "- ".$s->str()." [$s->{'repo'}->{'name'}] ".$s->lookup_str($solv::SOLVABLE_SUMMARY)."\n";
 284   }
 285   exit(0);
 286 }
 287
 288 my $addedprovides =  $pool->addfileprovides_ids();
 289 $pool->createwhatprovides();
 290
 291 my @jobs;
 292 for my $arg (@ARGV) {
 293   my @njobs = mkjobs($pool, $cmd, $arg);
 294   die("nothing matches '$arg'\n") unless @njobs;
 295   push @jobs, @njobs;
 296 }
 297
 298 if ($cmd eq 'list' || $cmd eq 'info') {
 299   die("no package matched.\n") unless @jobs;
 300   for my $job (@jobs) {
 301     for my $s ($pool->jobsolvables($job)) {
 302       if ($cmd eq 'info') {
 303         printf "Name:        %s\n", $s->str();
 304         printf "Repo:        %s\n", $s->{'repo'}->{'name'};
 305         printf "Summary:     %s\n", $s->lookup_str($solv::SOLVABLE_SUMMARY);
 306         my $str = $s->lookup_str($solv::SOLVABLE_URL);
 307         printf "Url:         %s\n", $str if $str;
 308         my $str = $s->lookup_str($solv::SOLVABLE_LICENSE);
 309         printf "License:     %s\n", $str if $str;
 310         printf "Description:\n%s\n", $s->lookup_str($solv::SOLVABLE_DESCRIPTION);
 311       } else {
 312         printf "  - %s [%s]\n", $s->str(), $s->{'repo'}->{'name'};
 313         printf "    %s\n", $s->lookup_str($solv::SOLVABLE_SUMMARY);
 314       }
 315     }
 316   }
 317   exit 0;
 318 }
 319
 320 if ($cmd eq 'install' || $cmd eq 'erase' || $cmd eq 'up' || $cmd eq 'dup' || $cmd eq 'verify') {
 321   if (!@jobs) {
 322     if ($cmd eq 'up' || $cmd eq 'verify') {
 323       push @jobs, $pool->Job($solv::Job::SOLVER_SOLVABLE_ALL, 0);
 324     } elsif ($cmd ne 'dup') {
 325       die("no package matched.\n");
 326     }
 327   }
 328   for my $job (@jobs) {
 329     if ($cmd eq 'up') {
 330       if ($job->{'how'} == $solv::Job::SOLVER_SOLVABLE_ALL || grep {$_->isinstalled()} @{$pool->jobsolvables($job)}) {
 331         $job->{'how'} |= $solv::Job::SOLVER_UPDATE;
 332       } else {
 333         $job->{'how'} |= $solv::Job::SOLVER_INSTALL;
 334       }
 335     } elsif ($cmd eq 'install') {
 336         $job->{'how'} |= $solv::Job::SOLVER_INSTALL;
 337     } elsif ($cmd eq 'erase') {
 338         $job->{'how'} |= $solv::Job::SOLVER_ERASE;
 339     } elsif ($cmd eq 'dup') {
 340         $job->{'how'} |= $solv::Job::SOLVER_DISTUPGRADE;
 341     } elsif ($cmd eq 'verify') {
 342         $job->{'how'} |= $solv::Job::SOLVER_VERIFY;
 343     }
 344   }
 345   my $solver;
 346   while (1) {
 347     $solver = $pool->create_solver();
 348     $solver->{'ignorealreadyrecommended'} = 1;
 349     $solver->{'allowuninstall'} = 1 if $cmd eq 'erase';
 350     if ($cmd eq 'dup' && !@jobs) {
 351       $solver->{'distupgrade'} = 1;
 352       $solver->{'updatesystem'} = 1;
 353       $solver->{'allowdowngrade'} = 1;
 354       $solver->{'allowvendorchange'} = 1;
 355       $solver->{'allowarchchange'} = 1;
 356       $solver->{'dosplitprovides'} = 1;
 357     } elsif ($cmd eq 'up' and @jobs == 1 and $jobs[0]->{'how'} == ($solv::Job::SOLVER_UPDATE | $solv::Job::SOLVER_SOLVABLE_ALL)) {
 358       $solver->{'dosplitprovides'} = 1;
 359     }
 360     my @problems = $solver->solve(\@jobs);
 361     last unless @problems;
 362     for my $problem (@problems) {
 363       print "Problem $problem->{'id'}:\n";
 364       my $r = $problem->findproblemrule();
 365       my ($type, $source, $target, $dep) = $r->info();
 366       if ($type == $solv::Solver::SOLVER_RULE_RPM_PACKAGE_CONFLICT) {
 367         printf "package %s conflicts with %s provided by %s\n", $source->str(), $pool->dep2str($dep), $target->str();
 368       }
 369       print "TYPE: $type\n";
 370       printf "SOURCE: %s\n", $source->str() if $source;
 371       printf "TARGET: %s\n", $target->str() if $target;
 372       printf "DEP: %s\n", $pool->dep2str($dep) if $dep;
 373     }
 374     exit(0);
 375   }
 376 }
 377
 378 exit 0;