#!/usr/bin/perl
#
# Quick-and-dirty program to contact an SSH server and print out some
# useful information about it supported algorithms.  Run with --help to
# see usage.
#
# Richard Silverman <slade@shore.net> Sun Jul 16 2000
# updated: $Date: 2001/07/30 02:12:26 $

use Getopt::Long;
use IO::Handle;
use IO::Socket;
use English;
use File::Basename;
use integer;
use Math::BigInteger;

### some useful constants

$TRUE  = (0==0);
$FALSE = (0==1);

###

$SSH1_PACKET_MAX = 262144;

@SSH1_PACKET_TYPE_NAMES = ('MSG_NONE', 'MSG_DISCONNECT', 'SMSG_PUBLIC_KEY',
'CMSG_SESSION_KEY', 'CMSG_USER', 'CMSG_AUTH_RHOSTS', 'CMSG_AUTH_RSA',
'SMSG_AUTH_RSA_CHALLENGE', 'CMSG_AUTH_RSA_RESPONSE', 'CMSG_AUTH_PASSWORD',
'CMSG_REQUEST_PTY', 'CMSG_WINDOW_SIZE', 'CMSG_EXEC_SHELL',
'CMSG_EXEC_CMD', 'SMSG_SUCCESS', 'SMSG_FAILURE', 'CMSG_STDIN_DATA',
'SMSG_STDOUT_DATA', 'SMSG_STDERR_DATA', 'CMSG_EOF', 'SMSG_EXITSTATUS',
'MSG_CHANNEL_OPEN_CONFIRMATION', 'MSG_CHANNEL_OPEN_FAILURE',
'MSG_CHANNEL_DATA', 'MSG_CHANNEL_CLOSE', 'MSG_CHANNEL_CLOSE_CONFIRMATION',
'SMSG_X11_OPEN', 'CMSG_PORT_FORWARD_REQUEST', 'MSG_PORT_OPEN',
'CMSG_AGENT_REQUEST_FORWARDING', 'SMSG_AGENT_OPEN', 'MSG_IGNORE',
'CMSG_EXIT_CONFIRMATION', 'CMSG_X11_REQUEST_FORWARDING',
'CMSG_AUTH_RHOSTS_RSA', 'MSG_DEBUG', 'CMSG_REQUEST_COMPRESSION',
'CMSG_MAX_PACKET_SIZE', 'CMSG_AUTH_TIS', 'SMSG_AUTH_TIS_CHALLENGE',
'CMSG_AUTH_TIS_RESPONSE', 'CMSG_AUTH_KERBEROS',
'SMSG_AUTH_KERBEROS_RESPONSE', 'CMSG_HAVE_KERBEROS_TGT');

$SSH1_PACKET_TYPE_MAX = $#SSH1_PACKET_TYPE_NAMES;

# define SSH1_* names to be their type codes
{
    my $i = 0;
    foreach $name (@SSH1_PACKET_TYPE_NAMES) {
        eval "\$SSH1_$name = $i";
        $i++;
    }
}

%SSH_TRANS_PACKET_TYPE_NAMES = 
    (
     1  => 'MSG_DISCONNECT',
     2  => 'MSG_IGNORE',
     3  => 'MSG_UNIMPLEMENTED',
     4  => 'MSG_DEBUG',
     5  => 'MSG_SERVICE_REQUEST',
     6  => 'MSG_SERVICE_ACCEPT',
     20 => 'MSG_KEXINIT',
     21 => 'MSG_NEWKEYS',
     30 => 'MSG_KEXDH_INIT',
     31 => 'MSG_KEXDH_REPLY'
     );

# define SSH2_* names to be their type codes
foreach $key (keys %SSH_TRANS_PACKET_TYPE_NAMES) {
    eval "\$SSH2_$SSH_TRANS_PACKET_TYPE_NAMES{$key} = $key";
}

###

sub decode_protocol_flags {
    my ($mask) = @_;

    my $s = '';
    $s .= "X11-screen-number"
	if $mask & $SSH_PROTOFLAG_SCREEN_NUMBER;
    $s .= " host-in-forward-open"
	if $mask & $SSH_PROTOFLAG_HOST_IN_FWD_OPEN;

    return $s;
}

