Modify test harness so that the minimum SSH version required to run

                                  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

114 - Ranged downloads on file:// URLs by Daniel Egger (patch failed to apply)

115 -

115 - Cleanup debugging messages in test harness, introduced for new minimum

      SSH version support for SCP, SFTP and SOCKS tests

116 -

#                            | (__| |_| |  _ <| |___

#                             \___|\___/|_| \_\_____|

#

# 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

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

#                            | (__| |_| |  _ <| |___

#                             \___|\___/|_| \_\_____|

#

# 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

@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";

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

#

        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";

    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

        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";

    # 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) {

                $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);

                    ($pid, $pid2) = runsocksserver("", 1);

                    printf ("TRACESSH:startservers: runsocksserver returns pid: %d pid2: %d\n", $pid, $pid2);

                    if($pid <= 0) {

                        return "failed starting socks server";

                    $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);

# Tests done, stop the servers

stopservers($verbose);

unlink($SOCKSPIDFILE);

my $all = $total + $skipped;

if($total) {

#***************************************************************************

#                                  _   _ ____  _

#  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;