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