view release on metacpan or  search on metacpan

lib/Net/SSH/Perl.pm  view on Meta::CPAN

sub set_protocol {
    my $ssh = shift;
    my $proto = shift;
    $ssh->{use_protocol} = $proto;
    my $proto_class = join '::', __PACKAGE__,
        ($proto == PROTOCOL_SSH2 ? "SSH2" : "SSH1");
    (my $lib = $proto_class . ".pm") =~ s!::!/!g;
    require $lib;
    bless $ssh, $proto_class;
    $ssh->debug($proto_class->version_string);
    $ssh->_proto_init;
}

use vars qw( @COMPAT );
@COMPAT = (
  [  '^OpenSSH[-_]2\.[012]' => SSH_COMPAT_OLD_SESSIONID,   ],
  [  'MindTerm'             => 0,                          ],
  [  '^2\.1\.0 '            => SSH_COMPAT_BUG_SIGBLOB |
                               SSH_COMPAT_BUG_HMAC |
                               SSH_COMPAT_OLD_SESSIONID,   ],
  [  '^2\.0\.'              => SSH_COMPAT_BUG_SIGBLOB |
                               SSH_COMPAT_BUG_HMAC |
                               SSH_COMPAT_OLD_SESSIONID |
                               SSH_COMPAT_BUG_PUBKEYAUTH |
                               SSH_COMPAT_BUG_X11FWD,      ],
  [  '^2\.[23]\.0 '         => SSH_COMPAT_BUG_HMAC,        ],
  [  '^2\.[2-9]\.'          => 0,                          ],
  [  '^2\.4$'               => SSH_COMPAT_OLD_SESSIONID,   ],
  [  '^3\.0 SecureCRT'      => SSH_COMPAT_OLD_SESSIONID,   ],
  [  '^1\.7 SecureFX'       => SSH_COMPAT_OLD_SESSIONID,   ],
  [  '^2\.'                 => SSH_COMPAT_BUG_HMAC,        ],
);

sub _compat_init {
    my $ssh = shift;
    my($version) = @_;
    $ssh->{datafellows} = 0;
    for my $rec (@COMPAT) {
        my($re, $mask) = @$rec[0, 1];
        if ($version =~ /$re/) {
            $ssh->debug("Compat match: '$version' matches pattern '$re'.");
            $ssh->{datafellows} = $mask;
            return;
        }
    }
    $ssh->debug("No compat match: $version.");
}

sub version_string { }

sub client_version_string { $_[0]->{client_version_string} }
sub server_version_string { $_[0]->{server_version_string} }

sub _current_user {
    if ( $^O eq 'MSWin32' ) {
        return _current_user_win32();
    }

    my $user;
    eval { $user = scalar getpwuid $> };
    return $user;
}

sub _init {
    my $ssh = shift;

    my %arg = @_;
    my $user_config = delete $arg{user_config}
      || catfile($ENV{HOME} || $ENV{USERPROFILE}, '.ssh', 'config');
    my $sys_config  = delete $arg{sys_config}
      || $^O eq 'MSWin32'
        ? catfile($ENV{WINDIR}, 'ssh_config')
        : "/etc/ssh_config";

    my $directives = delete $arg{options} || [];

    if (my $proto = delete $arg{protocol}) {
        push @$directives, "Protocol $proto";
    }

    my $cfg = Net::SSH::Perl::Config->new($ssh->{host}, %arg);
    $ssh->{config} = $cfg;

    # Merge config-format directives given through "options"
    # (just like -o option to ssh command line). Do this before
    # reading config files so we override files.
    for my $d (@$directives) {
        $cfg->merge_directive($d);
    }

    for my $f (($user_config, $sys_config)) {
        $ssh->debug("Reading configuration data $f");
        $cfg->read_config($f);
    }

    if (my $real_host = $ssh->{config}->get('hostname')) {
        $ssh->{host} = $real_host;
    }

    my $user = _current_user();
    if ($user && $user eq "root" &&
      !defined $ssh->{config}->get('privileged')) {
        $ssh->{config}->set('privileged', 1);
    }

    unless ($ssh->{config}->get('protocol')) {
        $ssh->{config}->set('protocol',
            PROTOCOL_SSH1 | PROTOCOL_SSH2 | PROTOCOL_SSH1_PREFERRED);
    }

    unless (defined $ssh->{config}->get('password_prompt_login')) {
        $ssh->{config}->set('password_prompt_login', 1);
    }
    unless (defined $ssh->{config}->get('password_prompt_host')) {
        $ssh->{config}->set('password_prompt_host', 1);
    }
    unless (defined $ssh->{config}->get('number_of_password_prompts')) {
        $ssh->{config}->set('number_of_password_prompts', 3);
    }
}