sub bit {
    my ($nbits) = @_;
    return (1 << $nbits);
}

sub warning {
    my ($msg) = @_;
    print STDERR $msg,"\n" unless $QUIET;
}

sub say {
    my ($msg) = @_;
    print $msg unless $QUIET;
}

sub fail {
    my ($msg) = @_;

    print STDERR $msg, "\n" if $msg;
    exit(1);
}

sub pfail {
    my ($msg) = @_;

    fail("$msg ($!)");
}

sub pull {
    my ($stream,$n) = @_;
    my ($buf, $status);

    $status = $stream->read($buf,$n);
    pfail "error reading network stream"
        unless defined($status);
    fail "unexpected end of file on network stream"
        if $status == 0;

    return $buf;
}

sub debug {
    my ($msg) = @_;
    print STDERR $msg, "\n" if $DEBUG;
}

sub hexdump {
    my ($buf) = @_;
    my $i, $j;
    
    my @bytes = unpack('C*',$buf);
    my @reprint = ();
    my $buflen = length $buf;

    print "==================================================================\n";

    for ($i = 0; $i < $buflen; $i++) {
        printf('%0.2X ',$bytes[$i]);
	push(@reprint,$bytes[$i]);
        if ($i % 16 == 15 || $i == $buflen-1) {
	    for ($j = 0; $j < 3*(15 - ($i % 16)); $j++) {print ' '};
	    print '| ';
	    map { $_ >= 32 && $_ < 127 ? print chr $_ : print '.' } @reprint;
	    @reprint = ();
	    print "\n" ;
	}
    }
    print "==================================================================\n";
}

# read an SSH1 packet, return the type and payload (without padding or
# check bytes)

sub ReadPacket1 {
    my ($stream) = @_;

    my ($buf, $ignore, $packet_length);

    # get the packet length
    $packet_length = uint32(pull($stream,4));

    fail("packet too big ($packet_length)") if $packet_length > $SSH1_PACKET_MAX;

    # discard the padding
    pull($stream, (8 - ($packet_length % 8)));

    # get the packet type
    $packet_type = unpack("C1",pull($stream,1));
    fail "illegal packet type ($packet_type)"
        if $packet_type > $SSH1_PACKET_TYPE_MAX;

    debug "got packet type $SSH1_PACKET_TYPE_NAMES[$packet_type] ($packet_type)";

    # read the payload
    $buf = pull($stream, $packet_length-5);

    # discard the check bytes
    pull($stream,4);

    hexdump $buf if $DEBUG > 1;
    
    return ($packet_type,$buf);
}

sub GetVersion {
    my ($stream) = @_;

    do {$v = $stream->getline} while ($v && ($v !~ /^SSH-/));

    fail "can't get version string from server"
        unless $v;

    fail qq*bad server version string: "$v"*
        unless $v =~ /^SSH-([0-9]+)\.([0-9]+)-(.*)\n/;
    
    # return (protocol-major,protocol-minor,comment)
    return ($1,$2,$3);
}

sub mp_int {
    my ($buf) = @_;
    my ($nbits,$bits,$bytes,$buflen);

    $buflen = length($buf);

    fail "mp_int: buffer not big enough"
        if $buflen < 2;

    # 16-bit number of bits in integer
    $nbits = unpack('n',$buf);

    $bytes = ($nbits + 7) / 8;

    fail "mp_int: bad integer"
        if $bytes > $buflen-2;

    debug "mp_int ($nbits bits)";

    my $bn = restore BigInteger substr($buf,2,$bytes);
    my $bn_length = $bn->bits;
    print "mp_int encoding error: claims $nbits bits, but actually $bn_length\n"
	unless $nbits == $bn_length;

    # modify caller's buffer
    @_[0] = substr($buf,$bytes+2);
    # return the bignum
    return $bn;
}

sub eat {
    my ($n,$buf) = @_;

    fail "eat: buffer not big enough"
        if $n > length($buf);

    return (substr($buf,0,$n),
            substr($buf,$n));
}

# parse the fields of this message that we care about

