12a95ed22Sespie# ex:ts=8 sw=4: 2*d803f986Sespie# $OpenBSD: LibSpec.pm,v 1.21 2023/10/08 12:45:31 espie Exp $ 32a95ed22Sespie# 42a95ed22Sespie# Copyright (c) 2010 Marc Espie <espie@openbsd.org> 52a95ed22Sespie# 62a95ed22Sespie# Permission to use, copy, modify, and distribute this software for any 72a95ed22Sespie# purpose with or without fee is hereby granted, provided that the above 82a95ed22Sespie# copyright notice and this permission notice appear in all copies. 92a95ed22Sespie# 102a95ed22Sespie# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 112a95ed22Sespie# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 122a95ed22Sespie# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 132a95ed22Sespie# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 142a95ed22Sespie# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 152a95ed22Sespie# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 162a95ed22Sespie# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 172a95ed22Sespie# 18039cbdaaSespieuse v5.36; 192a95ed22Sespie 204add690fSespiepackage OpenBSD::LibObject; 212a95ed22Sespie 22*d803f986Sespiesub systemlibraryclass($self) 23*d803f986Sespie{ 24*d803f986Sespie return ref($self); 25*d803f986Sespie} 26*d803f986Sespie 27039cbdaaSespiesub key($self) 282a95ed22Sespie{ 294add690fSespie if (defined $self->{dir}) { 302a95ed22Sespie return "$self->{dir}/$self->{stem}"; 314add690fSespie } else { 324add690fSespie return $self->{stem}; 334add690fSespie } 342a95ed22Sespie} 352a95ed22Sespie 36039cbdaaSespiesub major($self) 372a95ed22Sespie{ 382a95ed22Sespie return $self->{major}; 392a95ed22Sespie} 402a95ed22Sespie 41039cbdaaSespiesub minor($self) 422a95ed22Sespie{ 432a95ed22Sespie return $self->{minor}; 442a95ed22Sespie} 452a95ed22Sespie 46039cbdaaSespiesub version($self) 472a95ed22Sespie{ 486e1be68bSespie return ".".$self->major.".".$self->minor; 494add690fSespie} 504add690fSespie 51039cbdaaSespiesub is_static($) { 0 } 526e1be68bSespie 53039cbdaaSespiesub is_valid($) { 1 } 546e1be68bSespie 55039cbdaaSespiesub stem($self) 564add690fSespie{ 574add690fSespie return $self->{stem}; 584add690fSespie} 594add690fSespie 60039cbdaaSespiesub badclass($self) 614add690fSespie{ 624add690fSespie "OpenBSD::BadLib"; 634add690fSespie} 644add690fSespie 65039cbdaaSespiesub lookup($spec, $repo, $base) 664add690fSespie{ 674add690fSespie my $approx = $spec->lookup_stem($repo); 684add690fSespie if (!defined $approx) { 694add690fSespie return undef; 704add690fSespie } 714add690fSespie my $r = []; 724add690fSespie for my $c (@$approx) { 734add690fSespie if ($spec->match($c, $base)) { 744add690fSespie push(@$r, $c); 754add690fSespie } 764add690fSespie } 774add690fSespie return $r; 784add690fSespie} 794add690fSespie 80039cbdaaSespiesub compare($a, $b) 81605f450fSespie{ 82605f450fSespie if ($a->key ne $b->key) { 83605f450fSespie return $a->key cmp $b->key; 84605f450fSespie } 85605f450fSespie if ($a->major != $b->major) { 86605f450fSespie return $a->major <=> $b->major; 87605f450fSespie } 88605f450fSespie return $a->minor <=> $b->minor; 89605f450fSespie} 90605f450fSespie 914add690fSespiepackage OpenBSD::BadLib; 924add690fSespieour @ISA=qw(OpenBSD::LibObject); 934add690fSespie 94039cbdaaSespiesub to_string($self) 954add690fSespie{ 967e83eca3Sespie return $$self; 974add690fSespie} 984add690fSespie 99039cbdaaSespiesub new($class, $string) 1004add690fSespie{ 1014add690fSespie bless \$string, $class; 1024add690fSespie} 1034add690fSespie 104039cbdaaSespiesub is_valid($) 1054add690fSespie{ 1064add690fSespie return 0; 1074add690fSespie} 1084add690fSespie 109039cbdaaSespiesub lookup_stem($, $) 1104add690fSespie{ 1114add690fSespie return undef; 1124add690fSespie} 1134add690fSespie 1140413d3f2Sespie# $spec->match($library, $base) 115039cbdaaSespiesub match($, $, $) 1164add690fSespie{ 1174add690fSespie return 0; 1184add690fSespie} 1194add690fSespie 1204add690fSespiepackage OpenBSD::LibRepo; 121039cbdaaSespie 122039cbdaaSespiesub new($class) 1234add690fSespie{ 1244add690fSespie bless {}, $class; 1254add690fSespie} 1264add690fSespie 127039cbdaaSespiesub register($repo, $lib, $origin) 1284add690fSespie{ 1294add690fSespie $lib->set_origin($origin); 1304add690fSespie push @{$repo->{$lib->stem}}, $lib; 1314add690fSespie} 1324add690fSespie 133039cbdaaSespiesub find_best($repo, $stem) 134e4e7a0bbSespie{ 135e4e7a0bbSespie my $best; 136e4e7a0bbSespie 137e4e7a0bbSespie if (exists $repo->{$stem}) { 138e4e7a0bbSespie for my $lib (@{$repo->{$stem}}) { 139e4e7a0bbSespie if (!defined $best || $lib->is_better($best)) { 140e4e7a0bbSespie $best = $lib; 141e4e7a0bbSespie } 142e4e7a0bbSespie } 143e4e7a0bbSespie } 144e4e7a0bbSespie return $best; 145e4e7a0bbSespie} 146e4e7a0bbSespie 1474add690fSespiepackage OpenBSD::Library; 1484add690fSespieour @ISA = qw(OpenBSD::LibObject); 1494add690fSespie 150*d803f986Sespiesub systemlibraryclass($) 151*d803f986Sespie{ 152*d803f986Sespie "OpenBSD::Library::System"; 153*d803f986Sespie} 154*d803f986Sespie 155039cbdaaSespiesub from_string($class, $filename) 1564add690fSespie{ 1574add690fSespie if (my ($dir, $stem, $major, $minor) = $filename =~ m/^(.*)\/lib([^\/]+)\.so\.(\d+)\.(\d+)$/o) { 1584add690fSespie bless { dir => $dir, stem => $stem, major => $major, 1594add690fSespie minor => $minor }, $class; 1604add690fSespie } else { 1614add690fSespie return $class->badclass->new($filename); 1624add690fSespie } 1634add690fSespie} 1644add690fSespie 165039cbdaaSespiesub to_string($self) 1664add690fSespie{ 1674add690fSespie return "$self->{dir}/lib$self->{stem}.so.$self->{major}.$self->{minor}"; 1684add690fSespie} 1694add690fSespie 170039cbdaaSespiesub set_origin($self, $origin) 1714add690fSespie{ 1724add690fSespie $self->{origin} = $origin; 173*d803f986Sespie if ($origin eq 'system') { 174*d803f986Sespie bless $self, $self->systemlibraryclass; 175*d803f986Sespie } 1764add690fSespie return $self; 1774add690fSespie} 1784add690fSespie 179039cbdaaSespiesub origin($self) 1804add690fSespie{ 1814add690fSespie return $self->{origin}; 1824add690fSespie} 1834add690fSespie 184039cbdaaSespiesub no_match_dispatch($library, $spec, $base) 185456981a6Sespie{ 186456981a6Sespie return $spec->no_match_shared($library, $base); 187456981a6Sespie} 188456981a6Sespie 189039cbdaaSespiesub is_better($self, $other) 1906e1be68bSespie{ 1916e1be68bSespie if ($other->is_static) { 1926e1be68bSespie return 1; 1936e1be68bSespie } 1946e1be68bSespie if ($self->major > $other->major) { 1956e1be68bSespie return 1; 1966e1be68bSespie } 1976e1be68bSespie if ($self->major == $other->major && $self->minor > $other->minor) { 1986e1be68bSespie return 1; 1996e1be68bSespie } 2006e1be68bSespie return 0; 2016e1be68bSespie} 2026e1be68bSespie 203*d803f986Sespie# could be used for better reporting 204*d803f986Sespie# is used for regression testing 205*d803f986Sespiepackage OpenBSD::Library::System; 206*d803f986Sespieour @ISA = qw(OpenBSD::Library); 207*d803f986Sespie 2084add690fSespiepackage OpenBSD::LibSpec; 2094add690fSespieour @ISA = qw(OpenBSD::LibObject); 2104add690fSespie 211039cbdaaSespiesub new($class, $dir, $stem, $major, $minor) 2124add690fSespie{ 2134add690fSespie bless { 2144add690fSespie dir => $dir, stem => $stem, 2154add690fSespie major => $major, minor => $minor 2164add690fSespie }, $class; 2172a95ed22Sespie} 2182a95ed22Sespie 2197eb3bd1aSespiemy $cached = {}; 2207eb3bd1aSespie 221039cbdaaSespiesub from_string($class, $s) 2222a95ed22Sespie{ 223b62674ebSespie return $cached->{$s} //= $class->new_from_string($s); 2247eb3bd1aSespie} 2257eb3bd1aSespie 226039cbdaaSespiesub new_with_stem($class, $stem, $major, $minor) 2277eb3bd1aSespie{ 2282a95ed22Sespie if ($stem =~ m/^(.*)\/([^\/]+)$/o) { 2292a95ed22Sespie return $class->new($1, $2, $major, $minor); 2302a95ed22Sespie } else { 2312a95ed22Sespie return $class->new(undef, $stem, $major, $minor); 2322a95ed22Sespie } 233456981a6Sespie} 234456981a6Sespie 235039cbdaaSespiesub new_from_string($class, $string) 236456981a6Sespie{ 237456981a6Sespie if (my ($stem, $major, $minor) = $string =~ m/^(.*)\.(\d+)\.(\d+)$/o) { 238456981a6Sespie return $class->new_with_stem($stem, $major, $minor); 2392a95ed22Sespie } else { 2404add690fSespie return $class->badclass->new($string); 2412a95ed22Sespie } 2422a95ed22Sespie} 2432a95ed22Sespie 244039cbdaaSespiesub to_string($self) 2452a95ed22Sespie{ 2464add690fSespie return join('.', $self->key, $self->major, $self->minor); 2472a95ed22Sespie 2482a95ed22Sespie} 2492a95ed22Sespie 250039cbdaaSespiesub lookup_stem($spec, $repo) 2512a95ed22Sespie{ 2524add690fSespie my $result = $repo->{$spec->stem}; 2534add690fSespie if (!defined $result) { 2544add690fSespie return undef; 2554add690fSespie } else { 2564add690fSespie return $result; 2574add690fSespie } 2584add690fSespie} 2594add690fSespie 260039cbdaaSespiesub no_match_major($spec, $library) 261456981a6Sespie{ 262456981a6Sespie return $spec->major != $library->major; 263456981a6Sespie} 264456981a6Sespie 265039cbdaaSespiesub no_match_name($spec, $library, $base) 2664add690fSespie{ 2674add690fSespie if (defined $spec->{dir}) { 2684add690fSespie if ("$base/$spec->{dir}" eq $library->{dir}) { 2690571e82fSespie return undef; 2702a95ed22Sespie } 2714add690fSespie } else { 2724add690fSespie for my $d ($base, OpenBSD::Paths->library_dirs) { 2734add690fSespie if ("$d/lib" eq $library->{dir}) { 2740571e82fSespie return undef; 2752a95ed22Sespie } 2762a95ed22Sespie } 2774add690fSespie } 2780571e82fSespie return "bad directory"; 2790571e82fSespie} 280456981a6Sespie 281039cbdaaSespiesub no_match_shared($spec, $library, $base) 2826e1be68bSespie{ 2836e1be68bSespie if ($spec->no_match_major($library)) { 2846e1be68bSespie return "bad major"; 2856e1be68bSespie } 2866e1be68bSespie if ($spec->major == $library->major && 2876e1be68bSespie $spec->minor > $library->minor) { 2886e1be68bSespie return "minor is too small"; 2896e1be68bSespie } 2906e1be68bSespie return $spec->no_match_name($library, $base); 2916e1be68bSespie} 2926e1be68bSespie 293456981a6Sespie# classic double dispatch pattern 294039cbdaaSespiesub no_match($spec, $library, $base) 295456981a6Sespie{ 296456981a6Sespie return $library->no_match_dispatch($spec, $base); 297456981a6Sespie} 298456981a6Sespie 299039cbdaaSespiesub match($spec, $library, $base) 3000571e82fSespie{ 3010571e82fSespie return !$spec->no_match($library, $base); 3022a95ed22Sespie} 3032a95ed22Sespie 3042a95ed22Sespie1; 305