1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use IO::Async::Test; 7 8use Test::More; 9 10use IO::Async::Loop; 11use IO::Async::OS; 12 13plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK; 14 15use POSIX qw( WEXITSTATUS ); 16 17# These tests check the parts of Loop->spawn_child that need to be root to 18# work. Since we're unlikely to be root, skip the lot if we're not. 19 20unless( $< == 0 ) { 21 plan skip_all => "not root"; 22} 23 24is( $>, 0, 'am root'); 25 26my $loop = IO::Async::Loop->new_builtin; 27 28testing_loop( $loop ); 29 30my ( $exitcode, $dollarbang, $dollarat ); 31 32$loop->spawn_child( 33 code => sub { return $> }, 34 setup => [ setuid => 10 ], 35 on_exit => sub { ( undef, $exitcode, $dollarbang, $dollarat ) = @_ }, 36); 37 38wait_for { defined $exitcode }; 39 40is( WEXITSTATUS($exitcode), 10, 'setuid' ); 41 42$loop->spawn_child( 43 code => sub { return $) }, 44 setup => [ setgid => 10 ], 45 on_exit => sub { ( undef, $exitcode, $dollarbang, $dollarat ) = @_ }, 46); 47 48undef $exitcode; 49wait_for { defined $exitcode }; 50 51is( WEXITSTATUS($exitcode), 10, 'setgid' ); 52 53$loop->spawn_child( 54 code => sub { return $) =~ m/ 5 / }, 55 setup => [ setgroups => [ 4, 5, 6 ] ], 56 on_exit => sub { ( undef, $exitcode, $dollarbang, $dollarat ) = @_ }, 57); 58 59undef $exitcode; 60wait_for { defined $exitcode }; 61 62is( WEXITSTATUS($exitcode), 1, 'setgroups' ); 63 64my $child_out; 65 66$loop->run_child( 67 code => sub { 68 print "EUID: $>\n"; 69 my ( $gid, @groups ) = split( m/ /, $) ); 70 print "EGID: $gid\n"; 71 print "Groups: " . join( " ", sort { $a <=> $b } @groups ) . "\n"; 72 return 0; 73 }, 74 setup => [ 75 setgid => 10, 76 setgroups => [ 4, 5, 6, 10 ], 77 setuid => 20, 78 ], 79 on_finish => sub { ( undef, $exitcode, $child_out ) = @_; }, 80); 81 82undef $exitcode; 83wait_for { defined $exitcode }; 84 85is( $child_out, 86 "EUID: 20\nEGID: 10\nGroups: 4 5 6 10\n", 87 'combined setuid/gid/groups' ); 88 89done_testing; 90