1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
#!/usr/bin/env perl
#
# This is a script that runs when make is invoked recursively using the
# $(MAKE) variable. It simply reports to the parent make process what
# the make command was and what the current working directory is now.
# The parent makepp process sets the environment variable MAKEPP_SOCKET
# to be the name of a file that we're supposed to write information about the
# cwd and make command.
# $Id: recursive_makepp,v 1.8 2013/02/16 15:11:37 pfeiffer Exp $
#
use Cwd;
use IO::Socket;
my $socket_name = $ENV{'MAKEPP_SOCKET'};
# Where are we supposed to send the output?
defined $socket_name or
die "$0: not invoked from makepp\n";
my $socket = IO::Socket::UNIX->new(Peer => $socket_name,
Type => SOCK_STREAM);
# Open the socket.
unless( defined $socket ) {
print "Error opening $socket_name--$!\n";
sleep 500;
die "recursive makepp: socket open error--$!\n";
}
#
# Replace the quotes that used to be around each of the arguments. We
# can't make it exactly like it used to be, but if we place quotes around
# every argument, then we'll certainly not be confused by spaces.
#
my @words;
foreach (@ARGV) {
s/\\/\\\\/g; # Protect all backslashes.
s/\"/\\\"/g; # Protect all single quotes.
push @words, /[^-.\/\w]/ ? qq["$_"] : $_; # Append this word, keeping spaces intact.
}
my $message = join(' ', cwd, @words) . "\n"; # Send the command first.
while (($var, $val) = each %ENV) { # Send the environment back too.
$val =~ s{([\0-\037\\])}{sprintf("\\%o", ord($1))}eg;
# Protect any binary characters or backslashes.
$message .= "$var=$val\n";
}
print $socket $message . "\01END\01" or # Send to makepp.
die "recursive makepp: error writing to socket--$!\n";
my $response;
sysread $socket, $response, 16384;
$response .= $_
while sysread $socket, $_, 16384; # Wait for rest of response before we proceed.
if( $response =~ s/\A(\d+)\s+// ) { # Status is the first word of the response.
$status = $1;
} elsif( $response =~ /\Aexec (.+)\n(.*)\n/ ) { # Need to recurse traditionally
$ENV{_MAKEPPFLAGS} = $2;
my $cmd = join ' ', $1, grep !/^"recursive_makepp=\d+"$/, @words;
print "$cmd\n";
exec $cmd;
die "$0: can't exec $cmd--$!";
} else {
warn "recursive_makepp: protocol error '$response'\n";
$status = 253;
}
chomp $response; # Strip extra newline out if there is one.
$response and print STDERR "\$(MAKE): $response\n"; # Any error message?
#chomp $_;
#print "Recursive make: status was '$_'\n";
exit $status; # Exit with the same error code.
|
