git.sur5r.net Git - i3/i3/blob - testcases/lib/StartXServer.pm

   1 package StartXServer;
   2 # vim:ts=4:sw=4:expandtab
   3
   4 use strict;
   5 use warnings;
   6 use Exporter 'import';
   7 use Time::HiRes qw(sleep);
   8 use i3test::Util qw(slurp);
   9 use v5.10;
  10
  11 our @EXPORT = qw(start_xserver);
  12
  13 my @pids;
  14 my $x_socketpath = '/tmp/.X11-unix/X';
  15
  16 # forks an X server process
  17 sub fork_xserver {
  18     my $keep_xserver_output = shift;
  19     my $displaynum = shift;
  20     my $pid = fork();
  21     die "Could not fork: $!" unless defined($pid);
  22     if ($pid == 0) {
  23         # Child, close stdout/stderr, then start Xephyr
  24         if (!$keep_xserver_output) {
  25             close STDOUT;
  26             close STDERR;
  27         }
  28
  29         exec @_;
  30         exit 1;
  31     }
  32     push(@complete_run::CLEANUP, sub {
  33         kill(15, $pid);
  34         # Unlink the X11 socket, Xdmx seems to leave it there.
  35         unlink($x_socketpath . $displaynum);
  36     });
  37
  38     push @pids, $pid;
  39
  40     return $x_socketpath . $displaynum;
  41 }
  42
  43 # Blocks until the socket paths specified in the given array reference actually
  44 # exist.
  45 sub wait_for_x {
  46     my ($sockets_waiting) = @_;
  47
  48     # Wait until Xdmx actually runs. Pretty ugly solution, but as long as we
  49     # can’t socket-activate X11…
  50     while (1) {
  51         @$sockets_waiting = grep { ! -S $_ } @$sockets_waiting;
  52         last unless @$sockets_waiting;
  53         sleep 0.1;
  54     }
  55 }
  56
  57 =head2 start_xserver($parallel)
  58
  59 Starts C<$parallel> (or number of cores * 2 if undef) Xephyr processes (see
  60 https://www.freedesktop.org/wiki/Software/Xephyr/) and returns two arrayrefs: a
  61 list of X11 display numbers to the Xephyr processes and a list of PIDs of the
  62 processes.
  63
  64 =cut
  65
  66 sub start_xserver {
  67     my ($parallel, $numtests, $keep_xserver_output) = @_;
  68
  69     my @displays = ();
  70     my @childpids = ();
  71
  72     # Yeah, I know it’s non-standard, but Perl’s POSIX module doesn’t have
  73     # _SC_NPROCESSORS_CONF.
  74     my $num_cores;
  75     if (-e '/proc/cpuinfo') {
  76         my $cpuinfo = slurp('/proc/cpuinfo');
  77         $num_cores = scalar grep { /model name/ } split("\n", $cpuinfo);
  78     }
  79     # If /proc/cpuinfo does not exist, we fall back to 2 cores.
  80     $num_cores ||= 2;
  81
  82     # If unset, we use num_cores * 2.
  83     $parallel ||= ($num_cores * 2);
  84
  85     # If we are running a small number of tests, don’t over-parallelize.
  86     $parallel = $numtests if $numtests < $parallel;
  87
  88     # First get the last used display number, then increment it by one.
  89     # Effectively falls back to 1 if no X server is running.
  90     my ($displaynum) = map { /(\d+)$/ } reverse sort glob($x_socketpath . '*');
  91     $displaynum++;
  92
  93     say "Starting $parallel Xephyr instances, starting at :$displaynum...";
  94
  95     $SIG{CHLD} = sub {
  96         my $child = waitpid -1, POSIX::WNOHANG;
  97         @pids = grep { $_ != $child } @pids;
  98         return unless @pids == 0;
  99         print STDERR "All X server processes died.\n";
 100         print STDERR "Use ./complete-run.pl --parallel 1 --keep-xserver-output\n";
 101         exit 1;
 102     };
 103
 104     my @sockets_waiting;
 105     for (1 .. $parallel) {
 106         my $socket = fork_xserver($keep_xserver_output, $displaynum,
 107                 'Xephyr', ":$displaynum", '-screen', '1280x800',
 108                 '-nolisten', 'tcp');
 109         push(@displays, ":$displaynum");
 110         push(@sockets_waiting, $socket);
 111         $displaynum++;
 112     }
 113
 114     wait_for_x(\@sockets_waiting);
 115
 116     return @displays;
 117 }
 118
 119 1