mirror of
https://github.com/moparisthebest/curl
synced 2024-11-11 12:05:06 -05:00
Modify test harness so that the minimum SSH version required to run
SCP, SFTP and SOCKS4 tests is now OpenSSH 2.9.9 or SunSSH 1.0 For SOCKS5 tests minimum versions are OpenSSH 3.7 or SunSSH 1.0
This commit is contained in:
parent
083d3190e5
commit
fd8d862c37
5
CHANGES
5
CHANGES
@ -6,6 +6,11 @@
|
||||
|
||||
Changelog
|
||||
|
||||
Yang Tse (3 Jan 2008)
|
||||
- Modified test harness to allow SCP, SFTP and SOCKS4 tests to run with
|
||||
OpenSSH 2.9.9, SunSSH 1.0 or later versions. SOCKS5 tests need OpenSSH
|
||||
3.7, SunSSH 1.0 or later.
|
||||
|
||||
Daniel S (2 Jan 2008)
|
||||
- I fixed two cases of missing return code checks when handling chunked
|
||||
decoding where a write error (or abort return from a callback) didn't stop
|
||||
|
@ -17,5 +17,8 @@ To be addressed before 7.18.0 (planned release: January 2008)
|
||||
auth (to find and fix)
|
||||
|
||||
114 - Ranged downloads on file:// URLs by Daniel Egger (patch failed to apply)
|
||||
|
||||
115 - Cleanup debugging messages in test harness, introduced for new minimum
|
||||
SSH version support for SCP, SFTP and SOCKS tests
|
||||
|
||||
115 -
|
||||
116 -
|
||||
|
@ -5,7 +5,7 @@
|
||||
# | (__| |_| | _ <| |___
|
||||
# \___|\___/|_| \_\_____|
|
||||
#
|
||||
# Copyright (C) 1998 - 2005, Daniel Stenberg, <daniel@haxx.se>, et al.
|
||||
# Copyright (C) 1998 - 2008, Daniel Stenberg, <daniel@haxx.se>, et al.
|
||||
#
|
||||
# This software is licensed as described in the file COPYING, which
|
||||
# you should have received as part of this distribution. The terms
|
||||
@ -26,7 +26,7 @@ PDFPAGES = testcurl.pdf runtests.pdf
|
||||
|
||||
EXTRA_DIST = ftpserver.pl httpserver.pl httpsserver.pl runtests.pl getpart.pm \
|
||||
FILEFORMAT README stunnel.pem memanalyze.pl testcurl.pl valgrind.pm ftp.pm \
|
||||
sshserver.pl testcurl.1 runtests.1 $(HTMLPAGES) $(PDFPAGES)
|
||||
sshserver.pl sshhelp.pm testcurl.1 runtests.1 $(HTMLPAGES) $(PDFPAGES)
|
||||
|
||||
SUBDIRS = data server libtest
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
# | (__| |_| | _ <| |___
|
||||
# \___|\___/|_| \_\_____|
|
||||
#
|
||||
# Copyright (C) 1998 - 2007, Daniel Stenberg, <daniel@haxx.se>, et al.
|
||||
# Copyright (C) 1998 - 2008, Daniel Stenberg, <daniel@haxx.se>, et al.
|
||||
#
|
||||
# This software is licensed as described in the file COPYING, which
|
||||
# you should have received as part of this distribution. The terms
|
||||
@ -63,6 +63,16 @@ use Cwd;
|
||||
|
||||
@INC=(@INC, $ENV{'srcdir'}, ".");
|
||||
|
||||
# Variables and subs imported from sshhelp module
|
||||
use sshhelp qw(
|
||||
$sshexe
|
||||
$sshconfig
|
||||
$sshlog
|
||||
display_sshlog
|
||||
find_ssh
|
||||
sshversioninfo
|
||||
);
|
||||
|
||||
require "getpart.pm"; # array functions
|
||||
require "valgrind.pm"; # valgrind report parser
|
||||
require "ftp.pm";
|
||||
@ -173,6 +183,11 @@ my %skipped; # skipped{reason}=counter, reasons for skip
|
||||
my @teststat; # teststat[testnum]=reason, reasons for skip
|
||||
my %disabled_keywords; # key words of tests to skip
|
||||
|
||||
my $sshid; # for socks server, ssh version id
|
||||
my $sshvernum; # for socks server, ssh version number
|
||||
my $sshverstr; # for socks server, ssh version string
|
||||
my $ssherror; # for socks server, ssh version error
|
||||
|
||||
#######################################################################
|
||||
# variables the command line options may set
|
||||
#
|
||||
@ -294,7 +309,7 @@ sub startnew {
|
||||
die "error: exec() has returned";
|
||||
}
|
||||
|
||||
# Ugly hack but ssh doesn't support pid files
|
||||
# Ugly hack but ssh client doesn't support pid files
|
||||
if ($fake) {
|
||||
if(open(OUT, ">$pidfile")) {
|
||||
print OUT $child . "\n";
|
||||
@ -1042,6 +1057,7 @@ sub runsshserver {
|
||||
my ($id, $verbose, $ipv6) = @_;
|
||||
my $ip=$HOSTIP;
|
||||
my $port = $SSHPORT;
|
||||
my $socksport = $SOCKSPORT;
|
||||
my $pidfile = $SSHPIDFILE;
|
||||
|
||||
# don't retry if the server doesn't work
|
||||
@ -1056,11 +1072,12 @@ sub runsshserver {
|
||||
stopserver($pid);
|
||||
}
|
||||
|
||||
my $flag=$debugprotocol?"-v ":"";
|
||||
my $cmd="$perl $srcdir/sshserver.pl $flag-u $USER -l $HOSTIP -d $srcdir $port";
|
||||
my $flag=$verbose?'-v ':'';
|
||||
$flag .= '-d ' if($debugprotocol);
|
||||
|
||||
my $cmd="$perl $srcdir/sshserver.pl ${flag}-u $USER -l $ip -p $port -s $socksport";
|
||||
logmsg "TRACESSH:runsshserver: calling startnew with cmd: $cmd\n";
|
||||
my ($sshpid, $pid2) =
|
||||
startnew($cmd, $pidfile, 60, 0); # start the server in a new process
|
||||
my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
|
||||
|
||||
logmsg "TRACESSH:runsshserver: startnew returns sshpid: $sshpid pid2: $pid2\n";
|
||||
|
||||
@ -1101,39 +1118,80 @@ sub runsocksserver {
|
||||
|
||||
# don't retry if the server doesn't work
|
||||
if ($doesntrun{$pidfile}) {
|
||||
logmsg "TRACESSH:runsocksserver: socks server previously failed to start with pidfile: $pidfile\n";
|
||||
return (0,0);
|
||||
}
|
||||
|
||||
my $flag=$debugprotocol?"-v ":"";
|
||||
my $cmd="ssh -D $SOCKSPORT -N -F curl_ssh_config ${USER}\@${HOSTIP} -p ${SSHPORT} -vv >log/ssh.log 2>&1";
|
||||
logmsg "TRACESSH:runsocksserver: calling startnew with cmd: $cmd\n";
|
||||
my ($sshpid, $pid2) =
|
||||
startnew($cmd, $pidfile, 15, 1); # start the server in a new process
|
||||
my $pid = checkserver($pidfile);
|
||||
logmsg "TRACESSH:runsocksserver: checkserver on pidfile: $pidfile returns pid: $pid\n";
|
||||
if($pid > 0) {
|
||||
stopserver($pid);
|
||||
}
|
||||
unlink($pidfile);
|
||||
|
||||
# The ssh server must be already running
|
||||
if(!$run{'ssh'}) {
|
||||
logmsg "RUN: SOCKS server cannot find running SSH server\n";
|
||||
$doesntrun{$pidfile} = 1;
|
||||
return (0,0);
|
||||
}
|
||||
|
||||
# Find out ssh client canonical file name
|
||||
my $ssh = find_ssh();
|
||||
if(!$ssh) {
|
||||
logmsg "RUN: SOCKS server cannot find $sshexe\n";
|
||||
$doesntrun{$pidfile} = 1;
|
||||
return (0,0);
|
||||
}
|
||||
|
||||
# Find out ssh client version info
|
||||
($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh);
|
||||
if(!$sshid) {
|
||||
# Not an OpenSSH or SunSSH ssh client
|
||||
logmsg "$ssherror\n" if($verbose);
|
||||
logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
|
||||
$doesntrun{$pidfile} = 1;
|
||||
return (0,0);
|
||||
}
|
||||
|
||||
# Verify minimum ssh client version
|
||||
if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) ||
|
||||
(($sshid =~ /SunSSH/) && ($sshvernum < 100))) {
|
||||
logmsg "ssh client found $ssh is $sshverstr\n";
|
||||
logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
|
||||
$doesntrun{$pidfile} = 1;
|
||||
return (0,0);
|
||||
}
|
||||
logmsg "ssh client found $ssh is $sshverstr\n" if($verbose);
|
||||
|
||||
# Config file options for ssh client are previously set from sshserver.pl
|
||||
if(! -e $sshconfig) {
|
||||
logmsg "RUN: SOCKS server cannot find $sshconfig\n";
|
||||
$doesntrun{$pidfile} = 1;
|
||||
return (0,0);
|
||||
}
|
||||
|
||||
# start our socks server
|
||||
my $cmd="$ssh -N -F $sshconfig $ip > $sshlog 2>&1";
|
||||
my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1);
|
||||
|
||||
logmsg "TRACESSH:runsocksserver: startnew returns sshpid: $sshpid pid2: $pid2\n";
|
||||
|
||||
if($sshpid <= 0 || !kill(0, $sshpid)) {
|
||||
# it is NOT alive
|
||||
logmsg "RUN: failed to start the SOCKS server\n";
|
||||
logmsg "=== Start of file log/ssh.log\n";
|
||||
displaylogcontent("log/ssh.log");
|
||||
logmsg "=== End of file log/ssh.log\n";
|
||||
logmsg "TRACESSH:runsocksserver: calling stopserver with pid2: $pid2\n";
|
||||
display_sshlog();
|
||||
stopserver("$pid2");
|
||||
$doesntrun{$pidfile} = 1;
|
||||
logmsg "TRACESSH:runsocksserver: later dont try to start a server with pidfile: $pidfile\n";
|
||||
return (0,0);
|
||||
}
|
||||
|
||||
# Ugly hack but ssh doesn't support pid files
|
||||
if (!verifyserver('socks',$ip,$port)) {
|
||||
logmsg "RUN: SOCKS server failed verification\n";
|
||||
display_sshlog();
|
||||
# failed to talk to it properly. Kill the server and return failure
|
||||
logmsg "TRACESSH:runsocksserver: calling stopserver with sshpid: $sshpid pid2: $pid2\n";
|
||||
stopserver("$sshpid $pid2");
|
||||
$doesntrun{$pidfile} = 1;
|
||||
logmsg "TRACESSH:runsocksserver: later dont try to start a server with pidfile: $pidfile\n";
|
||||
return (0,0);
|
||||
}
|
||||
if($verbose) {
|
||||
@ -2404,36 +2462,34 @@ sub startservers {
|
||||
printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
|
||||
$run{'ssh'}="$pid $pid2";
|
||||
}
|
||||
if ($what eq "socks4" || $what eq "socks5") {
|
||||
if (!checkcmd("ssh")) {
|
||||
return "failed to find SSH client for socks support";
|
||||
}
|
||||
if(!$run{'socks'}) {
|
||||
my $sshversion=`ssh -V 2>&1`;
|
||||
if($sshversion =~ /OpenSSH[_-](\d+)\.(\d+)/i) {
|
||||
if ($1*10+$2 < 36) {
|
||||
# need 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
|
||||
return "OpenSSH version ($1.$2) insufficient; need at least 3.7";
|
||||
}
|
||||
}
|
||||
elsif($sshversion =~ /Sun[_-]SSH[_-](\d+)\.(\d+)/i) {
|
||||
if ($1*10+$2 < 11) {
|
||||
return "SunSSH version ($1.$2) insufficient; need at least 1.1";
|
||||
}
|
||||
}
|
||||
else {
|
||||
return "Unsupported ssh client\n";
|
||||
}
|
||||
|
||||
($pid, $pid2) = runsocksserver("", $verbose);
|
||||
if($what eq "socks4" || $what eq "socks5") {
|
||||
if(!$run{'socks'}) {
|
||||
($pid, $pid2) = runsocksserver("", 1);
|
||||
printf ("TRACESSH:startservers: runsocksserver returns pid: %d pid2: %d\n", $pid, $pid2);
|
||||
if($pid <= 0) {
|
||||
return "failed starting socks server";
|
||||
}
|
||||
printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
|
||||
$run{'socks'}="$pid $pid2";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if($what eq "socks5") {
|
||||
if(!$sshid) {
|
||||
# Not an OpenSSH or SunSSH ssh client
|
||||
logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n";
|
||||
return "failed starting socks5 server";
|
||||
}
|
||||
elsif(($sshid =~ /OpenSSH/) && ($sshvernum < 370)) {
|
||||
# Need OpenSSH 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
|
||||
logmsg "$sshverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
|
||||
return "failed starting socks5 server";
|
||||
}
|
||||
elsif(($sshid =~ /SunSSH/) && ($sshvernum < 100)) {
|
||||
# Need SunSSH 1.0 for socks5
|
||||
logmsg "$sshverstr insufficient; socks5 tests need at least SunSSH 1.0\n";
|
||||
return "failed starting socks5 server";
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif($what eq "none") {
|
||||
logmsg "* starts no server\n" if ($verbose);
|
||||
@ -2881,6 +2937,8 @@ close(CMDLOG);
|
||||
# Tests done, stop the servers
|
||||
stopservers($verbose);
|
||||
|
||||
unlink($SOCKSPIDFILE);
|
||||
|
||||
my $all = $total + $skipped;
|
||||
|
||||
if($total) {
|
||||
|
344
tests/sshhelp.pm
Normal file
344
tests/sshhelp.pm
Normal file
@ -0,0 +1,344 @@
|
||||
#***************************************************************************
|
||||
# _ _ ____ _
|
||||
# Project ___| | | | _ \| |
|
||||
# / __| | | | |_) | |
|
||||
# | (__| |_| | _ <| |___
|
||||
# \___|\___/|_| \_\_____|
|
||||
#
|
||||
# Copyright (C) 1998 - 2008, Daniel Stenberg, <daniel@haxx.se>, et al.
|
||||
#
|
||||
# This software is licensed as described in the file COPYING, which
|
||||
# you should have received as part of this distribution. The terms
|
||||
# are also available at http://curl.haxx.se/docs/copyright.html.
|
||||
#
|
||||
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
|
||||
# copies of the Software, and permit persons to whom the Software is
|
||||
# furnished to do so, under the terms of the COPYING file.
|
||||
#
|
||||
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
|
||||
# KIND, either express or implied.
|
||||
#
|
||||
# $Id:
|
||||
#***************************************************************************
|
||||
|
||||
package sshhelp;
|
||||
|
||||
use strict;
|
||||
#use warnings;
|
||||
use Exporter;
|
||||
use File::Spec;
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Global symbols allowed without explicit package name
|
||||
#
|
||||
use vars qw(
|
||||
@ISA
|
||||
@EXPORT_OK
|
||||
$sshdexe
|
||||
$sshexe
|
||||
$sftpexe
|
||||
$sshkeygenexe
|
||||
$sshdconfig
|
||||
$sshconfig
|
||||
$knownhosts
|
||||
$sshdlog
|
||||
$sshlog
|
||||
$hstprvkeyf
|
||||
$hstpubkeyf
|
||||
$cliprvkeyf
|
||||
$clipubkeyf
|
||||
@sftppath
|
||||
);
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Inherit Exporter's capabilities
|
||||
#
|
||||
@ISA = qw(Exporter);
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Global symbols this module will export upon request
|
||||
#
|
||||
@EXPORT_OK = qw(
|
||||
$sshdexe
|
||||
$sshexe
|
||||
$sftpexe
|
||||
$sshkeygenexe
|
||||
$sshdconfig
|
||||
$sshconfig
|
||||
$knownhosts
|
||||
$sshdlog
|
||||
$sshlog
|
||||
$hstprvkeyf
|
||||
$hstpubkeyf
|
||||
$cliprvkeyf
|
||||
$clipubkeyf
|
||||
display_sshdconfig
|
||||
display_sshconfig
|
||||
display_sshdlog
|
||||
display_sshlog
|
||||
dump_array
|
||||
find_sshd
|
||||
find_ssh
|
||||
find_sftp
|
||||
find_sshkeygen
|
||||
logmsg
|
||||
sshversioninfo
|
||||
);
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Global variables initialization
|
||||
#
|
||||
$sshdexe = 'sshd' .exe_ext(); # base name and ext of ssh daemon
|
||||
$sshexe = 'ssh' .exe_ext(); # base name and ext of ssh client
|
||||
$sftpexe = 'sftp-server' .exe_ext(); # base name and ext of sftp-server
|
||||
$sshkeygenexe = 'ssh-keygen' .exe_ext(); # base name and ext of ssh-keygen
|
||||
$sshdconfig = 'curl_sshd_config'; # ssh daemon config file
|
||||
$sshconfig = 'curl_ssh_config'; # ssh client config file
|
||||
$sshdlog = 'log/sshd.log'; # ssh daemon log file
|
||||
$sshlog = 'log/ssh.log'; # ssh client log file
|
||||
$knownhosts = 'curl_client_knownhosts'; # ssh knownhosts file
|
||||
$hstprvkeyf = 'curl_host_dsa_key'; # host private key file
|
||||
$hstpubkeyf = 'curl_host_dsa_key.pub'; # host public key file
|
||||
$cliprvkeyf = 'curl_client_key'; # client private key file
|
||||
$clipubkeyf = 'curl_client_key.pub'; # client public key file
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Absolute paths where to look for sftp-server plugin
|
||||
#
|
||||
@sftppath = qw(
|
||||
/usr/lib/openssh
|
||||
/usr/libexec/openssh
|
||||
/usr/libexec
|
||||
/usr/local/libexec
|
||||
/opt/local/libexec
|
||||
/usr/lib/ssh
|
||||
/usr/libexec/ssh
|
||||
/usr/sbin
|
||||
/usr/lib
|
||||
/usr/lib/ssh/openssh
|
||||
/usr/lib64/ssh
|
||||
/usr/lib64/misc
|
||||
/usr/lib/misc
|
||||
/usr/local/sbin
|
||||
/usr/freeware/bin
|
||||
/opt/ssh/sbin
|
||||
/opt/ssh/libexec
|
||||
);
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Return file extension for executable files on this operating system
|
||||
#
|
||||
sub exe_ext {
|
||||
if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys' ||
|
||||
$^O eq 'dos' || $^O eq 'os2') {
|
||||
return '.exe';
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Create or overwrite the given file with lines from an array of strings
|
||||
#
|
||||
sub dump_array {
|
||||
my ($filename, @arr) = @_;
|
||||
my $error;
|
||||
|
||||
if(!$filename) {
|
||||
$error = 'Error: Missing argument 1 for dump_array()';
|
||||
}
|
||||
elsif(open(TEXTFH, ">$filename")) {
|
||||
foreach my $line (@arr) {
|
||||
$line .= "\n" unless($line =~ /\n$/);
|
||||
print TEXTFH $line;
|
||||
}
|
||||
if(!close(TEXTFH)) {
|
||||
$error = "Error: cannot close file $filename";
|
||||
}
|
||||
}
|
||||
else {
|
||||
$error = "Error: cannot write file $filename";
|
||||
}
|
||||
return $error;
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Display a message
|
||||
#
|
||||
sub logmsg {
|
||||
my ($line) = @_;
|
||||
chomp $line if($line);
|
||||
$line .= "\n";
|
||||
print "$line";
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Display contents of the given file
|
||||
#
|
||||
sub display_file {
|
||||
my $filename = $_[0];
|
||||
print "=== Start of file $filename\n";
|
||||
if(open(DISPLAYFH, "<$filename")) {
|
||||
while(my $line = <DISPLAYFH>) {
|
||||
print "$line";
|
||||
}
|
||||
close DISPLAYFH;
|
||||
}
|
||||
print "=== End of file $filename\n";
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Display contents of the ssh daemon config file
|
||||
#
|
||||
sub display_sshdconfig {
|
||||
display_file($sshdconfig);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Display contents of the ssh client config file
|
||||
#
|
||||
sub display_sshconfig {
|
||||
display_file($sshconfig);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Display contents of the ssh daemon log file
|
||||
#
|
||||
sub display_sshdlog {
|
||||
display_file($sshdlog);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Display contents of the ssh client log file
|
||||
#
|
||||
sub display_sshlog {
|
||||
display_file($sshlog);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Find a file somewhere in the given path
|
||||
#
|
||||
sub find_file {
|
||||
my $fn = $_[0];
|
||||
shift;
|
||||
my @path = @_;
|
||||
foreach (@path) {
|
||||
my $file = File::Spec->catfile($_, $fn);
|
||||
if(-e $file) {
|
||||
return $file;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Find a file in environment path or in our sftppath
|
||||
#
|
||||
sub find_sfile {
|
||||
my $filename = $_[0];
|
||||
my @spath;
|
||||
push(@spath, File::Spec->path());
|
||||
push(@spath, @sftppath);
|
||||
return find_file($filename, @spath);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Find ssh daemon and return canonical filename
|
||||
#
|
||||
sub find_sshd {
|
||||
return find_sfile($sshdexe);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Find ssh client and return canonical filename
|
||||
#
|
||||
sub find_ssh {
|
||||
return find_sfile($sshexe);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Find sftp-server plugin and return canonical filename
|
||||
#
|
||||
sub find_sftp {
|
||||
return find_sfile($sftpexe);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Find ssh-keygen and return canonical filename
|
||||
#
|
||||
sub find_sshkeygen {
|
||||
return find_sfile($sshkeygenexe);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# Return version info for the given ssh client or server binaries
|
||||
#
|
||||
sub sshversioninfo {
|
||||
my $sshbin = $_[0]; # canonical filename
|
||||
my $major;
|
||||
my $minor;
|
||||
my $patch;
|
||||
my $sshid;
|
||||
my $versnum;
|
||||
my $versstr;
|
||||
my $error;
|
||||
|
||||
if(!$sshbin) {
|
||||
$error = 'Error: Missing argument 1 for sshversioninfo()';
|
||||
}
|
||||
elsif(! -x $sshbin) {
|
||||
$error = "Error: cannot read or execute $sshbin";
|
||||
}
|
||||
else {
|
||||
my $cmd = ($sshbin =~ /$sshdexe$/) ? "$sshbin -?" : "$sshbin -V";
|
||||
$error = "$cmd\n";
|
||||
foreach my $tmpstr (qx($cmd 2>&1)) {
|
||||
if($tmpstr =~ /OpenSSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
|
||||
$major = $1;
|
||||
$minor = $2;
|
||||
$patch = $4?$4:0;
|
||||
$sshid = 'OpenSSH';
|
||||
$versnum = (100*$major) + (10*$minor) + $patch;
|
||||
$versstr = "$sshid $major.$minor.$patch";
|
||||
$error = undef;
|
||||
last;
|
||||
}
|
||||
if($tmpstr =~ /Sun[_-]SSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
|
||||
$major = $1;
|
||||
$minor = $2;
|
||||
$patch = $4?$4:0;
|
||||
$sshid = 'SunSSH';
|
||||
$versnum = (100*$major) + (10*$minor) + $patch;
|
||||
$versstr = "$sshid $major.$minor.$patch";
|
||||
$error = undef;
|
||||
last;
|
||||
}
|
||||
$error .= $tmpstr;
|
||||
}
|
||||
chomp $error if($error);
|
||||
}
|
||||
return ($sshid, $versnum, $versstr, $error);
|
||||
}
|
||||
|
||||
|
||||
#***************************************************************************
|
||||
# End of library
|
||||
1;
|
||||
|
1098
tests/sshserver.pl
1098
tests/sshserver.pl
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user