| @@ -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 | |
15 | use v5.36; | | 15 | use v5.36; |
16 | use locale; | | 16 | use locale; |
17 | use strict; | | 17 | use strict; |
18 | use warnings; | | 18 | use warnings; |
19 | use Cwd 'realpath', 'getcwd'; | | 19 | use Cwd 'realpath', 'getcwd'; |
20 | use File::Basename; | | 20 | use File::Basename; |
21 | use File::Find; | | 21 | use File::Find; |
22 | use Getopt::Std; | | 22 | use Getopt::Std; |
23 | use IPC::Open3; | | 23 | use 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. |
27 | package PkgVer; | | 27 | package PkgVer; |
28 | | | 28 | |
29 | sub new($class, $pkgbase, $pkgversion) { | | 29 | sub 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 | |
39 | sub pkgbase($self) { | | 39 | sub pkgbase($self) { |
40 | $self->{pkgbase}; | | 40 | $self->{pkgbase}; |
41 | } | | 41 | } |
42 | | | 42 | |
43 | sub pkgversion($self) { | | 43 | sub pkgversion($self) { |
44 | $self->{pkgversion}; | | 44 | $self->{pkgversion}; |
45 | } | | 45 | } |
46 | | | 46 | |
47 | sub pkgname($self) { | | 47 | sub pkgname($self) { |
48 | $self->pkgbase . '-' . $self->pkgversion; | | 48 | $self->pkgbase . '-' . $self->pkgversion; |
49 | } | | 49 | } |
50 | | | 50 | |
51 | sub var($self, $name, $value = undef) { | | 51 | sub 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 | |
57 | sub vars($self) { | | 57 | sub 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-*. |
63 | package Pkgs; | | 63 | package Pkgs; |
64 | | | 64 | |
65 | sub new($class, $pkgbase) { | | 65 | sub 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 | |
74 | sub pkgbase($self) { | | 74 | sub 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. |
79 | sub versions($self) { | | 79 | sub versions($self) { |
80 | reverse sort keys $self->{pkgvers}->%*; | | 80 | reverse sort keys $self->{pkgvers}->%*; |
81 | } | | 81 | } |
82 | | | 82 | |
83 | sub add($self, $pkgbase, $pkgversion) { | | 83 | sub 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. |
88 | sub pkgvers_all($self) { | | 88 | sub 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 | |
93 | sub pkgver($self, $pkgversion) { | | 93 | sub 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. |
98 | package PkgDb; | | 98 | package PkgDb; |
99 | | | 99 | |
100 | sub new($class) { | | 100 | sub 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 | |
106 | sub add($self, $pkgbase, $pkgversion) { | | 106 | sub 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. |
113 | sub pkgvers_all($self) { | | 113 | sub 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. |
119 | sub pkgvers_by_pkgbase($self, $pkgbase) { | | 119 | sub 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 | |
124 | sub pkgver($self, $pkgbase, $pkgversion) { | | 124 | sub 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. |
132 | sub pkgs($self, $pkgbase = undef) { | | 132 | sub 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 | |
138 | package main; | | 138 | package main; |
139 | | | 139 | |
140 | # Buildtime configuration | | 140 | # Buildtime configuration |
141 | my $conf_make = '@MAKE@'; | | 141 | my $conf_make = '@MAKE@'; |
142 | my $conf_makeconf = '@MAKECONF@'; | | 142 | my $conf_makeconf = '@MAKECONF@'; |
143 | my $conf_pkg_info = '@PKG_INFO@'; | | 143 | my $conf_pkg_info = '@PKG_INFO@'; |
144 | my $conf_pkgsrcdir = '@PKGSRCDIR@'; | | 144 | my $conf_pkgsrcdir = '@PKGSRCDIR@'; |
145 | my $conf_prefix = '@PREFIX@'; | | 145 | my $conf_prefix = '@PREFIX@'; |
146 | my $conf_x11base = '@X11BASE@'; | | 146 | my $conf_x11base = '@X11BASE@'; |
147 | | | 147 | |
148 | my ( | | 148 | my ( |
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 |
159 | my $magic_undefined = 'M_a_G_i_C_uNdEfInEd'; | | 159 | my $magic_undefined = 'M_a_G_i_C_uNdEfInEd'; |
160 | | | 160 | |
161 | sub debug(@args) { | | 161 | sub debug(@args) { |
162 | $opt{D} and print STDERR 'DEBUG: ', @args, "\n"; | | 162 | $opt{D} and print STDERR 'DEBUG: ', @args, "\n"; |
163 | } | | 163 | } |
164 | | | 164 | |
165 | sub verbose(@args) { | | 165 | sub verbose(@args) { |
166 | -t STDERR and print STDERR @args; | | 166 | -t STDERR and print STDERR @args; |
167 | } | | 167 | } |
168 | | | 168 | |
169 | sub fail($msg) { | | 169 | sub 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 |
178 | sub listdir($base, $dir = undef) { | | 178 | sub 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 | |
203 | sub canonicalize_pkgname($pkgname) { | | 203 | sub 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 | |
210 | sub split_pkgversion($pkgversion) { | | 210 | sub 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 | |
233 | sub pkgversion_cmp($va, $op, $vb) { | | 233 | sub 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 | |
249 | sub expand_braces($str) { | | 249 | sub 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. |
267 | sub expand_exprs($value, $vars) { | | 267 | sub 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 | |
276 | sub eval_mk_cond_func($func, $arg, $vars) { | | 276 | sub 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 | |
325 | sub eval_mk_cond($line, $vars) { | | 325 | sub 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 | |
359 | sub parse_makefile_line_include($file, $incfile, | | 359 | sub 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 | |
420 | sub parse_makefile_line_var($varname, $op, $value, $vars) { | | 420 | sub 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 | |
445 | sub expand_modifiers($file, $varname, $left, $subvar, $mods, $right, $vars) { | | 445 | sub 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 | # |
503 | sub parse_makefile_vars($file, $cwd = undef) { | | 503 | sub 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 | |
640 | sub get_default_makefile_vars() { | | 640 | sub 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 | # |
713 | sub invalid_version($pkgmatch) { | | 713 | sub 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 | |
736 | sub list_installed_packages() { | | 736 | sub 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 | # |
746 | sub list_pkgsrc_categories($pkgsrcdir) { | | 746 | sub 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 | # |
761 | sub list_pkgsrc_pkgdirs($pkgsrcdir, $cat) { | | 761 | sub 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. |
777 | sub glob2regex($glob) { | | 777 | sub 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 | # |
829 | sub package_globmatch($pkgmatch) { | | 829 | sub 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 | # |
914 | sub parse_makefile_pkgsrc($file) { | | 914 | sub 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 | |
1009 | sub chdir_or_fail($dir) { | | 1009 | sub 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 | |
1014 | sub load_pkgdb_from_cache($fname) { | | 1014 | sub 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 | # |
1036 | sub scan_pkgsrc_makefiles($pkgsrcdir) { | | 1036 | sub 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 | # |
1073 | sub pkgsrc_check_depends() { | | 1073 | sub 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 | |
1095 | sub load_distinfo($dir) { | | 1095 | sub 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 | |
1119 | sub check_distinfo_hash($entry, $pkgpath, $distfiles, $warnings) { | | 1119 | sub 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 | # |
1146 | sub scan_pkgsrc_distfiles_vs_distinfo($pkgsrcdir, $pkgdistdir, $check_unref, | | 1146 | sub 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 | |
1240 | sub store_pkgdb_in_cache($db, $fname) { | | 1240 | sub 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 | # |
1268 | sub usage_and_exit($status) { | | 1268 | sub usage_and_exit($status) { |
1269 | print "Usage: lintpkgsrc [opts] [makefiles] | | 1269 | print "Usage: lintpkgsrc [opts] [makefiles] |
1270 | opts: | | 1270 | opts: |
1271 | -h : This help. [see lintpkgsrc(1) for more information] | | 1271 | -h : This help. [see lintpkgsrc(1) for more information] |
1272 | | | 1272 | |
1273 | Installed package options: Distfile options: | | 1273 | Installed 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 | |
1279 | Prebuilt package options: Makefile options: | | 1279 | Prebuilt 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 | |
1284 | Misc: | | 1284 | Misc: |
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 | |
1290 | Modifiers: | | 1290 | Modifiers: |
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. |
1302 | sub check_prebuilt_packages() { | | 1302 | sub 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 | |
1358 | sub debug_parse_makefiles(@args) { | | 1358 | sub 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 | |
1377 | sub check_distfiles($pkgsrcdir, $pkgdistdir) { | | 1377 | sub 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 |
| | | 1390 | sub 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 |
| | | 1417 | sub 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 | |
1388 | sub remove_distfiles($pkgsrcdir, $pkgdistdir) { | | 1442 | sub 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 | |
1476 | sub list_broken_packages($pkgsrcdir) { | | 1485 | sub 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 | # |
1487 | sub list_prebuilt_packages($pkgsrcdir) { | | 1496 | sub 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 | |
1504 | sub list_packages_not_in_SUBDIR($pkgsrcdir) { | | 1513 | sub 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 | |
1526 | sub generate_map_file($pkgsrcdir, $fname) { | | 1535 | sub 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 | |
1542 | sub check_outdated_installed_packages($pkgsrcdir) { | | 1551 | sub 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 | |
1587 | sub main() { | | 1596 | sub 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 | |
1653 | sub export_for_test() { | | 1662 | sub 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 | |
1661 | if (caller()) { | | 1670 | if (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 | |
1668 | main() unless caller(); | | 1677 | main() unless caller(); |