File Coverage

blib/lib/Protocol/DBus/Authn/Mechanism/EXTERNAL.pm
Criterion Covered Total %
statement 22 43 51.1
branch 3 10 30.0
condition 2 9 22.2
subroutine 6 8 75.0
pod 0 4 0.0
total 33 74 44.5


line stmt bran cond sub pod time code
1             package Protocol::DBus::Authn::Mechanism::EXTERNAL;
2              
3 5     5   84999 use strict;
  5         10  
  5         116  
4 5     5   17 use warnings;
  5         10  
  5         110  
5              
6 5     5   21 use parent 'Protocol::DBus::Authn::Mechanism';
  5         6  
  5         27  
7              
8 5     5   507 use Protocol::DBus::Socket ();
  5         12  
  5         1725  
9              
10             # The methods of user credential retrieval that the reference D-Bus
11             # server relies on prefer “out-of-band” methods like SO_PEERCRED
12             # on Linux rather than SCM_CREDS. (See See dbus/dbus-sysdeps-unix.c.)
13             # So for some OSes it’s just not necessary to do anything special to
14             # send credentials.
15             #
16             # This list is exposed for the sake of tests.
17             #
18             our @_OS_NO_MSGHDR_LIST = (
19              
20             # Reference server doesn’t need our help:
21             'linux',
22             'netbsd', # via LOCAL_PEEREID, which dbus calls
23              
24             # MacOS works, though … ??
25             'darwin',
26              
27             # 'openbsd', ??? Still trying to test.
28              
29             # No way to pass credentials via UNIX socket,
30             # so let’s just send EXTERNAL and see what happens.
31             # It’ll likely just fail over to DBUS_COOKIE_SHA1.
32             'cygwin',
33             'mswin32',
34             );
35              
36 1     1 0 59 sub INITIAL_RESPONSE { unpack 'H*', $> }
37              
38             # The reference server implementation does a number of things to try to
39             # fetch the peer credentials. .
40             sub must_send_initial {
41 6     6 0 20 my ($self) = @_;
42              
43 6 100       33 if (!defined $self->{'_must_send_initial'}) {
44              
45 5         15 my $can_skip_msghdr = grep { $_ eq $^O } @_OS_NO_MSGHDR_LIST;
  25         56  
46              
47 5   33     14 $can_skip_msghdr ||= eval { my $v = Socket::SO_PEERCRED(); 1 };
  0         0  
  0         0  
48 5   33     11 $can_skip_msghdr ||= eval { my $v = Socket::LOCAL_PEEREID(); 1 };
  0         0  
  0         0  
49              
50 5 50       14 if (!$can_skip_msghdr) {
51 0 0       0 eval { require Socket::MsgHdr; 1 } or do {
  0         0  
  0         0  
52 0         0 $self->{'_failed_socket_msghdr'} = $@;
53             };
54              
55 0         0 $can_skip_msghdr = 1;
56             }
57              
58             # As of this writing it seems FreeBSD and DragonflyBSD do require
59             # Socket::MsgHdr, even though they both have LOCAL_PEERCRED which
60             # should take care of that.
61 5         24 $self->{'_must_send_initial'} = !$can_skip_msghdr;
62             }
63              
64 6         19 return $self->{'_must_send_initial'};
65             }
66              
67             sub on_rejected {
68 0     0 0   my ($self) = @_;
69              
70 0 0         if ($self->{'_failed_socket_msghdr'}) {
71 0           warn "EXTERNAL authentication failed. Socket::MsgHdr failed to load earlier; maybe making it available would fix this? (Load failure was: $@)";
72             }
73              
74 0           return;
75             }
76              
77             sub send_initial {
78 0     0 0   my ($self, $s) = @_;
79              
80 0           my $msg = Socket::MsgHdr->new( buf => "\0" );
81              
82             # The kernel should fill in the payload.
83 0           $msg->cmsghdr( Socket::SOL_SOCKET(), Socket::SCM_CREDS(), "\0" x 64 );
84              
85 0           local $!;
86 0           my $ok = Protocol::DBus::Socket::sendmsg_nosignal($s, $msg, 0);
87              
88 0 0 0       if (!$ok && !$!{'EAGAIN'}) {
89 0           die "sendmsg($s): $!";
90             }
91              
92 0           return $ok;
93             }
94              
95             1;