| OLD | NEW |
|---|
| (Empty) |
| 1 # Copyright © 2008-2009 Raphaël Hertzog <hertzog@debian.org> | |
| 2 # Copyright © 2008 Frank Lichtenheld <djpig@debian.org> | |
| 3 # | |
| 4 # This program is free software; you can redistribute it and/or modify | |
| 5 # it under the terms of the GNU General Public License as published by | |
| 6 # the Free Software Foundation; either version 2 of the License, or | |
| 7 # (at your option) any later version. | |
| 8 # | |
| 9 # This program is distributed in the hope that it will be useful, | |
| 10 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 12 # GNU General Public License for more details. | |
| 13 # | |
| 14 # You should have received a copy of the GNU General Public License | |
| 15 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
| 16 | |
| 17 package Dpkg::IPC; | |
| 18 | |
| 19 use strict; | |
| 20 use warnings; | |
| 21 | |
| 22 our $VERSION = '1.00'; | |
| 23 | |
| 24 use Dpkg::ErrorHandling; | |
| 25 use Dpkg::Gettext; | |
| 26 | |
| 27 use Carp; | |
| 28 use Exporter qw(import); | |
| 29 our @EXPORT = qw(spawn wait_child); | |
| 30 | |
| 31 =encoding utf8 | |
| 32 | |
| 33 =head1 NAME | |
| 34 | |
| 35 Dpkg::IPC - helper functions for IPC | |
| 36 | |
| 37 =head1 DESCRIPTION | |
| 38 | |
| 39 Dpkg::IPC offers helper functions to allow you to execute | |
| 40 other programs in an easy, yet flexible way, while hiding | |
| 41 all the gory details of IPC (Inter-Process Communication) | |
| 42 from you. | |
| 43 | |
| 44 =head1 METHODS | |
| 45 | |
| 46 =over 4 | |
| 47 | |
| 48 =item spawn | |
| 49 | |
| 50 Creates a child process and executes another program in it. | |
| 51 The arguments are interpreted as a hash of options, specifying | |
| 52 how to handle the in and output of the program to execute. | |
| 53 Returns the pid of the child process (unless the wait_child | |
| 54 option was given). | |
| 55 | |
| 56 Any error will cause the function to exit with one of the | |
| 57 Dpkg::ErrorHandling functions. | |
| 58 | |
| 59 Options: | |
| 60 | |
| 61 =over 4 | |
| 62 | |
| 63 =item exec | |
| 64 | |
| 65 Can be either a scalar, i.e. the name of the program to be | |
| 66 executed, or an array reference, i.e. the name of the program | |
| 67 plus additional arguments. Note that the program will never be | |
| 68 executed via the shell, so you can't specify additional arguments | |
| 69 in the scalar string and you can't use any shell facilities like | |
| 70 globbing. | |
| 71 | |
| 72 Mandatory Option. | |
| 73 | |
| 74 =item from_file, to_file, error_to_file | |
| 75 | |
| 76 Filename as scalar. Standard input/output/error of the | |
| 77 child process will be redirected to the file specified. | |
| 78 | |
| 79 =item from_handle, to_handle, error_to_handle | |
| 80 | |
| 81 Filehandle. Standard input/output/error of the child process will be | |
| 82 dup'ed from the handle. | |
| 83 | |
| 84 =item from_pipe, to_pipe, error_to_pipe | |
| 85 | |
| 86 Scalar reference or object based on IO::Handle. A pipe will be opened for | |
| 87 each of the two options and either the reading (C<to_pipe> and | |
| 88 C<error_to_pipe>) or the writing end (C<from_pipe>) will be returned in | |
| 89 the referenced scalar. Standard input/output/error of the child process | |
| 90 will be dup'ed to the other ends of the pipes. | |
| 91 | |
| 92 =item from_string, to_string, error_to_string | |
| 93 | |
| 94 Scalar reference. Standard input/output/error of the child | |
| 95 process will be redirected to the string given as reference. Note | |
| 96 that it wouldn't be strictly necessary to use a scalar reference | |
| 97 for C<from_string>, as the string is not modified in any way. This was | |
| 98 chosen only for reasons of symmetry with C<to_string> and | |
| 99 C<error_to_string>. C<to_string> and C<error_to_string> imply the | |
| 100 C<wait_child> option. | |
| 101 | |
| 102 =item wait_child | |
| 103 | |
| 104 Scalar. If containing a true value, wait_child() will be called before | |
| 105 returning. The return value of spawn() will be a true value, not the pid. | |
| 106 | |
| 107 =item nocheck | |
| 108 | |
| 109 Scalar. Option of the wait_child() call. | |
| 110 | |
| 111 =item timeout | |
| 112 | |
| 113 Scalar. Option of the wait_child() call. | |
| 114 | |
| 115 =item chdir | |
| 116 | |
| 117 Scalar. The child process will chdir in the indicated directory before | |
| 118 calling exec. | |
| 119 | |
| 120 =item env | |
| 121 | |
| 122 Hash reference. The child process will populate %ENV with the items of the | |
| 123 hash before calling exec. This allows exporting environment variables. | |
| 124 | |
| 125 =item delete_env | |
| 126 | |
| 127 Array reference. The child process will remove all environment variables | |
| 128 listed in the array before calling exec. | |
| 129 | |
| 130 =back | |
| 131 | |
| 132 =cut | |
| 133 | |
| 134 sub _sanity_check_opts { | |
| 135 my (%opts) = @_; | |
| 136 | |
| 137 croak 'exec parameter is mandatory in spawn()' | |
| 138 unless $opts{exec}; | |
| 139 | |
| 140 my $to = my $error_to = my $from = 0; | |
| 141 foreach (qw(file handle string pipe)) { | |
| 142 $to++ if $opts{"to_$_"}; | |
| 143 $error_to++ if $opts{"error_to_$_"}; | |
| 144 $from++ if $opts{"from_$_"}; | |
| 145 } | |
| 146 croak 'not more than one of to_* parameters is allowed' | |
| 147 if $to > 1; | |
| 148 croak 'not more than one of error_to_* parameters is allowed' | |
| 149 if $error_to > 1; | |
| 150 croak 'not more than one of from_* parameters is allowed' | |
| 151 if $from > 1; | |
| 152 | |
| 153 foreach (qw(to_string error_to_string from_string)) { | |
| 154 if (exists $opts{$_} and | |
| 155 (not ref($opts{$_}) or ref($opts{$_}) ne 'SCALAR')) { | |
| 156 croak "parameter $_ must be a scalar reference"; | |
| 157 } | |
| 158 } | |
| 159 | |
| 160 foreach (qw(to_pipe error_to_pipe from_pipe)) { | |
| 161 if (exists $opts{$_} and | |
| 162 (not ref($opts{$_}) or (ref($opts{$_}) ne 'SCALAR' and | |
| 163 not $opts{$_}->isa('IO::Handle')))) { | |
| 164 croak "parameter $_ must be a scalar reference or " . | |
| 165 'an IO::Handle object'; | |
| 166 } | |
| 167 } | |
| 168 | |
| 169 if (exists $opts{timeout} and defined($opts{timeout}) and | |
| 170 $opts{timeout} !~ /^\d+$/) { | |
| 171 croak 'parameter timeout must be an integer'; | |
| 172 } | |
| 173 | |
| 174 if (exists $opts{env} and ref($opts{env}) ne 'HASH') { | |
| 175 croak 'parameter env must be a hash reference'; | |
| 176 } | |
| 177 | |
| 178 if (exists $opts{delete_env} and ref($opts{delete_env}) ne 'ARRAY') { | |
| 179 croak 'parameter delete_env must be an array reference'; | |
| 180 } | |
| 181 | |
| 182 return %opts; | |
| 183 } | |
| 184 | |
| 185 sub spawn { | |
| 186 my (%opts) = _sanity_check_opts(@_); | |
| 187 $opts{close_in_child} ||= []; | |
| 188 my @prog; | |
| 189 if (ref($opts{exec}) =~ /ARRAY/) { | |
| 190 push @prog, @{$opts{exec}}; | |
| 191 } elsif (not ref($opts{exec})) { | |
| 192 push @prog, $opts{exec}; | |
| 193 } else { | |
| 194 croak 'invalid exec parameter in spawn()'; | |
| 195 } | |
| 196 my ($from_string_pipe, $to_string_pipe, $error_to_string_pipe); | |
| 197 if ($opts{to_string}) { | |
| 198 $opts{to_pipe} = \$to_string_pipe; | |
| 199 $opts{wait_child} = 1; | |
| 200 } | |
| 201 if ($opts{error_to_string}) { | |
| 202 $opts{error_to_pipe} = \$error_to_string_pipe; | |
| 203 $opts{wait_child} = 1; | |
| 204 } | |
| 205 if ($opts{from_string}) { | |
| 206 $opts{from_pipe} = \$from_string_pipe; | |
| 207 } | |
| 208 # Create pipes if needed | |
| 209 my ($input_pipe, $output_pipe, $error_pipe); | |
| 210 if ($opts{from_pipe}) { | |
| 211 pipe($opts{from_handle}, $input_pipe) | |
| 212 or syserr(_g('pipe for %s'), "@prog"); | |
| 213 ${$opts{from_pipe}} = $input_pipe; | |
| 214 push @{$opts{close_in_child}}, $input_pipe; | |
| 215 } | |
| 216 if ($opts{to_pipe}) { | |
| 217 pipe($output_pipe, $opts{to_handle}) | |
| 218 or syserr(_g('pipe for %s'), "@prog"); | |
| 219 ${$opts{to_pipe}} = $output_pipe; | |
| 220 push @{$opts{close_in_child}}, $output_pipe; | |
| 221 } | |
| 222 if ($opts{error_to_pipe}) { | |
| 223 pipe($error_pipe, $opts{error_to_handle}) | |
| 224 or syserr(_g('pipe for %s'), "@prog"); | |
| 225 ${$opts{error_to_pipe}} = $error_pipe; | |
| 226 push @{$opts{close_in_child}}, $error_pipe; | |
| 227 } | |
| 228 # Fork and exec | |
| 229 my $pid = fork(); | |
| 230 syserr(_g('cannot fork for %s'), "@prog") unless defined $pid; | |
| 231 if (not $pid) { | |
| 232 # Define environment variables | |
| 233 if ($opts{env}) { | |
| 234 foreach (keys %{$opts{env}}) { | |
| 235 $ENV{$_} = $opts{env}{$_}; | |
| 236 } | |
| 237 } | |
| 238 if ($opts{delete_env}) { | |
| 239 delete $ENV{$_} foreach (@{$opts{delete_env}}); | |
| 240 } | |
| 241 # Change the current directory | |
| 242 if ($opts{chdir}) { | |
| 243 chdir($opts{chdir}) or syserr(_g('chdir to %s'), $opts{chdir}); | |
| 244 } | |
| 245 # Redirect STDIN if needed | |
| 246 if ($opts{from_file}) { | |
| 247 open(STDIN, '<', $opts{from_file}) | |
| 248 or syserr(_g('cannot open %s'), $opts{from_file}); | |
| 249 } elsif ($opts{from_handle}) { | |
| 250 open(STDIN, '<&', $opts{from_handle}) | |
| 251 or syserr(_g('reopen stdin')); | |
| 252 close($opts{from_handle}); # has been duped, can be closed | |
| 253 } | |
| 254 # Redirect STDOUT if needed | |
| 255 if ($opts{to_file}) { | |
| 256 open(STDOUT, '>', $opts{to_file}) | |
| 257 or syserr(_g('cannot write %s'), $opts{to_file}); | |
| 258 } elsif ($opts{to_handle}) { | |
| 259 open(STDOUT, '>&', $opts{to_handle}) | |
| 260 or syserr(_g('reopen stdout')); | |
| 261 close($opts{to_handle}); # has been duped, can be closed | |
| 262 } | |
| 263 # Redirect STDERR if needed | |
| 264 if ($opts{error_to_file}) { | |
| 265 open(STDERR, '>', $opts{error_to_file}) | |
| 266 or syserr(_g('cannot write %s'), $opts{error_to_file}); | |
| 267 } elsif ($opts{error_to_handle}) { | |
| 268 open(STDERR, '>&', $opts{error_to_handle}) | |
| 269 or syserr(_g('reopen stdout')); | |
| 270 close($opts{error_to_handle}); # has been duped, can be closed | |
| 271 } | |
| 272 # Close some inherited filehandles | |
| 273 close($_) foreach (@{$opts{close_in_child}}); | |
| 274 # Execute the program | |
| 275 exec({ $prog[0] } @prog) or syserr(_g('unable to execute %s'), "@prog"); | |
| 276 } | |
| 277 # Close handle that we can't use any more | |
| 278 close($opts{from_handle}) if exists $opts{from_handle}; | |
| 279 close($opts{to_handle}) if exists $opts{to_handle}; | |
| 280 close($opts{error_to_handle}) if exists $opts{error_to_handle}; | |
| 281 | |
| 282 if ($opts{from_string}) { | |
| 283 print { $from_string_pipe } ${$opts{from_string}}; | |
| 284 close($from_string_pipe); | |
| 285 } | |
| 286 if ($opts{to_string}) { | |
| 287 local $/ = undef; | |
| 288 ${$opts{to_string}} = readline($to_string_pipe); | |
| 289 } | |
| 290 if ($opts{error_to_string}) { | |
| 291 local $/ = undef; | |
| 292 ${$opts{error_to_string}} = readline($error_to_string_pipe); | |
| 293 } | |
| 294 if ($opts{wait_child}) { | |
| 295 my $cmdline = "@prog"; | |
| 296 if ($opts{env}) { | |
| 297 foreach (keys %{$opts{env}}) { | |
| 298 $cmdline = "$_=\"" . $opts{env}{$_} . "\" $cmdline"; | |
| 299 } | |
| 300 } | |
| 301 wait_child($pid, nocheck => $opts{nocheck}, | |
| 302 timeout => $opts{timeout}, cmdline => $cmdline); | |
| 303 return 1; | |
| 304 } | |
| 305 | |
| 306 return $pid; | |
| 307 } | |
| 308 | |
| 309 | |
| 310 =item wait_child | |
| 311 | |
| 312 Takes as first argument the pid of the process to wait for. | |
| 313 Remaining arguments are taken as a hash of options. Returns | |
| 314 nothing. Fails if the child has been ended by a signal or | |
| 315 if it exited non-zero. | |
| 316 | |
| 317 Options: | |
| 318 | |
| 319 =over 4 | |
| 320 | |
| 321 =item cmdline | |
| 322 | |
| 323 String to identify the child process in error messages. | |
| 324 Defaults to "child process". | |
| 325 | |
| 326 =item nocheck | |
| 327 | |
| 328 If true do not check the return status of the child (and thus | |
| 329 do not fail it it has been killed or if it exited with a | |
| 330 non-zero return code). | |
| 331 | |
| 332 =item timeout | |
| 333 | |
| 334 Set a maximum time to wait for the process, after that fail | |
| 335 with an error message. | |
| 336 | |
| 337 =back | |
| 338 | |
| 339 =cut | |
| 340 | |
| 341 sub wait_child { | |
| 342 my ($pid, %opts) = @_; | |
| 343 $opts{cmdline} ||= _g('child process'); | |
| 344 croak 'no PID set, cannot wait end of process' unless $pid; | |
| 345 eval { | |
| 346 local $SIG{ALRM} = sub { die "alarm\n" }; | |
| 347 alarm($opts{timeout}) if defined($opts{timeout}); | |
| 348 $pid == waitpid($pid, 0) or syserr(_g('wait for %s'), $opts{cmdline}); | |
| 349 alarm(0) if defined($opts{timeout}); | |
| 350 }; | |
| 351 if ($@) { | |
| 352 die $@ unless $@ eq "alarm\n"; | |
| 353 error(ngettext("%s didn't complete in %d second", | |
| 354 "%s didn't complete in %d seconds", | |
| 355 $opts{timeout}), | |
| 356 $opts{cmdline}, $opts{timeout}); | |
| 357 } | |
| 358 unless ($opts{nocheck}) { | |
| 359 subprocerr($opts{cmdline}) if $?; | |
| 360 } | |
| 361 } | |
| 362 | |
| 363 1; | |
| 364 __END__ | |
| 365 | |
| 366 =back | |
| 367 | |
| 368 =head1 AUTHORS | |
| 369 | |
| 370 Written by Raphaël Hertzog <hertzog@debian.org> and | |
| 371 Frank Lichtenheld <djpig@debian.org>. | |
| 372 | |
| 373 =head1 SEE ALSO | |
| 374 | |
| 375 Dpkg, Dpkg::ErrorHandling | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2425693003:
Revert of Linux build: Use sysroot when calculating dependencies (Closed)
