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

   1 package SocketActivation;
   2 # vim:ts=4:sw=4:expandtab
   3
   4 use strict;
   5 use warnings;
   6 use IO::Socket::UNIX; # core
   7 use Cwd qw(abs_path); # core
   8 use POSIX qw(:fcntl_h); # core
   9 use AnyEvent::Handle; # not core
  10 use Exporter 'import';
  11 use v5.10;
  12
  13 our @EXPORT = qw(activate_i3);
  14
  15 #
  16 # Starts i3 using socket activation. Creates a listening socket (with bind +
  17 # listen) which is then passed to i3, who in turn calls accept and handles the
  18 # requests.
  19 #
  20 # Since the kernel buffers the connect, the parent process can connect to the
  21 # socket immediately after forking. It then sends a request and waits until it
  22 # gets an answer. Obviously, i3 has to be initialized to actually answer the
  23 # request.
  24 #
  25 # This way, we can wait *precisely* the amount of time which i3 waits to get
  26 # ready, which is a *HUGE* speed gain (and a lot more robust) in comparison to
  27 # using sleep() with a fixed amount of time.
  28 #
  29 # unix_socket_path: Location of the socket to use for the activation
  30 # display: X11 $ENV{DISPLAY}
  31 # configfile: path to the configuration file to use
  32 # logpath: path to the logfile to which i3 will append
  33 # cv: an AnyEvent->condvar which will be triggered once i3 is ready
  34 #
  35 sub activate_i3 {
  36     my %args = @_;
  37
  38     # remove the old unix socket
  39     unlink($args{unix_socket_path});
  40
  41     my $socket = IO::Socket::UNIX->new(
  42         Listen => 1,
  43         Local => $args{unix_socket_path},
  44     );
  45
  46     my $pid = fork;
  47     if (!defined($pid)) {
  48         die "could not fork()";
  49     }
  50     if ($pid == 0) {
  51         $ENV{LISTEN_PID} = $$;
  52         $ENV{LISTEN_FDS} = 1;
  53         delete $ENV{DESKTOP_STARTUP_ID};
  54         $ENV{DISPLAY} = $args{display};
  55         $ENV{PATH} = join(':',
  56             '../i3-nagbar',
  57             '../i3-msg',
  58             '../i3-config-wizard',
  59             '../i3bar',
  60             '..',
  61             $ENV{PATH}
  62         );
  63
  64         # We are about to exec, but we did not modify $^F to include $socket
  65         # when creating the socket (because the file descriptor could have a
  66         # number != 3 which would lead to i3 leaking a file descriptor). This
  67         # caused Perl to set the FD_CLOEXEC flag, which would close $socket on
  68         # exec(), effectively *NOT* passing $socket to the new process.
  69         # Therefore, we explicitly clear FD_CLOEXEC (the only flag right now)
  70         # by setting the flags to 0.
  71         POSIX::fcntl($socket, F_SETFD, 0) or die "Could not clear fd flags: $!";
  72
  73         # If the socket does not use file descriptor 3 by chance already, we
  74         # close fd 3 and dup2() the socket to 3.
  75         if (fileno($socket) != 3) {
  76             POSIX::close(3);
  77             POSIX::dup2(fileno($socket), 3);
  78             POSIX::close(fileno($socket));
  79         }
  80
  81         # Construct the command to launch i3. Use maximum debug level, disable
  82         # the interactive signalhandler to make it crash immediately instead.
  83         my $i3cmd = abs_path("../i3") . " -V -d all --disable-signalhandler";
  84
  85         # For convenience:
  86         my $outdir = $args{outdir};
  87         my $test = $args{testname};
  88
  89         if ($args{valgrind}) {
  90             $i3cmd =
  91                 qq|valgrind -v --log-file="$outdir/valgrind-for-$test.log" | .
  92                 qq|--leak-check=full --track-origins=yes --num-callers=20 | .
  93                 qq|--tool=memcheck -- $i3cmd|;
  94         }
  95
  96         my $logfile = "$outdir/i3-log-for-$test";
  97         # Append to $logfile instead of overwriting because i3 might be
  98         # run multiple times in one testcase.
  99         my $cmd = "exec $i3cmd -c $args{configfile} >>$logfile 2>&1";
 100
 101         if ($args{strace}) {
 102             my $out = "$outdir/strace-for-$test.log";
 103
 104             # We overwrite LISTEN_PID with the correct process ID to make
 105             # socket activation work (LISTEN_PID has to match getpid(),
 106             # otherwise the LISTEN_FDS will be treated as a left-over).
 107             $cmd = qq|strace -fF -s2048 -v -o "$out" -- | .
 108                      'sh -c "export LISTEN_PID=\$\$; ' . $cmd . '"';
 109         }
 110
 111         # We need to use the shell due to using output redirections.
 112         exec '/bin/sh', '-c', $cmd;
 113
 114         # if we are still here, i3 could not be found or exec failed. bail out.
 115         exit 1;
 116     }
 117
 118     # close the socket, the child process should be the only one which keeps a file
 119     # descriptor on the listening socket.
 120     $socket->close;
 121
 122     # We now connect (will succeed immediately) and send a request afterwards.
 123     # As soon as the reply is there, i3 is considered ready.
 124     my $cl = IO::Socket::UNIX->new(Peer => $args{unix_socket_path});
 125     my $hdl;
 126     $hdl = AnyEvent::Handle->new(
 127         fh => $cl,
 128         on_error => sub {
 129             $hdl->destroy;
 130             $args{cv}->send(0);
 131         });
 132
 133     # send a get_tree message without payload
 134     $hdl->push_write('i3-ipc' . pack("LL", 0, 4));
 135
 136     # wait for the reply
 137     $hdl->push_read(chunk => 1, => sub {
 138         my ($h, $line) = @_;
 139         $args{cv}->send(1);
 140         undef $hdl;
 141     });
 142
 143     return $pid;
 144 }
 145
 146 1