Commit | Line | Data |
a9fdb55e |
1 | package Object::Remote::Connector::LocalSudo; |
2 | |
7efea51f |
3 | use Symbol qw(gensym); |
4 | use IPC::Open3; |
a9fdb55e |
5 | use Moo; |
6 | |
7 | extends 'Object::Remote::Connector::Local'; |
8 | |
7efea51f |
9 | has password_callback => (is => 'ro'); |
10 | |
11 | sub _sudo_perl_command { |
859f4451 |
12 | my ($self, $target_user) = @_; |
7efea51f |
13 | return |
14 | 'sudo', '-S', '-u', $target_user, '-p', "[sudo] password please\n", |
15 | 'perl', '-MPOSIX=dup2', |
859f4451 |
16 | '-e', 'print STDERR "GO\n"; exec(@ARGV);', |
17 | $self->_perl_command($target_user); |
7efea51f |
18 | } |
19 | |
20 | sub _start_perl { |
21 | my $self = shift; |
7efea51f |
22 | my $sudo_stderr = gensym; |
23 | my $pid = open3( |
24 | my $foreign_stdin, |
25 | my $foreign_stdout, |
26 | $sudo_stderr, |
859f4451 |
27 | $self->_sudo_perl_command(@_) |
7efea51f |
28 | ) or die "open3 failed: $!"; |
29 | chomp(my $line = <$sudo_stderr>); |
30 | if ($line eq "GO") { |
31 | # started already, we're good |
32 | } elsif ($line =~ /\[sudo\]/) { |
33 | my $cb = $self->password_callback; |
34 | die "sudo sent ${line} but we have no password callback" |
35 | unless $cb; |
36 | print $foreign_stdin $cb->($line, @_), "\n"; |
37 | chomp($line = <$sudo_stderr>); |
dac97b35 |
38 | die "sent password and expected newline from sudo, got ${line}" |
39 | if $line; |
40 | chomp($line = <$sudo_stderr>); |
7efea51f |
41 | die "sent password but next line was ${line}" |
42 | unless $line eq "GO"; |
43 | } else { |
44 | die "Got inexplicable line ${line} trying to sudo"; |
45 | }; |
859f4451 |
46 | Object::Remote->current_loop |
47 | ->watch_io( |
48 | handle => $sudo_stderr, |
49 | on_read_ready => sub { |
50 | if (sysread($sudo_stderr, my $buf, 1024) > 0) { |
51 | print STDERR $buf; |
52 | } else { |
53 | Object::Remote->current_loop |
54 | ->unwatch_io( |
55 | handle => $sudo_stderr, |
56 | on_read_ready => 1 |
57 | ); |
58 | } |
59 | } |
60 | ); |
7efea51f |
61 | return ($foreign_stdin, $foreign_stdout, $pid); |
a9fdb55e |
62 | }; |
63 | |
7efea51f |
64 | no warnings 'once'; |
65 | |
a9fdb55e |
66 | push @Object::Remote::Connection::Guess, sub { |
67 | for ($_[0]) { |
68 | # username followed by @ |
69 | if (defined and !ref and /^ ([^\@]*?) \@ $/x) { |
70 | return __PACKAGE__->new->connect($1); |
71 | } |
72 | } |
73 | return; |
74 | }; |
75 | |
76 | 1; |