sub parse_SSH1_SMSG_PUBLIC_KEY {
    my ($buf) = @_;

    my ($cookie,$foo,$ciphers,$auth_methods,$flags,
	$hostkey_bits,$hostkey,
	$hostkey_exponent,$hostkey_exponent_length,$hostkey_exponent_bits,
	$hostkey_modulus,$hostkey_modulus_length,$hostkey_modulus_bits);

    debug "parsing SMSG_PUBLIC_KEY";

    # get anti-spoofing cookie
    ($cookie,$buf) = eat(8,$buf);

    # discard server key
    uint32($buf);
    mp_int($buf);
    mp_int($buf);
    
    # get host key
    $hostkey_length = uint32($buf);
    $hostkey = {type => 'rsa',
		exponent => mp_int($buf),
		modulus => mp_int($buf),};
    
    my $modulus_length = $hostkey->{modulus}->bits;
    print STDERR "host key length confusion: claims $hostkey_length, but actually $modulus_length\n"
	unless $modulus_length == $hostkey_length || $QUIET;

    # get protocol flags
    $flags = uint32($buf);

    # get supported ciphers mask
    $ciphers = uint32($buf);

    # get supported authentication methods mask
    $auth_methods = uint32($buf);

    return ($cookie,$ciphers,$auth_methods,$hostkey,$flags);
}

sub plural {
    my ($n,$suffix) = @_;
    return (($n > 1) ? ($suffix or 's') : '');
}

sub decode_auth_methods_mask {
    my ($mask) = @_;
    my %methods = (1  => 'rhosts',
		   2  => 'RSA',
		   3  => 'password',
		   4  => 'RhostsRSA',
		   5  => 'TIS',
		   6  => 'Kerberos',
		   7  => 'Kerberos-TGT-forwarding',
		   21 => 'AFS-token-forwarding',
		   29 => 'Kerberos-5-OpenSSH',
		   );
    my @supported = ();
    
    my $tmask = $mask;
    foreach $bit (keys %methods) {
        my $m = bit($bit);
	if ($mask & $m) {
	    push(@supported,$methods{$bit});
	    print qq'
NOTE: The Kerberos-5-OpenSSH method is nonstandard, indicating use of the
OpenSSH Kerberos5 patch by Daniel Kouril (and its derivatives):
  http://www.ics.muni.cz/scb/devel/heimdal.html
  http://www.sxw.org.uk/computing/patches/openssh.html

'
              if ($bit == 29) and !$QUIET;
	}
        $tmask &= ~$m;
    }
    if ($tmask) {
	my ($i,@bits);
	for ($i = 0; $i < 32; $i++) {
	    push(@bits,"$i") if $tmask & (1<<$i);
	}
	printf("!! SERVER SUPPORTS SOME UNKNOWN AUTHENTICATION METHODS (bit%s %s)\n",
	       plural(scalar @bits), join(', ',@bits)) if $tmask and !$QUIET;
    }
    return join(',',@supported);
}

sub decode_cipher_mask {
    my ($mask) = @_;
    my @ciphers = ('none','IDEA','DES','3DES','TSS(obsolete)','arcfour','Blowfish');
    my @supported = ();
    
    my $i = 0;
    my $tmask = $mask;
    foreach $c (@ciphers) {
        my $cmask = (1<<$i++);
        push(@supported,$c) if $mask & $cmask;
        $tmask &= ~$cmask;
    }
    print "server supports some unknown ciphers (mask $mask)\n" if $tmask;
    return join(',',@supported);
}

