perl/t/02-unix_domain_socket.t

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config;
   7 use FCGI;
   8 use FCGI::Client;
   9 use File::Temp qw(tempfile);
  10 use IO::Socket;
  11 use Test::More 'tests' => 4;
  12
  13 BEGIN {
  14     my $reason;
  15     my $can_fork = $Config{d_fork}
  16         || (
  17             ($^O eq 'MSWin32' || $^O eq 'NetWare')
  18             and $Config{useithreads}
  19             and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
  20         );
  21     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
  22         $reason = 'Socket extension unavailable';
  23     } elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
  24         $reason = 'IO extension unavailable';
  25     } elsif ($^O eq 'os2') {
  26         eval { IO::Socket::pack_sockaddr_un('/foo/bar') || 1 };
  27         if ($@ !~ /not implemented/) {
  28             $reason = 'compiled without TCP/IP stack v4';
  29         }
  30     } elsif ($^O =~ m/^(?:qnx|nto|vos)$/ ) {
  31         $reason = "UNIX domain sockets not implemented on $^O";
  32     } elsif (! $can_fork) {
  33         $reason = 'no fork';
  34     } elsif ($^O eq 'MSWin32') {
  35         if ($ENV{CONTINUOUS_INTEGRATION}) {
  36             # https://github.com/Perl/perl5/issues/17429
  37             $reason = 'Skipping on Windows CI';
  38         } else {
  39             # https://github.com/Perl/perl5/issues/17575
  40             if (! eval { socket(my $sock, PF_UNIX, SOCK_STREAM, 0) }) {
  41                 $reason = "AF_UNIX unavailable or disabled on this platform"
  42             }
  43         }
  44     }
  45
  46     if ($reason) {
  47         print "1..0 # Skip: $reason\n";
  48         exit 0;
  49     }
  50 }
  51
  52 my (undef, $unix_socket_file) = tempfile();
  53 my $fcgi_socket = FCGI::OpenSocket($unix_socket_file, 5);
  54
  55 # Client
  56 if (my $pid = fork()) {
  57     my $right_ret = <<'END';
  58 Content-Type: text/plain
  59
  60 END
  61
  62     my ($stdout, $stderr) = client_request($unix_socket_file);
  63     is($stdout, $right_ret."0\n", 'Test first round on stdout.');
  64     is($stderr, undef, 'Test first round on stderr.');
  65
  66     ($stdout, $stderr) = client_request($unix_socket_file);
  67     is($stdout, $right_ret."1\n", 'Test second round on stdout.');
  68     is($stderr, undef, 'Test second round on stderr.');
  69
  70 # Server
  71 } elsif (defined $pid) {
  72     my $request = FCGI::Request(\*STDIN, \*STDOUT, \*STDERR, \%ENV, $fcgi_socket);
  73
  74     # Only two cycles.
  75     my $count = 0;
  76     while ($count < 2 && $request->Accept() >= 0) {
  77         print "Content-Type: text/plain\n\n";
  78         print $count++."\n";
  79     }
  80     exit;
  81
  82 } else {
  83     die $!;
  84 }
  85
  86 # Cleanup.
  87 FCGI::CloseSocket($fcgi_socket);
  88 unlink $unix_socket_file;
  89
  90 sub client_request {
  91         my $unix_socket_file = shift;
  92
  93         my $sock = IO::Socket::UNIX->new(
  94                 Peer => $unix_socket_file,
  95         ) or die $!;
  96         my $client = FCGI::Client::Connection->new(sock => $sock);
  97         my ($stdout, $stderr) = $client->request({
  98                 REQUEST_METHOD => 'GET',
  99         }, '');
 100
 101         return ($stdout, $stderr);
 102 }