Commit | Line | Data |
a9fdb55e |
1 | package Object::Remote::Connector::LocalSudo; |
2 | |
7efea51f |
3 | use Symbol qw(gensym); |
1b315002 |
4 | use Module::Runtime qw(use_module); |
7efea51f |
5 | use IPC::Open3; |
a9fdb55e |
6 | use Moo; |
7 | |
8 | extends 'Object::Remote::Connector::Local'; |
9 | |
1b315002 |
10 | has target_user => (is => 'ro', required => 1); |
11 | |
12 | has password_callback => (is => 'lazy'); |
13 | |
14 | sub _build_password_callback { |
15 | my ($self) = @_; |
16 | my $pw_prompt = use_module('Object::Remote::Prompt')->can('prompt_pw'); |
17 | my $user = $self->target_user; |
18 | return sub { |
19 | $pw_prompt->("sudo password for ${user}", undef, { cache => 1 }) |
20 | } |
21 | } |
7efea51f |
22 | |
498c4ad5 |
23 | has sudo_perl_command => (is => 'lazy'); |
24 | |
25 | sub _build_sudo_perl_command { |
1b315002 |
26 | my ($self) = @_; |
7efea51f |
27 | return |
1b315002 |
28 | 'sudo', '-S', '-u', $self->target_user, '-p', "[sudo] password please\n", |
7efea51f |
29 | 'perl', '-MPOSIX=dup2', |
859f4451 |
30 | '-e', 'print STDERR "GO\n"; exec(@ARGV);', |
498c4ad5 |
31 | $self->perl_command; |
7efea51f |
32 | } |
33 | |
34 | sub _start_perl { |
35 | my $self = shift; |
7efea51f |
36 | my $sudo_stderr = gensym; |
37 | my $pid = open3( |
38 | my $foreign_stdin, |
39 | my $foreign_stdout, |
40 | $sudo_stderr, |
498c4ad5 |
41 | @{$self->sudo_perl_command} |
7efea51f |
42 | ) or die "open3 failed: $!"; |
43 | chomp(my $line = <$sudo_stderr>); |
44 | if ($line eq "GO") { |
45 | # started already, we're good |
46 | } elsif ($line =~ /\[sudo\]/) { |
47 | my $cb = $self->password_callback; |
48 | die "sudo sent ${line} but we have no password callback" |
49 | unless $cb; |
50 | print $foreign_stdin $cb->($line, @_), "\n"; |
51 | chomp($line = <$sudo_stderr>); |
aa052874 |
52 | if ($line and $line ne 'GO') { |
53 | die "sent password and expected newline from sudo, got ${line}"; |
54 | } |
55 | elsif (not $line) { |
56 | chomp($line = <$sudo_stderr>); |
57 | die "sent password but next line was ${line}" |
58 | unless $line eq "GO"; |
59 | } |
7efea51f |
60 | } else { |
61 | die "Got inexplicable line ${line} trying to sudo"; |
62 | }; |
859f4451 |
63 | Object::Remote->current_loop |
64 | ->watch_io( |
65 | handle => $sudo_stderr, |
66 | on_read_ready => sub { |
2d81cf18 |
67 | #TODO is there a specific reason sysread() and syswrite() aren't |
68 | #a part of ::MiniLoop? It's one spot to handle errors and other |
69 | #logic involving filehandles |
07105aca |
70 | Dlog_debug { "LocalSudo: Preparing to read data from $_" } $sudo_stderr; |
71 | if (sysread($sudo_stderr, my $buf, 32768) > 0) { |
2d81cf18 |
72 | log_trace { "LocalSudo: successfully read data, printing it to STDERR" }; |
859f4451 |
73 | print STDERR $buf; |
2d81cf18 |
74 | log_trace { "LocalSudo: print() to STDERR is done" }; |
859f4451 |
75 | } else { |
2d81cf18 |
76 | log_debug { "LocalSudo: received EOF or error on file handle, unwatching it" }; |
859f4451 |
77 | Object::Remote->current_loop |
78 | ->unwatch_io( |
79 | handle => $sudo_stderr, |
80 | on_read_ready => 1 |
81 | ); |
82 | } |
83 | } |
84 | ); |
7efea51f |
85 | return ($foreign_stdin, $foreign_stdout, $pid); |
a9fdb55e |
86 | }; |
87 | |
7efea51f |
88 | no warnings 'once'; |
89 | |
a9fdb55e |
90 | push @Object::Remote::Connection::Guess, sub { |
91 | for ($_[0]) { |
92 | # username followed by @ |
93 | if (defined and !ref and /^ ([^\@]*?) \@ $/x) { |
69aaad21 |
94 | shift(@_); |
95 | return __PACKAGE__->new(@_, target_user => $1); |
a9fdb55e |
96 | } |
97 | } |
98 | return; |
99 | }; |
100 | |
101 | 1; |