sub DoSSH1 {
    my ($socket) = @_;

    # send our version string
    $socket->print("SSH-1.5-sshquery\n");

    # switch to packet protocol
    my ($type,$data) = ReadPacket1($socket);
    
    fail "initial server message was not SMSG_PUBLIC_KEY !?"
        unless $type == $SSH1_SMSG_PUBLIC_KEY;
    
    my ($cookie,$ciphers,$methods,$hostkey,$flags) =
	parse_SSH1_SMSG_PUBLIC_KEY($data);
    
    my ($cipher_list,$auth_methods,$nbits,$exponent,$modulus,$modulus_broken,$flags_text) =
	(decode_cipher_mask($ciphers),
	 decode_auth_methods_mask($methods),
	 $hostkey->{modulus}->bits,
	 bignum_to_string($hostkey->{exponent}),
	 bignum_to_string($hostkey->{modulus}),
	 bignum_to_string($hostkey->{modulus},50,'  '),
	 decode_protocol_flags($flags));

    do {
	print qq'server ciphers: $cipher_list
authentication methods: $auth_methods
protocol flags: $flags_text
host key:
 exponent: $exponent
 modulus ($nbits bits):
$modulus_broken
';
	return;
    }
    unless @PRINT_LIST;

    my %xlat = (ciphers => $cipher_list,
		protocol => "$major.$minor",
		comment => qq*"$comment"*,
		userauth => $auth_methods,
		hostkeylength => $nbits,
		hostkeyexponent => $exponent,
		hostkeymodulus => $modulus,
		flags => $flags_text);

    my @answers = map {$xlat{$_}} @PRINT_LIST;
    print join(' ',@answers,"\n");
}

sub bignum_to_string {
    my ($bn,$line_length,$indent) = @_;

    my $s = $bn->toString;

    if ($have_bc && !$HEX) {
	$s = uc $s;
	$s = `echo "ibase=16; print $s" | bc`;
	$s = join('',split(/\\\n/,$s));
    }

    return $s unless $line_length;
	
    my $ret = '';
    do {
	my $line = substr($s,0,$line_length);
	$s = substr($s,$line_length);
	$ret .= $indent.$line."\n";
    } while $s;

    return $ret;
}

# read an SSH2 packet, return the type and payload (without padding or
# check bytes)

sub ReadPacket2 {
    my ($stream) = @_;

    my ($buf, $ignore, $packet_length, $padding_length,
        $packet_type);

    # get the packet length, padding length and packet type fields
    $buf = pull($stream,6);
    $packet_length = uint32($buf);
    ($padding_length,$packet_type) = unpack("C2",$buf);

    # return the packet type and data
    $buf = pull($stream, $packet_length - $padding_length - 2);
    hexdump $buf if $DEBUG > 1;
    return($packet_type,$buf);
}

sub uint32 {
    my ($buf) = @_;

    fail "malformed uint32" if length $buf < 4;
    my $int = unpack('N',$buf);
    debug sprintf("uint32 (%d, 0x%0.8X)",$int,$int);
    # modify caller's buffer
    @_[0] = substr($buf,4);
    # return integer value
    return $int;
}

sub string {
    my ($buf) = @_;
    my ($length);

    $length= uint32 $buf;
    fail "malformed string" if length $buf < $length;
    return (substr($buf,0,$length),
            substr($buf,$length));
}

sub parse_SSH2_MSG_KEXINIT {
    my ($buf) = @_;
    my ($ignore, $i, $s);

    # discard random cookie
    ($ignore,$buf) = eat(16,$buf);

    # gather 10 strings and return them
    my @ret = ();
    for ($i = 0; $i < 10; $i++) {
        ($s,$buf) = string($buf);
        push(@ret,$s);
    }
    return @ret;
}

