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

   1 package StartXDummy;
   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 v5.10;
   9
  10 our @EXPORT = qw(start_xdummy);
  11
  12 # reads in a whole file
  13 sub slurp {
  14     open(my $fh, '<', shift) or return '';
  15     local $/;
  16     <$fh>;
  17 }
  18
  19 =head2 start_xdummy($parallel)
  20
  21 Starts C<$parallel> (or number of cores * 2 if undef) Xdummy processes (see
  22 the file ./Xdummy) and returns two arrayrefs: a list of X11 display numbers to
  23 the Xdummy processes and a list of PIDs of the processes.
  24
  25 =cut
  26 sub start_xdummy {
  27     my ($parallel) = @_;
  28
  29     my @displays = ();
  30     my @childpids = ();
  31
  32     # Yeah, I know it’s non-standard, but Perl’s POSIX module doesn’t have
  33     # _SC_NPROCESSORS_CONF.
  34     my $cpuinfo = slurp('/proc/cpuinfo');
  35     my $num_cores = scalar grep { /model name/ } split("\n", $cpuinfo);
  36     # If /proc/cpuinfo does not exist, we fall back to 2 cores.
  37     $num_cores ||= 2;
  38
  39     $parallel ||= $num_cores * 2;
  40
  41     # First get the last used display number, then increment it by one.
  42     # Effectively falls back to 1 if no X server is running.
  43     my ($displaynum) = reverse ('0', sort </tmp/.X11-unix/X*>);
  44     $displaynum =~ s/.*(\d)$/$1/;
  45     $displaynum++;
  46
  47     say "Starting $parallel Xdummy instances, starting at :$displaynum...";
  48
  49     for my $idx (0 .. ($parallel-1)) {
  50         my $pid = fork();
  51         die "Could not fork: $!" unless defined($pid);
  52         if ($pid == 0) {
  53             # Child, close stdout/stderr, then start Xdummy.
  54             close STDOUT;
  55             close STDERR;
  56             # We use -config /dev/null to prevent Xdummy from using the system
  57             # Xorg configuration. The tests should be independant from the
  58             # actual system X configuration.
  59             exec './Xdummy', ":$displaynum", '-config', '/dev/null';
  60             exit 1;
  61         }
  62         push(@childpids, $pid);
  63         push(@displays, ":$displaynum");
  64         $displaynum++;
  65     }
  66
  67     # Wait until the X11 sockets actually appear. Pretty ugly solution, but as
  68     # long as we can’t socket-activate X11…
  69     my $sockets_ready;
  70     do {
  71         $sockets_ready = 1;
  72         for (@displays) {
  73             my $path = "/tmp/.X11-unix/X" . substr($_, 1);
  74             $sockets_ready = 0 unless -S $path;
  75         }
  76         sleep 0.1;
  77     } until $sockets_ready;
  78
  79     return \@displays, \@childpids;
  80 }
  81
  82 1