xref: /openbsd/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm (revision 039cbdaa) 
1# ex:ts=8 sw=4:
2# $OpenBSD: PkgSpec.pm,v 1.51 2023/06/13 09:07:17 espie Exp $
3#
4# Copyright (c) 2003-2007 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# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18use v5.36;
19
20package OpenBSD::PkgSpec::flavorspec;
21sub new($class, $spec)
22{
23	bless \$spec, $class;
24}
25
26sub check_1flavor($f, $spec)
27{
28	for my $flavor (split /\-/o, $spec) {
29		# must not be here
30		if ($flavor =~ m/^\!(.*)$/o) {
31			return 0 if $f->{$1};
32		# must be here
33		} else {
34			return 0 unless $f->{$flavor};
35		}
36	}
37	return 1;
38}
39
40sub match($self, $h)
41{
42	# check each flavor constraint
43	for my $c (split /\,/o, $$self) {
44		if (check_1flavor($h->{flavors}, $c)) {
45			return 1;
46		}
47	}
48	return 0;
49}
50
51package OpenBSD::PkgSpec::exactflavor;
52our @ISA = qw(OpenBSD::PkgSpec::flavorspec);
53sub new($class, $value)
54{
55	bless {map{($_, 1)} split(/\-/, $value)}, $class;
56}
57
58sub flavor_string($self)
59{
60	return join('-', sort keys %$self);
61}
62
63sub match($self, $h)
64{
65	if ($self->flavor_string eq $h->flavor_string) {
66		return 1;
67	} else {
68		return 0;
69	}
70}
71
72package OpenBSD::PkgSpec::versionspec;
73our @ISA = qw(OpenBSD::PackageName::version);
74my $ops = {
75	'<' => 'lt',
76	'<=' => 'le',
77	'>' => 'gt',
78	'>=' => 'ge',
79	'=' => 'eq'
80};
81
82sub new($class, $s)
83{
84	my ($op, $version) = ('=', $s);
85	if ($s =~ m/^(\>\=|\>|\<\=|\<|\=)(.*)$/) {
86		($op, $version) = ($1, $2);
87	}
88	return "OpenBSD::PkgSpec::version::$ops->{$op}"->from_string($version);
89}
90
91sub pnum_compare($self, $b)
92{
93	if (!defined $self->{p}) {
94		return 0;
95	} else {
96		return $self->SUPER::pnum_compare($b);
97	}
98}
99
100sub is_exact($)
101{
102	return 0;
103}
104
105package OpenBSD::PkgSpec::version::lt;
106our @ISA = qw(OpenBSD::PkgSpec::versionspec);
107sub match($self, $b)
108{
109	-$self->compare($b->{version}) < 0 ? 1 : 0;
110}
111
112package OpenBSD::PkgSpec::version::le;
113our @ISA = qw(OpenBSD::PkgSpec::versionspec);
114sub match($self, $b)
115{
116	-$self->compare($b->{version}) <= 0 ? 1 : 0;
117}
118
119package OpenBSD::PkgSpec::version::gt;
120our @ISA = qw(OpenBSD::PkgSpec::versionspec);
121sub match($self, $b)
122{
123	-$self->compare($b->{version}) > 0 ? 1 : 0;
124}
125
126package OpenBSD::PkgSpec::version::ge;
127our @ISA = qw(OpenBSD::PkgSpec::versionspec);
128sub match($self, $b)
129{
130	-$self->compare($b->{version}) >= 0 ? 1 : 0;
131}
132
133package OpenBSD::PkgSpec::version::eq;
134our @ISA = qw(OpenBSD::PkgSpec::versionspec);
135sub match($self, $b)
136{
137	-$self->compare($b->{version}) == 0 ? 1 : 0;
138}
139
140sub is_exact($)
141{
142	return 1;
143}
144
145package OpenBSD::PkgSpec::badspec;
146sub new($class)
147{
148	bless {}, $class;
149}
150
151# $self->match*($list)
152sub match_ref($, $)
153{
154	return ();
155}
156
157sub match_libs_ref($, $)
158{
159	return ();
160}
161
162sub match_locations($, $)
163{
164	return [];
165}
166
167sub is_valid($)
168{
169	return 0;
170}
171
172package OpenBSD::PkgSpec::SubPattern;
173use OpenBSD::PackageName;
174
175sub parse($class, $p)
176{
177	my $r = {};
178
179	# let's try really hard to find the stem and the flavors
180	unless ($p =~ m/^
181	    	([^%]+?) # stem part
182		\-
183		(
184		    (?:\>|\>\=|\<\=|\<|\=)?\d[^-%]*  # optional op + version
185		    |\* # or any version
186		)
187		(?:\-([^%]*))? # optional flavor part
188	    $/x) {
189		return undef;
190	}
191	($r->{stemspec}, $r->{vspec}, $r->{flavorspec}) = ($1, $2, $3);
192
193	$r->{flavorspec} //= '';
194	$r->{stemspec} =~ s/\./\\\./go;
195	$r->{stemspec} =~ s/\+/\\\+/go;
196	$r->{stemspec} =~ s/\*/\.\*/go;
197	$r->{stemspec} =~ s/\?/\./go;
198	$r->{stemspec} =~ s/^(\\\.libs)\-/$1\\d*\-/go;
199	return $r;
200}
201
202sub add_version_constraints($class, $constraints, $vspec)
203{
204	# turn the vspec into a list of constraints.
205	if ($vspec eq '*') {
206		# non constraint
207	} else {
208		for my $c (split /\,/, $vspec) {
209			push(@$constraints,
210			    OpenBSD::PkgSpec::versionspec->new($c));
211		}
212	}
213}
214
215sub add_flavor_constraints($class, $constraints, $flavorspec)
216{
217	# and likewise for flavors
218	if ($flavorspec eq '') {
219		# non constraint
220	} else {
221		push(@$constraints,
222		    OpenBSD::PkgSpec::flavorspec->new($flavorspec));
223	}
224}
225
226sub new($class, $p, $with_partial)
227{
228	my $r = $class->parse($p);
229	if (defined $r) {
230		my $stemspec = $r->{stemspec};
231		my $constraints = [];
232		$class->add_version_constraints($constraints, $r->{vspec});
233		$class->add_flavor_constraints($constraints, $r->{flavorspec});
234
235		my $o = bless {
236			libstem => qr{^\.libs\d*\-$stemspec\-\d.*$},
237		    }, $class;
238
239		if ($with_partial) {
240			$o->{fuzzystem} = qr{^(?:partial\-)*$stemspec\-\d.*$};
241		} else {
242			$o->{fuzzystem} = qr{^$stemspec\-\d.*$};
243		}
244		if (@$constraints != 0) {
245			$o->{constraints} = $constraints;
246		}
247		if (defined $r->{e}) {
248			$o->{e} = 1;
249		}
250	   	return $o;
251	} else {
252		return OpenBSD::PkgSpec::badspec->new;
253	}
254}
255
256sub match_ref($o, $list)
257{
258	my @result = ();
259	# Now, have to extract the version number, and the flavor...
260LOOP1:
261	for my $s (grep(/$o->{fuzzystem}/, @$list)) {
262		my $name = OpenBSD::PackageName->from_string($s);
263		if (defined $o->{constraints}) {
264			for my $c (@{$o->{constraints}}) {
265				next LOOP1 unless $c->match($name);
266			}
267		}
268		if (wantarray) {
269			push(@result, $s);
270		} else {
271			return 1;
272		}
273	}
274
275	if (wantarray) {
276		return @result;
277	} else {
278		return 0;
279	}
280}
281
282sub match_libs_ref($o, $list)
283{
284	return grep(/$o->{libstem}/, @$list);
285}
286
287
288sub match_locations($o, $list)
289{
290	my $result = [];
291	# Now, have to extract the version number, and the flavor...
292LOOP2:
293	for my $s (grep { $_->name =~ m/$o->{fuzzystem}/} @$list) {
294		my $name = $s->pkgname;
295		if (defined $o->{constraints}) {
296			for my $c (@{$o->{constraints}}) {
297				next LOOP2 unless $c->match($name);
298			}
299		}
300		push(@$result, $s);
301	}
302
303	return $result;
304}
305
306sub is_valid($)
307{
308	return 1;
309}
310
311package OpenBSD::PkgSpec;
312sub subpattern_class($)
313{ "OpenBSD::PkgSpec::SubPattern" }
314sub new($class, $pattern, $with_partial = 0)
315{
316	my @l = map { $class->subpattern_class->new($_, $with_partial) }
317		(split /\|/o, $pattern);
318	if (@l == 1) {
319		return $l[0];
320	} else {
321		return bless \@l, $class;
322	}
323}
324
325sub match_ref($self, $r)
326{
327	if (wantarray) {
328		my @l = ();
329		for my $subpattern (@$self) {
330			push(@l, $subpattern->match_ref($r));
331		}
332		return @l;
333	} else {
334		for my $subpattern (@$self) {
335			if ($subpattern->match_ref($r)) {
336				return 1;
337			}
338		}
339		return 0;
340	}
341}
342
343sub match_libs_ref($self, $r)
344{
345	if (wantarray) {
346		my @l = ();
347		for my $subpattern (@$self) {
348			push(@l, $subpattern->match_libs_ref($r));
349		}
350		return @l;
351	} else {
352		for my $subpattern (@$self) {
353			if ($subpattern->match_libs_ref($r)) {
354				return 1;
355			}
356		}
357		return 0;
358	}
359}
360
361sub match_locations($self, $r)
362{
363	my $l = [];
364	for my $subpattern (@$self) {
365		push(@$l, @{$subpattern->match_locations($r)});
366	}
367	return $l;
368}
369
370sub is_valid($self)
371{
372	for my $subpattern (@$self) {
373		return 0 unless $subpattern->is_valid;
374	}
375	return 1;
376}
377
378package OpenBSD::PkgSpec::SubPattern::Exact;
379our @ISA = qw(OpenBSD::PkgSpec::SubPattern);
380
381sub add_version_constraints($class, $constraints, $vspec)
382{
383	return if $vspec eq '*'; # XXX
384	my $v = OpenBSD::PkgSpec::versionspec->new($vspec);
385	die "not a good exact spec" if !$v->is_exact;
386	delete $v->{p};
387	push(@$constraints, $v);
388}
389
390sub add_flavor_constraints($class, $constraints, $flavorspec)
391{
392	push(@$constraints, OpenBSD::PkgSpec::exactflavor->new($flavorspec));
393}
394
395package OpenBSD::PkgSpec::Exact;
396our @ISA = qw(OpenBSD::PkgSpec);
397
398sub subpattern_class($)
399{ "OpenBSD::PkgSpec::SubPattern::Exact" }
400
4011;
402