Tue Aug 16 19:07:53 2022 UTC ()
lintpkgsrc: split remove_distfiles into manageable pieces


(rillig)
diff -r1.99 -r1.100 pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl

cvs diff -r1.99 -r1.100 pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl (switch to unified diff)

--- pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl 2022/08/16 18:58:00 1.99
+++ pkgsrc/pkgtools/lintpkgsrc/files/lintpkgsrc.pl 2022/08/16 19:07:53 1.100
@@ -1,1668 +1,1677 @@ @@ -1,1668 +1,1677 @@
1#!@PERL5@ 1#!@PERL5@
2# $NetBSD: lintpkgsrc.pl,v 1.99 2022/08/16 18:58:00 rillig Exp $ 2# $NetBSD: lintpkgsrc.pl,v 1.100 2022/08/16 19:07:53 rillig Exp $
3 3
4# Written by David Brownlee <abs@netbsd.org>. 4# Written by David Brownlee <abs@netbsd.org>.
5# 5#
6# Caveats: 6# Caveats:
7# The 'Makefile parsing' algorithm used to obtain package versions and 7# The 'Makefile parsing' algorithm used to obtain package versions and
8# DEPENDS information is geared towards speed rather than perfection, 8# DEPENDS information is geared towards speed rather than perfection,
9# though it has gotten somewhat better over time, it only parses the 9# though it has gotten somewhat better over time, it only parses the
10# simpler Makefile conditionals. 10# simpler Makefile conditionals.
11# 11#
12# TODO: Handle fun DEPENDS like avifile-devel with 12# TODO: Handle fun DEPENDS like avifile-devel with
13# {qt2-designer>=2.2.4,qt2-designer-kde>=2.3.1nb1} 13# {qt2-designer>=2.2.4,qt2-designer-kde>=2.3.1nb1}
14 14
15use v5.36; 15use v5.36;
16use locale; 16use locale;
17use strict; 17use strict;
18use warnings; 18use warnings;
19use Cwd 'realpath', 'getcwd'; 19use Cwd 'realpath', 'getcwd';
20use File::Basename; 20use File::Basename;
21use File::Find; 21use File::Find;
22use Getopt::Std; 22use Getopt::Std;
23use IPC::Open3; 23use IPC::Open3;
24 24
25# PkgVer is a PKGBASE + PKGVERSION, including some of the variables that 25# PkgVer is a PKGBASE + PKGVERSION, including some of the variables that
26# have been extracted from the package Makefile. 26# have been extracted from the package Makefile.
27package PkgVer; 27package PkgVer;
28 28
29sub new($class, $pkgbase, $pkgversion) { 29sub new($class, $pkgbase, $pkgversion) {
30 my $self = { 30 my $self = {
31 pkgbase => $pkgbase, 31 pkgbase => $pkgbase,
32 pkgversion => $pkgversion, 32 pkgversion => $pkgversion,
33 vars => {}, 33 vars => {},
34 }; 34 };
35 bless $self, $class; 35 bless $self, $class;
36 return $self; 36 return $self;
37} 37}
38 38
39sub pkgbase($self) { 39sub pkgbase($self) {
40 $self->{pkgbase}; 40 $self->{pkgbase};
41} 41}
42 42
43sub pkgversion($self) { 43sub pkgversion($self) {
44 $self->{pkgversion}; 44 $self->{pkgversion};
45} 45}
46 46
47sub pkgname($self) { 47sub pkgname($self) {
48 $self->pkgbase . '-' . $self->pkgversion; 48 $self->pkgbase . '-' . $self->pkgversion;
49} 49}
50 50
51sub var($self, $name, $value = undef) { 51sub var($self, $name, $value = undef) {
52 defined $value 52 defined $value
53 ? ($self->{vars}->{$name} = $value) 53 ? ($self->{vars}->{$name} = $value)
54 : $self->{vars}->{$name}; 54 : $self->{vars}->{$name};
55} 55}
56 56
57sub vars($self) { 57sub vars($self) {
58 keys $self->{vars}->%*; 58 keys $self->{vars}->%*;
59} 59}
60 60
61# All versions of a given PKGBASE, e.g. apache-1.3.27 and apache-2.0.46. 61# All versions of a given PKGBASE, e.g. apache-1.3.27 and apache-2.0.46.
62# Multi-prefix packages like py39-* are stored as simply py-*. 62# Multi-prefix packages like py39-* are stored as simply py-*.
63package Pkgs; 63package Pkgs;
64 64
65sub new($class, $pkgbase) { 65sub new($class, $pkgbase) {
66 my $self = { 66 my $self = {
67 pkgbase => $pkgbase, 67 pkgbase => $pkgbase,
68 pkgvers => {}, 68 pkgvers => {},
69 }; 69 };
70 bless $self, $class; 70 bless $self, $class;
71 return $self; 71 return $self;
72} 72}
73 73
74sub pkgbase($self) { 74sub pkgbase($self) {
75 $self->{pkgbase}; 75 $self->{pkgbase};
76} 76}
77 77
78# All available versions of the package, in decreasing alphabetical(!) order. 78# All available versions of the package, in decreasing alphabetical(!) order.
79sub versions($self) { 79sub versions($self) {
80 reverse sort keys $self->{pkgvers}->%*; 80 reverse sort keys $self->{pkgvers}->%*;
81} 81}
82 82
83sub add($self, $pkgbase, $pkgversion) { 83sub add($self, $pkgbase, $pkgversion) {
84 $self->{pkgvers}->{$pkgversion} = PkgVer->new($pkgbase, $pkgversion); 84 $self->{pkgvers}->{$pkgversion} = PkgVer->new($pkgbase, $pkgversion);
85} 85}
86 86
87# All PkgVers of this pkgbase, in decreasing alphabetical(!) version order. 87# All PkgVers of this pkgbase, in decreasing alphabetical(!) version order.
88sub pkgvers_all($self) { 88sub pkgvers_all($self) {
89 my $pkgvers = $self->{pkgvers}; 89 my $pkgvers = $self->{pkgvers};
90 sort { $b->pkgversion cmp $a->pkgversion } values %$pkgvers; 90 sort { $b->pkgversion cmp $a->pkgversion } values %$pkgvers;
91} 91}
92 92
93sub pkgver($self, $pkgversion) { 93sub pkgver($self, $pkgversion) {
94 $self->{pkgvers}->{$pkgversion} 94 $self->{pkgvers}->{$pkgversion}
95} 95}
96 96
97# PkgDb is a small database of all packages in pkgsrc. 97# PkgDb is a small database of all packages in pkgsrc.
98package PkgDb; 98package PkgDb;
99 99
100sub new($class) { 100sub new($class) {
101 my $self = {}; # pkgbase => Pkgs 101 my $self = {}; # pkgbase => Pkgs
102 bless $self, $class; 102 bless $self, $class;
103 return $self; 103 return $self;
104} 104}
105 105
106sub add($self, $pkgbase, $pkgversion) { 106sub add($self, $pkgbase, $pkgversion) {
107 my $pkgs = ($self->{$pkgbase} ||= Pkgs->new($pkgbase)); 107 my $pkgs = ($self->{$pkgbase} ||= Pkgs->new($pkgbase));
108 $pkgs->add($pkgbase, $pkgversion); 108 $pkgs->add($pkgbase, $pkgversion);
109} 109}
110 110
111# All PkgVers, sorted by pkgbase, then by version in decreasing 111# All PkgVers, sorted by pkgbase, then by version in decreasing
112# alphabetical(!) order. 112# alphabetical(!) order.
113sub pkgvers_all($self) { 113sub pkgvers_all($self) {
114 map { $_->pkgvers_all } $self->pkgs; 114 map { $_->pkgvers_all } $self->pkgs;
115} 115}
116 116
117# All PkgVers of the given pkgbase, sorted by version in decreasing 117# All PkgVers of the given pkgbase, sorted by version in decreasing
118# alphabetical(!) order. 118# alphabetical(!) order.
119sub pkgvers_by_pkgbase($self, $pkgbase) { 119sub pkgvers_by_pkgbase($self, $pkgbase) {
120 my $pkgs = $self->{$pkgbase}; 120 my $pkgs = $self->{$pkgbase};
121 defined $pkgs ? $pkgs->pkgvers_all : (); 121 defined $pkgs ? $pkgs->pkgvers_all : ();
122} 122}
123 123
124sub pkgver($self, $pkgbase, $pkgversion) { 124sub pkgver($self, $pkgbase, $pkgversion) {
125 my $pkgs = $self->{$pkgbase}; 125 my $pkgs = $self->{$pkgbase};
126 defined $pkgs ? $pkgs->pkgver($pkgversion) : undef; 126 defined $pkgs ? $pkgs->pkgver($pkgversion) : undef;
127} 127}
128 128
129# pkgs() returns all Pkgs, sorted by pkgbase. 129# pkgs() returns all Pkgs, sorted by pkgbase.
130# 130#
131# pkgs($pkgbase) returns the Pkgs, or undef. 131# pkgs($pkgbase) returns the Pkgs, or undef.
132sub pkgs($self, $pkgbase = undef) { 132sub pkgs($self, $pkgbase = undef) {
133 defined $pkgbase 133 defined $pkgbase
134 ? $self->{$pkgbase} 134 ? $self->{$pkgbase}
135 : sort { $a->pkgbase cmp $b->pkgbase } values %$self; 135 : sort { $a->pkgbase cmp $b->pkgbase } values %$self;
136} 136}
137 137
138package main; 138package main;
139 139
140# Buildtime configuration 140# Buildtime configuration
141my $conf_make = '@MAKE@'; 141my $conf_make = '@MAKE@';
142my $conf_makeconf = '@MAKECONF@'; 142my $conf_makeconf = '@MAKECONF@';
143my $conf_pkg_info = '@PKG_INFO@'; 143my $conf_pkg_info = '@PKG_INFO@';
144my $conf_pkgsrcdir = '@PKGSRCDIR@'; 144my $conf_pkgsrcdir = '@PKGSRCDIR@';
145my $conf_prefix = '@PREFIX@'; 145my $conf_prefix = '@PREFIX@';
146my $conf_x11base = '@X11BASE@'; 146my $conf_x11base = '@X11BASE@';
147 147
148my ( 148my (
149 $pkgdb, # Database of pkgsrc packages 149 $pkgdb, # Database of pkgsrc packages
150 $default_vars, # Set for Makefiles, inc PACKAGES & PKGSRCDIR 150 $default_vars, # Set for Makefiles, inc PACKAGES & PKGSRCDIR
151 %opt, # Command line options 151 %opt, # Command line options
152 @matched_prebuiltpackages, # List of obsolete prebuilt package paths 152 @matched_prebuiltpackages, # List of obsolete prebuilt package paths
153 @prebuilt_pkgdirs, # Use to follow symlinks in prebuilt pkgdirs 153 @prebuilt_pkgdirs, # Use to follow symlinks in prebuilt pkgdirs
154 %prebuilt_pkgdir_cache, # To avoid symlink loops in prebuilt_pkgdirs 154 %prebuilt_pkgdir_cache, # To avoid symlink loops in prebuilt_pkgdirs
155); 155);
156 156
157# Horrible kludge to ensure we have a value for testing in conditionals, but 157# Horrible kludge to ensure we have a value for testing in conditionals, but
158# gets removed in the final evaluation 158# gets removed in the final evaluation
159my $magic_undefined = 'M_a_G_i_C_uNdEfInEd'; 159my $magic_undefined = 'M_a_G_i_C_uNdEfInEd';
160 160
161sub debug(@args) { 161sub debug(@args) {
162 $opt{D} and print STDERR 'DEBUG: ', @args, "\n"; 162 $opt{D} and print STDERR 'DEBUG: ', @args, "\n";
163} 163}
164 164
165sub verbose(@args) { 165sub verbose(@args) {
166 -t STDERR and print STDERR @args; 166 -t STDERR and print STDERR @args;
167} 167}
168 168
169sub fail($msg) { 169sub fail($msg) {
170 print STDERR $msg, "\n"; 170 print STDERR $msg, "\n";
171 exit(3); 171 exit(3);
172} 172}
173 173
174# List (recursive) non directory contents of specified directory 174# List (recursive) non directory contents of specified directory
175# 175#
176#TODO this entire sub should be replaced with direct calls to 176#TODO this entire sub should be replaced with direct calls to
177# File::Find 177# File::Find
178sub listdir($base, $dir = undef) { 178sub listdir($base, $dir = undef) {
179 my ($thisdir); 179 my ($thisdir);
180 my (@list, @thislist); 180 my (@list, @thislist);
181 181
182 $thisdir = $base; 182 $thisdir = $base;
183 if (defined $dir) { 183 if (defined $dir) {
184 $thisdir .= "/$dir"; 184 $thisdir .= "/$dir";
185 $dir .= '/'; 185 $dir .= '/';
186 } else { 186 } else {
187 $dir = ''; 187 $dir = '';
188 } 188 }
189 189
190 opendir(DIR, $thisdir) || fail("Unable to opendir($thisdir): $!"); 190 opendir(DIR, $thisdir) || fail("Unable to opendir($thisdir): $!");
191 @thislist = grep { substr($_, 0, 1) ne '.' && $_ ne 'CVS' } readdir(DIR); 191 @thislist = grep { substr($_, 0, 1) ne '.' && $_ ne 'CVS' } readdir(DIR);
192 closedir(DIR); 192 closedir(DIR);
193 foreach my $entry (@thislist) { 193 foreach my $entry (@thislist) {
194 if (-d "$thisdir/$entry") { 194 if (-d "$thisdir/$entry") {
195 push @list, listdir($base, "$dir$entry"); 195 push @list, listdir($base, "$dir$entry");
196 } else { 196 } else {
197 push @list, "$dir$entry"; 197 push @list, "$dir$entry";
198 } 198 }
199 } 199 }
200 @list; 200 @list;
201} 201}
202 202
203sub canonicalize_pkgname($pkgname) { 203sub canonicalize_pkgname($pkgname) {
204 $pkgname =~ s,^py\d+(?:pth|)-,py-,; 204 $pkgname =~ s,^py\d+(?:pth|)-,py-,;
205 $pkgname =~ s,^ruby\d+-,ruby-,; 205 $pkgname =~ s,^ruby\d+-,ruby-,;
206 $pkgname =~ s,^php\d+-,php-,; 206 $pkgname =~ s,^php\d+-,php-,;
207 return $pkgname; 207 return $pkgname;
208} 208}
209 209
210sub split_pkgversion($pkgversion) { 210sub split_pkgversion($pkgversion) {
211 $pkgversion = lc($pkgversion); 211 $pkgversion = lc($pkgversion);
212 212
213 # See pkgtools/pkg_install/files/lib/dewey.c. 213 # See pkgtools/pkg_install/files/lib/dewey.c.
214 my @temp = ($pkgversion =~ s/nb(\d+)//) ? +$1 : 0; 214 my @temp = ($pkgversion =~ s/nb(\d+)//) ? +$1 : 0;
215 foreach my $elem (split(/(pl|pre|rc|beta|alpha|\D)/, $pkgversion)) { 215 foreach my $elem (split(/(pl|pre|rc|beta|alpha|\D)/, $pkgversion)) {
216 if ($elem =~ /\d/) { 216 if ($elem =~ /\d/) {
217 push @temp, +$elem; 217 push @temp, +$elem;
218 } elsif ($elem eq 'pl' || $elem eq '.' || $elem eq '_') { 218 } elsif ($elem eq 'pl' || $elem eq '.' || $elem eq '_') {
219 push @temp, 0; 219 push @temp, 0;
220 } elsif ($elem eq 'pre' || $elem eq 'rc') { 220 } elsif ($elem eq 'pre' || $elem eq 'rc') {
221 push @temp, -1; 221 push @temp, -1;
222 } elsif ($elem eq 'beta') { 222 } elsif ($elem eq 'beta') {
223 push @temp, -2; 223 push @temp, -2;
224 } elsif ($elem eq 'alpha') { 224 } elsif ($elem eq 'alpha') {
225 push @temp, -3; 225 push @temp, -3;
226 } elsif ('a' le $elem && $elem le 'z') { 226 } elsif ('a' le $elem && $elem le 'z') {
227 push @temp, 0, ord($elem) - ord('a') + 1; 227 push @temp, 0, ord($elem) - ord('a') + 1;
228 } 228 }
229 } 229 }
230 @temp; 230 @temp;
231} 231}
232 232
233sub pkgversion_cmp($va, $op, $vb) { 233sub pkgversion_cmp($va, $op, $vb) {
234 my ($nb_a, @a) = split_pkgversion($va); 234 my ($nb_a, @a) = split_pkgversion($va);
235 my ($nb_b, @b) = split_pkgversion($vb); 235 my ($nb_b, @b) = split_pkgversion($vb);
236 236
237 my $cmp = 0; 237 my $cmp = 0;
238 while ($cmp == 0 && (@a || @b)) { 238 while ($cmp == 0 && (@a || @b)) {
239 $cmp = (shift @a || 0) <=> (shift @b || 0); 239 $cmp = (shift @a || 0) <=> (shift @b || 0);
240 } 240 }
241 $cmp ||= $nb_a <=> $nb_b; 241 $cmp ||= $nb_a <=> $nb_b;
242 242
243 $op eq '<' ? $cmp < 0 243 $op eq '<' ? $cmp < 0
244 : $op eq '<=' ? $cmp <= 0 244 : $op eq '<=' ? $cmp <= 0
245 : $op eq '>' ? $cmp > 0 245 : $op eq '>' ? $cmp > 0
246 : $cmp >= 0; 246 : $cmp >= 0;
247} 247}
248 248
249sub expand_braces($str) { 249sub expand_braces($str) {
250 my @todo = ($str); 250 my @todo = ($str);
251 251
252 my @expanded; 252 my @expanded;
253 while (defined($str = shift @todo)) { 253 while (defined($str = shift @todo)) {
254 if ($str =~ /(.*) \{ ([^{}]+) } (.*)/x) { 254 if ($str =~ /(.*) \{ ([^{}]+) } (.*)/x) {
255 foreach my $alt (split(',', $2, -1)) { 255 foreach my $alt (split(',', $2, -1)) {
256 push @todo, "$1$alt$3"; 256 push @todo, "$1$alt$3";
257 } 257 }
258 } else { 258 } else {
259 push @expanded, $str; 259 push @expanded, $str;
260 } 260 }
261 } 261 }
262 @expanded; 262 @expanded;
263} 263}
264 264
265# Return a copy of $value in which trivial variable expressions are replaced 265# Return a copy of $value in which trivial variable expressions are replaced
266# with their variable values. 266# with their variable values.
267sub expand_exprs($value, $vars) { 267sub expand_exprs($value, $vars) {
268 while ($value =~ /\$\{([-\w.]+)\}/) { 268 while ($value =~ /\$\{([-\w.]+)\}/) {
269 $value = defined $vars->{$1} 269 $value = defined $vars->{$1}
270 ? "$`$vars->{$1}$'" 270 ? "$`$vars->{$1}$'"
271 : "$`$magic_undefined$'"; 271 : "$`$magic_undefined$'";
272 } 272 }
273 $value; 273 $value;
274} 274}
275 275
276sub eval_mk_cond_func($func, $arg, $vars) { 276sub eval_mk_cond_func($func, $arg, $vars) {
277 if ($func eq 'defined') { 277 if ($func eq 'defined') {
278 my $varname = expand_exprs($arg, $vars); 278 my $varname = expand_exprs($arg, $vars);
279 defined $vars->{$varname} ? 1 : 0; 279 defined $vars->{$varname} ? 1 : 0;
280 280
281 } elsif ($func eq 'empty') { 281 } elsif ($func eq 'empty') {
282 282
283 # Implement (some of) make's :M modifier 283 # Implement (some of) make's :M modifier
284 if ($arg =~ /^ ([^:]+) :M ([^:]+) $/x) { 284 if ($arg =~ /^ ([^:]+) :M ([^:]+) $/x) {
285 my ($varname, $pattern) = ($1, $2); 285 my ($varname, $pattern) = ($1, $2);
286 $varname = expand_exprs($varname, $vars); 286 $varname = expand_exprs($varname, $vars);
287 $pattern = expand_exprs($pattern, $vars); 287 $pattern = expand_exprs($pattern, $vars);
288 288
289 my $value = $vars->{$varname}; 289 my $value = $vars->{$varname};
290 return 1 unless defined $value; 290 return 1 unless defined $value;
291 291
292 $value = expand_exprs($value, $vars); 292 $value = expand_exprs($value, $vars);
293 293
294 $pattern =~ s/([{.+])/\\$1/g; 294 $pattern =~ s/([{.+])/\\$1/g;
295 $pattern =~ s/\*/.*/g; 295 $pattern =~ s/\*/.*/g;
296 $pattern =~ s/\?/./g; 296 $pattern =~ s/\?/./g;
297 $pattern = '^' . $pattern . '$'; 297 $pattern = '^' . $pattern . '$';
298 298
299 # XXX: Splitting by whitespace is not correct, but 299 # XXX: Splitting by whitespace is not correct, but
300 # it's good enough for lists with only unquoted 300 # it's good enough for lists with only unquoted
301 # words. See devel/bmake/files/str.c:brk_string. 301 # words. See devel/bmake/files/str.c:brk_string.
302 foreach my $word (split(/\s+/, $value)) { 302 foreach my $word (split(/\s+/, $value)) {
303 return 0 if $word =~ /$pattern/; 303 return 0 if $word =~ /$pattern/;
304 } 304 }
305 return 1; 305 return 1;
306 } elsif ($arg =~ /:M/) { 306 } elsif ($arg =~ /:M/) {
307 debug("Unsupported ':M' modifier in '$arg'"); 307 debug("Unsupported ':M' modifier in '$arg'");
308 } 308 }
309 309
310 my $value = expand_exprs("\${$arg}", $vars); 310 my $value = expand_exprs("\${$arg}", $vars);
311 defined $value && $value =~ /\S/ ? 0 : 1; 311 defined $value && $value =~ /\S/ ? 0 : 1;
312 312
313 } elsif ($func eq 'exists') { 313 } elsif ($func eq 'exists') {
314 my $fname = expand_exprs($arg, $vars); 314 my $fname = expand_exprs($arg, $vars);
315 -e $fname ? 1 : 0; 315 -e $fname ? 1 : 0;
316 316
317 } elsif ($func eq 'make') { 317 } elsif ($func eq 'make') {
318 0; 318 0;
319 319
320 } else { # $func eq 'target' 320 } else { # $func eq 'target'
321 0; 321 0;
322 } 322 }
323} 323}
324 324
325sub eval_mk_cond($line, $vars) { 325sub eval_mk_cond($line, $vars) {
326 my $cond = expand_exprs($line, $vars); 326 my $cond = expand_exprs($line, $vars);
327 327
328 # XXX This is _so_ wrong - need to parse this correctly 328 # XXX This is _so_ wrong - need to parse this correctly
329 $cond =~ s/""/\r/g; 329 $cond =~ s/""/\r/g;
330 $cond =~ s/"//g; 330 $cond =~ s/"//g;
331 $cond =~ s/\r/""/g; 331 $cond =~ s/\r/""/g;
332 332
333 debug("conditional: $cond"); 333 debug("conditional: $cond");
334 334
335 while ($cond =~ /(target|empty|make|defined|exists)\s*\(([^()]+)\)/) { 335 while ($cond =~ /(target|empty|make|defined|exists)\s*\(([^()]+)\)/) {
336 my ($func, $arg) = ($1, $2); 336 my ($func, $arg) = ($1, $2);
337 my $result = eval_mk_cond_func($func, $arg, $vars); 337 my $result = eval_mk_cond_func($func, $arg, $vars);
338 $cond =~ s/$func\s*\([^()]+\)/$result/; 338 $cond =~ s/$func\s*\([^()]+\)/$result/;
339 debug("conditional: update to $cond"); 339 debug("conditional: update to $cond");
340 } 340 }
341 341
342 while ($cond =~ /([^\s()\|\&]+) \s+ (!=|==) \s+ ([^\s()]+)/x) { 342 while ($cond =~ /([^\s()\|\&]+) \s+ (!=|==) \s+ ([^\s()]+)/x) {
343 my $result = 0 + (($2 eq '==') ? ($1 eq $3) : ($1 ne $3)); 343 my $result = 0 + (($2 eq '==') ? ($1 eq $3) : ($1 ne $3));
344 $cond =~ s/[^\s()\|\&]+ \s+ (!=|==) \s+ [^\s()]+/$result/x; 344 $cond =~ s/[^\s()\|\&]+ \s+ (!=|==) \s+ [^\s()]+/$result/x;
345 } 345 }
346 346
347 if ($cond =~ /^[ <> \d () \s & | . ! ]+$/xx) { 347 if ($cond =~ /^[ <> \d () \s & | . ! ]+$/xx) {
348 my $result = eval "($cond) ? 1 : 0"; 348 my $result = eval "($cond) ? 1 : 0";
349 defined $result or fail("Eval '$cond' failed in '$line': $@"); 349 defined $result or fail("Eval '$cond' failed in '$line': $@");
350 debug("conditional: evaluated to " . ($result ? 'true' : 'false')); 350 debug("conditional: evaluated to " . ($result ? 'true' : 'false'));
351 $result; 351 $result;
352 352
353 } else { 353 } else {
354 debug("conditional: defaulting '$cond' to true"); 354 debug("conditional: defaulting '$cond' to true");
355 1; 355 1;
356 } 356 }
357} 357}
358 358
359sub parse_makefile_line_include($file, $incfile, 359sub parse_makefile_line_include($file, $incfile,
360 $incdirs, $included, $lines, $vars) { 360 $incdirs, $included, $lines, $vars) {
361 361
362 # At this point just skip any includes which we were 362 # At this point just skip any includes which we were
363 # not able to fully expand. 363 # not able to fully expand.
364 if ($incfile =~ m#/mk/bsd# 364 if ($incfile =~ m#/mk/bsd#
365 || $incfile =~ /$magic_undefined/ 365 || $incfile =~ /$magic_undefined/
366 || $incfile =~ /\$\{/ 366 || $incfile =~ /\$\{/
367 || (!$opt{d} && $incfile =~ m#/(buildlink[^/]*\.mk)#)) { 367 || (!$opt{d} && $incfile =~ m#/(buildlink[^/]*\.mk)#)) {
368 debug("$file: .include \"$incfile\" skipped"); 368 debug("$file: .include \"$incfile\" skipped");
369 return; 369 return;
370 } 370 }
371 371
372 debug("$file: .include \"$incfile\""); 372 debug("$file: .include \"$incfile\"");
373 373
374 if (substr($incfile, 0, 1) ne '/') { 374 if (substr($incfile, 0, 1) ne '/') {
375 foreach my $dir (reverse @$incdirs) { 375 foreach my $dir (reverse @$incdirs) {
376 if (-f "$dir/$incfile") { 376 if (-f "$dir/$incfile") {
377 $incfile = "$dir/$incfile"; 377 $incfile = "$dir/$incfile";
378 last; 378 last;
379 } 379 }
380 } 380 }
381 } 381 }
382 382
383 # perl 5.6.1 realpath() cannot handle files, only directories. 383 # perl 5.6.1 realpath() cannot handle files, only directories.
384 # If the last component is a symlink, this will give a false 384 # If the last component is a symlink, this will give a false
385 # negative, but that is not a problem, as the duplicate check 385 # negative, but that is not a problem, as the duplicate check
386 # is for performance. 386 # is for performance.
387 $incfile =~ m#^(.+)(/[^/]+)$#; 387 $incfile =~ m#^(.+)(/[^/]+)$#;
388 388
389 if (!-f $incfile) { 389 if (!-f $incfile) {
390 $opt{L} or verbose("\n"); 390 $opt{L} or verbose("\n");
391 391
392 my $dirs = join(' ', @$incdirs); 392 my $dirs = join(' ', @$incdirs);
393 verbose("$file: Cannot locate $incfile in $dirs\n"); 393 verbose("$file: Cannot locate $incfile in $dirs\n");
394 return; 394 return;
395 } 395 }
396 396
397 $incfile = realpath($1) . $2; 397 $incfile = realpath($1) . $2;
398 return if $included->{$incfile}; 398 return if $included->{$incfile};
399 399
400 $opt{L} and print "inc $incfile\n"; 400 $opt{L} and print "inc $incfile\n";
401 $included->{$incfile} = 1; 401 $included->{$incfile} = 1;
402 402
403 if (!open(FILE, $incfile)) { 403 if (!open(FILE, $incfile)) {
404 verbose("Cannot open '$incfile' (from $file): $_ $!\n"); 404 verbose("Cannot open '$incfile' (from $file): $_ $!\n");
405 return; 405 return;
406 } 406 }
407 407
408 # FIXME: .CURDIR doesn't change, but .PARSEDIR does. 408 # FIXME: .CURDIR doesn't change, but .PARSEDIR does.
409 my $NEWCURDIR = $incfile; 409 my $NEWCURDIR = $incfile;
410 $NEWCURDIR =~ s#/[^/]*$##; 410 $NEWCURDIR =~ s#/[^/]*$##;
411 push @$incdirs, $NEWCURDIR 411 push @$incdirs, $NEWCURDIR
412 unless grep { $_ eq $NEWCURDIR } @$incdirs; 412 unless grep { $_ eq $NEWCURDIR } @$incdirs;
413 unshift @$lines, ".CURDIR=" . $vars->{'.CURDIR'}; 413 unshift @$lines, ".CURDIR=" . $vars->{'.CURDIR'};
414 chomp(my @inc_lines = <FILE>); 414 chomp(my @inc_lines = <FILE>);
415 unshift @$lines, @inc_lines; 415 unshift @$lines, @inc_lines;
416 unshift @$lines, ".CURDIR=$NEWCURDIR"; 416 unshift @$lines, ".CURDIR=$NEWCURDIR";
417 close(FILE); 417 close(FILE);
418} 418}
419 419
420sub parse_makefile_line_var($varname, $op, $value, $vars) { 420sub parse_makefile_line_var($varname, $op, $value, $vars) {
421 if ($op eq ':=') { 421 if ($op eq ':=') {
422 $vars->{$varname} = expand_exprs($value, $vars); 422 $vars->{$varname} = expand_exprs($value, $vars);
423 } elsif ($op eq '+=' && defined $vars->{$varname}) { 423 } elsif ($op eq '+=' && defined $vars->{$varname}) {
424 $vars->{$varname} .= " $value"; 424 $vars->{$varname} .= " $value";
425 } elsif ($op eq '?=' && defined $vars->{$varname}) { 425 } elsif ($op eq '?=' && defined $vars->{$varname}) {
426 # Do nothing. 426 # Do nothing.
427 } else { 427 } else {
428 $vars->{$varname} = $value; 428 $vars->{$varname} = $value;
429 } 429 }
430 debug($op eq '=' 430 debug($op eq '='
431 ? "assignment: $varname $op $value" 431 ? "assignment: $varname $op $value"
432 : "assignment: $varname $op $value => $vars->{$varname}"); 432 : "assignment: $varname $op $value => $vars->{$varname}");
433 433
434 # Give python a little hand (XXX - do we wanna consider actually 434 # Give python a little hand (XXX - do we wanna consider actually
435 # implementing make .for loops, etc? 435 # implementing make .for loops, etc?
436 # 436 #
437 if ($varname eq 'PYTHON_VERSIONS_ACCEPTED') { 437 if ($varname eq 'PYTHON_VERSIONS_ACCEPTED') {
438 foreach my $pv (split(/\s+/, $vars->{PYTHON_VERSIONS_ACCEPTED})) { 438 foreach my $pv (split(/\s+/, $vars->{PYTHON_VERSIONS_ACCEPTED})) {
439 $vars->{'_PYTHON_VERSION_FIRSTACCEPTED'} ||= $pv; 439 $vars->{'_PYTHON_VERSION_FIRSTACCEPTED'} ||= $pv;
440 $vars->{"_PYTHON_VERSION_${pv}_OK"} = 'yes'; 440 $vars->{"_PYTHON_VERSION_${pv}_OK"} = 'yes';
441 } 441 }
442 } 442 }
443} 443}
444 444
445sub expand_modifiers($file, $varname, $left, $subvar, $mods, $right, $vars) { 445sub expand_modifiers($file, $varname, $left, $subvar, $mods, $right, $vars) {
446 my @mods = split(':', $mods); 446 my @mods = split(':', $mods);
447 my $result = $vars->{$subvar}; 447 my $result = $vars->{$subvar};
448 $result = '' unless defined $result; 448 $result = '' unless defined $result;
449 449
450 # If the value of $subvar contains a '$', skip it on this pass. 450 # If the value of $subvar contains a '$', skip it on this pass.
451 # Hopefully it will get substituted and we can catch it 451 # Hopefully it will get substituted and we can catch it
452 # next time around. 452 # next time around.
453 return 0 if index($result, '${') != -1; 453 return 0 if index($result, '${') != -1;
454 454
455 debug("$file: substitutelist $varname ($result) $subvar (@mods)"); 455 debug("$file: substitutelist $varname ($result) $subvar (@mods)");
456 foreach (@mods) { 456 foreach (@mods) {
457 debug("expanding modifier '$_'"); 457 debug("expanding modifier '$_'");
458 458
459 if (m#^ (U) (.*) #x) { 459 if (m#^ (U) (.*) #x) {
460 $result = $2 unless defined $vars->{$subvar}; 460 $result = $2 unless defined $vars->{$subvar};
461 461
462 } elsif (m#^ ([CS]) (.) ([^/\@]+) \2 ([^/\@]*) \2 ([1g]*) #x) { 462 } elsif (m#^ ([CS]) (.) ([^/\@]+) \2 ([^/\@]*) \2 ([1g]*) #x) {
463 # TODO: Use non-greedy repetitions above. 463 # TODO: Use non-greedy repetitions above.
464 # TODO: Properly handle separators other than '/' and '@'. 464 # TODO: Properly handle separators other than '/' and '@'.
465 my ($how, $from, $to, $global) = ($1, $3, $4, $5); 465 my ($how, $from, $to, $global) = ($1, $3, $4, $5);
466 466
467 debug("$file: ':S' $subvar, $how, $from, $to, $global"); 467 debug("$file: ':S' $subvar, $how, $from, $to, $global");
468 if ($how eq 'S') { 468 if ($how eq 'S') {
469 # Limited substitution - keep ^ and $ 469 # Limited substitution - keep ^ and $
470 $from =~ s/([?.{}\]\[*+])/\\$1/g; 470 $from =~ s/([?.{}\]\[*+])/\\$1/g;
471 } 471 }
472 $to =~ s/\\(\d)/\$$1/g; # Change \1 etc to $1 472 $to =~ s/\\(\d)/\$$1/g; # Change \1 etc to $1
473 $to =~ s/\&/\$&/g; 473 $to =~ s/\&/\$&/g;
474 474
475 my ($notfirst); 475 my ($notfirst);
476 if ($global =~ s/1//) { 476 if ($global =~ s/1//) {
477 # FIXME: The modifier '1' applies to the first 477 # FIXME: The modifier '1' applies to the first
478 # occurrence in any word, it doesn't have to 478 # occurrence in any word, it doesn't have to
479 # be in the first word. 479 # be in the first word.
480 ($from, $notfirst) = split('\s', $from, 2); 480 ($from, $notfirst) = split('\s', $from, 2);
481 } 481 }
482 482
483 debug("$file: substituteperl $subvar, $how, $from, $to"); 483 debug("$file: substituteperl $subvar, $how, $from, $to");
484 debug("eval substitute <$from> <$to> <$global>"); 484 debug("eval substitute <$from> <$to> <$global>");
485 eval "\$result =~ s/$from/$to/$global"; 485 eval "\$result =~ s/$from/$to/$global";
486 if (defined $notfirst) { 486 if (defined $notfirst) {
487 $result .= " $notfirst"; 487 $result .= " $notfirst";
488 } 488 }
489 489
490 } else { 490 } else {
491 debug("$file: variable '$varname' has unknown modifier '$_'"); 491 debug("$file: variable '$varname' has unknown modifier '$_'");
492 } 492 }
493 } 493 }
494 494
495 $result = '' if !defined $result; 495 $result = '' if !defined $result;
496 $vars->{$varname} = "$left$result$right"; 496 $vars->{$varname} = "$left$result$right";
497 return 1; 497 return 1;
498} 498}
499 499
500# Extract variable assignments from Makefile 500# Extract variable assignments from Makefile
501# Much unpalatable magic to avoid having to use make (all for speed) 501# Much unpalatable magic to avoid having to use make (all for speed)
502# 502#
503sub parse_makefile_vars($file, $cwd = undef) { 503sub parse_makefile_vars($file, $cwd = undef) {
504 my %vars; 504 my %vars;
505 my %incfiles; # Cache of previously included files 505 my %incfiles; # Cache of previously included files
506 my @incdirs; # Directories in which to check for includes 506 my @incdirs; # Directories in which to check for includes
507 my @lines; 507 my @lines;
508 508
509 open(FILE, $file) or return undef; 509 open(FILE, $file) or return undef;
510 chomp(@lines = <FILE>); 510 chomp(@lines = <FILE>);
511 close(FILE); 511 close(FILE);
512 512
513 push @incdirs, '.'; 513 push @incdirs, '.';
514 push @incdirs, dirname($file); 514 push @incdirs, dirname($file);
515 515
516 # Some Makefiles depend on these being set 516 # Some Makefiles depend on these being set
517 if ($file eq $conf_makeconf) { 517 if ($file eq $conf_makeconf) {
518 $vars{LINTPKGSRC} = 'YES'; 518 $vars{LINTPKGSRC} = 'YES';
519 } else { 519 } else {
520 %vars = %{$default_vars}; 520 %vars = %{$default_vars};
521 } 521 }
522 $vars{BSD_PKG_MK} = 'YES'; 522 $vars{BSD_PKG_MK} = 'YES';
523 523
524 my $curdir = $cwd || ($file =~ m#(.*)/# ? $1 : getcwd); 524 my $curdir = $cwd || ($file =~ m#(.*)/# ? $1 : getcwd);
525 $vars{'.CURDIR'} = $curdir; 525 $vars{'.CURDIR'} = $curdir;
526 push @incdirs, $curdir; 526 push @incdirs, $curdir;
527 if ($opt{L}) { 527 if ($opt{L}) {
528 print "$file\n"; 528 print "$file\n";
529 } 529 }
530 530
531 my @if_state; # 'not_yet', 'active', 'done' 531 my @if_state; # 'not_yet', 'active', 'done'
532 while (defined($_ = shift @lines)) { 532 while (defined($_ = shift @lines)) {
533 s/(*negative_lookbehind:\\)#.*//; 533 s/(*negative_lookbehind:\\)#.*//;
534 s/\s+$//; 534 s/\s+$//;
535 535
536 # Join continuation lines. 536 # Join continuation lines.
537 # See devel/bmake/files/parse.c, 'replace following'. 537 # See devel/bmake/files/parse.c, 'replace following'.
538 while (substr($_, -1) eq "\\" && @lines > 0) { 538 while (substr($_, -1) eq "\\" && @lines > 0) {
539 my $cont = shift @lines; 539 my $cont = shift @lines;
540 $cont =~ s,^\s*, ,; 540 $cont =~ s,^\s*, ,;
541 $cont =~ s/(*negative_lookbehind:\\)#.*//; 541 $cont =~ s/(*negative_lookbehind:\\)#.*//;
542 $cont =~ s/\s+$//; 542 $cont =~ s/\s+$//;
543 substr($_, -1) = $cont; 543 substr($_, -1) = $cont;
544 } 544 }
545 545
546 # Conditionals 546 # Conditionals
547 # 547 #
548 if (m#^ \. \s* (if|ifdef|ifndef) \s+ (.*) #x) { 548 if (m#^ \. \s* (if|ifdef|ifndef) \s+ (.*) #x) {
549 my ($kind, $cond) = ($1, $2); 549 my ($kind, $cond) = ($1, $2);
550 550
551 if (@if_state > 0 && $if_state[-1] ne 'active') { 551 if (@if_state > 0 && $if_state[-1] ne 'active') {
552 push @if_state, 'done'; 552 push @if_state, 'done';
553 553
554 } elsif ($kind eq 'if') { 554 } elsif ($kind eq 'if') {
555 my $result = eval_mk_cond($cond, \%vars); 555 my $result = eval_mk_cond($cond, \%vars);
556 push @if_state, $result ? 'active' : 'not_yet'; 556 push @if_state, $result ? 'active' : 'not_yet';
557 557
558 } else { 558 } else {
559 my $varname = expand_exprs($cond, \%vars); 559 my $varname = expand_exprs($cond, \%vars);
560 560
561 # bmake also allows '.ifdef A && B'. 561 # bmake also allows '.ifdef A && B'.
562 debug("not implemented: .ifdef $varname") 562 debug("not implemented: .ifdef $varname")
563 if $cond =~ /\s/; 563 if $cond =~ /\s/;
564 564
565 my $result = $kind eq 'ifdef' 565 my $result = $kind eq 'ifdef'
566 ? defined($vars{$varname}) 566 ? defined($vars{$varname})
567 : !defined($vars{$varname}); 567 : !defined($vars{$varname});
568 push @if_state, $result ? 'active' : 'not_yet'; 568 push @if_state, $result ? 'active' : 'not_yet';
569 } 569 }
570 570
571 debug("$file: .$kind @if_state"); 571 debug("$file: .$kind @if_state");
572 572
573 } elsif ( # XXX: bmake also knows '.elifdef' and '.elifnmake'. 573 } elsif ( # XXX: bmake also knows '.elifdef' and '.elifnmake'.
574 m#^ \. \s* elif \s+ (.*)#x && @if_state > 0) { 574 m#^ \. \s* elif \s+ (.*)#x && @if_state > 0) {
575 my ($cond) = ($1); 575 my ($cond) = ($1);
576 576
577 if ($if_state[-1] eq 'active') { 577 if ($if_state[-1] eq 'active') {
578 $if_state[-1] = 'done'; 578 $if_state[-1] = 'done';
579 } elsif ($if_state[-1] eq 'not_yet' 579 } elsif ($if_state[-1] eq 'not_yet'
580 && eval_mk_cond($cond, \%vars)) { 580 && eval_mk_cond($cond, \%vars)) {
581 $if_state[-1] = 'active'; 581 $if_state[-1] = 'active';
582 } 582 }
583 debug("$file: .elif @if_state"); 583 debug("$file: .elif @if_state");
584 584
585 } elsif (m#^ \. \s* else \b #x && @if_state > 0) { 585 } elsif (m#^ \. \s* else \b #x && @if_state > 0) {
586 $if_state[-1] = 586 $if_state[-1] =
587 $if_state[-1] eq 'not_yet' ? 'active' : 'done'; 587 $if_state[-1] eq 'not_yet' ? 'active' : 'done';
588 debug("$file: .else @if_state"); 588 debug("$file: .else @if_state");
589 589
590 } elsif (m#^\. \s* endif \b #x) { 590 } elsif (m#^\. \s* endif \b #x) {
591 pop @if_state; 591 pop @if_state;
592 debug("$file: .endif @if_state"); 592 debug("$file: .endif @if_state");
593 593
594 } elsif (@if_state > 0 && $if_state[-1] ne 'active') { 594 } elsif (@if_state > 0 && $if_state[-1] ne 'active') {
595 # Skip branches whose condition evaluated to false. 595 # Skip branches whose condition evaluated to false.
596 596
597 } elsif (m#^\. \s* include \s+ "([^"]+)" #x) { 597 } elsif (m#^\. \s* include \s+ "([^"]+)" #x) {
598 my $incfile = expand_exprs($1, \%vars); 598 my $incfile = expand_exprs($1, \%vars);
599 599
600 parse_makefile_line_include($file, $incfile, 600 parse_makefile_line_include($file, $incfile,
601 \@incdirs, \%incfiles, \@lines, \%vars); 601 \@incdirs, \%incfiles, \@lines, \%vars);
602 602
603 } elsif (m#^[ ]* ([-\w\.]+) \s* ([:+?]?=) \s* (.*)#x) { 603 } elsif (m#^[ ]* ([-\w\.]+) \s* ([:+?]?=) \s* (.*)#x) {
604 parse_makefile_line_var($1, $2, $3, \%vars); 604 parse_makefile_line_var($1, $2, $3, \%vars);
605 605
606 } elsif ($_ eq '' || m#^\s*\## || m#^\t#) { 606 } elsif ($_ eq '' || m#^\s*\## || m#^\t#) {
607 # Skip comment lines and shell commands. 607 # Skip comment lines and shell commands.
608 608
609 } else { 609 } else {
610 debug("$file: unknown line '$_'"); 610 debug("$file: unknown line '$_'");
611 } 611 }
612 } 612 }
613 613
614 debug("$file: expand"); 614 debug("$file: expand");
615 615
616 # Handle variable substitutions FRED = a-${JIM:S/-/-b-/} 616 # Handle variable substitutions FRED = a-${JIM:S/-/-b-/}
617 617
618 for (my $loop = 1; $loop != 0;) { 618 for (my $loop = 1; $loop != 0;) {
619 $loop = 0; 619 $loop = 0;
620 foreach my $key (keys %vars) { 620 foreach my $key (keys %vars) {
621 next if index($vars{$key}, '$') == -1; 621 next if index($vars{$key}, '$') == -1;
622 622
623 $_ = expand_exprs($vars{$key}, \%vars); 623 $_ = expand_exprs($vars{$key}, \%vars);
624 if ($_ ne $vars{$key}) { 624 if ($_ ne $vars{$key}) {
625 $vars{$key} = $_; 625 $vars{$key} = $_;
626 $loop = 1; 626 $loop = 1;
627 627
628 } elsif ($vars{$key} =~ m#\$\{([\w.]+):([CS]([^{}])[^{}\3]+\3[^{}\3]*\3[g1]*(|:[^{}]+)|U[^{}]+)\}#) { 628 } elsif ($vars{$key} =~ m#\$\{([\w.]+):([CS]([^{}])[^{}\3]+\3[^{}\3]*\3[g1]*(|:[^{}]+)|U[^{}]+)\}#) {
629 $loop ||= expand_modifiers($file, $key, $`, $1, $2, $', \%vars); 629 $loop ||= expand_modifiers($file, $key, $`, $1, $2, $', \%vars);
630 } 630 }
631 } 631 }
632 } 632 }
633 633
634 foreach my $key (keys %vars) { 634 foreach my $key (keys %vars) {
635 $vars{$key} =~ s/$magic_undefined//; 635 $vars{$key} =~ s/$magic_undefined//;
636 } 636 }
637 \%vars; 637 \%vars;
638} 638}
639 639
640sub get_default_makefile_vars() { 640sub get_default_makefile_vars() {
641 641
642 chomp($_ = `uname -srm`); 642 chomp($_ = `uname -srm`);
643 ( 643 (
644 $default_vars->{OPSYS}, 644 $default_vars->{OPSYS},
645 $default_vars->{OS_VERSION}, 645 $default_vars->{OS_VERSION},
646 $default_vars->{MACHINE} 646 $default_vars->{MACHINE}
647 ) = split; 647 ) = split;
648 $default_vars->{MACHINE} 648 $default_vars->{MACHINE}
649 or die('Unable to extract machine from uname'); 649 or die('Unable to extract machine from uname');
650 650
651 # Handle systems without uname -p (NetBSD pre 1.4) 651 # Handle systems without uname -p (NetBSD pre 1.4)
652 chomp($default_vars->{MACHINE_ARCH} = `uname -p 2>/dev/null`); 652 chomp($default_vars->{MACHINE_ARCH} = `uname -p 2>/dev/null`);
653 653
654 if (!$default_vars->{MACHINE_ARCH} 654 if (!$default_vars->{MACHINE_ARCH}
655 && $default_vars->{OS_VERSION} eq 'NetBSD') { 655 && $default_vars->{OS_VERSION} eq 'NetBSD') {
656 chomp($default_vars->{MACHINE_ARCH} = `sysctl -n hw.machine_arch`); 656 chomp($default_vars->{MACHINE_ARCH} = `sysctl -n hw.machine_arch`);
657 } 657 }
658 658
659 $default_vars->{MACHINE_ARCH} ||= $default_vars->{MACHINE}; 659 $default_vars->{MACHINE_ARCH} ||= $default_vars->{MACHINE};
660 660
661 $default_vars->{OBJECT_FMT} = 'x'; 661 $default_vars->{OBJECT_FMT} = 'x';
662 $default_vars->{LOWER_OPSYS} = lc($default_vars->{OPSYS}); 662 $default_vars->{LOWER_OPSYS} = lc($default_vars->{OPSYS});
663 663
664 $default_vars->{PKGSRCDIR} = $opt{P} 664 $default_vars->{PKGSRCDIR} = $opt{P}
665 ? realpath($opt{P}) 665 ? realpath($opt{P})
666 : $conf_pkgsrcdir; 666 : $conf_pkgsrcdir;
667 667
668 $default_vars->{DESTDIR} = ''; 668 $default_vars->{DESTDIR} = '';
669 $default_vars->{LOCALBASE} = $conf_pkgsrcdir; 669 $default_vars->{LOCALBASE} = $conf_pkgsrcdir;
670 $default_vars->{X11BASE} = $conf_x11base; 670 $default_vars->{X11BASE} = $conf_x11base;
671 671
672 my ($vars); 672 my ($vars);
673 if (-f $conf_makeconf && 673 if (-f $conf_makeconf &&
674 ($vars = parse_makefile_vars($conf_makeconf, undef))) { 674 ($vars = parse_makefile_vars($conf_makeconf, undef))) {
675 foreach my $var (keys %{$vars}) { 675 foreach my $var (keys %{$vars}) {
676 $default_vars->{$var} = $vars->{$var}; 676 $default_vars->{$var} = $vars->{$var};
677 } 677 }
678 } 678 }
679 679
680 # XXX: repeated from above? 680 # XXX: repeated from above?
681 if ($opt{P}) { 681 if ($opt{P}) {
682 $default_vars->{PKGSRCDIR} = realpath($opt{P}); 682 $default_vars->{PKGSRCDIR} = realpath($opt{P});
683 } 683 }
684 684
685 if ($opt{M}) { 685 if ($opt{M}) {
686 $default_vars->{DISTDIR} = realpath($opt{M}); 686 $default_vars->{DISTDIR} = realpath($opt{M});
687 } else { 687 } else {
688 $default_vars->{DISTDIR} ||= $default_vars->{PKGSRCDIR} . '/distfiles'; 688 $default_vars->{DISTDIR} ||= $default_vars->{PKGSRCDIR} . '/distfiles';
689 } 689 }
690 690
691 if ($opt{K}) { 691 if ($opt{K}) {
692 $default_vars->{PACKAGES} = realpath($opt{K}); 692 $default_vars->{PACKAGES} = realpath($opt{K});
693 } 693 }
694 694
695 # Extract some variables from bsd.pkg.mk 695 # Extract some variables from bsd.pkg.mk
696 my ($mkvars); 696 my ($mkvars);
697 $mkvars = parse_makefile_vars( 697 $mkvars = parse_makefile_vars(
698 "$default_vars->{PKGSRCDIR}/mk/bsd.pkg.mk", 698 "$default_vars->{PKGSRCDIR}/mk/bsd.pkg.mk",
699 "$default_vars->{PKGSRCDIR}/mk/scripts" 699 "$default_vars->{PKGSRCDIR}/mk/scripts"
700 ); 700 );
701 foreach my $varname (keys %{$mkvars}) { 701 foreach my $varname (keys %{$mkvars}) {
702 if ($varname =~ /_REQD$/ || $varname eq 'EXTRACT_SUFX') { 702 if ($varname =~ /_REQD$/ || $varname eq 'EXTRACT_SUFX') {
703 $default_vars->{$varname} = $mkvars->{$varname}; 703 $default_vars->{$varname} = $mkvars->{$varname};
704 } 704 }
705 } 705 }
706 706
707 $default_vars->{PACKAGES} ||= $default_vars->{PKGSRCDIR} . '/packages'; 707 $default_vars->{PACKAGES} ||= $default_vars->{PKGSRCDIR} . '/packages';
708} 708}
709 709
710# Determine if a package version is current. If not, report correct version 710# Determine if a package version is current. If not, report correct version
711# if found 711# if found
712# 712#
713sub invalid_version($pkgmatch) { 713sub invalid_version($pkgmatch) {
714 my ($fail, $ok); 714 my ($fail, $ok);
715 715
716 my @pkgmatches = expand_braces($pkgmatch); 716 my @pkgmatches = expand_braces($pkgmatch);
717 foreach $pkgmatch (@pkgmatches) { 717 foreach $pkgmatch (@pkgmatches) {
718 my ($pkg, $badver) = package_globmatch($pkgmatch); 718 my ($pkg, $badver) = package_globmatch($pkgmatch);
719 719
720 if (defined $badver) { 720 if (defined $badver) {
721 if (my $pkgs = $pkgdb->pkgs($pkg)) { 721 if (my $pkgs = $pkgdb->pkgs($pkg)) {
722 $fail .= 722 $fail .=
723 "Version mismatch: '$pkg' $badver vs " 723 "Version mismatch: '$pkg' $badver vs "
724 . join(',', $pkgs->versions) . "\n"; 724 . join(',', $pkgs->versions) . "\n";
725 } else { 725 } else {
726 $fail .= "Unknown package: '$pkg' version $badver\n"; 726 $fail .= "Unknown package: '$pkg' version $badver\n";
727 } 727 }
728 } else { 728 } else {
729 # If we find one match, don't bitch about others 729 # If we find one match, don't bitch about others
730 $ok = 1; 730 $ok = 1;
731 } 731 }
732 } 732 }
733 $ok ? undef : $fail; 733 $ok ? undef : $fail;
734} 734}
735 735
736sub list_installed_packages() { 736sub list_installed_packages() {
737 open(PKG_INFO, "$conf_pkg_info -e '*' |") 737 open(PKG_INFO, "$conf_pkg_info -e '*' |")
738 or fail("Unable to run $conf_pkg_info: $!"); 738 or fail("Unable to run $conf_pkg_info: $!");
739 chomp(my @pkgs = <PKG_INFO>); 739 chomp(my @pkgs = <PKG_INFO>);
740 close(PKG_INFO); 740 close(PKG_INFO);
741 map { $_ = canonicalize_pkgname($_) } @pkgs; 741 map { $_ = canonicalize_pkgname($_) } @pkgs;
742} 742}
743 743
744# List top level pkgsrc categories 744# List top level pkgsrc categories
745# 745#
746sub list_pkgsrc_categories($pkgsrcdir) { 746sub list_pkgsrc_categories($pkgsrcdir) {
747 my (@categories); 747 my (@categories);
748 748
749 opendir(BASE, $pkgsrcdir) || die("Unable to opendir($pkgsrcdir): $!"); 749 opendir(BASE, $pkgsrcdir) || die("Unable to opendir($pkgsrcdir): $!");
750 @categories = 750 @categories =
751 grep(substr($_, 0, 1) ne '.' 751 grep(substr($_, 0, 1) ne '.'
752 && $_ ne 'CVS' 752 && $_ ne 'CVS'
753 && -f "$pkgsrcdir/$_/Makefile", 753 && -f "$pkgsrcdir/$_/Makefile",
754 readdir(BASE)); 754 readdir(BASE));
755 closedir(BASE); 755 closedir(BASE);
756 @categories; 756 @categories;
757} 757}
758 758
759# For a given category, list potentially valid pkgdirs 759# For a given category, list potentially valid pkgdirs
760# 760#
761sub list_pkgsrc_pkgdirs($pkgsrcdir, $cat) { 761sub list_pkgsrc_pkgdirs($pkgsrcdir, $cat) {
762 opendir(CAT, "$pkgsrcdir/$cat") 762 opendir(CAT, "$pkgsrcdir/$cat")
763 or die("Unable to opendir($pkgsrcdir/$cat): $!"); 763 or die("Unable to opendir($pkgsrcdir/$cat): $!");
764 my @pkgdirs = sort grep { 764 my @pkgdirs = sort grep {
765 $_ ne 'Makefile' 765 $_ ne 'Makefile'
766 && $_ ne 'pkg' 766 && $_ ne 'pkg'
767 && $_ ne 'CVS' 767 && $_ ne 'CVS'
768 && substr($_, 0, 1) ne '.' 768 && substr($_, 0, 1) ne '.'
769 } readdir(CAT); 769 } readdir(CAT);
770 closedir(CAT) or die; 770 closedir(CAT) or die;
771 @pkgdirs; 771 @pkgdirs;
772} 772}
773 773
774# Convert the glob pattern to a regular expression. 774# Convert the glob pattern to a regular expression.
775# Return '' if the regular expression equals the glob expression. 775# Return '' if the regular expression equals the glob expression.
776# Return undef on error. 776# Return undef on error.
777sub glob2regex($glob) { 777sub glob2regex($glob) {
778 my @chars = split(//, $glob); 778 my @chars = split(//, $glob);
779 my $alternative_depth = 0; 779 my $alternative_depth = 0;
780 my $regex = ''; 780 my $regex = '';
781 while (defined($_ = shift @chars)) { 781 while (defined($_ = shift @chars)) {
782 if ($_ eq '*') { 782 if ($_ eq '*') {
783 $regex .= '.*'; 783 $regex .= '.*';
784 } elsif ($_ eq '?') { 784 } elsif ($_ eq '?') {
785 $regex .= '.'; 785 $regex .= '.';
786 } elsif ($_ eq '+') { 786 } elsif ($_ eq '+') {
787 $regex .= '\\+'; 787 $regex .= '\\+';
788 } elsif ($_ eq '\\' && @chars > 0) { 788 } elsif ($_ eq '\\' && @chars > 0) {
789 my $next = shift @chars; 789 my $next = shift @chars;
790 $regex .= $next =~ /\w/ ? $next : "\\$next"; 790 $regex .= $next =~ /\w/ ? $next : "\\$next";
791 } elsif ($_ eq '.' || $_ eq '|') { 791 } elsif ($_ eq '.' || $_ eq '|') {
792 $regex .= "\\$_"; 792 $regex .= "\\$_";
793 } elsif ($_ eq '{') { 793 } elsif ($_ eq '{') {
794 $regex .= '('; 794 $regex .= '(';
795 ++$alternative_depth; 795 ++$alternative_depth;
796 } elsif ($_ eq '}') { 796 } elsif ($_ eq '}') {
797 return undef if $alternative_depth == 0; 797 return undef if $alternative_depth == 0;
798 $regex .= ')'; 798 $regex .= ')';
799 --$alternative_depth; 799 --$alternative_depth;
800 } elsif ($_ eq ',' && $alternative_depth > 0) { 800 } elsif ($_ eq ',' && $alternative_depth > 0) {
801 $regex .= '|'; 801 $regex .= '|';
802 } elsif ($_ eq '[') { 802 } elsif ($_ eq '[') {
803 $regex .= '['; 803 $regex .= '[';
804 while (defined($_ = shift @chars)) { 804 while (defined($_ = shift @chars)) {
805 $regex .= $_; 805 $regex .= $_;
806 if ($_ eq ']') { 806 if ($_ eq ']') {
807 last; 807 last;
808 } elsif ($_ eq '\\' && @chars > 0) { 808 } elsif ($_ eq '\\' && @chars > 0) {
809 $regex .= shift @chars; 809 $regex .= shift @chars;
810 } 810 }
811 } 811 }
812 return undef if $_ ne ']'; 812 return undef if $_ ne ']';
813 } else { 813 } else {
814 $regex .= $_; 814 $regex .= $_;
815 } 815 }
816 } 816 }
817 817
818 return undef if $alternative_depth > 0; 818 return undef if $alternative_depth > 0;
819 return '' if $regex eq $glob; # XXX: why? 819 return '' if $regex eq $glob; # XXX: why?
820 820
821 $opt{D} and print "glob2regex: $glob -> $regex\n"; 821 $opt{D} and print "glob2regex: $glob -> $regex\n";
822 '^' . $regex . '$'; 822 '^' . $regex . '$';
823} 823}
824 824
825# Perform some (reasonable) subset of 'pkg_info -e' / glob(3) 825# Perform some (reasonable) subset of 'pkg_info -e' / glob(3)
826# Returns (sometimes best guess at) package name, 826# Returns (sometimes best guess at) package name,
827# and either 'problem version' or undef if all OK 827# and either 'problem version' or undef if all OK
828# 828#
829sub package_globmatch($pkgmatch) { 829sub package_globmatch($pkgmatch) {
830 830
831 if ($pkgmatch =~ /^ ([^*?[]+) (<|>|<=|>=|-) (\d[^*?[{]*) $/x) { 831 if ($pkgmatch =~ /^ ([^*?[]+) (<|>|<=|>=|-) (\d[^*?[{]*) $/x) {
832 # TODO: rename $matchpkgname to be more accurate. 832 # TODO: rename $matchpkgname to be more accurate.
833 my ($matchpkgname, $op, $matchver) = ($1, $2, $3); 833 my ($matchpkgname, $op, $matchver) = ($1, $2, $3);
834 834
835 if (my @pkgvers = $pkgdb->pkgvers_by_pkgbase($matchpkgname)) { 835 if (my @pkgvers = $pkgdb->pkgvers_by_pkgbase($matchpkgname)) {
836 foreach my $pkgver (@pkgvers) { 836 foreach my $pkgver (@pkgvers) {
837 if ($op eq '-') { 837 if ($op eq '-') {
838 if ($pkgver->pkgversion eq $matchver) { 838 if ($pkgver->pkgversion eq $matchver) {
839 $matchver = undef; 839 $matchver = undef;
840 last; 840 last;
841 } 841 }
842 } else { 842 } else {
843 if (pkgversion_cmp($pkgver->pkgversion, $op, $matchver)) { 843 if (pkgversion_cmp($pkgver->pkgversion, $op, $matchver)) {
844 $matchver = undef; 844 $matchver = undef;
845 last; 845 last;
846 } 846 }
847 } 847 }
848 } 848 }
849 849
850 if ($matchver && $op ne '-') { 850 if ($matchver && $op ne '-') {
851 $matchver = "$op$matchver"; 851 $matchver = "$op$matchver";
852 } 852 }
853 } 853 }
854 ($matchpkgname, $matchver); 854 ($matchpkgname, $matchver);
855 855
856 } elsif ($pkgmatch =~ /^ ([^[]+) - ([\d*?{[].*) $/x) { 856 } elsif ($pkgmatch =~ /^ ([^[]+) - ([\d*?{[].*) $/x) {
857 my ($matchpkgname, $matchver) = ($1, $2); 857 my ($matchpkgname, $matchver) = ($1, $2);
858 858
859 my @pkgnames; 859 my @pkgnames;
860 if (defined $pkgdb->pkgs($matchpkgname)) { 860 if (defined $pkgdb->pkgs($matchpkgname)) {
861 push @pkgnames, $matchpkgname; 861 push @pkgnames, $matchpkgname;
862 862
863 } elsif (my $regex = glob2regex($matchpkgname)) { 863 } elsif (my $regex = glob2regex($matchpkgname)) {
864 foreach my $pkg ($pkgdb->pkgs) { 864 foreach my $pkg ($pkgdb->pkgs) {
865 if ($pkg->pkgbase =~ /$regex/) { 865 if ($pkg->pkgbase =~ /$regex/) {
866 push @pkgnames, $pkg->pkgbase; 866 push @pkgnames, $pkg->pkgbase;
867 } 867 }
868 } 868 }
869 } 869 }
870 870
871 # Try to convert $matchver into regex version 871 # Try to convert $matchver into regex version
872 # 872 #
873 my $regex = glob2regex($matchver); 873 my $regex = glob2regex($matchver);
874 874
875 foreach my $pkg (@pkgnames) { 875 foreach my $pkg (@pkgnames) {
876 if (defined $pkgdb->pkgver($pkg, $matchver)) { 876 if (defined $pkgdb->pkgver($pkg, $matchver)) {
877 return ($matchver); 877 return ($matchver);
878 } 878 }
879 879
880 if ($regex) { 880 if ($regex) {
881 foreach my $ver ($pkgdb->pkgs($pkg)->versions) { 881 foreach my $ver ($pkgdb->pkgs($pkg)->versions) {
882 if ($ver =~ /$regex/) { 882 if ($ver =~ /$regex/) {
883 $matchver = undef; 883 $matchver = undef;
884 last; 884 last;
885 } 885 }
886 } 886 }
887 } 887 }
888 888
889 $matchver or last; 889 $matchver or last;
890 } 890 }
891 891
892 # last ditch attempt to handle the whole DEPENDS as a glob 892 # last ditch attempt to handle the whole DEPENDS as a glob
893 # 893 #
894 if ($matchver && ($regex = glob2regex($pkgmatch))) { 894 if ($matchver && ($regex = glob2regex($pkgmatch))) {
895 895
896 # (large-glob) 896 # (large-glob)
897 foreach my $pkgver ($pkgdb->pkgvers_all) { 897 foreach my $pkgver ($pkgdb->pkgvers_all) {
898 if ($pkgver->pkgname =~ /$regex/) { 898 if ($pkgver->pkgname =~ /$regex/) {
899 $matchver = undef; 899 $matchver = undef;
900 last; 900 last;
901 } 901 }
902 } 902 }
903 } 903 }
904 904
905 ($matchpkgname, $matchver); 905 ($matchpkgname, $matchver);
906 906
907 } else { 907 } else {
908 ($pkgmatch, 'missing'); 908 ($pkgmatch, 'missing');
909 } 909 }
910} 910}
911 911
912# Parse a pkgsrc package makefile and return the pkgname and set variables 912# Parse a pkgsrc package makefile and return the pkgname and set variables
913# 913#
914sub parse_makefile_pkgsrc($file) { 914sub parse_makefile_pkgsrc($file) {
915 my ($pkgname, $vars); 915 my ($pkgname, $vars);
916 916
917 $vars = parse_makefile_vars($file, undef); 917 $vars = parse_makefile_vars($file, undef);
918 defined $vars or return undef; # Missing Makefile. 918 defined $vars or return undef; # Missing Makefile.
919 919
920 if (defined $vars->{PKGNAME}) { 920 if (defined $vars->{PKGNAME}) {
921 $pkgname = $vars->{PKGNAME}; 921 $pkgname = $vars->{PKGNAME};
922 } elsif (defined $vars->{DISTNAME}) { 922 } elsif (defined $vars->{DISTNAME}) {
923 $pkgname = $vars->{DISTNAME}; 923 $pkgname = $vars->{DISTNAME};
924 } 924 }
925 925
926 if (defined $vars->{PKGNAME}) { 926 if (defined $vars->{PKGNAME}) {
927 debug("$file: PKGNAME=$vars->{PKGNAME}"); 927 debug("$file: PKGNAME=$vars->{PKGNAME}");
928 } 928 }
929 if (defined $vars->{DISTNAME}) { 929 if (defined $vars->{DISTNAME}) {
930 debug("$file: DISTNAME=$vars->{DISTNAME}"); 930 debug("$file: DISTNAME=$vars->{DISTNAME}");
931 } 931 }
932 932
933 if (!defined $pkgname || $pkgname =~ /\$/ || $pkgname !~ /(.*)-(\d.*)/) { 933 if (!defined $pkgname || $pkgname =~ /\$/ || $pkgname !~ /(.*)-(\d.*)/) {
934 934
935 # invoke make here as a last resort 935 # invoke make here as a last resort
936 my $pkgdir = dirname $file; 936 my $pkgdir = dirname $file;
937 debug("Running '$conf_make' in '$pkgdir'"); 937 debug("Running '$conf_make' in '$pkgdir'");
938 my $pid = open3(\*WTR, \*RDR, \*ERR, 938 my $pid = open3(\*WTR, \*RDR, \*ERR,
939 "cd $pkgdir || exit 1; $conf_make show-vars VARNAMES=PKGNAME"); 939 "cd $pkgdir || exit 1; $conf_make show-vars VARNAMES=PKGNAME");
940 if (!$pid) { 940 if (!$pid) {
941 warn "$file: Unable to run make: $!"; 941 warn "$file: Unable to run make: $!";
942 } else { 942 } else {
943 close(WTR); 943 close(WTR);
944 my @errors = <ERR>; 944 my @errors = <ERR>;
945 close(ERR); 945 close(ERR);
946 my ($makepkgname) = <RDR>; 946 my ($makepkgname) = <RDR>;
947 close(RDR); 947 close(RDR);
948 wait; 948 wait;
949 chomp @errors; 949 chomp @errors;
950 if (@errors) { warn "\n$file: @errors\n"; } 950 if (@errors) { warn "\n$file: @errors\n"; }
951 951
952 if ($makepkgname =~ /(.*)-(\d.*)/) { 952 if ($makepkgname =~ /(.*)-(\d.*)/) {
953 $pkgname = $makepkgname; 953 $pkgname = $makepkgname;
954 } 954 }
955 } 955 }
956 } 956 }
957 957
958 if (defined $pkgname) { 958 if (defined $pkgname) {
959 $pkgname = canonicalize_pkgname($pkgname); 959 $pkgname = canonicalize_pkgname($pkgname);
960 960
961 if (defined $vars->{PKGREVISION} 961 if (defined $vars->{PKGREVISION}
962 and not $vars->{PKGREVISION} =~ /^\s*$/) { 962 and not $vars->{PKGREVISION} =~ /^\s*$/) {
963 if ($vars->{PKGREVISION} =~ /^\$\{(_(CVS|GIT|HG|SVN)_PKGVERSION):.*\}$/) { 963 if ($vars->{PKGREVISION} =~ /^\$\{(_(CVS|GIT|HG|SVN)_PKGVERSION):.*\}$/) {
964 # See wip/mk/*-package.mk. 964 # See wip/mk/*-package.mk.
965 } elsif ($vars->{PKGREVISION} =~ /\D/) { 965 } elsif ($vars->{PKGREVISION} =~ /\D/) {
966 print "\nBogus: PKGREVISION $vars->{PKGREVISION} (from $file)\n"; 966 print "\nBogus: PKGREVISION $vars->{PKGREVISION} (from $file)\n";
967 967
968 } elsif ($vars->{PKGREVISION}) { 968 } elsif ($vars->{PKGREVISION}) {
969 $pkgname .= 'nb'; 969 $pkgname .= 'nb';
970 $pkgname .= $vars->{PKGREVISION}; 970 $pkgname .= $vars->{PKGREVISION};
971 } 971 }
972 } 972 }
973 973
974 if ($pkgname =~ /\$/) { 974 if ($pkgname =~ /\$/) {
975 print "\nBogus: $pkgname (from $file)\n"; 975 print "\nBogus: $pkgname (from $file)\n";
976 976
977 } elsif ($pkgname =~ /(.*)-(\d.*)/) { 977 } elsif ($pkgname =~ /(.*)-(\d.*)/) {
978 if ($pkgdb) { 978 if ($pkgdb) {
979 my ($pkgver) = $pkgdb->add($1, $2); 979 my ($pkgver) = $pkgdb->add($1, $2);
980 980
981 debug("add $1 $2"); 981 debug("add $1 $2");
982 982
983 foreach my $var (qw(DEPENDS RESTRICTED OSVERSION_SPECIFIC BROKEN)) { 983 foreach my $var (qw(DEPENDS RESTRICTED OSVERSION_SPECIFIC BROKEN)) {
984 $pkgver->var($var, $vars->{$var}); 984 $pkgver->var($var, $vars->{$var});
985 } 985 }
986 986
987 if (defined $vars->{NO_BIN_ON_FTP}) { 987 if (defined $vars->{NO_BIN_ON_FTP}) {
988 $pkgver->var('RESTRICTED', 'NO_BIN_ON_FTP'); 988 $pkgver->var('RESTRICTED', 'NO_BIN_ON_FTP');
989 } 989 }
990 990
991 if ($file =~ m:([^/]+/[^/]+)/Makefile$:) { 991 if ($file =~ m:([^/]+/[^/]+)/Makefile$:) {
992 $pkgver->var('dir', $1); 992 $pkgver->var('dir', $1);
993 } else { 993 } else {
994 $pkgver->var('dir', 'unknown'); 994 $pkgver->var('dir', 'unknown');
995 } 995 }
996 } 996 }
997 } else { 997 } else {
998 print "Cannot extract $pkgname version ($file)\n"; 998 print "Cannot extract $pkgname version ($file)\n";
999 } 999 }
1000 1000
1001 return ($pkgname, $vars); 1001 return ($pkgname, $vars);
1002 1002
1003 } else { 1003 } else {
1004 return (undef); 1004 return (undef);
1005 } 1005 }
1006} 1006}
1007 1007
1008 1008
1009sub chdir_or_fail($dir) { 1009sub chdir_or_fail($dir) {
1010 debug("chdir: $dir"); 1010 debug("chdir: $dir");
1011 chdir($dir) or fail("Cannot chdir($dir): $!\n"); 1011 chdir($dir) or fail("Cannot chdir($dir): $!\n");
1012} 1012}
1013 1013
1014sub load_pkgdb_from_cache($fname) { 1014sub load_pkgdb_from_cache($fname) {
1015 open(STORE, '<', $fname) 1015 open(STORE, '<', $fname)
1016 or die("Cannot read pkgsrc store from $fname: $!\n"); 1016 or die("Cannot read pkgsrc store from $fname: $!\n");
1017 my ($pkgver); 1017 my ($pkgver);
1018 $pkgdb = PkgDb->new(); 1018 $pkgdb = PkgDb->new();
1019 while (defined(my $line = <STORE>)) { 1019 while (defined(my $line = <STORE>)) {
1020 chomp($line); 1020 chomp($line);
1021 if ($line =~ m"^ package \t ([^\t]+) \t ([^\t]+) $"x) { 1021 if ($line =~ m"^ package \t ([^\t]+) \t ([^\t]+) $"x) {
1022 $pkgver = $pkgdb->add($1, $2); 1022 $pkgver = $pkgdb->add($1, $2);
1023 } elsif ($line =~ m"^ var \t ([^\t]+) \t (.*) $"x) { 1023 } elsif ($line =~ m"^ var \t ([^\t]+) \t (.*) $"x) {
1024 $pkgver->var($1, $2); 1024 $pkgver->var($1, $2);
1025 } elsif ($line =~ m"^ sub ") { 1025 } elsif ($line =~ m"^ sub ") {
1026 die "Outdated cache format in '$fname'\n"; 1026 die "Outdated cache format in '$fname'\n";
1027 } else { 1027 } else {
1028 die "Invalid line '$line' in cache '$fname'\n"; 1028 die "Invalid line '$line' in cache '$fname'\n";
1029 } 1029 }
1030 } 1030 }
1031 close(STORE); 1031 close(STORE);
1032} 1032}
1033 1033
1034# Generate pkgname->category/pkg mapping, optionally check DEPENDS 1034# Generate pkgname->category/pkg mapping, optionally check DEPENDS
1035# 1035#
1036sub scan_pkgsrc_makefiles($pkgsrcdir) { 1036sub scan_pkgsrc_makefiles($pkgsrcdir) {
1037 1037
1038 return if defined $pkgdb; # Already done. 1038 return if defined $pkgdb; # Already done.
1039 1039
1040 if ($opt{I}) { 1040 if ($opt{I}) {
1041 load_pkgdb_from_cache($opt{I}); 1041 load_pkgdb_from_cache($opt{I});
1042 return; 1042 return;
1043 } 1043 }
1044 1044
1045 $pkgdb = PkgDb->new(); 1045 $pkgdb = PkgDb->new();
1046 my @categories = list_pkgsrc_categories($pkgsrcdir); 1046 my @categories = list_pkgsrc_categories($pkgsrcdir);
1047 1047
1048 if ($opt{L}) { 1048 if ($opt{L}) {
1049 verbose("Scan Makefiles:\n"); 1049 verbose("Scan Makefiles:\n");
1050 } else { 1050 } else {
1051 verbose('Scan Makefiles: ', '_' x @categories, "\b" x @categories); 1051 verbose('Scan Makefiles: ', '_' x @categories, "\b" x @categories);
1052 } 1052 }
1053 1053
1054 foreach my $cat (sort @categories) { 1054 foreach my $cat (sort @categories) {
1055 foreach my $pkgdir (list_pkgsrc_pkgdirs($pkgsrcdir, $cat)) { 1055 foreach my $pkgdir (list_pkgsrc_pkgdirs($pkgsrcdir, $cat)) {
1056 my ($pkg, $vars) = parse_makefile_pkgsrc("$pkgsrcdir/$cat/$pkgdir/Makefile"); 1056 my ($pkg, $vars) = parse_makefile_pkgsrc("$pkgsrcdir/$cat/$pkgdir/Makefile");
1057 } 1057 }
1058 1058
1059 verbose('.') unless $opt{L}; 1059 verbose('.') unless $opt{L};
1060 } 1060 }
1061 1061
1062 if (!$opt{L}) { 1062 if (!$opt{L}) {
1063 my ($len); 1063 my ($len);
1064 1064
1065 $_ = scalar $pkgdb->pkgvers_all . ' packages'; 1065 $_ = scalar $pkgdb->pkgvers_all . ' packages';
1066 $len = @categories - length($_); 1066 $len = @categories - length($_);
1067 verbose("\b" x @categories, $_, ' ' x $len, "\b" x $len, "\n"); 1067 verbose("\b" x @categories, $_, ' ' x $len, "\b" x $len, "\n");
1068 } 1068 }
1069} 1069}
1070 1070
1071# Cross reference all depends 1071# Cross reference all depends
1072# 1072#
1073sub pkgsrc_check_depends() { 1073sub pkgsrc_check_depends() {
1074 foreach my $pkgver ($pkgdb->pkgvers_all) { 1074 foreach my $pkgver ($pkgdb->pkgvers_all) {
1075 my $depends = $pkgver->var('DEPENDS'); 1075 my $depends = $pkgver->var('DEPENDS');
1076 next unless defined $depends; 1076 next unless defined $depends;
1077 1077
1078 my $seen_header = 0; 1078 my $seen_header = 0;
1079 foreach my $depend (split(' ', $depends)) { 1079 foreach my $depend (split(' ', $depends)) {
1080 next unless $depend =~ s/:.*//; 1080 next unless $depend =~ s/:.*//;
1081 1081
1082 $depend = canonicalize_pkgname($depend); 1082 $depend = canonicalize_pkgname($depend);
1083 if ((my $msg = invalid_version($depend))) { 1083 if ((my $msg = invalid_version($depend))) {
1084 if ($seen_header == 0) { 1084 if ($seen_header == 0) {
1085 print $pkgver->pkgname . " DEPENDS errors:\n"; 1085 print $pkgver->pkgname . " DEPENDS errors:\n";
1086 $seen_header = 1; 1086 $seen_header = 1;
1087 } 1087 }
1088 $msg =~ s/(\n)(.)/$1\t$2/g; 1088 $msg =~ s/(\n)(.)/$1\t$2/g;
1089 print "\t$msg"; 1089 print "\t$msg";
1090 } 1090 }
1091 } 1091 }
1092 } 1092 }
1093} 1093}
1094 1094
1095sub load_distinfo($dir) { 1095sub load_distinfo($dir) {
1096 my $fname = "$dir/distinfo"; 1096 my $fname = "$dir/distinfo";
1097 open(my $f, '<', $fname) or return; 1097 open(my $f, '<', $fname) or return;
1098 chomp(my @lines = <$f>); 1098 chomp(my @lines = <$f>);
1099 close($f) or die; 1099 close($f) or die;
1100 1100
1101 my @entries; 1101 my @entries;
1102 foreach my $line (@lines) { 1102 foreach my $line (@lines) {
1103 next if $line eq '' || $line =~ m#^\$NetBSD#; 1103 next if $line eq '' || $line =~ m#^\$NetBSD#;
1104 1104
1105 if ($line =~ m/^ (\w+) \s \( ([^)]+) \) \s=\s (\S+)/x) { 1105 if ($line =~ m/^ (\w+) \s \( ([^)]+) \) \s=\s (\S+)/x) {
1106 push @entries, { 1106 push @entries, {
1107 algorithm => $1, 1107 algorithm => $1,
1108 distfile => $2, 1108 distfile => $2,
1109 hash => $3, 1109 hash => $3,
1110 }; 1110 };
1111 } else { 1111 } else {
1112 warn "Invalid line in $fname: $line\n"; 1112 warn "Invalid line in $fname: $line\n";
1113 } 1113 }
1114 } 1114 }
1115 1115
1116 @entries; 1116 @entries;
1117} 1117}
1118 1118
1119sub check_distinfo_hash($entry, $pkgpath, $distfiles, $warnings) { 1119sub check_distinfo_hash($entry, $pkgpath, $distfiles, $warnings) {
1120 my $algorithm = $entry->{algorithm}; 1120 my $algorithm = $entry->{algorithm};
1121 my $distfile = $entry->{distfile}; 1121 my $distfile = $entry->{distfile};
1122 my $hash = $entry->{hash}; 1122 my $hash = $entry->{hash};
1123 1123
1124 return if $distfile =~ /^patch-[\w.+\-]+$/; 1124 return if $distfile =~ /^patch-[\w.+\-]+$/;
1125 1125
1126 # Only store and check the first algorithm listed in distinfo. 1126 # Only store and check the first algorithm listed in distinfo.
1127 my $other_entry = $distfiles->{$distfile}; 1127 my $other_entry = $distfiles->{$distfile};
1128 if (!defined $other_entry) { 1128 if (!defined $other_entry) {
1129 $distfiles->{$distfile} = { 1129 $distfiles->{$distfile} = {
1130 algorithm => $algorithm, 1130 algorithm => $algorithm,
1131 hash => $hash, 1131 hash => $hash,
1132 pkgpath => $pkgpath, 1132 pkgpath => $pkgpath,
1133 }; 1133 };
1134 1134
1135 } elsif ($other_entry->{algorithm} eq $algorithm 1135 } elsif ($other_entry->{algorithm} eq $algorithm
1136 && $other_entry->{hash} ne $hash) { 1136 && $other_entry->{hash} ne $hash) {
1137 my $other_pkgpath = $other_entry->{pkgpath}; 1137 my $other_pkgpath = $other_entry->{pkgpath};
1138 my $warning = "checksum mismatch for '$algorithm' " 1138 my $warning = "checksum mismatch for '$algorithm' "
1139 . "of '$distfile' between '$pkgpath' and '$other_pkgpath'\n"; 1139 . "of '$distfile' between '$pkgpath' and '$other_pkgpath'\n";
1140 push @$warnings, $warning; 1140 push @$warnings, $warning;
1141 } 1141 }
1142} 1142}
1143 1143
1144# Extract all distinfo entries, then verify contents of distfiles 1144# Extract all distinfo entries, then verify contents of distfiles
1145# 1145#
1146sub scan_pkgsrc_distfiles_vs_distinfo($pkgsrcdir, $pkgdistdir, $check_unref, 1146sub scan_pkgsrc_distfiles_vs_distinfo($pkgsrcdir, $pkgdistdir, $check_unref,
1147 $check_distinfo) { 1147 $check_distinfo) {
1148 my (@categories); 1148 my (@categories);
1149 my (%distfiles, %sumfiles, @distwarn, $numpkg); 1149 my (%distfiles, %sumfiles, @distwarn, $numpkg);
1150 my (%unref_distfiles); 1150 my (%unref_distfiles);
1151 1151
1152 @categories = list_pkgsrc_categories($pkgsrcdir); 1152 @categories = list_pkgsrc_categories($pkgsrcdir);
1153 1153
1154 verbose('Scan distinfo: ' . '_' x @categories . "\b" x @categories); 1154 verbose('Scan distinfo: ' . '_' x @categories . "\b" x @categories);
1155 $numpkg = 0; 1155 $numpkg = 0;
1156 foreach my $cat (sort @categories) { 1156 foreach my $cat (sort @categories) {
1157 foreach my $pkgdir (list_pkgsrc_pkgdirs($pkgsrcdir, $cat)) { 1157 foreach my $pkgdir (list_pkgsrc_pkgdirs($pkgsrcdir, $cat)) {
1158 ++$numpkg; 1158 ++$numpkg;
1159 my $pkgpath = "$cat/$pkgdir"; 1159 my $pkgpath = "$cat/$pkgdir";
1160 foreach my $entry (load_distinfo("$pkgsrcdir/$pkgpath")) { 1160 foreach my $entry (load_distinfo("$pkgsrcdir/$pkgpath")) {
1161 check_distinfo_hash($entry, $pkgpath, 1161 check_distinfo_hash($entry, $pkgpath,
1162 \%distfiles, \@distwarn); 1162 \%distfiles, \@distwarn);
1163 } 1163 }
1164 } 1164 }
1165 verbose('.'); 1165 verbose('.');
1166 } 1166 }
1167 verbose(" ($numpkg packages)\n"); 1167 verbose(" ($numpkg packages)\n");
1168 1168
1169 # check each file in $pkgdistdir 1169 # check each file in $pkgdistdir
1170 find({ wanted => sub { 1170 find({ wanted => sub {
1171 my ($dist); 1171 my ($dist);
1172 if (-f $File::Find::name) { 1172 if (-f $File::Find::name) {
1173 my $distn = $File::Find::name; 1173 my $distn = $File::Find::name;
1174 $distn =~ s/$pkgdistdir\/?//g; 1174 $distn =~ s/$pkgdistdir\/?//g;
1175 #pkg/47516 ignore cvs dirs 1175 #pkg/47516 ignore cvs dirs
1176 return if $distn =~ m/^\.cvsignore/; 1176 return if $distn =~ m/^\.cvsignore/;
1177 return if $distn =~ m/^CVS\//; 1177 return if $distn =~ m/^CVS\//;
1178 if (!defined($dist = $distfiles{$distn})) { 1178 if (!defined($dist = $distfiles{$distn})) {
1179 $unref_distfiles{$distn} = 1; 1179 $unref_distfiles{$distn} = 1;
1180 } else { 1180 } else {
1181 push @{$sumfiles{$dist->{algorithm}}}, $distn; 1181 push @{$sumfiles{$dist->{algorithm}}}, $distn;
1182 } 1182 }
1183 } 1183 }
1184 } }, 1184 } },
1185 ($pkgdistdir)); 1185 ($pkgdistdir));
1186 1186
1187 if ($check_unref && %unref_distfiles) { 1187 if ($check_unref && %unref_distfiles) {
1188 verbose(scalar(keys %unref_distfiles), 1188 verbose(scalar(keys %unref_distfiles),
1189 " unreferenced file(s) in '$pkgdistdir':\n"); 1189 " unreferenced file(s) in '$pkgdistdir':\n");
1190 print join("\n", sort keys %unref_distfiles), "\n"; 1190 print join("\n", sort keys %unref_distfiles), "\n";
1191 } 1191 }
1192 1192
1193 if ($check_distinfo) { 1193 if ($check_distinfo) {
1194 if (@distwarn) { 1194 if (@distwarn) {
1195 verbose(@distwarn); 1195 verbose(@distwarn);
1196 } 1196 }
1197 1197
1198 verbose("checksum mismatches\n"); 1198 verbose("checksum mismatches\n");
1199 my $prev_cwd = getcwd() or die; 1199 my $prev_cwd = getcwd() or die;
1200 chdir_or_fail($pkgdistdir); 1200 chdir_or_fail($pkgdistdir);
1201 foreach my $sum (keys %sumfiles) { 1201 foreach my $sum (keys %sumfiles) {
1202 if ($sum eq 'Size') { 1202 if ($sum eq 'Size') {
1203 foreach my $file (@{$sumfiles{$sum}}) { 1203 foreach my $file (@{$sumfiles{$sum}}) {
1204 if (!-f $file || -S $file != $distfiles{$file}{hash}) { 1204 if (!-f $file || -S $file != $distfiles{$file}{hash}) {
1205 print $file, " (Size)\n"; 1205 print $file, " (Size)\n";
1206 $unref_distfiles{$file} = 1; 1206 $unref_distfiles{$file} = 1;
1207 } 1207 }
1208 } 1208 }
1209 next; 1209 next;
1210 } 1210 }
1211 1211
1212 my $pid = open3(my $in, my $out, undef, 'xargs', 'digest', $sum); 1212 my $pid = open3(my $in, my $out, undef, 'xargs', 'digest', $sum);
1213 defined $pid || fail 'fork'; 1213 defined $pid || fail 'fork';
1214 my $pid2 = fork(); 1214 my $pid2 = fork();
1215 defined $pid2 || fail 'fork'; 1215 defined $pid2 || fail 'fork';
1216 if ($pid2) { 1216 if ($pid2) {
1217 close($in); 1217 close($in);
1218 } else { 1218 } else {
1219 print $in "@{$sumfiles{$sum}}"; 1219 print $in "@{$sumfiles{$sum}}";
1220 exit 0; 1220 exit 0;
1221 } 1221 }
1222 while (<$out>) { 1222 while (<$out>) {
1223 if (m/^$sum ?\(([^\)]+)\) = (\S+)/) { 1223 if (m/^$sum ?\(([^\)]+)\) = (\S+)/) {
1224 if ($distfiles{$1}{hash} ne $2) { 1224 if ($distfiles{$1}{hash} ne $2) {
1225 print $1, " ($sum)\n"; 1225 print $1, " ($sum)\n";
1226 $unref_distfiles{$1} = 1; 1226 $unref_distfiles{$1} = 1;
1227 } 1227 }
1228 } 1228 }
1229 } 1229 }
1230 close($out); 1230 close($out);
1231 waitpid($pid, 0) || fail "xargs digest $sum"; 1231 waitpid($pid, 0) || fail "xargs digest $sum";
1232 waitpid($pid2, 0) || fail 'pipe write to xargs'; 1232 waitpid($pid2, 0) || fail 'pipe write to xargs';
1233 } 1233 }
1234 chdir_or_fail($prev_cwd); 1234 chdir_or_fail($prev_cwd);
1235 } 1235 }
1236 1236
1237 sort keys %unref_distfiles; 1237 sort keys %unref_distfiles;
1238} 1238}
1239 1239
1240sub store_pkgdb_in_cache($db, $fname) { 1240sub store_pkgdb_in_cache($db, $fname) {
1241 open(STORE, '>', $fname) 1241 open(STORE, '>', $fname)
1242 or die("Cannot save package data to $fname: $!\n"); 1242 or die("Cannot save package data to $fname: $!\n");
1243 foreach my $pkgver ($db->pkgvers_all) { 1243 foreach my $pkgver ($db->pkgvers_all) {
1244 my $pkgbase = $pkgver->pkgbase; 1244 my $pkgbase = $pkgver->pkgbase;
1245 my $pkgversion = $pkgver->pkgversion; 1245 my $pkgversion = $pkgver->pkgversion;
1246 1246
1247 $pkgbase =~ /^\S+$/ 1247 $pkgbase =~ /^\S+$/
1248 or die "cannot store package name '$pkgbase'\n"; 1248 or die "cannot store package name '$pkgbase'\n";
1249 $pkgversion =~ /^\S+$/ 1249 $pkgversion =~ /^\S+$/
1250 or die "cannot store package version '$pkgversion'\n"; 1250 or die "cannot store package version '$pkgversion'\n";
1251 print STORE "package\t$pkgbase\t$pkgversion\n"; 1251 print STORE "package\t$pkgbase\t$pkgversion\n";
1252 1252
1253 foreach my $varname (sort $pkgver->vars) { 1253 foreach my $varname (sort $pkgver->vars) {
1254 my $value = $pkgver->var($varname); 1254 my $value = $pkgver->var($varname);
1255 $varname =~ /^\S+$/ 1255 $varname =~ /^\S+$/
1256 or die "cannot store variable name '$varname'\n"; 1256 or die "cannot store variable name '$varname'\n";
1257 $value =~ /^.*$/ 1257 $value =~ /^.*$/
1258 or die "cannot store variable value '$value'\n"; 1258 or die "cannot store variable value '$value'\n";
1259 print STORE "var\t$varname\t$value\n"; 1259 print STORE "var\t$varname\t$value\n";
1260 } 1260 }
1261 } 1261 }
1262 close(STORE) 1262 close(STORE)
1263 or die("Cannot save package data to $fname: $!\n"); 1263 or die("Cannot save package data to $fname: $!\n");
1264} 1264}
1265 1265
1266# Remember to update manual page when modifying option list 1266# Remember to update manual page when modifying option list
1267# 1267#
1268sub usage_and_exit($status) { 1268sub usage_and_exit($status) {
1269 print "Usage: lintpkgsrc [opts] [makefiles] 1269 print "Usage: lintpkgsrc [opts] [makefiles]
1270opts: 1270opts:
1271 -h : This help. [see lintpkgsrc(1) for more information] 1271 -h : This help. [see lintpkgsrc(1) for more information]
1272 1272
1273Installed package options: Distfile options: 1273Installed package options: Distfile options:
1274 -i : Check version against pkgsrc -m : List distinfo mismatches 1274 -i : Check version against pkgsrc -m : List distinfo mismatches
1275 -u : As -i + fetch dist (may change) -o : List obsolete (no distinfo) 1275 -u : As -i + fetch dist (may change) -o : List obsolete (no distinfo)
1276 -y : Remove orphan distfiles 1276 -y : Remove orphan distfiles
1277 -z : Remove installed distfiles 1277 -z : Remove installed distfiles
1278 1278
1279Prebuilt package options: Makefile options: 1279Prebuilt package options: Makefile options:
1280 -p : List old/obsolete -B : List packages marked as 'BROKEN' 1280 -p : List old/obsolete -B : List packages marked as 'BROKEN'
1281 -O : List OSVERSION_SPECIFIC -d : Check 'DEPENDS' up to date 1281 -O : List OSVERSION_SPECIFIC -d : Check 'DEPENDS' up to date
1282 -R : List NO_BIN_ON_FTP/RESTRICTED -S : List packages not in 'SUBDIRS' 1282 -R : List NO_BIN_ON_FTP/RESTRICTED -S : List packages not in 'SUBDIRS'
1283 1283
1284Misc: 1284Misc:
1285 -E file : Export the internal pkgsrc database to file 1285 -E file : Export the internal pkgsrc database to file
1286 -I file : Import the internal pkgsrc database to file (for use with -i) 1286 -I file : Import the internal pkgsrc database to file (for use with -i)
1287 -g file : Generate 'pkgname pkgdir pkgver' map in file 1287 -g file : Generate 'pkgname pkgdir pkgver' map in file
1288 -r : Remove bad files (Without -m -o -p or -V implies all, can use -R) 1288 -r : Remove bad files (Without -m -o -p or -V implies all, can use -R)
1289 1289
1290Modifiers: 1290Modifiers:
1291 -K path : Set PACKAGES basedir (default PKGSRCDIR/packages) 1291 -K path : Set PACKAGES basedir (default PKGSRCDIR/packages)
1292 -M path : Set DISTDIR (default PKGSRCDIR/distfiles) 1292 -M path : Set DISTDIR (default PKGSRCDIR/distfiles)
1293 -P path : Set PKGSRCDIR (default $conf_pkgsrcdir) 1293 -P path : Set PKGSRCDIR (default $conf_pkgsrcdir)
1294 -D : Debug makefile and glob parsing 1294 -D : Debug makefile and glob parsing
1295 -L : List each Makefile when scanned 1295 -L : List each Makefile when scanned
1296"; 1296";
1297 exit $status; 1297 exit $status;
1298} 1298}
1299 1299
1300# Could speed up by building a cache of package names to paths, then processing 1300# Could speed up by building a cache of package names to paths, then processing
1301# each package name once against the tests. 1301# each package name once against the tests.
1302sub check_prebuilt_packages() { 1302sub check_prebuilt_packages() {
1303 1303
1304 if ($_ eq 'distfiles' || $_ eq 'pkgsrc') { 1304 if ($_ eq 'distfiles' || $_ eq 'pkgsrc') {
1305 # Skip these subdirs if present 1305 # Skip these subdirs if present
1306 $File::Find::prune = 1; 1306 $File::Find::prune = 1;
1307 1307
1308 } elsif (/(.+)-(\d.*)\.t[bg]z$/) { 1308 } elsif (/(.+)-(\d.*)\.t[bg]z$/) {
1309 my ($pkg, $ver) = ($1, $2); 1309 my ($pkg, $ver) = ($1, $2);
1310 1310
1311 $pkg = canonicalize_pkgname($pkg); 1311 $pkg = canonicalize_pkgname($pkg);
1312 1312
1313 my ($pkgs); 1313 my ($pkgs);
1314 if ($pkgs = $pkgdb->pkgs($pkg)) { 1314 if ($pkgs = $pkgdb->pkgs($pkg)) {
1315 my ($pkgver) = $pkgs->pkgver($ver); 1315 my ($pkgver) = $pkgs->pkgver($ver);
1316 1316
1317 if (!defined $pkgver) { 1317 if (!defined $pkgver) {
1318 if ($opt{p}) { 1318 if ($opt{p}) {
1319 print "$File::Find::dir/$_\n"; 1319 print "$File::Find::dir/$_\n";
1320 push @matched_prebuiltpackages, "$File::Find::dir/$_"; 1320 push @matched_prebuiltpackages, "$File::Find::dir/$_";
1321 } 1321 }
1322 1322
1323 # Pick probably the last version 1323 # Pick probably the last version
1324 $pkgver = ($pkgs->pkgvers_all)[0]; 1324 $pkgver = ($pkgs->pkgvers_all)[0];
1325 } 1325 }
1326 1326
1327 if ($opt{R} && $pkgver->var('RESTRICTED')) { 1327 if ($opt{R} && $pkgver->var('RESTRICTED')) {
1328 print "$File::Find::dir/$_\n"; 1328 print "$File::Find::dir/$_\n";
1329 push @matched_prebuiltpackages, "$File::Find::dir/$_"; 1329 push @matched_prebuiltpackages, "$File::Find::dir/$_";
1330 } 1330 }
1331 1331
1332 if ($opt{O} && $pkgver->var('OSVERSION_SPECIFIC')) { 1332 if ($opt{O} && $pkgver->var('OSVERSION_SPECIFIC')) {
1333 print "$File::Find::dir/$_\n"; 1333 print "$File::Find::dir/$_\n";
1334 push @matched_prebuiltpackages, "$File::Find::dir/$_"; 1334 push @matched_prebuiltpackages, "$File::Find::dir/$_";
1335 } 1335 }
1336 } 1336 }
1337 1337
1338 } elsif (-d $_) { 1338 } elsif (-d $_) {
1339 if ($prebuilt_pkgdir_cache{"$File::Find::dir/$_"}) { 1339 if ($prebuilt_pkgdir_cache{"$File::Find::dir/$_"}) {
1340 $File::Find::prune = 1; 1340 $File::Find::prune = 1;
1341 return; 1341 return;
1342 } 1342 }
1343 1343
1344 $prebuilt_pkgdir_cache{"$File::Find::dir/$_"} = 1; 1344 $prebuilt_pkgdir_cache{"$File::Find::dir/$_"} = 1;
1345 if (-l $_) { 1345 if (-l $_) {
1346 my ($dest) = readlink($_); 1346 my ($dest) = readlink($_);
1347 1347
1348 if (substr($dest, 0, 1) ne '/') { 1348 if (substr($dest, 0, 1) ne '/') {
1349 $dest = "$File::Find::dir/$dest"; 1349 $dest = "$File::Find::dir/$dest";
1350 } 1350 }
1351 if (!$prebuilt_pkgdir_cache{$dest}) { 1351 if (!$prebuilt_pkgdir_cache{$dest}) {
1352 push @prebuilt_pkgdirs, $dest; 1352 push @prebuilt_pkgdirs, $dest;
1353 } 1353 }
1354 } 1354 }
1355 } 1355 }
1356} 1356}
1357 1357
1358sub debug_parse_makefiles(@args) { 1358sub debug_parse_makefiles(@args) {
1359 foreach my $file (@args) { 1359 foreach my $file (@args) {
1360 -d $file and $file .= '/Makefile'; 1360 -d $file and $file .= '/Makefile';
1361 -f $file or fail("No such file: $file"); 1361 -f $file or fail("No such file: $file");
1362 1362
1363 my ($pkgname, $vars) = parse_makefile_pkgsrc($file); 1363 my ($pkgname, $vars) = parse_makefile_pkgsrc($file);
1364 $pkgname ||= 'uNDEFINEd'; 1364 $pkgname ||= 'uNDEFINEd';
1365 1365
1366 print "$file -> $pkgname\n"; 1366 print "$file -> $pkgname\n";
1367 foreach my $varname (sort keys %$vars) { 1367 foreach my $varname (sort keys %$vars) {
1368 print "\t$varname = $vars->{$varname}\n"; 1368 print "\t$varname = $vars->{$varname}\n";
1369 } 1369 }
1370 1370
1371 #if ($opt{d}) { 1371 #if ($opt{d}) {
1372 # pkgsrc_check_depends(); 1372 # pkgsrc_check_depends();
1373 #} 1373 #}
1374 } 1374 }
1375} 1375}
1376 1376
1377sub check_distfiles($pkgsrcdir, $pkgdistdir) { 1377sub check_distfiles($pkgsrcdir, $pkgdistdir) {
1378 my @unref_distfiles = scan_pkgsrc_distfiles_vs_distinfo( 1378 my @unref_distfiles = scan_pkgsrc_distfiles_vs_distinfo(
1379 $pkgsrcdir, $pkgdistdir, $opt{o}, $opt{m}); 1379 $pkgsrcdir, $pkgdistdir, $opt{o}, $opt{m});
1380 1380
1381 return unless $opt{r}; 1381 return unless $opt{r};
1382 verbose("Unlinking unreferenced distfiles\n"); 1382 verbose("Unlinking unreferenced distfiles\n");
1383 foreach my $distfile (@unref_distfiles) { 1383 foreach my $distfile (@unref_distfiles) {
1384 unlink("$pkgdistdir/$distfile"); 1384 unlink("$pkgdistdir/$distfile");
1385 } 1385 }
1386} 1386}
1387 1387
 1388# looking for files that are downloaded on the current system
 1389# but do not belong to any currently installed package i.e. orphaned
 1390sub remove_orphaned_distfiles($dldistfiles, $pkgdistfiles, $pkgdistdir) {
 1391 my $found = 0;
 1392 my @orphan;
 1393 foreach my $dldf (@$dldistfiles) {
 1394 foreach my $pkgdf (@$pkgdistfiles) {
 1395 if ($dldf eq $pkgdf) {
 1396 $found = 1;
 1397 }
 1398 }
 1399 if ($found != 1) {
 1400 push @orphan, $dldf;
 1401 print "Orphaned file: $dldf\n";
 1402 }
 1403 $found = 0;
 1404 }
 1405
 1406 if ($opt{r}) {
 1407 chdir_or_fail("$pkgdistdir");
 1408 verbose("Unlinking 'orphaned' distfiles\n");
 1409 foreach my $distfile (@orphan) {
 1410 unlink($distfile)
 1411 }
 1412 }
 1413}
 1414
 1415# looking for files that are downloaded on the current system
 1416# but belong to a currently installed package i.e. parented
 1417sub remove_parented_distfiles($dldistfiles, $pkgdistfiles, $pkgdistdir) {
 1418 my $found = 0;
 1419 my @parent;
 1420 foreach my $pkgdf (sort @$pkgdistfiles) {
 1421 foreach my $dldf (@$dldistfiles) {
 1422 if ($pkgdf eq $dldf) {
 1423 $found = 1;
 1424 }
 1425 }
 1426 if ($found == 1) {
 1427 push @parent, $pkgdf;
 1428 print "Parented file: $pkgdf\n";
 1429 }
 1430 $found = 0;
 1431 }
 1432
 1433 if ($opt{r}) {
 1434 chdir_or_fail("$pkgdistdir");
 1435 verbose("Unlinking 'parented' distfiles\n");
 1436 foreach my $distfile (@parent) {
 1437 unlink($distfile);
 1438 }
 1439 }
 1440}
 1441
1388sub remove_distfiles($pkgsrcdir, $pkgdistdir) { 1442sub remove_distfiles($pkgsrcdir, $pkgdistdir) {
1389 my @pkgs = list_installed_packages(); 1443 my @installed_pkgnames = list_installed_packages();
1390 scan_pkgsrc_makefiles($pkgsrcdir); 1444 scan_pkgsrc_makefiles($pkgsrcdir);
1391 1445
1392 # list the installed packages and the directory they live in 1446 # list the installed packages and the directory they live in
1393 my @installed; 1447 my @installed_pkgvers;
1394 foreach my $pkgname (sort @pkgs) { 1448 foreach my $pkgname (sort @installed_pkgnames) {
1395 if ($pkgname =~ /^([^*?[]+)-([\d*?[].*)/) { 1449 if ($pkgname !~ /^ ([^*?[]+) - ([\d*?[].*) /x) {
1396 foreach my $pkgver ($pkgdb->pkgvers_by_pkgbase($1)) { 1450 warn "Invalid installed package name: $pkgname";
1397 next if $pkgver->var('dir') =~ /-current/; 1451 next;
1398 push @installed, $pkgver; 1452 }
1399 last; 1453
1400 } 1454 foreach my $pkgver ($pkgdb->pkgvers_by_pkgbase($1)) {
 1455 next if $pkgver->var('dir') =~ /-current/;
 1456 push @installed_pkgvers, $pkgver;
 1457 last;
1401 } 1458 }
1402 } 1459 }
1403 1460
1404 # distfiles belonging to the currently installed packages 1461 # distfiles belonging to the currently installed packages
1405 my (%distfiles, @pkgdistfiles); 1462 my (%distfiles, @pkgdistfiles);
1406 foreach my $pkgver (sort @installed) { 1463 foreach my $pkgver (sort @installed_pkgvers) {
1407 my $pkgpath = $pkgver->var('dir'); 1464 my $pkgpath = $pkgver->var('dir');
1408 foreach my $entry (load_distinfo("$pkgsrcdir/$pkgpath")) { 1465 foreach my $entry (load_distinfo("$pkgsrcdir/$pkgpath")) {
1409 my $distfile = $entry->{distfile}; 1466 my $distfile = $entry->{distfile};
1410 next if $distfile =~ /^patch-[\w.+\-]+$/; 1467 next if $distfile =~ /^patch-[\w.+\-]+$/;
1411 next if defined $distfiles{$distfile}; 1468 next if defined $distfiles{$distfile};
1412 $distfiles{$distfile}->{name} = $distfile; 1469 $distfiles{$distfile}->{name} = $distfile;
1413 push @pkgdistfiles, $distfile; 1470 push @pkgdistfiles, $distfile;
1414 } 1471 }
1415 } 1472 }
1416 1473
1417 # distfiles downloaded on the current system 1474 # distfiles downloaded on the current system
1418 my @dldistfiles = sort grep { $_ ne 'pkg-vulnerabilities' } 1475 my @dldistfiles = sort grep { $_ ne 'pkg-vulnerabilities' }
1419 listdir("$pkgdistdir", undef); 1476 listdir("$pkgdistdir", undef);
1420 1477
1421 if ($opt{y}) { 1478 $opt{y} and remove_orphaned_distfiles(
1422 # looking for files that are downloaded on the current system 1479 \@dldistfiles, \@pkgdistfiles, $pkgdistdir);
1423 # but do not belong to any currently installed package i.e. orphaned 
1424 my $found = 0; 
1425 my @orphan; 
1426 foreach my $dldf (@dldistfiles) { 
1427 foreach my $pkgdf (@pkgdistfiles) { 
1428 if ($dldf eq $pkgdf) { 
1429 $found = 1; 
1430 } 
1431 } 
1432 if ($found != 1) { 
1433 push @orphan, $dldf; 
1434 print "Orphaned file: $dldf\n"; 
1435 } 
1436 $found = 0; 
1437 } 
1438 1480
1439 if ($opt{r}) { 1481 $opt{z} and remove_parented_distfiles(
1440 chdir_or_fail("$pkgdistdir"); 1482 \@dldistfiles, \@pkgdistfiles, $pkgdistdir);
1441 verbose("Unlinking 'orphaned' distfiles\n"); 
1442 foreach my $distfile (@orphan) { 
1443 unlink($distfile) 
1444 } 
1445 } 
1446 } 
1447 
1448 if ($opt{z}) { 
1449 # looking for files that are downloaded on the current system 
1450 # but belong to a currently installed package i.e. parented 
1451 my $found = 0; 
1452 my @parent; 
1453 foreach my $pkgdf (sort @pkgdistfiles) { 
1454 foreach my $dldf (@dldistfiles) { 
1455 if ($pkgdf eq $dldf) { 
1456 $found = 1; 
1457 } 
1458 } 
1459 if ($found == 1) { 
1460 push @parent, $pkgdf; 
1461 print "Parented file: $pkgdf\n"; 
1462 } 
1463 $found = 0; 
1464 } 
1465 
1466 if ($opt{r}) { 
1467 chdir_or_fail("$pkgdistdir"); 
1468 verbose("Unlinking 'parented' distfiles\n"); 
1469 foreach my $distfile (@parent) { 
1470 unlink($distfile); 
1471 } 
1472 } 
1473 } 
1474} 1483}
1475 1484
1476sub list_broken_packages($pkgsrcdir) { 1485sub list_broken_packages($pkgsrcdir) {
1477 scan_pkgsrc_makefiles($pkgsrcdir); 1486 scan_pkgsrc_makefiles($pkgsrcdir);
1478 foreach my $pkgver ($pkgdb->pkgvers_all) { 1487 foreach my $pkgver ($pkgdb->pkgvers_all) {
1479 my $broken = $pkgver->var('BROKEN'); 1488 my $broken = $pkgver->var('BROKEN');
1480 next unless $broken; 1489 next unless $broken;
1481 print $pkgver->pkgname . ": $broken\n"; 1490 print $pkgver->pkgname . ": $broken\n";
1482 } 1491 }
1483} 1492}
1484 1493
1485# List obsolete or NO_BIN_ON_FTP/RESTRICTED prebuilt packages 1494# List obsolete or NO_BIN_ON_FTP/RESTRICTED prebuilt packages
1486# 1495#
1487sub list_prebuilt_packages($pkgsrcdir) { 1496sub list_prebuilt_packages($pkgsrcdir) {
1488 scan_pkgsrc_makefiles($pkgsrcdir); 1497 scan_pkgsrc_makefiles($pkgsrcdir);
1489 1498
1490 @prebuilt_pkgdirs = ($default_vars->{PACKAGES}); 1499 @prebuilt_pkgdirs = ($default_vars->{PACKAGES});
1491 %prebuilt_pkgdir_cache = (); 1500 %prebuilt_pkgdir_cache = ();
1492 1501
1493 while (@prebuilt_pkgdirs) { 1502 while (@prebuilt_pkgdirs) {
1494 find(\&check_prebuilt_packages, shift @prebuilt_pkgdirs); 1503 find(\&check_prebuilt_packages, shift @prebuilt_pkgdirs);
1495 } 1504 }
1496 1505
1497 return unless $opt{r}; 1506 return unless $opt{r};
1498 verbose("Unlinking listed prebuilt packages\n"); 1507 verbose("Unlinking listed prebuilt packages\n");
1499 foreach my $pkgfile (@matched_prebuiltpackages) { 1508 foreach my $pkgfile (@matched_prebuiltpackages) {
1500 unlink($pkgfile); 1509 unlink($pkgfile);
1501 } 1510 }
1502} 1511}
1503 1512
1504sub list_packages_not_in_SUBDIR($pkgsrcdir) { 1513sub list_packages_not_in_SUBDIR($pkgsrcdir) {
1505 my (%in_subdir); 1514 my (%in_subdir);
1506 foreach my $cat (list_pkgsrc_categories($pkgsrcdir)) { 1515 foreach my $cat (list_pkgsrc_categories($pkgsrcdir)) {
1507 my $makefile = "$pkgsrcdir/$cat/Makefile"; 1516 my $makefile = "$pkgsrcdir/$cat/Makefile";
1508 my $vars = parse_makefile_vars($makefile, undef); 1517 my $vars = parse_makefile_vars($makefile, undef);
1509 my $subdirs = $vars->{SUBDIR}; 1518 my $subdirs = $vars->{SUBDIR};
1510 defined $subdirs or die "No SUBDIR in $makefile"; 1519 defined $subdirs or die "No SUBDIR in $makefile";
1511 1520
1512 foreach my $pkgdir (split(/\s+/, $subdirs)) { 1521 foreach my $pkgdir (split(/\s+/, $subdirs)) {
1513 $in_subdir{"$cat/$pkgdir"} = 1; 1522 $in_subdir{"$cat/$pkgdir"} = 1;
1514 } 1523 }
1515 } 1524 }
1516 1525
1517 scan_pkgsrc_makefiles($pkgsrcdir); 1526 scan_pkgsrc_makefiles($pkgsrcdir);
1518 foreach my $pkgver ($pkgdb->pkgvers_all) { 1527 foreach my $pkgver ($pkgdb->pkgvers_all) {
1519 my $pkgpath = $pkgver->var('dir'); 1528 my $pkgpath = $pkgver->var('dir');
1520 if (!defined $in_subdir{$pkgpath}) { 1529 if (!defined $in_subdir{$pkgpath}) {
1521 print "$pkgpath: Not in SUBDIR\n"; 1530 print "$pkgpath: Not in SUBDIR\n";
1522 } 1531 }
1523 } 1532 }
1524} 1533}
1525 1534
1526sub generate_map_file($pkgsrcdir, $fname) { 1535sub generate_map_file($pkgsrcdir, $fname) {
1527 my $tmpfile = "$fname.tmp.$$"; 1536 my $tmpfile = "$fname.tmp.$$";
1528 1537
1529 scan_pkgsrc_makefiles($pkgsrcdir); 1538 scan_pkgsrc_makefiles($pkgsrcdir);
1530 open(TABLE, '>', $tmpfile) or fail("Cannot write '$tmpfile': $!"); 1539 open(TABLE, '>', $tmpfile) or fail("Cannot write '$tmpfile': $!");
1531 foreach my $pkgver ($pkgdb->pkgvers_all) { 1540 foreach my $pkgver ($pkgdb->pkgvers_all) {
1532 printf TABLE "%s\t%s\t%s\n", 1541 printf TABLE "%s\t%s\t%s\n",
1533 $pkgver->pkgbase, 1542 $pkgver->pkgbase,
1534 $pkgver->var('dir'), 1543 $pkgver->var('dir'),
1535 $pkgver->pkgversion; 1544 $pkgver->pkgversion;
1536 } 1545 }
1537 close(TABLE) or fail("close('$tmpfile'): $!"); 1546 close(TABLE) or fail("close('$tmpfile'): $!");
1538 rename($tmpfile, $fname) 1547 rename($tmpfile, $fname)
1539 or fail("rename('$tmpfile', '$fname'): $!"); 1548 or fail("rename('$tmpfile', '$fname'): $!");
1540} 1549}
1541 1550
1542sub check_outdated_installed_packages($pkgsrcdir) { 1551sub check_outdated_installed_packages($pkgsrcdir) {
1543 my @pkgs = list_installed_packages(); 1552 my @pkgs = list_installed_packages();
1544 scan_pkgsrc_makefiles($pkgsrcdir); 1553 scan_pkgsrc_makefiles($pkgsrcdir);
1545 1554
1546 my @update; 1555 my @update;
1547 foreach my $pkgname (sort @pkgs) { 1556 foreach my $pkgname (sort @pkgs) {
1548 next unless $_ = invalid_version($pkgname); 1557 next unless $_ = invalid_version($pkgname);
1549 1558
1550 print $_; 1559 print $_;
1551 next unless $pkgname =~ /^([^*?[]+)-([\d*?[].*)/; 1560 next unless $pkgname =~ /^([^*?[]+)-([\d*?[].*)/;
1552 1561
1553 foreach my $pkgver ($pkgdb->pkgvers_by_pkgbase($1)) { 1562 foreach my $pkgver ($pkgdb->pkgvers_by_pkgbase($1)) {
1554 next if $pkgver->var('dir') =~ /-current/; 1563 next if $pkgver->var('dir') =~ /-current/;
1555 push @update, $pkgver; 1564 push @update, $pkgver;
1556 last; 1565 last;
1557 } 1566 }
1558 } 1567 }
1559 1568
1560 return unless $opt{u}; 1569 return unless $opt{u};
1561 1570
1562 print "\nREQUIRED details for packages that could be updated:\n"; 1571 print "\nREQUIRED details for packages that could be updated:\n";
1563 1572
1564 foreach my $pkgver (@update) { 1573 foreach my $pkgver (@update) {
1565 my $pkgbase = $pkgver->pkgbase; 1574 my $pkgbase = $pkgver->pkgbase;
1566 print "$pkgbase:"; 1575 print "$pkgbase:";
1567 open(PKGINFO, "$conf_pkg_info -q -R $pkgbase |") or die; 1576 open(PKGINFO, "$conf_pkg_info -q -R $pkgbase |") or die;
1568 while (<PKGINFO>) { 1577 while (<PKGINFO>) {
1569 print " $1" if /^(.*?)-\d/; 1578 print " $1" if /^(.*?)-\d/;
1570 } 1579 }
1571 close(PKGINFO); 1580 close(PKGINFO);
1572 print "\n"; 1581 print "\n";
1573 } 1582 }
1574 1583
1575 print "\nRunning '$conf_make fetch-list | sh' for each package:\n"; 1584 print "\nRunning '$conf_make fetch-list | sh' for each package:\n";
1576 foreach my $pkgver (@update) { 1585 foreach my $pkgver (@update) {
1577 my $pkgpath = $pkgver->var('dir'); 1586 my $pkgpath = $pkgver->var('dir');
1578 defined $pkgpath 1587 defined $pkgpath
1579 or fail('Cannot determine ' . $pkgver->pkgbase . ' directory'); 1588 or fail('Cannot determine ' . $pkgver->pkgbase . ' directory');
1580 1589
1581 print "$pkgsrcdir/$pkgpath\n"; 1590 print "$pkgsrcdir/$pkgpath\n";
1582 chdir_or_fail("$pkgsrcdir/$pkgpath"); 1591 chdir_or_fail("$pkgsrcdir/$pkgpath");
1583 system("$conf_make fetch-list | sh"); 1592 system("$conf_make fetch-list | sh");
1584 } 1593 }
1585} 1594}
1586 1595
1587sub main() { 1596sub main() {
1588 1597
1589 $ENV{PATH} .= 1598 $ENV{PATH} .=
1590 ":/bin:/usr/bin:/sbin:/usr/sbin:$conf_prefix/sbin:$conf_prefix/bin"; 1599 ":/bin:/usr/bin:/sbin:/usr/sbin:$conf_prefix/sbin:$conf_prefix/bin";
1591 1600
1592 if ( 1601 if (
1593 !getopts('-BDE:I:K:LM:OP:RSVdg:himopruyz', \%opt) 1602 !getopts('-BDE:I:K:LM:OP:RSVdg:himopruyz', \%opt)
1594 || $opt{h} 1603 || $opt{h}
1595 || !grep(/[BDEORSdgimopruyz]/, keys %opt)) { 1604 || !grep(/[BDEORSdgimopruyz]/, keys %opt)) {
1596 usage_and_exit($opt{h} ? 0 : 1); 1605 usage_and_exit($opt{h} ? 0 : 1);
1597 } 1606 }
1598 $| = 1; 1607 $| = 1;
1599 1608
1600 get_default_makefile_vars(); # $default_vars 1609 get_default_makefile_vars(); # $default_vars
1601 1610
1602 if ($opt{D} && @ARGV) { 1611 if ($opt{D} && @ARGV) {
1603 debug_parse_makefiles(@ARGV); 1612 debug_parse_makefiles(@ARGV);
1604 exit; 1613 exit;
1605 } 1614 }
1606 1615
1607 my $pkgsrcdir = $default_vars->{PKGSRCDIR}; 1616 my $pkgsrcdir = $default_vars->{PKGSRCDIR};
1608 my $pkgdistdir = $default_vars->{DISTDIR}; 1617 my $pkgdistdir = $default_vars->{DISTDIR};
1609 1618
1610 if ($opt{r} && !$opt{o} && !$opt{m} && !$opt{p}) { 1619 if ($opt{r} && !$opt{o} && !$opt{m} && !$opt{p}) {
1611 $opt{o} = $opt{m} = $opt{p} = 1; 1620 $opt{o} = $opt{m} = $opt{p} = 1;
1612 } 1621 }
1613 if ($opt{o} || $opt{m}) { 1622 if ($opt{o} || $opt{m}) {
1614 check_distfiles($pkgsrcdir, $pkgdistdir); 1623 check_distfiles($pkgsrcdir, $pkgdistdir);
1615 } 1624 }
1616 1625
1617 # Remove all distfiles that are / are not part of an installed package 1626 # Remove all distfiles that are / are not part of an installed package
1618 if ($opt{y} || $opt{z}) { 1627 if ($opt{y} || $opt{z}) {
1619 remove_distfiles($pkgsrcdir, $pkgdistdir); 1628 remove_distfiles($pkgsrcdir, $pkgdistdir);
1620 } 1629 }
1621 1630
1622 if ($opt{B}) { 1631 if ($opt{B}) {
1623 list_broken_packages($pkgsrcdir); 1632 list_broken_packages($pkgsrcdir);
1624 } 1633 }
1625 1634
1626 if ($opt{p} || $opt{O} || $opt{R}) { 1635 if ($opt{p} || $opt{O} || $opt{R}) {
1627 list_prebuilt_packages($pkgsrcdir); 1636 list_prebuilt_packages($pkgsrcdir);
1628 } 1637 }
1629 1638
1630 if ($opt{S}) { 1639 if ($opt{S}) {
1631 list_packages_not_in_SUBDIR($pkgsrcdir); 1640 list_packages_not_in_SUBDIR($pkgsrcdir);
1632 } 1641 }
1633 1642
1634 if ($opt{g}) { 1643 if ($opt{g}) {
1635 generate_map_file($pkgsrcdir, $opt{g}); 1644 generate_map_file($pkgsrcdir, $opt{g});
1636 } 1645 }
1637 1646
1638 if ($opt{d}) { 1647 if ($opt{d}) {
1639 scan_pkgsrc_makefiles($pkgsrcdir); 1648 scan_pkgsrc_makefiles($pkgsrcdir);
1640 pkgsrc_check_depends(); 1649 pkgsrc_check_depends();
1641 } 1650 }
1642 1651
1643 if ($opt{i} || $opt{u}) { 1652 if ($opt{i} || $opt{u}) {
1644 check_outdated_installed_packages($pkgsrcdir); 1653 check_outdated_installed_packages($pkgsrcdir);
1645 } 1654 }
1646 1655
1647 if ($opt{E}) { 1656 if ($opt{E}) {
1648 scan_pkgsrc_makefiles($pkgsrcdir); 1657 scan_pkgsrc_makefiles($pkgsrcdir);
1649 store_pkgdb_in_cache($pkgdb, $opt{E}); 1658 store_pkgdb_in_cache($pkgdb, $opt{E});
1650 } 1659 }
1651} 1660}
1652 1661
1653sub export_for_test() { 1662sub export_for_test() {
1654 ({ 1663 ({
1655 'opt' => \%opt, 1664 'opt' => \%opt,
1656 'default_vars' => $default_vars, 1665 'default_vars' => $default_vars,
1657 'pkgdb' => $pkgdb, 1666 'pkgdb' => $pkgdb,
1658 }); 1667 });
1659} 1668}
1660 1669
1661if (caller()) { 1670if (caller()) {
1662 # To allow easy testing of the code. 1671 # To allow easy testing of the code.
1663 # TODO: reduce the use of global variables, or make them accessible 1672 # TODO: reduce the use of global variables, or make them accessible
1664 # to the tests. 1673 # to the tests.
1665 $default_vars = {}; 1674 $default_vars = {};
1666} 1675}
1667 1676
1668main() unless caller(); 1677main() unless caller();