mirror/curl
2
0
Fork 0
mirror of https://github.com/curl/curl.git synced 2024-12-15 06:40:09 +08:00
Code Issues Packages Projects Releases Wiki Activity
4ae2d9f24d
curl/tests/sshhelp.pm
Dan Fandrich 70d2fca2f6 tests: move server config files under the pid dir 
These files are generated by the test servers and must therefore be
found in the log directory to make them available to only those servers
once multiple test runners are executing in parallel. They must also not
be deleted with the log files, so they are stored in the pidfile
directory.

Ref: #10818
Closes #10875
2023-03-31 23:08:00 -07:00

491 lines
13 KiB
Perl
Raw Blame History

#***************************************************************************
# _ _ ____ _
# Project ___| | | | _ \| |
# / __| | | | |_) | |
# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
# Copyright (C) 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 https://curl.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.
#
# SPDX-License-Identifier: curl
#
#***************************************************************************
package sshhelp;
use strict;
use warnings;
use File::Spec;
#***************************************************************************
# Global symbols allowed without explicit package name
#
use vars qw(
@EXPORT_OK
$sshdexe
$sshexe
$sftpsrvexe
$sftpexe
$sshkeygenexe
$httptlssrvexe
$sshdconfig
$sshconfig
$sftpconfig
$knownhosts
$sshdlog
$sshlog
$sftplog
$sftpcmds
$hstprvkeyf
$hstpubkeyf
$hstpubmd5f
$hstpubsha256f
$cliprvkeyf
$clipubkeyf
@sftppath
@httptlssrvpath
);
#***************************************************************************
# Inherit Exporter's capabilities
#
use base qw(Exporter);
#***************************************************************************
# Global symbols this module will export upon request
#
@EXPORT_OK = qw(
$sshdexe
$sshexe
$sftpsrvexe
$sftpexe
$sshkeygenexe
$sshdconfig
$sshconfig
$sftpconfig
$knownhosts
$sshdlog
$sshlog
$sftplog
$sftpcmds
$hstprvkeyf
$hstpubkeyf
$hstpubmd5f
$hstpubsha256f
$cliprvkeyf
$clipubkeyf
display_sshdconfig
display_sshconfig
display_sftpconfig
display_sshdlog
display_sshlog
display_sftplog
dump_array
exe_ext
find_sshd
find_ssh
find_sftpsrv
find_sftp
find_sshkeygen
find_httptlssrv
logmsg
sshversioninfo
);
#***************************************************************************
# Global variables initialization
#
$sshdexe = 'sshd' .exe_ext('SSH'); # base name and ext of ssh daemon
$sshexe = 'ssh' .exe_ext('SSH'); # base name and ext of ssh client
$sftpsrvexe = 'sftp-server' .exe_ext('SSH'); # base name and ext of sftp-server
$sftpexe = 'sftp' .exe_ext('SSH'); # base name and ext of sftp client
$sshkeygenexe = 'ssh-keygen' .exe_ext('SSH'); # base name and ext of ssh-keygen
$httptlssrvexe = 'gnutls-serv' .exe_ext('SSH'); # base name and ext of gnutls-serv
$sshdconfig = 'curl_sshd_config'; # ssh daemon config file
$sshconfig = 'curl_ssh_config'; # ssh client config file
$sftpconfig = 'curl_sftp_config'; # sftp client config file
$sshdlog = undef; # ssh daemon log file
$sshlog = undef; # ssh client log file
$sftplog = undef; # sftp client log file
$sftpcmds = 'curl_sftp_cmds'; # sftp client commands batch file
$knownhosts = 'curl_client_knownhosts'; # ssh knownhosts file
$hstprvkeyf = 'curl_host_rsa_key'; # host private key file
$hstpubkeyf = 'curl_host_rsa_key.pub'; # host public key file
$hstpubmd5f = 'curl_host_rsa_key.pub_md5'; # md5 hash of host public key
$hstpubsha256f = 'curl_host_rsa_key.pub_sha256'; # sha256 hash of host public key
$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, when not in PATH
#
@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
/usr/freeware/sbin
/usr/freeware/libexec
/opt/ssh/sbin
/opt/ssh/libexec
);
#***************************************************************************
# Absolute paths where to look for httptlssrv (gnutls-serv), when not in PATH
#
@httptlssrvpath = qw(
/usr/sbin
/usr/libexec
/usr/lib
/usr/lib/misc
/usr/lib64/misc
/usr/local/bin
/usr/local/sbin
/usr/local/libexec
/opt/local/bin
/opt/local/sbin
/opt/local/libexec
/usr/freeware/bin
/usr/freeware/sbin
/usr/freeware/libexec
/opt/gnutls/bin
/opt/gnutls/sbin
/opt/gnutls/libexec
);
#***************************************************************************
# Return file extension for executable files on this operating system
#
sub exe_ext {
my ($component, @arr) = @_;
if ($ENV{'CURL_TEST_EXE_EXT'}) {
return $ENV{'CURL_TEST_EXE_EXT'};
}
if ($ENV{'CURL_TEST_EXE_EXT_'.$component}) {
return $ENV{'CURL_TEST_EXE_EXT_'.$component};
}
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(my $textfh, ">", $filename)) {
foreach my $line (@arr) {
$line .= "\n" if($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(my $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 sftp client config file
#
sub display_sftpconfig {
display_file($sftpconfig);
}
#***************************************************************************
# Display contents of the ssh daemon log file
#
sub display_sshdlog {
die "error: \$sshdlog uninitialized" if(not defined $sshdlog);
display_file($sshdlog);
}
#***************************************************************************
# Display contents of the ssh client log file
#
sub display_sshlog {
die "error: \$sshlog uninitialized" if(not defined $sshlog);
display_file($sshlog);
}
#***************************************************************************
# Display contents of the sftp client log file
#
sub display_sftplog {
die "error: \$sftplog uninitialized" if(not defined $sftplog);
display_file($sftplog);
}
#***************************************************************************
# 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 && ! -d $file) {
return $file;
}
}
return "";
}
#***************************************************************************
# Find an executable file somewhere in the given path
#
sub find_exe_file {
my $fn = $_[0];
shift;
my @path = @_;
my $xext = exe_ext('SSH');
foreach (@path) {
my $file = File::Spec->catfile($_, $fn);
if(-e $file && ! -d $file) {
return $file if(-x $file);
return $file if(($xext) && (lc($file) =~ /\Q$xext\E$/));
}
}
return "";
}
#***************************************************************************
# Find a file in environment path or in our sftppath
#
sub find_file_spath {
my $filename = $_[0];
my @spath;
push(@spath, File::Spec->path());
push(@spath, @sftppath);
return find_file($filename, @spath);
}
#***************************************************************************
# Find an executable file in environment path or in our httptlssrvpath
#
sub find_exe_file_hpath {
my $filename = $_[0];
my @hpath;
push(@hpath, File::Spec->path());
push(@hpath, @httptlssrvpath);
return find_exe_file($filename, @hpath);
}
#***************************************************************************
# Find ssh daemon and return canonical filename
#
sub find_sshd {
return find_file_spath($sshdexe);
}
#***************************************************************************
# Find ssh client and return canonical filename
#
sub find_ssh {
return find_file_spath($sshexe);
}
#***************************************************************************
# Find sftp-server plugin and return canonical filename
#
sub find_sftpsrv {
return find_file_spath($sftpsrvexe);
}
#***************************************************************************
# Find sftp client and return canonical filename
#
sub find_sftp {
return find_file_spath($sftpexe);
}
#***************************************************************************
# Find ssh-keygen and return canonical filename
#
sub find_sshkeygen {
return find_file_spath($sshkeygenexe);
}
#***************************************************************************
# Find httptlssrv (gnutls-serv) and return canonical filename
#
sub find_httptlssrv {
my $p = find_exe_file_hpath($httptlssrvexe);
if($p) {
my @o = `"$p" -l`;
my $found;
for(@o) {
if(/Key exchange: SRP/) {
$found = 1;
last;
}
}
return $p if($found);
}
return "";
}
#***************************************************************************
# 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 =~ /OpenSSH[_-]for[_-]Windows[_-](\d+)\.(\d+)(\.(\d+))*/i) {
$major = $1;
$minor = $2;
$patch = $4?$4:0;
$sshid = 'OpenSSH-Windows';
$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;
Reference in New Issue View Git Blame Copy Permalink