view release on metacpan or  search on metacpan

t/psshd  view on Meta::CPAN

use strict;

use Getopt::Long;
use Carp qw/croak/;
use Digest::MD5 qw/md5/;

use Net::SSH::Perl;
use Net::SSH::Perl::Packet;
use Net::SSH::Perl::Cipher;
use Net::SSH::Perl::Auth;
use Net::SSH::Perl::Util qw( :ssh1mp :rsa :hosts _load_private_key );
use Net::SSH::Perl::Constants qw( :msg :hosts PROTOCOL_MAJOR PROTOCOL_MINOR );
use IO::Socket;
use Math::GMP;

use vars qw( $VERSION );
$VERSION = "0.01";

use vars qw( $DEBUG );

GetOptions("port|p=i", \my $port, "debug|d", \$DEBUG,
           "bits|b=i", \my $key_bits,
           "gen-hostkey|g", \my $generate_host_key);

$port ||= 60000;
$DEBUG  = 0 unless defined $DEBUG;
$key_bits ||= 768;

use vars qw( $USER_AUTHORIZED_KEYS $DUMMY_PASSWD $KNOWN_HOSTS
             $PID_FILE );
BEGIN { unshift @INC, 't/' }
require 'test-common.pl';

my $PID = $$;
$SIG{TERM} = sub {
    if ($$ == $PID && -e $PID_FILE) {
        unlink $PID_FILE or die "Can't unlink $PID: $!";
    }
    die "Terminated.\n";
};

my $ssh = Net::SSH::Perl->new("dummy",
    debug => $DEBUG,
    user_known_hosts => $KNOWN_HOSTS);

if (-e $PID_FILE) {
    $ssh->debug("Removing old pid file $PID_FILE");
    unlink $PID_FILE or die "Can't unlink old pid file $PID_FILE: $!";
}

my $SERVER = IO::Socket::INET->new(
    Listen    => 5,
    LocalAddr => 'localhost',
    LocalPort => $port,
    Proto     => 'tcp',
    Reuse     => 1);
die "$0: Couldn't create server on port $port: $@"
    unless $SERVER;
$ssh->debug("Server listening on port $port.");

$ssh->debug("Generating $key_bits bit RSA key.");
my($public, $private) = _rsa_generate_key($key_bits);
$ssh->debug("Key generation complete.");

my %keys;
if ($generate_host_key) {
    $ssh->debug("Generating 1024 bit host key.");
    my($hpub, $hprv) = _rsa_generate_key(1024);
    $ssh->debug("Host key generation complete.");

    $keys{host} = $hprv;

    if (-e $KNOWN_HOSTS) {
        unlink $KNOWN_HOSTS or die "Can't unlink $KNOWN_HOSTS: $!";
    }
    _add_host_to_hostfile("localhost", $KNOWN_HOSTS, $hpub);
}
else {
    $keys{host} = _load_private_key("/etc/ssh_host_key");
}

$keys{server} = $public;
$keys{private} = $private;

$ssh->debug("Writing pid file with pid $PID.");
{
    local *FH;
    open FH, ">$PID_FILE" or die "Can't open $PID_FILE: $!";
    print FH $PID;
    close FH or die "Can't close $PID_FILE: $!";
}

$ssh->debug("Ready to serve connections.");

my $waitedpid = 0;
sub REAPER {
    $waitedpid = wait;
    $SIG{CHLD} = \&REAPER;
    $ssh->debug("Reaped $waitedpid");
}
$SIG{CHLD} = \&REAPER;

while (my $client = $SERVER->accept) {
    my $pid;
    if (!defined($pid = fork)) {
        $ssh->debug("Cannot fork: $!");
    }
    elsif ($pid) {
        $ssh->debug("Forked $pid to handle client");
    }
    else {
        _handle_child($SERVER, $ssh, \%keys, $client);
        exit;
    }
}

sub _handle_child {
    my($server, $ssh, $keys, $client) = @_;

    $client->autoflush(1);

    printf $client "SSH-%d.%d-%s\n",
        PROTOCOL_MAJOR, PROTOCOL_MINOR, $VERSION;
    my $remote_id = <$client>;
    my($remote_major, $remote_minor, $remote_version) = $remote_id =~
        /^SSH-(\d+)\.(\d+)-([^\n]+)\n$/;
    print $client "Protocol mismatch.\n"
        unless $remote_major && $remote_minor && $remote_version;
    $ssh->debug("Client protocol version $remote_major.$remote_minor, remote software version $remote_version");

    $ssh->{session}{sock} = $client;

    _do_connection($server, $ssh, $keys);
}

sub _do_connection {
    my($server, $ssh, $keys) = @_;
    my($packet);