tjh.dev
Clone of https://github.com/NixOS/nixpkgs.git (to stress-test knotserver)
1use strict;
2use feature 'signatures';
3use Cwd 'abs_path';
4use IO::Handle;
5use File::Path;
6use File::Basename;
7use File::Compare;
8use JSON::PP;
9
10STDOUT->autoflush(1);
11
12$SIG{__WARN__} = sub { warn "pkgs.buildEnv warning: ", @_ };
13$SIG{__DIE__} = sub { die "pkgs.buildEnv error: ", @_ };
14
15my $out = $ENV{"out"};
16my $extraPrefix = $ENV{"extraPrefix"};
17
18my @pathsToLink = split ' ', $ENV{"pathsToLink"};
19
20sub isInPathsToLink($path) {
21 $path = "/" if $path eq "";
22 foreach my $elem (@pathsToLink) {
23 return 1 if
24 $elem eq "/" ||
25 (substr($path, 0, length($elem)) eq $elem
26 && (($path eq $elem) || (substr($path, length($elem), 1) eq "/")));
27 }
28 return 0;
29}
30
31# Returns whether a path in one of the linked packages may contain
32# files in one of the elements of pathsToLink.
33sub hasPathsToLink($path) {
34 foreach my $elem (@pathsToLink) {
35 return 1 if
36 $path eq "" ||
37 (substr($elem, 0, length($path)) eq $path
38 && (($path eq $elem) || (substr($elem, length($path), 1) eq "/")));
39 }
40 return 0;
41}
42
43# Similar to `lib.isStorePath`
44sub isStorePath($path) {
45 my $storePath = "@storeDir@";
46
47 return substr($path, 0, 1) eq "/" && dirname($path) eq $storePath;
48}
49
50# For each activated package, determine what symlinks to create.
51
52my %symlinks;
53
54# Add all pathsToLink and all parent directories.
55#
56# For "/a/b/c" that will include
57# [ "", "/a", "/a/b", "/a/b/c" ]
58#
59# That ensures the whole directory tree needed by pathsToLink is
60# created as directories and not symlinks.
61$symlinks{""} = ["", 0];
62for my $p (@pathsToLink) {
63 my @parts = split '/', $p;
64
65 my $cur = "";
66 for my $x (@parts) {
67 $cur = $cur . "/$x";
68 $cur = "" if $cur eq "/";
69 $symlinks{$cur} = ["", 0];
70 }
71}
72
73sub findFiles;
74
75sub findFilesInDir($relName, $target, $ignoreCollisions, $checkCollisionContents, $priority, $ignoreSingleFileOutputs) {
76 opendir DIR, "$target" or die "cannot open `$target': $!";
77 my @names = readdir DIR or die;
78 closedir DIR;
79
80 foreach my $name (@names) {
81 next if $name eq "." || $name eq "..";
82 findFiles("$relName/$name", "$target/$name", $name, $ignoreCollisions, $checkCollisionContents, $priority, $ignoreSingleFileOutputs);
83 }
84}
85
86sub checkCollision($path1, $path2) {
87 if (! -e $path1 || ! -e $path2) {
88 return 0;
89 }
90
91 my $stat1 = (stat($path1))[2];
92 my $stat2 = (stat($path2))[2];
93
94 if ($stat1 != $stat2) {
95 warn "different permissions in `$path1' and `$path2': "
96 . sprintf("%04o", $stat1 & 07777) . " <-> "
97 . sprintf("%04o", $stat2 & 07777);
98 return 0;
99 }
100
101 return compare($path1, $path2) == 0;
102}
103
104sub prependDangling($path) {
105 return (-l $path && ! -e $path ? "dangling symlink " : "") . "`$path'";
106}
107
108sub findFiles($relName, $target, $baseName, $ignoreCollisions, $checkCollisionContents, $priority, $ignoreSingleFileOutputs) {
109 # The store path must not be a file when not ignoreSingleFileOutputs
110 if (-f $target && isStorePath $target) {
111 if ($ignoreSingleFileOutputs) {
112 warn "The store path $target is a file and can't be merged into an environment using pkgs.buildEnv, ignoring it";
113 return;
114 } else {
115 die "The store path $target is a file and can't be merged into an environment using pkgs.buildEnv!";
116 }
117 }
118
119 # Urgh, hacky...
120 return if
121 $relName eq "/propagated-build-inputs" ||
122 $relName eq "/nix-support" ||
123 $relName =~ /info\/dir$/ ||
124 ( $relName =~ /^\/share\/mime\// && !( $relName =~ /^\/share\/mime\/packages/ ) ) ||
125 $baseName eq "perllocal.pod" ||
126 $baseName eq "log" ||
127 ! (hasPathsToLink($relName) || isInPathsToLink($relName));
128
129 my ($oldTarget, $oldPriority) = @{$symlinks{$relName} // [undef, undef]};
130
131 # If target doesn't exist, create it. If it already exists as a
132 # symlink to a file (not a directory) in a lower-priority package,
133 # overwrite it.
134 if (!defined $oldTarget || ($priority < $oldPriority && ($oldTarget ne "" && ! -d $oldTarget))) {
135 # If target is a dangling symlink, emit a warning.
136 if (-l $target && ! -e $target) {
137 my $link = readlink $target;
138 warn "creating dangling symlink `$out$extraPrefix/$relName' -> `$target' -> `$link'\n";
139 }
140 $symlinks{$relName} = [$target, $priority];
141 return;
142 }
143
144 # If target already exists and both targets resolves to the same path, skip
145 if (
146 defined $oldTarget && $oldTarget ne "" &&
147 defined abs_path($target) && defined abs_path($oldTarget) &&
148 abs_path($target) eq abs_path($oldTarget)
149 ) {
150 # Prefer the target that is not a symlink, if any
151 if (-l $oldTarget && ! -l $target) {
152 $symlinks{$relName} = [$target, $priority];
153 }
154 return;
155 }
156
157 # If target already exists as a symlink to a file (not a
158 # directory) in a higher-priority package, skip.
159 if (defined $oldTarget && $priority > $oldPriority && $oldTarget ne "" && ! -d $oldTarget) {
160 return;
161 }
162
163 # If target is supposed to be a directory but it isn't, die with an error message
164 # instead of attempting to recurse into it, only to fail then.
165 # This happens e.g. when pathsToLink contains a non-directory path.
166 if ($oldTarget eq "" && ! -d $target) {
167 die "not a directory: `$target'\n";
168 }
169
170 unless (-d $target && ($oldTarget eq "" || -d $oldTarget)) {
171 # Prepend "dangling symlink" to paths if applicable.
172 my $targetRef = prependDangling($target);
173 my $oldTargetRef = prependDangling($oldTarget);
174
175 if ($ignoreCollisions) {
176 warn "colliding subpath (ignored): $targetRef and $oldTargetRef\n" if $ignoreCollisions == 1;
177 return;
178 } elsif ($checkCollisionContents && checkCollision($oldTarget, $target)) {
179 return;
180 } else {
181 die "two given paths contain a conflicting subpath:\n $targetRef and\n $oldTargetRef\nhint: this may be caused by two different versions of the same package in buildEnv's `paths` parameter\nhint: `pkgs.nix-diff` can be used to compare derivations\n";
182 }
183 }
184
185 findFilesInDir($relName, $oldTarget, $ignoreCollisions, $checkCollisionContents, $oldPriority, $ignoreSingleFileOutputs) unless $oldTarget eq "";
186 findFilesInDir($relName, $target, $ignoreCollisions, $checkCollisionContents, $priority, $ignoreSingleFileOutputs);
187
188 $symlinks{$relName} = ["", $priority]; # denotes directory
189}
190
191
192my %done;
193my %postponed;
194
195sub addPkg($pkgDir, $ignoreCollisions, $checkCollisionContents, $priority, $ignoreSingleFileOutputs) {
196 return if (defined $done{$pkgDir});
197 $done{$pkgDir} = 1;
198
199 findFiles("", $pkgDir, "", $ignoreCollisions, $checkCollisionContents, $priority, $ignoreSingleFileOutputs);
200
201 my $propagatedFN = "$pkgDir/nix-support/propagated-user-env-packages";
202 if (-e $propagatedFN) {
203 open PROP, "<$propagatedFN" or die;
204 my $propagated = <PROP>;
205 close PROP;
206 my @propagated = split ' ', $propagated;
207 foreach my $p (@propagated) {
208 $postponed{$p} = 1 unless defined $done{$p};
209 }
210 }
211}
212
213# Read packages list.
214my $pkgs;
215
216if (exists $ENV{"pkgsPath"}) {
217 open FILE, $ENV{"pkgsPath"};
218 $pkgs = <FILE>;
219 close FILE;
220} else {
221 $pkgs = $ENV{"pkgs"}
222}
223
224# Symlink to the packages that have been installed explicitly by the
225# user.
226for my $pkg (@{decode_json $pkgs}) {
227 for my $path (@{$pkg->{paths}}) {
228 addPkg($path,
229 $ENV{"ignoreCollisions"} eq "1",
230 $ENV{"checkCollisionContents"} eq "1",
231 $pkg->{priority},
232 $ENV{"ignoreSingleFileOutputs"} eq "1")
233 if -e $path;
234 }
235}
236
237
238# Symlink to the packages that have been "propagated" by packages
239# installed by the user (i.e., package X declares that it wants Y
240# installed as well). We do these later because they have a lower
241# priority in case of collisions.
242my $priorityCounter = 1000; # don't care about collisions
243while (scalar(keys %postponed) > 0) {
244 my @pkgDirs = keys %postponed;
245 %postponed = ();
246 foreach my $pkgDir (sort @pkgDirs) {
247 addPkg($pkgDir, 2, $ENV{"checkCollisionContents"} eq "1", $priorityCounter++, $ENV{"ignoreSingleFileOutputs"} eq "1");
248 }
249}
250
251my $extraPathsFilePath = $ENV{"extraPathsFrom"};
252if ($extraPathsFilePath) {
253 open FILE, $extraPathsFilePath or die "cannot open extra paths file $extraPathsFilePath: $!";
254
255 while(my $line = <FILE>) {
256 chomp $line;
257 addPkg($line,
258 $ENV{"ignoreCollisions"} eq "1",
259 $ENV{"checkCollisionContents"} eq "1",
260 1000,
261 $ENV{"ignoreSingleFileOutputs"} eq "1")
262 if -d $line;
263 }
264
265 close FILE;
266}
267
268# Create the symlinks.
269my $nrLinks = 0;
270foreach my $relName (sort keys %symlinks) {
271 my ($target, $priority) = @{$symlinks{$relName}};
272 my $abs = "$out" . "$extraPrefix" . "/$relName";
273 next unless isInPathsToLink $relName;
274 if ($target eq "") {
275 #print "creating directory $relName\n";
276 mkpath $abs or die "cannot create directory `$abs': $!";
277 } else {
278 #print "creating symlink $relName to $target\n";
279 symlink $target, $abs ||
280 die "error creating link `$abs': $!";
281 $nrLinks++;
282 }
283}
284
285
286print STDERR "created $nrLinks symlinks in user environment\n";
287
288
289my $manifest = $ENV{"manifest"};
290if ($manifest) {
291 symlink($manifest, "$out/manifest") or die "cannot create manifest";
292}