view release on metacpan or  search on metacpan

bin/bcvi  view on Meta::CPAN

A wrapper around invoking ssh to connect to a specified host.  Ensures the
environment is set up to pass the authentication key and other data to the
C<bcvi> client on the remote server.
END_POD
    );

    $class->register_option(
        name        => 'version',
        alias       => 'v',
        dispatch_to => 'show_versions',
        summary     => 'display bcvi version number',
        description => <<'END_POD'
When invoking a command use this option to indicate that the arguments are not
filenames and the translation of relative pathnames to absolute should be
skipped.
END_POD
    );

    $class->register_option(
        name        => 'no-path-xlate',
        alias       => 'n',
        summary     => 'skip translation of args from relative to absolute',
        description => <<'END_POD'
Displays the version number of the bcvi client and if applicable, of the
listener process.
END_POD
    );

    $class->register_option(
        name        => 'port',
        alias       => 'p',
        arg_spec    => '=i',
        arg_name    => '<port>',
        summary     => 'port number for listener/port-forward',
        description => <<'END_POD'
When used with C<--listener>, this is the port the server process will listen
on.  When used with C<--wrap-ssh> this is the port number on the remote machine
that will be forwarded back to the listener process.  The default in both cases
is calculated using the user's numeric UID multiplied by 10 and added to 9.
The intent is to reduce the chance of collisions with other bcvi users.
END_POD
    );

    $class->register_option(
        name        => 'command',
        alias       => 'c',
        arg_spec    => '=s',
        arg_name    => '<cmnd>',
        summary     => 'command to send over back-channel',
        description => <<'END_POD'
Use C<cmnd> as the command to send over the back-channel (default: vi).
Recognised commands are described in L<COMMANDS> below.
END_POD
    );

    $class->register_option(
        name        => 'reuse-auth',
        summary     => "don't generate a new auth key on listener startup",
        description => <<'END_POD'
A new (random) authorisation key is generated when the listener process is
started - this will invalidate the keys in use by existing SSH sessions.
This option is for use when it is necessary to restart the listener process
without invalidating client keys.
END_POD
    );

    $class->register_option(
        name        => 'plugin-help',
        arg_spec    => '=s',
        arg_name    => '<plugin>',
        dispatch_to => 'plugin_help',
        summary     => "display documentation for <plugin>",
        description => <<'END_POD'
The --help output includes a list of installed plugins.  Use this option to
read the documentation for a named plugin.
END_POD
    );


    $class->register_command(
        name        => 'vi',
        description => <<'END_POD'
Invokes C<gvim> on the remote file - after translating the host+path to
an scp URI.  This is the default command if no C<--command> option is
specified.  If multiple filenames are supplied, the first will be opened
in gvim and you should use C<:n> to load the 'next' file.
END_POD
    );

    $class->register_command(
        name        => 'viwait',
        description => <<'END_POD'
This command works exactly the same as C<vi> above, except it waits for the
editor process to exit before bcvi exits on the remote machine.  This is
primarily for use with C<sudoedit>.  Note: when used with C<sudoedit>, the file
will not be updated on the remote machine until you exit the editor on your
workstation.
END_POD
    );

    $class->register_command(
        name        => 'scpd',
        description => <<'END_POD'
Uses C<scp> to copy the specified files or directories to the calling user's
F<~/Desktop>.`
END_POD
    );


    $class->add_home_bin();
    $class->register_aliases(
        'test -n "$(which bcvi)" && eval "$(bcvi --unpack-term)"',
        'test -n "${BCVI_CONF}"  && alias vi="bcvi"',
        'test -n "${BCVI_CONF}"  && alias suvi="EDITOR=\'bcvi -c viwait\' sudoedit"',
        'test -n "${BCVI_CONF}"  && alias bcp="bcvi -c scpd"',
    );

    $class->pod_class->init();

}

bin/bcvi  view on Meta::CPAN

        $self->DEBUG("Reusing auth key: $self->{auth_key}");
        return;
    }

    my $data = "$self" . $$ . time() . rand();
    $self->{auth_key} = md5_hex($data);
    $self->DEBUG("Generated new auth key: $self->{auth_key}");

    my $auth_file = $self->auth_key_filename();
    open my $fh, '>', $auth_file or die "open(>$auth_file): $!";
    print $fh $self->{auth_key}, "\n";
}


sub create_listener_socket {
    my($self) = @_;

    my $port = $self->opt('port') || $self->default_port();
    $self->save_port($port);
    my $local_addr = $self->listen_address . ':' .  $port;
    $self->DEBUG("Starting listener on: $local_addr");
    $self->{sock} = IO::Socket::INET->new(
        LocalAddr => $local_addr,
        ReuseAddr => 1,
        Proto     => 'tcp',
        Listen    => 5,
        Blocking  => 1,
    ) or die "Error creating listener for port '$local_addr': $!";
}


sub accept_loop {
    my($self) = @_;

    $SIG{CHLD} = 'IGNORE';  # let Perl reap the zombies

    my $sock = $self->sock();
    while(1) {
        my $new = $sock->accept();
        next if $!{EINTR};
        $self->DEBUG("Accepted connection");
        if(fork()) {  # In parent
            close $new;
        }
        else {        # In child
            close $sock;
            $self->{sock} = $new;
            $self->dispatch_request();
            exit(0);
        }
    }
}


sub dispatch_request {
    my($self) = @_;

    $self->send_response(100);
    my $req = $self->collect_headers();
    $self->DEBUG("Calling host: " . $self->calling_host) if $self->calling_host;
    $self->validate_auth_key($req->{auth_key})
        or $self->exit_response(900);
    $self->DEBUG("Received command: $req->{command}");
    my $method = $self->command_handler($req->{command})
        or $self->exit_response(910);
    $self->DEBUG("Dispatching to: $method");
    $self->$method();
    $self->send_response(200);
}


sub validate_auth_key {
    my($self, $key) = @_;

    return 1 if $key && $key eq $self->auth_key;
    my $alias = $self->calling_host();
    $self->DEBUG("Invalid Auth-Key in request from $alias") if $key;
    return;
}


sub send_response {
    my($self, $code) = @_;

    my $message = $self->message_from_code($code) || 'Invalid response code';
    $message = Encode::encode('utf8', $message);
    $self->DEBUG("Sending response: $code $message");
    $self->sock->write(qq{$code $message\x0A});
}


sub exit_response {
    my($self, $code) = @_;

    $self->send_response($code);
    exit(0);
}


sub collect_headers {
    my($self) = @_;

    my $sock = $self->sock();
    my $req  = {};
    while(my($line) = $sock->getline() || '') {
        chomp($line);
        last if $line eq '';
        $line = Encode::decode('utf8', $line);
        if(my($name, $value) = $line =~ m{^(\S+)\s*:\s*(.*)$}) {
            $name =~ s/-/_/;
            $req->{lc($name)} = $value;
        }
    }
    $self->{request} = $req;
}


sub read_request_body {
    my($self) = @_;

    my $bytes = $self->request->{content_length};
    my $sock  = $self->sock();
    my $buf   = '';
    while(my $count = $sock->read($buf, $bytes, length($buf))) {
        $bytes -= $count;
        last if $bytes < 1;
    }
    return $buf;
}


sub get_filenames {