1# ex:ts=8 sw=4: 2# $OpenBSD: PackageInfo.pm,v 1.65 2023/06/13 09:07:17 espie Exp $ 3# 4# Copyright (c) 2003-2014 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::PackageInfo; 21require Exporter; 22our @ISA=qw(Exporter); 23our @EXPORT=qw(installed_packages installed_info installed_name info_names is_info_name installed_stems 24 lock_db unlock_db 25 add_installed delete_installed is_installed borked_package 26 CONTENTS DESC REQUIRED_BY REQUIRING DISPLAY UNDISPLAY); 27 28use OpenBSD::PackageName; 29use OpenBSD::Paths; 30use constant { 31 CONTENTS => '+CONTENTS', 32 DESC => '+DESC', 33 REQUIRED_BY => '+REQUIRED_BY', 34 REQUIRING => '+REQUIRING', 35 DISPLAY => '+DISPLAY', 36 UNDISPLAY => '+UNDISPLAY'}; 37 38use Fcntl qw/:flock/; 39my $pkg_db = $ENV{"PKG_DBDIR"} || OpenBSD::Paths->pkgdb; 40 41my ($list, $stemlist); 42 43our @info = (CONTENTS, DESC, REQUIRED_BY, REQUIRING, DISPLAY, UNDISPLAY); 44 45our %info = (); 46for my $i (@info) { 47 my $j = $i; 48 $j =~ s/\+/F/o; 49 $info{$i} = $j; 50} 51 52sub _init_list() 53{ 54 $list = {}; 55 $stemlist = OpenBSD::PackageName::compile_stemlist(); 56 57 opendir(my $dir, $pkg_db) or die "Bad pkg_db: $!"; 58 while (my $e = readdir($dir)) { 59 next if $e eq '.' or $e eq '..'; 60 add_installed($e); 61 } 62 closedir($dir); 63} 64 65sub add_installed(@p) 66{ 67 if (!defined $list) { 68 _init_list(); 69 } 70 for my $p (@p) { 71 $list->{$p} = 1; 72 $stemlist->add($p); 73 } 74} 75 76sub delete_installed(@p) 77{ 78 if (!defined $list) { 79 _init_list(); 80 } 81 for my $p (@p) { 82 delete $list->{$p}; 83 $stemlist->delete($p); 84 85 } 86} 87 88sub installed_stems() 89{ 90 if (!defined $list) { 91 _init_list(); 92 } 93 return $stemlist; 94} 95 96sub installed_packages($all = 0) 97{ 98 if (!defined $list) { 99 _init_list(); 100 } 101 if ($all) { 102 return grep { !/^\./o } keys %$list; 103 } else { 104 return keys %$list; 105 } 106} 107 108sub installed_info($name) 109{ 110 # XXX remove the o if we allow pkg_db to change dynamically 111 if ($name =~ m|^\Q$pkg_db\E/?|o) { 112 return "$name/"; 113 } else { 114 return "$pkg_db/$name/"; 115 } 116} 117 118sub installed_contents($name) 119{ 120 return installed_info($name).CONTENTS; 121} 122 123sub borked_package($pkgname) 124{ 125 $pkgname = "partial-$pkgname" unless $pkgname =~ m/^partial\-/; 126 unless (-e "$pkg_db/$pkgname") { 127 return $pkgname; 128 } 129 my $i = 1; 130 131 while (-e "$pkg_db/$pkgname.$i") { 132 $i++; 133 } 134 return "$pkgname.$i"; 135} 136 137sub libs_package($pkgname) 138{ 139 $pkgname =~ s/^\.libs\d*\-//; 140 unless (-e "$pkg_db/.libs-$pkgname") { 141 return ".libs-$pkgname"; 142 } 143 my $i = 1; 144 145 while (-e "$pkg_db/.libs$i-$pkgname") { 146 $i++; 147 } 148 return ".libs$i-$pkgname"; 149} 150 151sub is_installed($p) 152{ 153 my $name = installed_name($p); 154 if (!defined $list) { 155 installed_packages(); 156 } 157 return defined $list->{$name}; 158} 159 160sub installed_name($p) 161{ 162 require File::Spec; 163 my $name = File::Spec->canonpath($p); 164 $name =~ s|/$||o; 165 # XXX remove the o if we allow pkg_db to change dynamically 166 $name =~ s|^\Q$pkg_db\E/?||o; 167 $name =~ s|/\+CONTENTS$||o; 168 return $name; 169} 170 171sub info_names() 172{ 173 return @info; 174} 175 176sub is_info_name($name) 177{ 178 return $info{$name}; 179} 180 181my $dlock; 182 183sub lock_db($shared = 0, $state = undef) 184{ 185 my $mode = $shared ? LOCK_SH : LOCK_EX; 186 open($dlock, '<', $pkg_db) or return; 187 if (flock($dlock, $mode | LOCK_NB)) { 188 return; 189 } 190 if (!defined $state) { 191 require OpenBSD::BaseState; 192 $state = 'OpenBSD::BaseState'; 193 } 194 $state->errprint("Package database already locked... awaiting release... "); 195 while (!flock($dlock, $mode)) { 196 } 197 $state->errsay("done!"); 198 return; 199} 200 201sub unlock_db() 202{ 203 if (defined $dlock) { 204 flock($dlock, LOCK_UN); 205 close($dlock); 206 } 207} 208 2091; 210