add Object::Remote->connect
[scpubgit/Object-Remote.git] / lib / Object / Remote / Connector / LocalSudo.pm
CommitLineData
a9fdb55e 1package Object::Remote::Connector::LocalSudo;
2
7efea51f 3use Symbol qw(gensym);
4use IPC::Open3;
a9fdb55e 5use Moo;
6
7extends 'Object::Remote::Connector::Local';
8
7efea51f 9has password_callback => (is => 'ro');
10
11sub _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
20sub _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 64no warnings 'once';
65
a9fdb55e 66push @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
761;