sub DoSSH2 {
    my ($socket) = @_;

    # send our version string
    $socket->print("SSH-2.0-sshquery\r\n");
    
    # switch to packet protocol
    my ($type,$data) = ReadPacket2($socket);

    fail "initial server message was not KEXINIT !? (got type $type instead)"
        unless $type == $SSH2_MSG_KEXINIT;
    
    my $prefix = "\n                ";
    my $ciphers_sc = $macs_sc = $compression_sc = '';

    my ($kex_algorithms,
        $server_host_key_algorithms,
        $encryption_algorithms_client_to_server,
        $encryption_algorithms_server_to_client,
        $mac_algorithms_client_to_server,
        $mac_algorithms_server_to_client,
        $compression_algorithms_client_to_server,
        $compression_algorithms_server_to_client,
        $languages_client_to_server,
        $languages_server_to_client
        ) =  map {my $foo = $_; $foo =~ s/,/$prefix/g; $foo} 
                 parse_SSH2_MSG_KEXINIT($data);

# If the cipher, mac, and compression algorithm lists are all the same in
# both directions (client->server/server->client), then just list them
# once.  If any differ, list them in two labelled sections.

    $ciphers_sc =
	(($encryption_algorithms_server_to_client eq 
	  $encryption_algorithms_client_to_server) ?
	 '[same]' : $encryption_algorithms_server_to_client);

    $macs_sc =
	(($mac_algorithms_server_to_client eq 
	  $mac_algorithms_client_to_server) ?
	 '[same]' : $mac_algorithms_server_to_client);

    $compression_sc =
	(($compression_algorithms_server_to_client eq 
	  $compression_algorithms_client_to_server) ?
	 '[same]' : $compression_algorithms_server_to_client);

    print qq*
  key exchange: $kex_algorithms
     host keys: $server_host_key_algorithms*;

    my $cs = qq*
       ciphers: $encryption_algorithms_client_to_server
           MAC: $mac_algorithms_client_to_server
   compression: $compression_algorithms_client_to_server
*;

    if (($ciphers_sc     ne '[same]') or
	($macs_sc        ne '[same]') or 
	($compression_sc ne '[same]')) {
	print qq*

  (CLIENT->SERVER)$cs
  (SERVER->CLIENT)
       ciphers: $ciphers_sc
           MAC: $macs_sc
   compression: $compression_sc
*;
    } else {
	print $cs;
    }
}

$SSH_PROTOFLAG_SCREEN_NUMBER    = bit 0;
$SSH_PROTOFLAG_HOST_IN_FWD_OPEN = bit 1;

### main

$program     = basename $0;
$rcs_version = '$Revision: 1.20 $';
$rcs_date    = '$Date: 2001/07/30 02:12:26 $';

$USAGE = qq*
    $program -- contact an SSH server and print out various bits of useful
    information, including supported algorithms and authentication methods

    usage: $program <options> server[:port]

    -1  .......... force protocol 1 even if server supports 2
    --debug[=n] .. print some extra info (more for higher n)
    --help ....... print this message
    --hex ........ print long integers in hexadecimal

    --print item1,item2,...

      Without this option, print a human-friendly report.  With it, print
      a space-separated list of the requested items.  Available items are:

      protocol 1: ciphers,userauth,hostkey-length,hostkey-exponent,
		  hostkey-modulus,protocol,comment

      protocol 2: [not yet implemented]

    --quiet ...... not so much chatter (--print implies this)

    Richard Silverman <slade\@shore.net>
    $rcs_version
    $rcs_date

*;

$DEBUG = $FALSE;
$FORCE_PROTOCOL_1 = $FALSE;
@PRINT_LIST = ();
$QUIET = $FALSE;

$have_bc = (`echo 10 | bc` eq "10\n");

if ((! GetOptions('debug=i' => \$DEBUG,
                  'quiet'   => \$QUIET,
		  'hex'     => \$HEX,
                  '1'       => \$FORCE_PROTOCOL_1,
		  'print=s' => \$print_spec,
                  'help'    => \$help,
                  )) ||
    scalar @ARGV < 1 ||         # at least one argument
    $help)
{
    print $USAGE;
    exit ($help ? 0 : 1);
}

($server) = @ARGV;

@PRINT_LIST = split(/,/,$print_spec)
    if $print_spec;

$QUIET = $TRUE if @PRINT_LIST;

warning "can't find 'bc', so can't print in decimal"
    if !$HEX && !$have_bc;

# open a TCP connection to the server; default to port 22 unless
# overriden by $server eq "server:port"
$socket = IO::Socket::INET->new(PeerAddr => $server,
				PeerPort => 22)
    || pfail qq*cannot connect to "$server"*;

# get & parse the server version string
($major,$minor,$comment) = GetVersion($socket);

say "server protocol $major.$minor ($comment)\n";

# note what SSH protocol versions are supported
$protocol_1 = $major eq '1';
$protocol_2 = $major eq '2' || $minor eq '99';

fail "unrecognized protocol version!" 
    if (!($protocol_1 || $protocol_2));

# switch on the major protocol version
if ($protocol_2 && !$FORCE_PROTOCOL_1) {
    say "doing protocol 2\n";
    DoSSH2 $socket;
} else {
    say "doing protocol 1\n";
    DoSSH1 $socket;
}

# all done
$socket->close;
exit 0;