- more ruby code, better array handling in solv.i
[platform/upstream/libsolv.git] / examples / p5solv
1 #!/usr/bin/perl -w
2
3 use POSIX;
4 use Fcntl;
5 use Config::IniFiles;
6 use File::FnMatch;
7 use Data::Dumper;
8 use solv;
9 use Devel::Peek;
10 use FileHandle;
11 use File::Temp ();
12 use strict;
13
14 package Repo::generic;
15
16 sub new {
17   my ($class, $alias, $type, $attr) = @_;
18   my $r = { %{$attr || {}} };
19   $r->{'alias'} = $alias;
20   $r->{'type'} = $type;
21   return bless $r, $class;
22 }
23
24 sub calc_cookie_fp {
25   my ($self, $fp) = @_;
26   my $chksum = solv::Chksum->new($solv::REPOKEY_TYPE_SHA256);
27   $chksum->add_fp($fp);
28   return $chksum->raw();
29 }
30
31 sub calc_cookie_file {
32   my ($self, $filename) = @_;
33   my $chksum = solv::Chksum->new($solv::REPOKEY_TYPE_SHA256);
34   $chksum->add("1.1");
35   $chksum->add_stat($filename);
36   return $chksum->raw();
37 }
38
39 sub cachepath {
40   my ($self, $ext) = @_;
41   my $path = $self->{'alias'};
42   $path =~ s/^\./_/s;
43   $path .= $ext ? "_$ext.solvx" : '.solv';
44   $path =~ s/\//_/gs;
45   return "/var/cache/solv/$path";
46 }
47
48 sub load {
49   my ($self, $pool) = @_;
50   $self->{'handle'} = $pool->add_repo($self->{'alias'});
51   $self->{'handle'}->{'appdata'} = $self;
52   $self->{'handle'}->{'priority'} = 99 - $self->{'priority'};
53   my $dorefresh = $self->{'autorefresh'};
54   if ($dorefresh) {
55     my @s = stat($self->cachepath());
56     $dorefresh = 0 if @s && time() - $s[9] < $self->{'metadata_expire'};
57   }
58   $self->{'cookie'} = '';
59   if (!$dorefresh && $self->usecachedrepo()) {
60     print "repo: '$self->{'alias'}' cached\n";
61     return 1;
62   }
63   return $self->load_if_changed();
64 }
65
66 sub load_if_changed {
67   return 0;
68 }
69
70 sub load_ext {
71   return 0;
72 }
73
74 sub download {
75   my ($self, $file, $uncompress, $chksum, $markincomplete) = @_;
76   if (!$self->{'baseurl'}) {
77     print "$self->{'alias'}: no baseurl\n";
78     return undef;
79   }
80   my $url = $self->{'baseurl'};
81   $url =~ s/\/$//;
82   $url .= "/$file";
83   open(my $f, '+>', undef) || die;
84   fcntl($f, Fcntl::F_SETFD, 0);
85   my $st = system('curl', '-f', '-s', '-L', '-o', "/dev/fd/".fileno($f), '--', $url);
86   if (POSIX::lseek(fileno($f), 0, POSIX::SEEK_END) == 0 && ($st == 0 || !$chksum)) {
87     return undef;
88   }
89   POSIX::lseek(fileno($f), 0, POSIX::SEEK_SET);
90   if ($st) {
91     print "$file: download error #$st\n";
92     $self->{'incomplete'} = 1 if $markincomplete;
93     return undef;
94   }
95   if ($chksum) {
96     my $fchksum = solv::Chksum->new($chksum->{'type'});
97     $fchksum->add_fd(fileno($f));
98     if (!$fchksum->matches($chksum)) {
99       print "$file: checksum error\n";
100       $self->{'incomplete'} = 1 if $markincomplete;
101       return undef;
102     }
103   }
104   if ($uncompress) {
105     return solv::xfopen_fd($file, POSIX::dup(fileno($f)));
106   } else {
107     return solv::xfopen_fd('', POSIX::dup(fileno($f)));
108   }
109 }
110
111 sub usecachedrepo {
112   my ($self, $ext, $mark) = @_;
113   my $cookie = $ext ? $self->{'extcookie'} : $self->{'cookie'};
114   my $handle = $self->{'handle'};
115   my $cachepath = $self->cachepath($ext);
116   my $fextcookie;
117   if (sysopen(my $f, $cachepath, POSIX::O_RDONLY)) {
118     sysseek($f, -32, Fcntl::SEEK_END);
119     my $fcookie = '';
120     return undef if sysread($f, $fcookie, 32) != 32;
121     return undef if $cookie && $fcookie ne $cookie;
122     if ($self->{'type'} ne 'system' && !$ext) {
123       sysseek($f, -32 * 2, Fcntl::SEEK_END);
124       return undef if sysread($f, $fextcookie, 32) != 32;
125     }
126     sysseek($f, 0, Fcntl::SEEK_SET);
127     $f = solv::xfopen_fd('', POSIX::dup(fileno($f)));
128     my $flags = $ext ? $solv::Repo::REPO_USE_LOADING|$solv::Repo::REPO_EXTEND_SOLVABLES : 0;
129     $flags |= $solv::Repo::REPO_LOCALPOOL if $ext && $ext ne 'DL';
130     if (!$self->{'handle'}->add_solv($f, $flags)) {
131       solv::xfclose($f);
132       return undef;
133     }
134     solv::xfclose($f);
135     $self->{'cookie'} = $fcookie unless $ext;
136     $self->{'extcookie'} = $fextcookie if $fextcookie;
137     utime undef, undef, $f if $mark;
138     return 1;
139   }
140   return undef;
141 }
142
143 sub genextcookie {
144   my ($self, $f) = @_;
145   my $chksum = solv::Chksum->new($solv::REPOKEY_TYPE_SHA256);
146   $chksum->add($self->{'cookie'});
147   if ($f) {
148     my @s = stat($f);
149     $chksum->add("@s");
150   }
151   my $extcookie = $chksum->raw();
152   substr($extcookie, 0, 1) = chr(1) if ord(substr($extcookie, 0, 1)) == 0;
153   $self->{'extcookie'} = $extcookie;
154 }
155
156 sub writecachedrepo {
157   my ($self, $ext, $info) = @_;
158   mkdir("/var/cache/solv", 0755) unless -d "/var/cache/solv";
159   my ($f, $tmpname);
160   eval {
161     ($f, $tmpname) = File::Temp::tempfile(".newsolv-XXXXXX", 'DIR' => '/var/cache/solv');
162   };
163   return unless $f;
164   chmod 0444, $f;
165   my $ff = solv::xfopen_fd('', POSIX::dup(fileno($f)));
166   if (!$info) {
167     $self->{'handle'}->write($ff);
168   } elsif ($ext) {
169     $info->write($ff);
170   } else {
171      $self->{'handle'}->write_first_repodata($ff);
172   }
173   solv::xfclose($ff);
174   if ($self->{'type'} ne 'system' && !$ext) {
175     $self->genextcookie($f) unless $self->{'extcookie'};
176     syswrite($f, $self->{'extcookie'});
177   }
178   syswrite($f, $ext ? $self->{'extcookie'} : $self->{'cookie'});
179   close($f);
180   if ($self->{'handle'}->iscontiguous()) {
181     $f = solv::xfopen($tmpname);
182     if ($f) {
183       if (!$ext) {
184         $self->{'handle'}->empty();
185         die("internal error, cannot reload solv file\n") unless $self->{'handle'}->add_solv($f, $solv::Repo::SOLV_ADD_NO_STUBS);
186       } else {
187         $info->extend_to_repo();
188         $info->read_solv_flags($f, $solv::Repo::REPO_EXTEND_SOLVABLES);
189       }
190       solv::xfclose($f);
191     }
192   }
193   rename($tmpname, $self->cachepath($ext));
194 }
195
196 package Repo::rpmmd;
197
198 our @ISA = ('Repo::generic');
199
200 sub find {
201   my ($self, $what) = @_;
202   my $di = $self->{'handle'}->Dataiterator($solv::SOLVID_META, $solv::REPOSITORY_REPOMD_TYPE, $what, $solv::Dataiterator::SEARCH_STRING);
203   $di->prepend_keyname($solv::REPOSITORY_REPOMD);
204   for my $d (@$di) {
205     $d->setpos_parent();
206     my $filename = $d->{'pool'}->lookup_str($solv::SOLVID_POS, $solv::REPOSITORY_REPOMD_LOCATION);
207     my $chksum = $d->{'pool'}->lookup_checksum($solv::SOLVID_POS, $solv::REPOSITORY_REPOMD_CHECKSUM);
208     if ($filename && !$chksum) {
209       print "no $filename file checksum!\n";
210       return (undef, undef);
211     }
212     return ($filename, $chksum) if $filename;
213   }
214   return (undef, undef);
215 }
216
217 sub add_ext {
218   my ($self, $repodata, $what, $ext) = @_;
219   my ($filename, $chksum) = $self->find($what);
220   ($filename, $chksum) = $self->find('prestodelta') if !$filename && $what eq 'deltainfo';
221   return unless $filename;
222   my $handle = $repodata->new_handle();
223   $repodata->set_poolstr($handle, $solv::REPOSITORY_REPOMD_TYPE, $what);
224   $repodata->set_str($handle, $solv::REPOSITORY_REPOMD_LOCATION, $filename);
225   $repodata->set_checksum($handle, $solv::REPOSITORY_REPOMD_CHECKSUM, $chksum);
226   if ($ext eq 'DL') {
227     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::REPOSITORY_DELTAINFO);
228     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::REPOKEY_TYPE_FLEXARRAY);
229   } elsif ($ext eq 'FL') {
230     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::SOLVABLE_FILELIST);
231     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::REPOKEY_TYPE_DIRSTRARRAY);
232   }
233   $repodata->add_flexarray($solv::SOLVID_META, $solv::REPOSITORY_EXTERNAL, $handle);
234 }
235
236 sub add_exts {
237   my ($self) = @_;
238   my $repodata = $self->{'handle'}->add_repodata(0);
239   $self->add_ext($repodata, 'deltainfo', 'DL');
240   $self->add_ext($repodata, 'filelists', 'FL');
241   $repodata->internalize();
242 }
243
244 sub load_ext {
245   my ($self, $repodata) = @_;
246   my $repomdtype = $repodata->lookup_str($solv::SOLVID_META, $solv::REPOSITORY_REPOMD_TYPE);
247   my $ext;
248   if ($repomdtype eq 'filelists') {
249     $ext = 'FL';
250   } elsif ($repomdtype eq 'deltainfo') {
251     $ext = 'DL';
252   } else {
253     return 0;
254   }
255   print("[$self->{'alias'}:$ext: ");
256   STDOUT->flush();
257   if ($self->usecachedrepo($ext)) {
258     print "cached]\n";
259     return 1;
260   }
261   print "fetching]\n";
262   my $filename = $repodata->lookup_str($solv::SOLVID_META, $solv::REPOSITORY_REPOMD_LOCATION);
263   my $filechksum = $repodata->lookup_checksum($solv::SOLVID_META, $solv::REPOSITORY_REPOMD_CHECKSUM);
264   my $f = $self->download($filename, 1, $filechksum);
265   return 0 unless $f;
266   if ($ext eq 'FL') {
267     $self->{'handle'}->add_rpmmd($f, 'FL', $solv::Repo::REPO_USE_LOADING|$solv::Repo::REPO_EXTEND_SOLVABLES);
268   } elsif ($ext eq 'FL') {
269     $self->{'handle'}->add_deltainfoxml($f, $solv::Repo::REPO_USE_LOADING);
270   }
271   solv::xfclose($f);
272   $self->writecachedrepo($ext, $repodata);
273   return 1;
274 }
275
276 sub load_if_changed {
277   my ($self) = @_;
278   print "rpmmd repo '$self->{'alias'}': ";
279   STDOUT->flush();
280   my $f = $self->download("repodata/repomd.xml");
281   if (!$f) {
282     print "no repomd.xml file, skipped\n";
283     $self->{'handle'}->free(1);
284     delete $self->{'handle'};
285     return undef;
286   }
287   $self->{'cookie'} = $self->calc_cookie_fp($f);
288   if ($self->usecachedrepo(undef, 1)) {
289     print "cached\n";
290     solv::xfclose($f);
291     return 1;
292   }
293   $self->{'handle'}->add_repomdxml($f, 0);
294   solv::xfclose($f);
295   print "fetching\n";
296   my ($filename, $filechksum) = $self->find('primary');
297   if ($filename) {
298     $f = $self->download($filename, 1, $filechksum, 1);
299     if ($f) {
300       $self->{'handle'}->add_rpmmd($f, undef, 0);
301       solv::xfclose($f);
302     }
303     return undef if $self->{'incomplete'};
304   }
305   ($filename, $filechksum) = $self->find('updateinfo');
306   if ($filename) {
307     $f = $self->download($filename, 1, $filechksum, 1);
308     if ($f) {
309       $self->{'handle'}->add_updateinfoxml($f, 0);
310       solv::xfclose($f);
311     }
312   }
313   $self->add_exts();
314   $self->writecachedrepo() unless $self->{'incomplete'};
315   $self->{'handle'}->create_stubs();
316   return 1;
317 }
318
319 package Repo::susetags;
320
321 our @ISA = ('Repo::generic');
322
323 sub find {
324   my ($self, $what) = @_;
325   
326   my $di = $self->{'handle'}->Dataiterator($solv::SOLVID_META, $solv::SUSETAGS_FILE_NAME, $what, $solv::Dataiterator::SEARCH_STRING);
327   $di->prepend_keyname($solv::SUSETAGS_FILE);
328   for my $d (@$di) {
329     $d->setpos_parent();
330     my $chksum = $d->{'pool'}->lookup_checksum($solv::SOLVID_POS, $solv::SUSETAGS_FILE_CHECKSUM);
331     return ($what, $chksum);
332   }
333   return (undef, undef);
334 }
335
336 my %langtags = (
337   $solv::SOLVABLE_SUMMARY     => $solv::REPOKEY_TYPE_STR,
338   $solv::SOLVABLE_DESCRIPTION => $solv::REPOKEY_TYPE_STR,
339   $solv::SOLVABLE_EULA        => $solv::REPOKEY_TYPE_STR,
340   $solv::SOLVABLE_MESSAGEINS  => $solv::REPOKEY_TYPE_STR,
341   $solv::SOLVABLE_MESSAGEDEL  => $solv::REPOKEY_TYPE_STR,
342   $solv::SOLVABLE_CATEGORY    => $solv::REPOKEY_TYPE_ID,
343 );
344
345 sub add_ext {
346   my ($self, $repodata, $what, $ext) = @_;
347   my ($filename, $chksum) = $self->find($what);
348   my $handle = $repodata->new_handle();
349   $repodata->set_str($handle, $solv::SUSETAGS_FILE_NAME, $filename);
350   $repodata->set_checksum($handle, $solv::SUSETAGS_FILE_CHECKSUM, $chksum);
351   if ($ext eq 'DL') {
352     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::REPOSITORY_DELTAINFO);
353     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::REPOKEY_TYPE_FLEXARRAY);
354   } elsif ($ext eq 'DU') {
355     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::SOLVABLE_DISKUSAGE);
356     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::REPOKEY_TYPE_DIRNUMNUMARRAY);
357   } elsif ($ext eq 'FL') {
358     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::SOLVABLE_FILELIST);
359     $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $solv::REPOKEY_TYPE_DIRSTRARRAY);
360   } else {
361     for my $langid (sort {$a <=> $b} keys %langtags) {
362       $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $self->{'handle'}->{'pool'}->id2langid($langid, $ext, 1));
363       $repodata->add_idarray($handle, $solv::REPOSITORY_KEYS, $langtags{$langid});
364     }
365   }
366   $repodata->add_flexarray($solv::SOLVID_META, $solv::REPOSITORY_EXTERNAL, $handle);
367 }
368
369 sub add_exts {
370   my ($self) = @_;
371   my $repodata = $self->{'handle'}->add_repodata(0);
372   my $di = $self->{'handle'}->Dataiterator($solv::SOLVID_META, $solv::SUSETAGS_FILE_NAME, undef, 0);
373   $di->prepend_keyname($solv::SUSETAGS_FILE);
374   for my $d (@$di) {
375     my $filename = $d->match_str();
376     next unless $filename && $filename =~ /^packages\.(..)(?:\..*)$/;
377     next if $1 eq 'en' || $1 eq 'gz';
378     $self->add_ext($repodata, $filename, $1);
379   }
380   $repodata->internalize();
381 }
382
383 sub load_ext {
384   my ($self, $repodata) = @_;
385   my $filename = $repodata->lookup_str($solv::SOLVID_META, $solv::SUSETAGS_FILE_NAME);
386   my $ext = substr($filename, 9, 2);
387   print("[$self->{'alias'}:$ext: ");
388   STDOUT->flush();
389   if ($self->usecachedrepo($ext)) {
390     print "cached]\n";
391     return 1;
392   }
393   print "fetching]\n";
394   my $defvendorid = $self->{'handle'}->lookup_id($solv::SOLVID_META, $solv::SUSETAGS_DEFAULTVENDOR);
395   my $descrdir = $self->{'handle'}->lookup_str($solv::SOLVID_META, $solv::SUSETAGS_DESCRDIR) || 'suse/setup/descr'; 
396   my $filechksum = $repodata->lookup_checksum($solv::SOLVID_META, $solv::SUSETAGS_FILE_CHECKSUM);
397   my $f = $self->download("$descrdir/$filename", 1, $filechksum);
398   return 0 unless $f;
399   $self->{'handle'}->add_susetags($f, $defvendorid, $ext, $solv::Repo::REPO_USE_LOADING|$solv::Repo::REPO_EXTEND_SOLVABLES);
400   solv::xfclose($f);
401   $self->writecachedrepo($ext, $repodata);
402   return 1;
403 }
404
405 sub load_if_changed {
406   my ($self) = @_;
407   print "susetags repo '$self->{'alias'}': ";
408   STDOUT->flush();
409   my $f = $self->download("content");
410   if (!$f) {
411     print "no content file, skipped\n";
412     $self->{'handle'}->free(1);
413     delete $self->{'handle'};
414     return undef;
415   }
416   $self->{'cookie'} = $self->calc_cookie_fp($f);
417   if ($self->usecachedrepo(undef, 1)) {
418     print "cached\n";
419     solv::xfclose($f);
420     return 1;
421   }
422   $self->{'handle'}->add_content($f, 0);
423   solv::xfclose($f);
424   print "fetching\n";
425   my $defvendorid = $self->{'handle'}->lookup_id($solv::SOLVID_META, $solv::SUSETAGS_DEFAULTVENDOR);
426   my $descrdir = $self->{'handle'}->lookup_str($solv::SOLVID_META, $solv::SUSETAGS_DESCRDIR) || 'suse/setup/descr'; 
427   my ($filename, $filechksum) = $self->find('packages.gz');
428   ($filename, $filechksum) = $self->find('packages') unless $filename;
429   if ($filename) {
430     $f = $self->download("$descrdir/$filename", 1, $filechksum, 1);
431     if ($f) {
432       $self->{'handle'}->add_susetags($f, $defvendorid, undef, $solv::Repo::REPO_NO_INTERNALIZE|$solv::Repo::SUSETAGS_RECORD_SHARES);
433       solv::xfclose($f);
434       ($filename, $filechksum) = $self->find('packages.en.gz');
435       ($filename, $filechksum) = $self->find('packages.en') unless $filename;
436       if ($filename) {
437         $f = $self->download("$descrdir/$filename", 1, $filechksum, 1);
438         if ($f) {
439           $self->{'handle'}->add_susetags($f, $defvendorid, undef, $solv::Repo::REPO_NO_INTERNALIZE|$solv::Repo::REPO_REUSE_REPODATA|$solv::Repo::REPO_EXTEND_SOLVABLES);
440           solv::xfclose($f);
441         }
442       }
443       $self->{'handle'}->internalize();
444     }
445   }
446   $self->add_exts();
447   $self->writecachedrepo() unless $self->{'incomplete'};
448   $self->{'handle'}->create_stubs();
449   return undef;
450 }
451
452 package Repo::unknown;
453
454 our @ISA = ('Repo::generic');
455
456 sub load {
457   my ($self, $pool) = @_;
458   print "unsupported repo '$self->{'alias'}': skipped\n";
459   return 0;
460 }
461
462 package Repo::system;
463
464 our @ISA = ('Repo::generic');
465
466 sub load {
467   my ($self, $pool) = @_;
468
469   $self->{'handle'} = $pool->add_repo($self->{'alias'});
470   $self->{'handle'}->{'appdata'} = $self;
471   $pool->{'installed'} = $self->{'handle'};
472   print "rpm database: ";
473   $self->{'cookie'} = $self->calc_cookie_file('/var/lib/rpm/Packages');
474   if ($self->usecachedrepo()) {
475     print "cached\n";
476     return 1;
477   }
478   print "reading\n";
479   $self->{'handle'}->add_products("/etc/products.d", $solv::Repo::REPO_NO_INTERNALIZE);
480   $self->{'handle'}->add_rpmdb(undef, $solv::Repo::REPO_REUSE_REPODATA);
481   return 1;
482 }
483
484 package main;
485
486 sub validarch {
487   my ($pool, $arch) = @_;
488   return undef unless $arch;
489   my $id = $pool->str2id($arch, 0);
490   return $id && $pool->isknownarch($id) ? 1 : undef;
491 }
492
493 sub depglob {
494   my ($pool, $name, $globname, $globdep) = @_;
495   my $id = $pool->str2id($name, 0);
496   if ($id) {
497     my $match;
498     for my $s ($pool->providers($id)) {
499       return $pool->Job($solv::Job::SOLVER_SOLVABLE_NAME, $id) if $globname && $s->{'nameid'} == $id;
500       $match = 1;
501     }
502     if ($match) {
503       print "[using capability match for '$name']\n" if $globname && $globdep;
504       return $pool->Job($solv::Job::SOLVER_SOLVABLE_PROVIDES, $id);
505     }
506   }
507   return unless $name =~ /[[*?]/;
508   if ($globname) {
509     my %idmatches;
510     for my $d (@{$pool->Dataiterator(0, $solv::SOLVABLE_NAME, $name, $solv::Dataiterator::SEARCH_GLOB)}) {
511       my $s = $d->{'solvable'};
512       $idmatches{$s->{'nameid'}} = 1 if $s->installable();
513     }
514     if (%idmatches) {
515       return map {$pool->Job($solv::Job::SOLVER_SOLVABLE_NAME, $_)} sort(keys %idmatches);
516     }
517   }
518   if ($globdep) {
519     my @idmatches = $pool->matchprovidingids($name, $solv::Dataiterator::SEARCH_GLOB);
520     if (@idmatches) {
521       print "[using capability match for '$name']\n";
522       return map {$pool->Job($solv::Job::SOLVER_SOLVABLE_PROVIDES, $_)} sort(@idmatches);
523     }
524   }
525   return;
526 }
527
528 sub limitjobs {
529   my ($pool, $jobs, $flags, $evr) = @_;
530   my @jobs;
531   for my $j (@$jobs) {
532     my $how = $j->{'how'};
533     my $sel = $how & $solv::Job::SOLVER_SELECTMASK;
534     my $what = $pool->rel2id($j->{'what'}, $evr, $flags);
535     if ($flags == $solv::REL_ARCH) {
536       $how |= $solv::Job::SOLVER_SETARCH;
537     } elsif ($flags == $solv::REL_EQ && $sel == $solv::Job::SOLVER_SOLVABLE_NAME) {
538       $how |= $pool->id2str($evr) =~ /-/ ? $solv::Job::SOLVER_SETEVR : $solv::Job::SOLVER_SETEV;
539     }
540     push @jobs, $pool->Job($how, $what);
541   }
542   return @jobs;
543 }
544
545 sub limitjobs_arch {
546   my ($pool, $jobs, $flags, $evrstr) = @_;
547   if ($evrstr =~ /^(.+)\.(.+?)$/ && validarch($pool, $2)) {
548     my $evr = $pool->str2id($1);
549     my @jobs = limitjobs($pool, $jobs, $solv::REL_ARCH, $pool->str2id($2));
550     return limitjobs($pool, \@jobs, $flags, $evr);
551   }
552   return limitjobs($pool, $jobs, $flags, $pool->str2id($evrstr));
553 }
554
555 sub mkjobs_rel {
556   my ($pool, $cmd, $name, $rel, $evr) = @_;
557   my $flags = 0;
558   $flags |= $solv::REL_LT if $rel =~ /</;
559   $flags |= $solv::REL_EQ if $rel =~ /=/;
560   $flags |= $solv::REL_GT if $rel =~ />/;
561   my @jobs = depglob($pool, $name, 1, 1);
562   return limitjobs($pool, \@jobs, $flags, $pool->str2id($evr)) if @jobs;
563   if (($name =~ /^(.+)\.(.+?)$/s) && validarch($pool, $2)) {
564     my $arch = $2;
565     @jobs = depglob($pool, $1, 1, 1);
566     if (@jobs) {
567       @jobs = limitjobs($pool, \@jobs, $solv::REL_ARCH, $pool->str2id($arch));
568       return limitjobs($pool, \@jobs, $flags, $pool->str2id($evr));
569     }
570   }
571   return ();
572 }
573
574 sub mkjobs_nevra {
575   my ($pool, $cmd, $arg) = @_;
576   my @jobs = depglob($pool, $arg, 1, 1);
577   return @jobs if @jobs;
578   if (($arg =~ /^(.+)\.(.+?)$/s) && validarch($pool, $2)) {
579     my $arch = $2;
580     @jobs = depglob($pool, $1, 1, 1);
581     return limitjobs($pool, \@jobs, $solv::REL_ARCH, $pool->str2id($arch)) if @jobs;
582   }
583   if ($arg =~ /^(.+)-(.+?)$/s) {
584     my $evr = $2;
585     @jobs = depglob($pool, $1, 1, 0);
586     return limitjobs_arch($pool, \@jobs, $solv::REL_EQ, $evr) if @jobs;
587   }
588   if ($arg =~ /^(.+)-(.+?-.+?)$/s) {
589     my $evr = $2;
590     @jobs = depglob($pool, $1, 1, 0);
591     return limitjobs_arch($pool, \@jobs, $solv::REL_EQ, $evr) if @jobs;
592   }
593   return ();
594 }
595
596 sub mkjobs_filelist {
597   my ($pool, $cmd, $arg) = @_;
598   my $type = ($arg =~ /[[*?]/) ? $solv::Dataiterator::SEARCH_GLOB : $solv::Dataiterator::SEARCH_STRING;
599   $type |= $solv::Dataiterator::SEARCH_FILES | $solv::Dataiterator::SEARCH_COMPLETE_FILELIST;
600   my $di;
601   if ($cmd eq 'erase') {
602     $di = $pool->{'installed'}->Dataiterator(0, $solv::SOLVABLE_FILELIST, $arg, $type);
603   } else {
604     $di = $pool->Dataiterator(0, $solv::SOLVABLE_FILELIST, $arg, $type);
605   }
606   my @matches;
607   for my $d (@$di) {
608     my $s = $d->{'solvable'};
609     next unless $s && $s->installable();
610     push @matches, $s->{'id'};
611     $di->skip_solvable();
612   }
613   return () unless @matches;
614   print "[using file list match for '$arg']\n";
615   if (@matches > 1) {
616     return $pool->Job($solv::Job::SOLVER_SOLVABLE_ONE_OF, $pool->towhatprovides(\@matches));
617   } else {
618     return $pool->Job($solv::Job::SOLVER_SOLVABLE | $solv::Job::SOLVER_NOAUTOSET, $matches[0]);
619   }
620 }
621
622 sub mkjobs {
623   my ($pool, $cmd, $arg) = @_;
624   if ($arg && $arg =~ /^\//) {
625     my @jobs = mkjobs_filelist($pool, $cmd, $arg);
626     return @jobs if @jobs;
627   }
628   if ($arg =~ /^(.+?)\s*([<=>]+)\s*(.+?)$/s) {
629     return mkjobs_rel($pool, $cmd, $1, $2, $3);
630   } else {
631     return mkjobs_nevra($pool, $cmd, $arg);
632   }
633 }
634
635 sub load_stub {
636   my ($repodata) = @_;
637   my $repo = $repodata->{'repo'}->{'appdata'};
638   return $repo ? $repo->load_ext($repodata) : 0;
639 }
640
641 die("Usage: p5solv COMMAND [ARGS]\n") unless @ARGV;
642 my $cmd = shift @ARGV;
643 $cmd = 'list' if $cmd eq 'li';
644 $cmd = 'install' if $cmd eq 'in';
645 $cmd = 'erase' if $cmd eq 'rm';
646 $cmd = 'verify' if $cmd eq 've';
647 $cmd = 'search' if $cmd eq 'se';
648
649 my @repos;
650 for my $reposdir ('/etc/zypp/repos.d') {
651   next unless -d $reposdir;
652   next unless opendir(DIR, $reposdir);
653   for my $reponame (sort(grep {/\.repo$/} readdir(DIR))) {
654     my $cfg = new Config::IniFiles('-file' => "$reposdir/$reponame");
655     for my $alias ($cfg->Sections()) {
656       my $repoattr = {'alias' => $alias, 'enabled' => 0, 'priority' => 99, 'autorefresh' => 1, 'type' => 'rpm-md', 'metadata_expire' => 900};
657       for my $p ($cfg->Parameters($alias)) {
658         $repoattr->{$p} = $cfg->val($alias, $p);
659       }
660       my $repo;
661       if ($repoattr->{'type'} eq 'rpm-md') {
662         $repo = Repo::rpmmd->new($alias, 'repomd', $repoattr);
663       } elsif ($repoattr->{'type'} eq 'yast2') {
664         $repo = Repo::susetags->new($alias, 'susetags', $repoattr);
665       } else {
666         $repo = Repo::unknown->new($alias, 'unknown', $repoattr);
667       }
668       push @repos, $repo;
669     }
670   }
671 }
672
673 my $pool = solv::Pool->new();
674 $pool->setarch((POSIX::uname())[4]);
675 $pool->set_loadcallback(\&load_stub);
676
677 my $sysrepo = Repo::system->new('@System', 'system');
678 $sysrepo->load($pool);
679 for my $repo (@repos) {
680   $repo->load($pool) if $repo->{'enabled'};
681 }
682
683 if ($cmd eq 'search') {
684   my %matches;
685   my $di = $pool->Dataiterator(0, $solv::SOLVABLE_NAME, $ARGV[0], $solv::Dataiterator::SEARCH_SUBSTRING | $solv::Dataiterator::SEARCH_NOCASE);
686   for my $d (@$di) {
687     $matches{$d->{'solvid'}} = 1;
688   }
689   for my $solvid (sort keys %matches) {
690     my $s = $pool->{'solvables'}->[$solvid];
691     print "- ".$s->str()." [$s->{'repo'}->{'name'}] ".$s->lookup_str($solv::SOLVABLE_SUMMARY)."\n";
692   }
693   exit(0);
694 }
695
696 my @addedprovides =  $pool->addfileprovides_ids();
697 $pool->createwhatprovides();
698
699 my @jobs;
700 for my $arg (@ARGV) {
701   my @njobs = mkjobs($pool, $cmd, $arg);
702   die("nothing matches '$arg'\n") unless @njobs;
703   push @jobs, @njobs;
704 }
705
706 if ($cmd eq 'list' || $cmd eq 'info') {
707   die("no package matched.\n") unless @jobs;
708   for my $job (@jobs) {
709     for my $s ($pool->jobsolvables($job)) {
710       if ($cmd eq 'info') {
711         printf "Name:        %s\n", $s->str();
712         printf "Repo:        %s\n", $s->{'repo'}->{'name'};
713         printf "Summary:     %s\n", $s->lookup_str($solv::SOLVABLE_SUMMARY);
714         my $str = $s->lookup_str($solv::SOLVABLE_URL);
715         printf "Url:         %s\n", $str if $str;
716         $str = $s->lookup_str($solv::SOLVABLE_LICENSE);
717         printf "License:     %s\n", $str if $str;
718         printf "Description:\n%s\n", $s->lookup_str($solv::SOLVABLE_DESCRIPTION);
719       } else {
720         printf "  - %s [%s]\n", $s->str(), $s->{'repo'}->{'name'};
721         printf "    %s\n", $s->lookup_str($solv::SOLVABLE_SUMMARY);
722       }
723     }
724   }
725   exit 0;
726 }
727
728 if ($cmd eq 'install' || $cmd eq 'erase' || $cmd eq 'up' || $cmd eq 'dup' || $cmd eq 'verify') {
729   if (!@jobs) {
730     if ($cmd eq 'up' || $cmd eq 'verify') {
731       push @jobs, $pool->Job($solv::Job::SOLVER_SOLVABLE_ALL, 0);
732     } elsif ($cmd ne 'dup') {
733       die("no package matched.\n");
734     }
735   }
736   for my $job (@jobs) {
737     if ($cmd eq 'up') {
738       if ($job->{'how'} == $solv::Job::SOLVER_SOLVABLE_ALL || grep {$_->isinstalled()} $pool->jobsolvables($job)) {
739         $job->{'how'} |= $solv::Job::SOLVER_UPDATE;
740       } else {
741         $job->{'how'} |= $solv::Job::SOLVER_INSTALL;
742       }
743     } elsif ($cmd eq 'install') {
744         $job->{'how'} |= $solv::Job::SOLVER_INSTALL;
745     } elsif ($cmd eq 'erase') {
746         $job->{'how'} |= $solv::Job::SOLVER_ERASE;
747     } elsif ($cmd eq 'dup') {
748         $job->{'how'} |= $solv::Job::SOLVER_DISTUPGRADE;
749     } elsif ($cmd eq 'verify') {
750         $job->{'how'} |= $solv::Job::SOLVER_VERIFY;
751     }
752   }
753   my $solver;
754   while (1) {
755     $solver = $pool->Solver();
756     $solver->{'ignorealreadyrecommended'} = 1;
757     $solver->{'allowuninstall'} = 1 if $cmd eq 'erase';
758     if ($cmd eq 'dup' && !@jobs) {
759       $solver->{'distupgrade'} = 1;
760       $solver->{'updatesystem'} = 1;
761       $solver->{'allowdowngrade'} = 1;
762       $solver->{'allowvendorchange'} = 1;
763       $solver->{'allowarchchange'} = 1;
764       $solver->{'dosplitprovides'} = 1;
765     } elsif ($cmd eq 'up' and @jobs == 1 and $jobs[0]->{'how'} == ($solv::Job::SOLVER_UPDATE | $solv::Job::SOLVER_SOLVABLE_ALL)) {
766       $solver->{'dosplitprovides'} = 1;
767     }
768     my @problems = $solver->solve(\@jobs);
769     last unless @problems;
770     for my $problem (@problems) {
771       print "Problem $problem->{'id'}/".@problems.":\n";
772       my $r = $problem->findproblemrule();
773       my $ri = $r->info();
774       print $ri->problemstr()."\n";
775       my @solutions = $problem->solutions();
776       for my $solution (@solutions) {
777         print "  Solution $solution->{'id'}:\n";
778         for my $element ($solution->elements()) {
779           my $etype = $element->{'type'};
780           if ($etype == $solv::Solver::SOLVER_SOLUTION_JOB) {
781             print "  - do not ask to ".$jobs[$element->{'jobidx'}]->str()."\n";
782           } elsif ($etype == $solv::Solver::SOLVER_SOLUTION_INFARCH) {
783             if ($element->{'solvable'}->isinstalled()) {
784               print "  - keep ".$element->{'solvable'}->str()." despite the inferior architecture\n";
785             } else {
786               print "  - install ".$element->{'solvable'}->str()." despite the inferior architecture\n";
787             }
788           } elsif ($etype == $solv::Solver::SOLVER_SOLUTION_DISTUPGRADE) {
789             if ($element->{'solvable'}->isinstalled()) {
790               print "  - keep obsolete ".$element->{'solvable'}->str()."\n";
791             } else {
792               print "  - install ".$element->{'solvable'}->str()." from excluded repository\n";
793             }
794           } elsif ($etype == $solv::Solver::SOLVER_SOLUTION_REPLACE) {
795             print "  - allow replacement of ".$element->{'solvable'}->str()." with ".$element->{'replacement'}->str()."\n";
796           } elsif ($etype == $solv::Solver::SOLVER_SOLUTION_ERASE) {
797             print "  - allow deinstallation of ".$element->{'solvable'}->str()."\n";
798           } else {
799             print "  - allow something else\n";
800           }
801         }
802       }
803       my $sol;
804       while (1) {
805         print "Please choose a solution: ";
806         $sol = <STDIN>;
807         chomp $sol;
808         last if $sol eq 's' || $sol eq 'q' || ($sol =~ /^\d+$/ && $sol >= 1 && $sol <= @solutions);
809       }
810       next if $sol eq 's';
811       exit(1) if $sol eq 'q';
812       my $solution = $solutions[$sol - 1];
813       for my $element ($solution->elements()) {
814         my $etype = $element->{'type'};
815         if ($etype == $solv::Solver::SOLVER_SOLUTION_JOB) {
816           $jobs[$element->{'jobidx'}] = $pool->Job($solv::Job::SOLVER_NOOP, 0);
817         } else {
818           my $newjob = $element->Job();
819           push @jobs, $newjob if $newjob && !grep {$_->{'how'} == $newjob->{'how'} && $_->{'what'} == $newjob->{'what'}} @jobs;
820         }
821       }
822     }
823   }
824   my $trans = $solver->transaction();
825   undef $solver;
826   if ($trans->isempty()) {
827     print "Nothing to do.\n";
828     exit 0;
829   }
830   print "\nTransaction summary:\n\n";
831   for my $c ($trans->classify()) {
832     my ($ctype, $pkgs, $fromid, $toid) = @$c;
833     if ($ctype == $solv::Transaction::SOLVER_TRANSACTION_ERASE) {
834       printf "%d erased packages:\n", scalar(@$pkgs);
835     } elsif ($ctype == $solv::Transaction::SOLVER_TRANSACTION_INSTALL) {
836       printf "%d installed packages:\n", scalar(@$pkgs);
837     } elsif ($ctype == $solv::Transaction::SOLVER_TRANSACTION_REINSTALLED) {
838       printf "%d reinstalled packages:\n", scalar(@$pkgs);
839     } elsif ($ctype == $solv::Transaction::SOLVER_TRANSACTION_DOWNGRADED) {
840       printf "%d downgraded packages:\n", scalar(@$pkgs);
841     } elsif ($ctype == $solv::Transaction::SOLVER_TRANSACTION_CHANGED) {
842       printf "%d changed packages:\n", scalar(@$pkgs);
843     } elsif ($ctype == $solv::Transaction::SOLVER_TRANSACTION_UPGRADED) {
844       printf "%d upgraded packages:\n", scalar(@$pkgs);
845     } elsif ($ctype == $solv::Transaction::SOLVER_TRANSACTION_VENDORCHANGE) {
846       printf "%d vendor changes from '%s' to '%s':\n", scalar(@$pkgs), $pool->id2str($fromid), $pool->id2str($toid);
847     } elsif ($ctype == $solv::Transaction::SOLVER_TRANSACTION_ARCHCHANGE) {
848       printf "%d arch changes from '%s' to '%s':\n", scalar(@$pkgs), $pool->id2str($fromid), $pool->id2str($toid);
849     } else {
850       next;
851     }
852     for my $p (@$pkgs) {
853       if ($ctype == $solv::Transaction::SOLVER_TRANSACTION_UPGRADED || $ctype == $solv::Transaction::SOLVER_TRANSACTION_DOWNGRADED) {
854         my $other = $trans->othersolvable($p);
855         printf "  - %s -> %s\n", $p->str(), $other->str();
856       } else {
857         printf "  - %s\n", $p->str();
858       }
859     }
860     print "\n";
861   }
862   printf "install size change: %d K\n\n", $trans->calc_installsizechange();
863   while (1) {
864     print("OK to continue (y/n)? ");
865     my $yn = <STDIN>;
866     chomp $yn;
867     last if $yn eq 'y';
868     exit(1) if $yn eq 'n';
869   }
870   my @newpkgs = $trans->newpackages();
871   my %newpkgsfps;
872   if (@newpkgs) {
873     my $downloadsize = 0;
874     $downloadsize += $_->lookup_num($solv::SOLVABLE_DOWNLOADSIZE) for @newpkgs;
875     printf "Downloading %d packages, %d K\n", scalar(@newpkgs), $downloadsize;
876     for my $p (@newpkgs) {
877       my $repo = $p->{'repo'}->{'appdata'};
878       my ($location, $medianr) = $p->lookup_location();
879       next unless $location;
880       if ($repo->{'type'} eq 'susetags') {
881         $location = ($repo->{'handle'}->lookup_str($solv::SOLVID_META, $solv::SUSETAGS_DATADIR) || 'suse') ."/$location";
882       }
883       my $chksum = $p->lookup_checksum($solv::SOLVABLE_CHECKSUM);
884       my $f = $repo->download($location, 0, $chksum);
885       die("\n$repo->{'alias'}: $location not found in repository\n") unless $f;
886       $newpkgsfps{$p->{'id'}} = $f;
887       print ".";
888       STDOUT->flush();
889     }
890     print "\n";
891   }
892   print "Committing transaction:\n\n";
893   $trans->order(0);
894   for my $p ($trans->steps()) {
895     my $steptype = $trans->steptype($p, $solv::Transaction::SOLVER_TRANSACTION_RPM_ONLY);
896     if ($steptype == $solv::Transaction::SOLVER_TRANSACTION_ERASE) {
897       print "erase ".$p->str()."\n";
898       next unless $p->lookup_num($solv::RPM_RPMDBID);
899       my $evr = $p->{'evr'};
900       $evr =~ s/^[0-9]+://;     # strip epoch
901       system('rpm', '-e', '--nodeps', '--nodigest', '--nosignature', "$p->{'name'}-$evr.$p->{'arch'}") && die("rpm failed: $?\n");
902     } elsif ($steptype == $solv::Transaction::SOLVER_TRANSACTION_INSTALL || $steptype == $solv::Transaction::SOLVER_TRANSACTION_MULTIINSTALL) {
903       print "install ".$p->str()."\n";
904       my $f = $newpkgsfps{$p->{'id'}};
905       my $mode = $steptype == $solv::Transaction::SOLVER_TRANSACTION_INSTALL ? '-U' : '-i';
906       system('rpm', $mode, '--force', '--nodeps', '--nodigest', '--nosignature', "/dev/fd/".solv::xfileno($f)) && die("rpm failed: $?\n");
907       solv::xfclose($f);
908       delete $newpkgsfps{$p->{'id'}};
909     }
910   }
911 }
912
913 exit 0;