diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | doio.c | 57 | ||||
| -rw-r--r-- | embed.fnc | 3 | ||||
| -rw-r--r-- | embed.h | 3 | ||||
| -rw-r--r-- | pp_sys.c | 47 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | t/io/pipe.t | 14 | ||||
| -rw-r--r-- | t/io/socket.t | 27 | ||||
| -rw-r--r-- | t/io/socketpair.t | 51 | ||||
| -rw-r--r-- | util.c | 21 |
10 files changed, 153 insertions, 74 deletions
@@ -5443,6 +5443,7 @@ t/io/sem.t See if SysV semaphores work t/io/semctl.t See if SysV semaphore semctl works t/io/shm.t See if SysV shared memory works t/io/socket.t See if socket functions work +t/io/socketpair.t See if socketpair function works t/io/tell.t See if file seeking works t/io/through.t See if pipe passes data intact t/io/utf8.t See if file seeking works @@ -60,22 +60,43 @@ #include <signal.h> +void +Perl_setfd_cloexec(pTHX_ int fd) +{ + assert(fd >= 0); #if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) -# define DO_ONESET_CLOEXEC(fd) ((void) fcntl(fd, F_SETFD, FD_CLOEXEC)) -#else -# define DO_ONESET_CLOEXEC(fd) ((void) 0) + (void) fcntl(fd, F_SETFD, FD_CLOEXEC); +#endif +} + +void +Perl_setfd_inhexec(pTHX_ int fd) +{ + assert(fd >= 0); +#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) + (void) fcntl(fd, F_SETFD, 0); #endif -#define DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC) \ +} + +void +Perl_setfd_inhexec_for_sysfd(pTHX_ int fd) +{ + assert(fd >= 0); + if(fd <= PL_maxsysfd) + setfd_inhexec(fd); +} + +#define DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ do { \ int res = (GENOPEN_NORMAL); \ - if(LIKELY(res != -1)) GENSET_CLOEXEC; \ + if(LIKELY(res != -1)) GENSETFD_CLOEXEC; \ return res; \ } while(0) #if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) && \ defined(F_GETFD) enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN }; # define DO_GENOPEN_EXPERIMENTING_CLOEXEC(TESTFD, GENOPEN_CLOEXEC, \ - GENOPEN_NORMAL, GENSET_CLOEXEC) \ + GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ do { \ static int strategy = CLOEXEC_EXPERIMENT; \ switch (strategy) { \ @@ -88,14 +109,14 @@ enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN }; strategy = CLOEXEC_AT_OPEN; \ } else { \ strategy = CLOEXEC_AFTER_OPEN; \ - GENSET_CLOEXEC; \ + GENSETFD_CLOEXEC; \ } \ } else if (UNLIKELY((eno = errno) == EINVAL || \ eno == ENOSYS)) { \ res = (GENOPEN_NORMAL); \ if (LIKELY(res != -1)) { \ strategy = CLOEXEC_AFTER_OPEN; \ - GENSET_CLOEXEC; \ + GENSETFD_CLOEXEC; \ } else if (!LIKELY((eno = errno) == EINVAL || \ eno == ENOSYS)) { \ strategy = CLOEXEC_AFTER_OPEN; \ @@ -106,39 +127,39 @@ enum { CLOEXEC_EXPERIMENT, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN }; case CLOEXEC_AT_OPEN: \ return (GENOPEN_CLOEXEC); \ case CLOEXEC_AFTER_OPEN: \ - DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC); \ + DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC); \ } \ } while(0) #else # define DO_GENOPEN_EXPERIMENTING_CLOEXEC(TESTFD, GENOPEN_CLOEXEC, \ - GENOPEN_NORMAL, GENSET_CLOEXEC) \ - DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSET_CLOEXEC) + GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ + DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC) #endif #define DO_ONEOPEN_THEN_CLOEXEC(ONEOPEN_NORMAL) \ do { \ int fd; \ DO_GENOPEN_THEN_CLOEXEC(fd = (ONEOPEN_NORMAL), \ - DO_ONESET_CLOEXEC(fd)); \ + setfd_cloexec(fd)); \ } while(0) #define DO_ONEOPEN_EXPERIMENTING_CLOEXEC(ONEOPEN_CLOEXEC, ONEOPEN_NORMAL) \ do { \ int fd; \ DO_GENOPEN_EXPERIMENTING_CLOEXEC(fd, fd = (ONEOPEN_CLOEXEC), \ - fd = (ONEOPEN_NORMAL), DO_ONESET_CLOEXEC(fd)); \ + fd = (ONEOPEN_NORMAL), setfd_cloexec(fd)); \ } while(0) -#define DO_PIPESET_CLOEXEC(PIPEFD) \ +#define DO_PIPESETFD_CLOEXEC(PIPEFD) \ do { \ - DO_ONESET_CLOEXEC((PIPEFD)[0]); \ - DO_ONESET_CLOEXEC((PIPEFD)[1]); \ + setfd_cloexec((PIPEFD)[0]); \ + setfd_cloexec((PIPEFD)[1]); \ } while(0) #define DO_PIPEOPEN_THEN_CLOEXEC(PIPEFD, PIPEOPEN_NORMAL) \ - DO_GENOPEN_THEN_CLOEXEC(PIPEOPEN_NORMAL, DO_PIPESET_CLOEXEC(PIPEFD)) + DO_GENOPEN_THEN_CLOEXEC(PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD)) #define DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PIPEFD, PIPEOPEN_CLOEXEC, \ PIPEOPEN_NORMAL) \ DO_GENOPEN_EXPERIMENTING_CLOEXEC((PIPEFD)[0], PIPEOPEN_CLOEXEC, \ - PIPEOPEN_NORMAL, DO_PIPESET_CLOEXEC(PIPEFD)) + PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD)) int Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd) @@ -464,6 +464,9 @@ Apmb |bool |do_open |NN GV* gv|NN const char* name|I32 len|int as_raw \ Ap |bool |do_open9 |NN GV *gv|NN const char *name|I32 len|int as_raw \ |int rawmode|int rawperm|NULLOK PerlIO *supplied_fp \ |NN SV *svs|I32 num +p |void |setfd_cloexec|int fd +p |void |setfd_inhexec|int fd +p |void |setfd_inhexec_for_sysfd|int fd pR |int |PerlLIO_dup_cloexec|int oldfd pR |int |PerlLIO_dup2_cloexec|int oldfd|int newfd pR |int |PerlLIO_open_cloexec|NN const char *file|int flag @@ -1382,6 +1382,9 @@ #define set_caret_X() Perl_set_caret_X(aTHX) #define set_numeric_standard() Perl_set_numeric_standard(aTHX) #define set_numeric_underlying() Perl_set_numeric_underlying(aTHX) +#define setfd_cloexec(a) Perl_setfd_cloexec(aTHX_ a) +#define setfd_inhexec(a) Perl_setfd_inhexec(aTHX_ a) +#define setfd_inhexec_for_sysfd(a) Perl_setfd_inhexec_for_sysfd(aTHX_ a) #define sub_crush_depth(a) Perl_sub_crush_depth(aTHX_ a) #define sv_2num(a) Perl_sv_2num(aTHX_ a) #define sv_clean_all() Perl_sv_clean_all(aTHX) @@ -690,8 +690,10 @@ PP(pp_pipe_op) if (IoIFP(wstio)) do_close(wgv, FALSE); - if (PerlProc_pipe(fd) < 0) + if (PerlProc_pipe_cloexec(fd) < 0) goto badexit; + setfd_inhexec_for_sysfd(fd[0]); + setfd_inhexec_for_sysfd(fd[1]); IoIFP(rstio) = PerlIO_fdopen(fd[0], "r" PIPE_OPEN_MODE); IoOFP(wstio) = PerlIO_fdopen(fd[1], "w" PIPE_OPEN_MODE); @@ -711,12 +713,6 @@ PP(pp_pipe_op) PerlLIO_close(fd[1]); goto badexit; } -#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) - /* ensure close-on-exec */ - if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) || - (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0)) - goto badexit; -#endif RETPUSHYES; badexit: @@ -2379,7 +2375,7 @@ PP(pp_truncate) */ mode |= O_BINARY; #endif - tmpfd = PerlLIO_open(name, mode); + tmpfd = PerlLIO_open_cloexec(name, mode); if (tmpfd < 0) { result = 0; @@ -2521,10 +2517,11 @@ PP(pp_socket) do_close(gv, FALSE); TAINT_PROPER("socket"); - fd = PerlSock_socket(domain, type, protocol); + fd = PerlSock_socket_cloexec(domain, type, protocol); if (fd < 0) { RETPUSHUNDEF; } + setfd_inhexec_for_sysfd(fd); IoIFP(io) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w" SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2534,11 +2531,6 @@ PP(pp_socket) if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd); RETPUSHUNDEF; } -#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) - /* ensure close-on-exec */ - if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) - RETPUSHUNDEF; -#endif RETPUSHYES; } @@ -2564,8 +2556,10 @@ PP(pp_sockpair) do_close(gv2, FALSE); TAINT_PROPER("socketpair"); - if (PerlSock_socketpair(domain, type, protocol, fd) < 0) + if (PerlSock_socketpair_cloexec(domain, type, protocol, fd) < 0) RETPUSHUNDEF; + setfd_inhexec_for_sysfd(fd[0]); + setfd_inhexec_for_sysfd(fd[1]); IoIFP(io1) = PerlIO_fdopen(fd[0], "r" SOCKET_OPEN_MODE); IoOFP(io1) = PerlIO_fdopen(fd[0], "w" SOCKET_OPEN_MODE); IoTYPE(io1) = IoTYPE_SOCKET; @@ -2581,12 +2575,6 @@ PP(pp_sockpair) if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]); RETPUSHUNDEF; } -#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) - /* ensure close-on-exec */ - if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) || - (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0)) - RETPUSHUNDEF; -#endif RETPUSHYES; #else @@ -2673,7 +2661,7 @@ PP(pp_accept) goto nuts; nstio = GvIOn(ngv); - fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len); + fd = PerlSock_accept_cloexec(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len); #if defined(OEMVS) if (len == 0) { /* Some platforms indicate zero length when an AF_UNIX client is @@ -2687,6 +2675,7 @@ PP(pp_accept) if (fd < 0) goto badexit; + setfd_inhexec_for_sysfd(fd); if (IoIFP(nstio)) do_close(ngv, FALSE); IoIFP(nstio) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE); @@ -2698,11 +2687,6 @@ PP(pp_accept) if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd); goto badexit; } -#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) - /* ensure close-on-exec */ - if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) - goto badexit; -#endif #ifdef __SCO_VERSION__ len = sizeof (struct sockaddr_in); /* OpenUNIX 8 somehow truncates info */ @@ -4449,7 +4433,7 @@ PP(pp_system) sigset_t newset, oldset; #endif - if (PerlProc_pipe(pp) >= 0) + if (PerlProc_pipe_cloexec(pp) >= 0) did_pipes = 1; #ifdef __amigaos4__ amigaos_fork_set_userdata(aTHX_ @@ -4546,13 +4530,8 @@ PP(pp_system) #ifdef HAS_SIGPROCMASK sigprocmask(SIG_SETMASK, &oldset, NULL); #endif - if (did_pipes) { + if (did_pipes) PerlLIO_close(pp[0]); -#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) - if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) - RETPUSHUNDEF; -#endif - } if (PL_op->op_flags & OPf_STACKED) { SV * const really = *++MARK; value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes); @@ -2928,6 +2928,9 @@ PERL_CALLCONV void Perl_set_numeric_underlying(pTHX); PERL_CALLCONV void Perl_setdefout(pTHX_ GV* gv); #define PERL_ARGS_ASSERT_SETDEFOUT \ assert(gv) +PERL_CALLCONV void Perl_setfd_cloexec(pTHX_ int fd); +PERL_CALLCONV void Perl_setfd_inhexec(pTHX_ int fd); +PERL_CALLCONV void Perl_setfd_inhexec_for_sysfd(pTHX_ int fd); PERL_CALLCONV char* Perl_setlocale(int category, const char* locale); PERL_CALLCONV HEK* Perl_share_hek(pTHX_ const char* str, SSize_t len, U32 hash); #define PERL_ARGS_ASSERT_SHARE_HEK \ diff --git a/t/io/pipe.t b/t/io/pipe.t index bec1a662b9..f9ee65afe8 100644 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -10,7 +10,7 @@ if (!$Config{'d_fork'}) { skip_all("fork required to pipe"); } else { - plan(tests => 24); + plan(tests => 25); } my $Perl = which_perl(); @@ -138,6 +138,18 @@ sleep 1; next_test; pass(); +SKIP: { + skip "no fcntl", 1 unless $Config{d_fcntl}; + my($r, $w); + pipe($r, $w) || die "pipe: $!"; + my $fdr = fileno($r); + my $fdw = fileno($w); + fresh_perl_is(qq( + print open(F, "<&=$fdr") ? 1 : 0, "\\n"; + print open(F, ">&=$fdw") ? 1 : 0, "\\n"; + ), "0\n0\n", {}, "pipe endpoints not inherited across exec"); +} + # VMS doesn't like spawning subprocesses that are still connected to # STDOUT. Someone should modify these tests to work with VMS. diff --git a/t/io/socket.t b/t/io/socket.t index bba4e4a705..952ff09742 100644 --- a/t/io/socket.t +++ b/t/io/socket.t @@ -46,12 +46,12 @@ my $fork = $Config{d_fork} || $Config{d_pseudofork}; SKIP: { # test it all in TCP - $local or skip("No localhost", 2); + $local or skip("No localhost", 3); ok(socket(my $serv, PF_INET, SOCK_STREAM, $tcp), "make a tcp socket"); my $bind_at = pack_sockaddr_in(0, $local); ok(bind($serv, $bind_at), "bind works") - or skip("Couldn't bind to localhost", 3); + or skip("Couldn't bind to localhost", 4); my $bind_name = getsockname($serv); ok($bind_name, "getsockname() on bound socket"); my ($bind_port) = unpack_sockaddr_in($bind_name); @@ -63,7 +63,7 @@ SKIP: { ok(listen($serv, 5), "listen() works") or diag "listen error: $!"; - $fork or skip("No fork", 1); + $fork or skip("No fork", 2); my $pid = fork; my $send_data = "test" x 50_000; if ($pid) { @@ -73,6 +73,13 @@ SKIP: { ok(my $addr = accept($accept, $serv), "accept() works") or diag "accept error: $!"; binmode $accept; + SKIP: { + skip "no fcntl", 1 unless $Config{d_fcntl}; + my $acceptfd = fileno($accept); + fresh_perl_is(qq( + print open(F, "+<&=$acceptfd") ? 1 : 0, "\\n"; + ), "0\n", {}, "accepted socket not inherited across exec"); + } my $sent_total = 0; while ($sent_total < length $send_data) { my $sent = send($accept, substr($send_data, $sent_total), 0); @@ -91,7 +98,7 @@ SKIP: { ok($shutdown, "shutdown() works"); } elsif (defined $pid) { - curr_test(curr_test()+2); + curr_test(curr_test()+3); #sleep 1; # child ok_child(close($serv), "close server socket in child"); @@ -123,7 +130,7 @@ SKIP: { else { # failed to fork diag "fork() failed $!"; - skip("fork() failed", 1); + skip("fork() failed", 2); } } } @@ -162,6 +169,16 @@ SKIP: ok('RT #7614: still alive after accept($sock, $sock)'); } +SKIP: { + skip "no fcntl", 1 unless $Config{d_fcntl}; + my $sock; + socket($sock, PF_INET, SOCK_STREAM, $tcp) or die "socket: $!"; + my $sockfd = fileno($sock); + fresh_perl_is(qq( + print open(F, "+<&=$sockfd") ? 1 : 0, "\\n"; + ), "0\n", {}, "fresh socket not inherited across exec"); +} + done_testing(); my @child_tests; diff --git a/t/io/socketpair.t b/t/io/socketpair.t new file mode 100644 index 0000000000..a80e411d7d --- /dev/null +++ b/t/io/socketpair.t @@ -0,0 +1,51 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require Config; import Config; + require './test.pl'; + set_up_inc('../lib'); + skip_all_if_miniperl(); + for my $needed (qw(d_socket)) { + if ($Config{$needed} ne 'define') { + skip_all("-- \$Config{$needed} undefined"); + } + } + unless ($Config{extensions} =~ /\bSocket\b/) { + skip_all('-- Socket not available'); + } +} + +use strict; +use IO::Handle; +use Socket; + +{ + socketpair(my $a, my $b, PF_UNIX, SOCK_STREAM, 0) + or skip_all("socketpair() for PF_UNIX failed ($!)"); +} + +plan(tests => 8); + +{ + my($a, $b); + ok socketpair($a, $b, PF_UNIX, SOCK_STREAM, 0), "create socket pair"; + ok($a->printflush("aa\n"), "write one way"); + ok($b->printflush("bb\n"), "write other way"); + is(readline($b), "aa\n", "read one way"); + is(readline($a), "bb\n", "read other way"); + ok(close $a, "close one end"); + ok(close $b, "close other end"); +} + +SKIP: { + skip "no fcntl", 1 unless $Config{d_fcntl}; + my($a, $b); + socketpair($a, $b, PF_UNIX, SOCK_STREAM, 0) or die "socketpair: $!"; + my $fda = fileno($a); + my $fdb = fileno($b); + fresh_perl_is(qq( + print open(F, "+<&=$fda") ? 1 : 0, "\\n"; + print open(F, "+<&=$fdb") ? 1 : 0, "\\n"; + ), "0\n0\n", {}, "sockets not inherited across exec"); +} @@ -2241,7 +2241,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) if (PerlProc_pipe(p) < 0) return NULL; /* Try for another pipe pair for error return */ - if (PerlProc_pipe(pp) >= 0) + if (PerlProc_pipe_cloexec(pp) >= 0) did_pipes = 1; while ((pid = PerlProc_fork()) < 0) { if (errno != EAGAIN) { @@ -2263,14 +2263,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) #define THIS that #define THAT This /* Close parent's end of error status pipe (if any) */ - if (did_pipes) { + if (did_pipes) PerlLIO_close(pp[0]); -#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) - /* Close error pipe automatically if exec works */ - if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) - return NULL; -#endif - } /* Now dup our end of _the_ pipe to right position */ if (p[THIS] != (*mode == 'r')) { PerlLIO_dup2(p[THIS], *mode == 'r'); @@ -2386,7 +2380,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) } if (PerlProc_pipe(p) < 0) return NULL; - if (doexec && PerlProc_pipe(pp) >= 0) + if (doexec && PerlProc_pipe_cloexec(pp) >= 0) did_pipes = 1; while ((pid = PerlProc_fork()) < 0) { if (errno != EAGAIN) { @@ -2409,13 +2403,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) #undef THAT #define THIS that #define THAT This - if (did_pipes) { + if (did_pipes) PerlLIO_close(pp[0]); -#if defined(HAS_FCNTL) && defined(F_SETFD) - if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) - return NULL; -#endif - } if (p[THIS] != (*mode == 'r')) { PerlLIO_dup2(p[THIS], *mode == 'r'); PerlLIO_close(p[THIS]); @@ -4443,7 +4432,7 @@ Perl_seed(pTHX) # define PERL_RANDOM_DEVICE "/dev/urandom" # endif #endif - fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0); + fd = PerlLIO_open_cloexec(PERL_RANDOM_DEVICE, 0); if (fd != -1) { if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u) u = 0; |