#
# This is a modified version of Net::SSH::W32Perl, written by Scott Sc
+ecina,
# to add SOCKS functionality. To use the SOCKS functionality you need 
+to
# utilize the new Net::SSH::Perl::Config data items:
#        my $ssh->new(target.machine.com, socks_proxy=>'proxy.machine.
+com',
#                socks_port=>123, socks_protocol=>5);
#
package mySSH;

use strict;
use English;
use Carp;

use Data::Dumper;
use IO::Socket;

use Net::SSH::Perl;
use Net::SSH::Perl::Constants qw( :protocol );
use constant DEFAULT_SSH_PORT => '22';

use vars qw/ $VERSION @ISA/;
$VERSION = '0.06';

@ISA = qw/Net::SSH::Perl/;

sub _init {
    my $ssh = shift;
    my %arg = @_;

   $arg{protocol} = 2 unless exists $arg{protocol};

    $ssh->SUPER::_init(%arg);
}

sub _connect {
    my $ssh = shift;

    my $rhost = $ssh->{host};
    my $rport = $ssh->{config}->get('port') || DEFAULT_SSH_PORT;

    ############################
    # SOCKS proxy socket stuff #
    ############################
    my $proxy;
    my $sock;
    my $sockshost = $ssh->{config}->get('socks_proxy');
    my $socksport = $ssh->{config}->get('socks_port');
    my $socksprotocol = $ssh->{config}->get('socks_protocol');
    # Create a SOCKS proxy socket first (works for all platforms)...
    if($sockshost){
        $ssh->debug("Creating SOCKS proxy socket...");
        use Net::SOCKS;
        $proxy = new Net::SOCKS(
            socks_addr=>$sockshost,
            socks_port=>$socksport,
            protocol_version => $socksprotocol,
        ) || die "wow: $!";
        $ssh->{session}{sock} = $Net::SOCKS::self{fh};
    }

    ############################
    # Non-Windows socket stuff #
    ############################
    # If no SOCKS proxy and not on windows, do normal _connect()...
    elsif( (!$proxy) && ($OSNAME!~/^MSWin32/) ) {
        return $ssh->SUPER::_connect(@_);
    }
    ########################
    # Windows socket stuff #
    ########################
    else{
        $ssh->debug("Connecting to $ssh->{host}, port $rport.");
        $sock = IO::Socket::INET->new(
            PeerAddr => $rhost,
            PeerPort => $rport,
            Proto    => 'tcp'
        ) || die "Can't connect to $rhost: $!\n";
        $ssh->{session}{sock} = $sock;
    }

    if($proxy) {
        $ssh->debug("Using $sockshost:$socksport as SOCKS proxy.");
        $proxy->connect(
            peer_addr=>$rhost,
            peer_port=>$rport,
        ) || die "yikes: ", Net::SOCKS::status_message($proxy->param('
+status_num'));
        $ssh->{session}{sock} = $Net::SOCKS::self{fh};
    }

    my $t = $|;
    $| = 0;
    $ssh->debug("Socket created, turning on blocking...");
    $ssh->{session}{sock}->blocking(1);
    $ssh->_exchange_identification;
    $ssh->{session}{sock}->blocking(0);
    $| = $t;

    $ssh->debug("Connection established.");
}

sub protocol_class {
    if($OSNAME!~/^MSWin32/) {
        return shift->SUPER::protocol_class(@_);
    }
    
    die "SSH2 is the only supported protocol under MSWin32!"
        unless (PROTOCOL_SSH2 == $_[1]);
        
    return 'Net::SSH::W32Perl::SSH2';
}

sub Close {}

1;
__END__

=head1 NAME

Net::SSH::W32Perl - MSWin32 compatibility layer for Net::SSH::Perl

=head1 SYNOPSIS

 use Net::SSH::W32Perl;

 my $host = 'foo.bar.com';
 my $ssh = new Net::SSH::W32Perl($host, [options]);
 $ssh->login('user', 'password');
 my ($out, $err, $exit) = $ssh->cmd('cat', 'Hello Net::SSH::W32Perl Us
+er!');

=head1 DESCRIPTION

This module provides limited Net::SSH::Perl functionality 
under MSWin32 (ActivePerl).  See L<Net::SSH::Perl> for a
functional description.

When used on non-MSWin32 systems, Net::SSH::W32Perl 
reverts to traditional Net::SSH::Perl functionality.

SSH2 is the default protocol under MSWin32. Specifying a 
protocol other than SSH2 will cause SSH2 to die() - see below.

=head1 LIMITATIONS

=over 4

=item *

SSH2 is the only supported protocol due to Net::SSH::Perl's 
reliance on Math::GMP.

=item *

The C<shell()> interface is not supported due to MSWin32's 
lack of support for C<select()> on non-socket filehandles.

=item *

The I<privileged> option is not supported - I hope to fix 
this in a future release.

=item *

Anything else that doesn't work :)

=back

=head1 TO DO

Integrate the Net::SSH::Perl tests, fix C<privileged>, etc...

=head1 AUTHOR & COPYRIGHT

Scott Scecina, E<lt>scotts@inmind.comE<gt>

Except where otherwise noted, Net::SSH::W32Perl is Copyright
2001 Scott Scecina. All rights reserved. Net::SSH::W32Perl is
free software; you may redistribute it and/or modify it under
the same terms as Perl itself.

Code taken from Net::SSH::Perl is Copyright 2001 Benjamin Trott. 
Please see L<Net::SSH::Perl> for more information.

=head1 SEE ALSO

L<Net::SSH::Perl>

=cut