1# ex:ts=8 sw=4:
2# $OpenBSD: Dependencies.pm,v 1.151 2010/12/24 09:04:14 espie Exp $
3#
4# Copyright (c) 2005-2010 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16
17use strict;
18use warnings;
19
20use OpenBSD::SharedLibs;
21
22# generic dependencies lookup class: walk the dependency tree as far
23# as necessary to resolve dependencies
24package OpenBSD::lookup;
25
26sub lookup
27{
28	my ($self, $solver, $dependencies, $state, $obj) = @_;
29
30	my $known = $self->{known};
31	if (my $r = $self->find_in_already_done($solver, $state, $obj)) {
32		$dependencies->{$r} = 1;
33		return 1;
34	}
35	if ($self->find_in_extra_sources($solver, $state, $obj)) {
36		return 1;
37	}
38	# lookup through the rest of the tree...
39	my $done = $self->{done};
40	while (my $dep = pop @{$self->{todo}}) {
41		require OpenBSD::RequiredBy;
42
43		next if $done->{$dep};
44		$done->{$dep} = 1;
45		for my $dep2 (OpenBSD::Requiring->new($dep)->list) {
46			push(@{$self->{todo}}, $dep2) unless $done->{$dep2};
47		}
48		$known->{$dep} = 1;
49		if ($self->find_in_new_source($solver, $state, $obj, $dep)) {
50			$dependencies->{$dep} = 1;
51			return 1;
52		}
53	}
54	if (my $r = $self->find_elsewhere($solver, $state, $obj)) {
55		$dependencies->{$r} = 1;
56		return 1;
57	}
58
59	return 0;
60}
61
62sub new
63{
64	my ($class, $solver) = @_;
65
66	# prepare for closure
67	my @todo = $solver->dependencies;
68	bless { todo => \@todo, done => {}, known => {} }, $class;
69}
70
71sub dump
72{
73	my ($self, $state) = @_;
74
75	return unless %{$self->{done}};
76	$state->say("Full dependency tree is #1",
77	    join(' ', keys %{$self->{done}}));
78}
79
80package OpenBSD::lookup::library;
81our @ISA=qw(OpenBSD::lookup);
82
83sub say_found
84{
85	my ($self, $state, $obj, $where) = @_;
86
87	$state->say("found libspec #1 in #2", $obj->to_string, $where)
88	    if $state->verbose >= 3;
89}
90
91sub find_in_already_done
92{
93	my ($self, $solver, $state, $obj) = @_;
94
95
96	my $r = $solver->check_lib_spec($solver->{localbase}, $obj,
97	    $self->{known});
98	if ($r) {
99		$self->say_found($state, $obj, $state->f("package #1", $r));
100		return $r;
101	} else {
102		return undef;
103	}
104}
105
106sub find_in_extra_sources
107{
108	my ($self, $solver, $state, $obj) = @_;
109	return undef if !$obj->is_valid || defined $obj->{dir};
110
111	OpenBSD::SharedLibs::add_libs_from_system($state->{destdir}, $state);
112	for my $dir (OpenBSD::SharedLibs::system_dirs()) {
113		if ($solver->check_lib_spec($dir, $obj, {system => 1})) {
114			$self->say_found($state, $obj, $state->f("#1/lib", $dir));
115			return 'system';
116		}
117	}
118	return undef;
119}
120
121sub find_in_new_source
122{
123	my ($self, $solver, $state, $obj, $dep) = @_;
124
125	if (defined $solver->{set}->{newer}->{$dep}) {
126		OpenBSD::SharedLibs::add_libs_from_plist($solver->{set}->{newer}->{$dep}->plist, $state);
127	} else {
128		OpenBSD::SharedLibs::add_libs_from_installed_package($dep, $state);
129	}
130	if ($solver->check_lib_spec($solver->{localbase}, $obj, {$dep => 1})) {
131		$self->say_found($state, $obj, $state->f("package #1", $dep));
132		return $dep;
133	}
134	return undef;
135}
136
137sub find_elsewhere
138{
139	my ($self, $solver, $state, $obj) = @_;
140
141	for my $n ($solver->{set}->newer) {
142		for my $dep (@{$n->{plist}->{depend}}) {
143			my $r = $solver->find_old_lib($state,
144			    $solver->{localbase}, $dep->{pattern}, $obj);
145			if ($r) {
146				$self->say_found($state, $obj,
147				    $state->f("old package #1", $r));
148				return $r;
149			}
150		}
151	}
152	return undef;
153}
154
155package OpenBSD::lookup::tag;
156our @ISA=qw(OpenBSD::lookup);
157sub find_in_extra_sources
158{
159}
160
161sub find_elsewhere
162{
163}
164
165sub find_in_already_done
166{
167	my ($self, $solver, $state, $obj) = @_;
168	my $r = $self->{known_tags}->{$obj};
169	if (defined $r) {
170		$state->say("Found tag #1 in #2", $obj, $r)
171		    if $state->verbose >= 3;
172	}
173	return $r;
174}
175
176sub find_in_plist
177{
178	my ($self, $plist, $dep) = @_;
179	if ($plist->has('define-tag')) {
180		for my $t (@{$plist->{'define-tag'}}) {
181			$self->{known_tags}->{$t->name} = $dep;
182		}
183	}
184}
185
186sub find_in_new_source
187{
188	my ($self, $solver, $state, $obj, $dep) = @_;
189	my $plist = OpenBSD::PackingList->from_installation($dep,
190	    \&OpenBSD::PackingList::DependOnly);
191	if (!defined $plist) {
192		$state->errsay("Can't read plist for #1", $dep);
193	}
194	$self->find_in_plist($plist, $dep);
195	return $self->find_in_already_done($solver, $state, $obj);
196}
197
198package _cache;
199
200sub new
201{
202	my ($class, $v) = @_;
203	bless \$v, $class;
204}
205
206sub pretty
207{
208	my $self = shift;
209	return ref($self)."(".$$self.")";
210}
211
212package _cache::self;
213our @ISA=(qw(_cache));
214sub do
215{
216	my ($v, $solver, $state, $dep, $package) = @_;
217	push(@{$package->{before}}, $$v);
218	return $$v;
219}
220
221package _cache::installed;
222our @ISA=(qw(_cache));
223sub do
224{
225	my ($v, $solver, $state, $dep, $package) = @_;
226	return $$v;
227}
228
229package _cache::bad;
230our @ISA=(qw(_cache));
231sub do
232{
233	my ($v, $solver, $state, $dep, $package) = @_;
234	return $$v;
235}
236
237package _cache::to_install;
238our @ISA=(qw(_cache));
239sub do
240{
241	my ($v, $solver, $state, $dep, $package) = @_;
242	if ($state->tracker->{uptodate}{$$v}) {
243		bless $v, "_cache::installed";
244		$solver->set_global($dep, $v);
245		return $$v;
246	}
247	if ($state->tracker->{cant_install}{$$v}) {
248		bless $v, "_cache::bad";
249		$solver->set_global($dep, $v);
250		return $$v;
251	}
252	if ($state->tracker->{to_install}{$$v}) {
253		my $set = $state->tracker->{to_install}{$$v};
254		if ($set->real_set eq $solver->{set}) {
255			bless $v, "_cache::self";
256			return $v->do($solver, $state, $dep, $package);
257		} else {
258			$solver->add_dep($set);
259			return $$v;
260		}
261	}
262	return;
263}
264
265package _cache::to_update;
266our @ISA=(qw(_cache));
267sub do
268{
269	my ($v, $solver, $state, $dep, $package) = @_;
270	my $alt = $solver->find_dep_in_self($state, $dep);
271	if ($alt) {
272		$solver->set_cache($dep, _cache::self->new($alt));
273		push(@{$package->{before}}, $alt);
274		return $alt;
275	}
276
277	if ($state->tracker->{to_update}{$$v}) {
278		$solver->add_dep($state->tracker->{to_update}{$$v});
279		return $$v;
280	}
281	if ($state->tracker->{uptodate}{$$v}) {
282		bless $v, "_cache::installed";
283		$solver->set_global($dep, $v);
284		return $$v;
285	}
286	if ($state->tracker->{cant_update}{$$v}) {
287		bless $v, "_cache::bad";
288		$solver->set_global($dep, $v);
289		return $$v;
290	}
291	my @candidates = $dep->spec->filter(keys %{$state->tracker->{installed}});
292	if (@candidates > 0) {
293		$solver->set_global($dep, _cache::installed->new($candidates[0]));
294		return $candidates[0];
295	}
296	return;
297}
298
299package OpenBSD::Cloner;
300sub clone
301{
302	my ($self, $h, @extra) = @_;
303	for my $extra (@extra) {
304		next unless defined $extra;
305		while (my ($k, $e) = each %{$extra->{$h}}) {
306			$self->{$h}{$k} //= $e;
307		}
308	}
309}
310
311package OpenBSD::Dependencies::SolverBase;
312our @ISA = qw(OpenBSD::Cloner);
313
314my $global_cache = {};
315
316sub cached
317{
318	my ($self, $dep) = @_;
319	return $global_cache->{$dep->{pattern}} ||
320	    $self->{cache}{$dep->{pattern}};
321}
322
323sub set_cache
324{
325	my ($self, $dep, $value) = @_;
326	$self->{cache}{$dep->{pattern}} = $value;
327}
328
329sub set_global
330{
331	my ($self, $dep, $value) = @_;
332	$global_cache->{$dep->{pattern}} = $value;
333}
334
335sub global_cache
336{
337	my ($self, $pattern) = @_;
338	return $global_cache->{$pattern};
339}
340
341sub find_candidate
342{
343	my ($self, $dep, @list) = @_;
344	my @candidates = $dep->spec->filter(@list);
345	if (@candidates >= 1) {
346		return $candidates[0];
347	} else {
348		return undef;
349	}
350}
351
352sub solve_dependency
353{
354	my ($self, $state, $dep, $package) = @_;
355
356	my $v;
357
358	if (defined $self->cached($dep)) {
359		if ($state->defines('stat_cache')) {
360			if (defined $self->global_cache($dep->{pattern})) {
361				$state->print("Global ");
362			}
363			$state->say("Cache hit on #1: #2", $dep->{pattern},
364			    $self->cached($dep)->pretty);
365		}
366		$v = $self->cached($dep)->do($self, $state, $dep, $package);
367		return $v if $v;
368	}
369	if ($state->defines('stat_cache')) {
370		$state->say("No cache hit on #1", $dep->{pattern});
371	}
372
373	$self->really_solve_dependency($state, $dep, $package);
374}
375
376sub solve_depends
377{
378	my ($self, $state) = @_;
379
380	$self->{all_dependencies} = {};
381	$self->{to_register} = {};
382	$self->{deplist} = {};
383	delete $self->{installed};
384
385	for my $package ($self->{set}->newer, $self->{set}->kept) {
386		$package->{before} = [];
387		for my $dep (@{$package->{plist}->{depend}}) {
388			my $v = $self->solve_dependency($state, $dep, $package);
389			# XXX
390			next if !defined $v;
391			$self->{all_dependencies}->{$v} = $dep;
392			$self->{to_register}->{$package}->{$v} = $dep;
393		}
394	}
395
396	return values %{$self->{deplist}};
397}
398
399sub solve_wantlibs
400{
401	my ($solver, $state) = @_;
402	my $okay = 1;
403
404	my $lib_finder = OpenBSD::lookup::library->new($solver);
405	for my $h ($solver->{set}->newer) {
406		for my $lib (@{$h->{plist}->{wantlib}}) {
407			$solver->{localbase} = $h->{plist}->localbase;
408			next if $lib_finder->lookup($solver,
409			    $solver->{to_register}->{$h}, $state,
410			    $lib->spec);
411			if ($okay) {
412				$solver->errsay_library($state, $h);
413			}
414			$okay = 0;
415			OpenBSD::SharedLibs::report_problem($state,
416			    $lib->spec);
417		}
418	}
419	if (!$okay) {
420		$solver->dump($state);
421		$lib_finder->dump($state);
422	}
423	return $okay;
424}
425
426sub dump
427{
428	my ($self, $state) = @_;
429	if ($self->dependencies) {
430	    $state->print("Direct dependencies for #1 resolve to #2",
431	    	$self->{set}->print, join(' ',  $self->dependencies));
432	    $state->print(" (todo: #1)",
433	    	join(' ', (map {$_->print} values %{$self->{deplist}})))
434	    	if %{$self->{deplist}};
435	    $state->print("\n");
436	}
437}
438
439sub dependencies
440{
441	my $self = shift;
442	if (wantarray) {
443		return keys %{$self->{all_dependencies}};
444	} else {
445		return scalar(%{$self->{all_dependencies}});
446	}
447}
448
449sub check_lib_spec
450{
451	my ($self, $base, $spec, $dependencies) = @_;
452	my $r = OpenBSD::SharedLibs::lookup_libspec($base, $spec);
453	for my $candidate (@$r) {
454		if ($dependencies->{$candidate->origin}) {
455			return $candidate->origin;
456		}
457	}
458	return;
459}
460
461sub find_dep_in_installed
462{
463	my ($self, $state, $dep) = @_;
464
465	return $self->find_candidate($dep, @{$self->installed_list});
466}
467
468sub find_dep_in_self
469{
470	my ($self, $state, $dep) = @_;
471
472	return $self->find_candidate($dep, $self->{set}->newer_names);
473}
474
475use OpenBSD::PackageInfo;
476OpenBSD::Auto::cache(installed_list,
477	sub {
478		my $self = shift;
479		my @l = installed_packages();
480
481		for my $o ($self->{set}->older_names) {
482			@l = grep {$_ ne $o} @l;
483		}
484		return \@l;
485	}
486);
487
488sub add_dep
489{
490	my ($self, $d) = @_;
491	$self->{deplist}{$d} = $d;
492}
493
494package OpenBSD::Dependencies::Solver;
495our @ISA = qw(OpenBSD::Dependencies::SolverBase);
496
497use OpenBSD::PackageInfo;
498
499sub merge
500{
501	my ($solver, @extra) = @_;
502
503	$solver->clone('cache', @extra);
504}
505
506sub new
507{
508	my ($class, $set) = @_;
509	bless { set => $set, bad => [] }, $class;
510}
511
512sub check_for_loops
513{
514	my ($self, $state) = @_;
515
516	my $initial = $self->{set};
517
518	my @todo = ();
519	my @to_merge = ();
520	push(@todo, $initial);
521	my $done = {};
522
523	while (my $set = shift @todo) {
524		next unless defined $set->{solver};
525		for my $l (values %{$set->solver->{deplist}}) {
526			if ($l eq $initial) {
527				push(@to_merge, $set);
528			}
529			next if $done->{$l};
530			next if $done->{$l->real_set};
531			push(@todo, $l);
532			$done->{$l} = $set;
533		}
534	}
535	if (@to_merge > 0) {
536		my $merged = {};
537		my @real = ();
538		$state->say("Detected loop, merging sets #1", $state->ntogo);
539		$state->say("| #1", $initial->print);
540		for my $set (@to_merge) {
541			my $k = $set;
542			while ($k ne $initial && !$merged->{$k}) {
543				unless ($k->{finished}) {
544					$state->say("| #1", $k->print);
545					delete $k->solver->{deplist};
546					push(@real, $k);
547				}
548				$merged->{$k} = 1;
549				$k = $done->{$k};
550			}
551		}
552		delete $initial->solver->{deplist};
553		$initial->merge($state->tracker, @real);
554	}
555}
556
557sub find_dep_in_repositories
558{
559	my ($self, $state, $dep) = @_;
560
561	return unless $dep->spec->is_valid;
562
563	my $candidates = $self->{set}->match_locations($dep->spec);
564	if (!$state->defines('allversions')) {
565		require OpenBSD::Search;
566		$candidates = OpenBSD::Search::FilterLocation->
567		    keep_most_recent->filter_locations($candidates);
568	}
569	# XXX not really efficient, but hey
570	my %c = map {($_->name, $_)} @$candidates;
571	my @pkgs = keys %c;
572	if (@pkgs == 1) {
573		return $candidates->[0];
574	} elsif (@pkgs > 1) {
575		require OpenBSD::Interactive;
576
577		# put default first if available
578		@pkgs = ((grep {$_ eq $dep->{def}} @pkgs),
579		    (sort (grep {$_ ne $dep->{def}} @pkgs)));
580		my $good = $state->ask_list(
581		    'Ambiguous: choose dependency for '.$self->{set}->print.': ',
582		    $state->{interactive}, @pkgs);
583		return $c{$good};
584	} else {
585		return;
586	}
587}
588
589sub find_dep_in_stuff_to_install
590{
591	my ($self, $state, $dep) = @_;
592
593	my $v = $self->find_candidate($dep,
594	    keys %{$state->tracker->{uptodate}});
595	if ($v) {
596		$self->set_global($dep, _cache::installed->new($v));
597		return $v;
598	}
599	# this is tricky, we don't always know what we're going to actually
600	# install yet.
601	my @candidates = $dep->spec->filter(keys %{$state->tracker->{to_update}});
602	if (@candidates > 0) {
603		for my $k (@candidates) {
604			my $set = $state->tracker->{to_update}{$k};
605			$self->add_dep($set);
606		}
607		if (@candidates == 1) {
608			$self->set_cache($dep,
609			    _cache::to_update->new($candidates[0]));
610		}
611		return $candidates[0];
612	}
613
614	$v = $self->find_candidate($dep, keys %{$state->tracker->{to_install}});
615	if ($v) {
616		$self->set_cache($dep, _cache::to_install->new($v));
617		$self->add_dep($state->tracker->{to_install}->{$v});
618	}
619	return $v;
620}
621
622sub really_solve_dependency
623{
624	my ($self, $state, $dep, $package) = @_;
625
626	my $v;
627
628	if ($state->{allow_replacing}) {
629
630		$v = $self->find_dep_in_self($state, $dep);
631		if ($v) {
632			$self->set_cache($dep, _cache::self->new($v));
633			push(@{$package->{before}}, $v);
634			return $v;
635		}
636		$v = $self->find_candidate($dep, $self->{set}->older_names);
637		if ($v) {
638			push(@{$self->{bad}}, $dep->{pattern});
639			return $v;
640		}
641		$v = $self->find_dep_in_stuff_to_install($state, $dep);
642		return $v if $v;
643	}
644
645	$v = $self->find_dep_in_installed($state, $dep);
646	if ($v) {
647		if ($state->{newupdates}) {
648			if ($state->tracker->is_known($v)) {
649				return $v;
650			}
651			my $set = $state->updateset->add_older(OpenBSD::Handle->create_old($v, $state));
652			$set->merge_paths($self->{set});
653			$self->add_dep($set);
654			$self->set_cache($dep, _cache::to_update->new($v));
655			$state->tracker->todo($set);
656		}
657		return $v;
658	}
659	if (!$state->{allow_replacing}) {
660		$v = $self->find_dep_in_stuff_to_install($state, $dep);
661		return $v if $v;
662	}
663
664	$v = $self->find_dep_in_repositories($state, $dep);
665
666	my $s;
667	if ($v) {
668		$s = $state->updateset_from_location($v);
669		$v = $v->name;
670	} else {
671		# resort to default if nothing else
672		$v = $dep->{def};
673		$s = $state->updateset_with_new($v);
674	}
675
676	$s->merge_paths($self->{set});
677	$state->tracker->todo($s);
678	$self->add_dep($s);
679	$self->set_cache($dep, _cache::to_install->new($v));
680	return $v;
681}
682
683sub check_depends
684{
685	my $self = shift;
686
687	for my $dep ($self->dependencies) {
688		push(@{$self->{bad}}, $dep)
689		    unless is_installed($dep) or
690		    	defined $self->{set}->{newer}->{$dep};
691	}
692	return $self->{bad};
693}
694
695sub register_dependencies
696{
697	my ($self, $state) = @_;
698
699	require OpenBSD::RequiredBy;
700	for my $pkg ($self->{set}->newer) {
701		my $pkgname = $pkg->pkgname;
702		my @l = keys %{$self->{to_register}->{$pkg}};
703
704		OpenBSD::Requiring->new($pkgname)->add(@l);
705		for my $dep (@l) {
706			OpenBSD::RequiredBy->new($dep)->add($pkgname);
707		}
708	}
709}
710
711sub repair_dependencies
712{
713	my ($self, $state) = @_;
714	for my $p ($self->{set}->newer) {
715		my $pkgname = $p->pkgname;
716		for my $pkg (installed_packages(1)) {
717			my $plist = OpenBSD::PackingList->from_installation(
718			    $pkg, \&OpenBSD::PackingList::DependOnly);
719			$plist->repair_dependency($pkg, $pkgname);
720		}
721	}
722}
723
724sub find_old_lib
725{
726	my ($self, $state, $base, $pattern, $lib) = @_;
727
728	require OpenBSD::Search;
729
730	my $r = $state->repo->installed->match_locations(OpenBSD::Search::PkgSpec->new(".libs-".$pattern));
731	for my $try (map {$_->name} @$r) {
732		OpenBSD::SharedLibs::add_libs_from_installed_package($try, $state);
733		if ($self->check_lib_spec($base, $lib, {$try => 1})) {
734			return $try;
735		}
736	}
737	return undef;
738}
739
740sub errsay_library
741{
742	my ($solver, $state, $h) = @_;
743
744	$state->errsay("Can't install #1 because of libraries", $h->pkgname);
745}
746
747sub solve_tags
748{
749	my ($solver, $state) = @_;
750	my $okay = 1;
751
752	my $tag_finder = OpenBSD::lookup::tag->new($solver);
753	for my $h ($solver->{set}->newer) {
754		for my $tag (keys %{$h->{plist}->{tags}}) {
755			next if $tag_finder->lookup($solver,
756			    $solver->{to_register}->{$h}, $state, $tag);
757			$state->errsay("Can't install #1: tag definition not found #2",
758			    $h->pkgname, $tag);
759			if ($okay) {
760				$solver->dump($state);
761				$tag_finder->dump($state);
762				$okay = 0;
763			}
764	    	}
765	}
766	return $okay;
767}
768
769package OpenBSD::PackingElement;
770sub repair_dependency
771{
772}
773
774package OpenBSD::PackingElement::Dependency;
775sub repair_dependency
776{
777	my ($self, $requiring, $required) = @_;
778	if ($self->spec->filter($required) == 1) {
779		require OpenBSD::RequiredBy;
780		OpenBSD::RequiredBy->new($required)->add($requiring);
781		OpenBSD::Requiring->new($requiring)->add($required);
782	}
783}
784
7851;
786