home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / W32Perl.pm < prev    next >
Encoding:
Perl POD Document  |  2002-04-18  |  2.9 KB  |  139 lines
  1. package Net::SSH::W32Perl;
  2.  
  3. use strict;
  4. use Carp;
  5.  
  6. use IO::Socket;
  7.  
  8. use Net::SSH::Perl;
  9. use Net::SSH::Perl::Constants qw( :protocol );
  10. use constant DEFAULT_SSH_PORT => '22';
  11. use constant IS_WIN32 => ($^O =~ /MSWin32/i);
  12.  
  13. use vars qw/ $VERSION @ISA/;
  14. $VERSION = '0.05';
  15.  
  16. @ISA = qw/Net::SSH::Perl/;
  17.  
  18. sub _init {
  19.     my $ssh = shift;
  20.     my %arg = @_;
  21.  
  22.    $arg{protocol} = 2 unless exists $arg{protocol};
  23.  
  24.     $ssh->SUPER::_init(%arg);
  25. }
  26.  
  27. sub _connect {
  28.     my $ssh = shift;
  29.     return $ssh->SUPER::_connect(@_) unless IS_WIN32;
  30.  
  31.     my $rport = $ssh->{config}->get('port') || DEFAULT_SSH_PORT;
  32.     my $rhost = $ssh->{host};
  33.  
  34.     $ssh->debug("Connecting to $ssh->{host}, port $rport.");
  35.     my $sock = IO::Socket::INET->new(
  36.         PeerAddr => $rhost,
  37.         PeerPort => $rport,
  38.         Proto    => 'tcp'
  39.     ) || die "Can't connect to $rhost: $!\n";
  40.     
  41.     $ssh->{session}{sock} = $sock;
  42.  
  43.     my $t = $|;
  44.     $| = 0;
  45.     $ssh->debug("Socket created, turning on blocking...");
  46.     $sock->blocking(1);
  47.     $ssh->_exchange_identification;
  48.     $sock->blocking(0);
  49.     $| = $t;
  50.  
  51.     $ssh->debug("Connection established.");
  52. }
  53.  
  54. sub protocol_class {
  55.     return shift->SUPER::protocol_class(@_) unless IS_WIN32;
  56.     
  57.     die "SSH2 is the only supported protocol under MSWin32!"
  58.         unless (PROTOCOL_SSH2 == $_[1]);
  59.         
  60.     return 'Net::SSH::W32Perl::SSH2';
  61. }
  62.  
  63. sub Close {}
  64.  
  65. 1;
  66. __END__
  67.  
  68. =head1 NAME
  69.  
  70. Net::SSH::W32Perl - MSWin32 compatibility layer for Net::SSH::Perl
  71.  
  72. =head1 SYNOPSIS
  73.  
  74.  use Net::SSH::W32Perl;
  75.  
  76.  my $host = 'foo.bar.com';
  77.  my $ssh = new Net::SSH::W32Perl($host, [options]);
  78.  $ssh->login('user', 'password');
  79.  my ($out, $err, $exit) = $ssh->cmd('cat', 'Hello Net::SSH::W32Perl User!');
  80.  
  81. =head1 DESCRIPTION
  82.  
  83. This module provides limited Net::SSH::Perl functionality 
  84. under MSWin32 (ActivePerl).  See L<Net::SSH::Perl> for a
  85. functional description.
  86.  
  87. When used on non-MSWin32 systems, Net::SSH::W32Perl 
  88. reverts to traditional Net::SSH::Perl functionality.
  89.  
  90. SSH2 is the default protocol under MSWin32. Specifying a 
  91. protocol other than SSH2 will cause SSH2 to die() - see below.
  92.  
  93. =head1 LIMITATIONS
  94.  
  95. =over 4
  96.  
  97. =item *
  98.  
  99. SSH2 is the only supported protocol due to Net::SSH::Perl's 
  100. reliance on Math::GMP.
  101.  
  102. =item *
  103.  
  104. The C<shell()> interface is not supported due to MSWin32's 
  105. lack of support for C<select()> on non-socket filehandles.
  106.  
  107. =item *
  108.  
  109. The I<privileged> option is not supported - I hope to fix 
  110. this in a future release.
  111.  
  112. =item *
  113.  
  114. Anything else that doesn't work :)
  115.  
  116. =back
  117.  
  118. =head1 TO DO
  119.  
  120. Integrate the Net::SSH::Perl tests, fix C<privileged>, etc...
  121.  
  122. =head1 AUTHOR & COPYRIGHT
  123.  
  124. Scott Scecina, E<lt>scotts@inmind.comE<gt>
  125.  
  126. Except where otherwise noted, Net::SSH::W32Perl is Copyright
  127. 2001 Scott Scecina. All rights reserved. Net::SSH::W32Perl is
  128. free software; you may redistribute it and/or modify it under
  129. the same terms as Perl itself.
  130.  
  131. Code taken from Net::SSH::Perl is Copyright 2001 Benjamin Trott. 
  132. Please see L<Net::SSH::Perl> for more information.
  133.  
  134. =head1 SEE ALSO
  135.  
  136. L<Net::SSH::Perl>
  137.  
  138. =cut
  139.