tests/sshhelp.pm

   1 #***************************************************************************
   2 #                                  _   _ ____  _
   3 #  Project                     ___| | | |  _ \| |
   4 #                             / __| | | | |_) | |
   5 #                            | (__| |_| |  _ <| |___
   6 #                             \___|\___/|_| \_\_____|
   7 #
   8 # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
   9 #
  10 # This software is licensed as described in the file COPYING, which
  11 # you should have received as part of this distribution. The terms
  12 # are also available at https://curl.se/docs/copyright.html.
  13 #
  14 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  15 # copies of the Software, and permit persons to whom the Software is
  16 # furnished to do so, under the terms of the COPYING file.
  17 #
  18 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  19 # KIND, either express or implied.
  20 #
  21 # SPDX-License-Identifier: curl
  22 #
  23 #***************************************************************************
  24
  25 package sshhelp;
  26
  27 use strict;
  28 use warnings;
  29
  30 BEGIN {
  31     use base qw(Exporter);
  32
  33     our @EXPORT_OK = qw(
  34         $sshdexe
  35         $sshexe
  36         $sftpsrvexe
  37         $sftpexe
  38         $sshkeygenexe
  39         $sshdconfig
  40         $sshconfig
  41         $sftpconfig
  42         $knownhosts
  43         $sshdlog
  44         $sshlog
  45         $sftplog
  46         $sftpcmds
  47         $hstprvkeyf
  48         $hstpubkeyf
  49         $hstpubmd5f
  50         $hstpubsha256f
  51         $cliprvkeyf
  52         $clipubkeyf
  53         display_sshdconfig
  54         display_sshconfig
  55         display_sftpconfig
  56         display_sshdlog
  57         display_sshlog
  58         display_sftplog
  59         dump_array
  60         find_sshd
  61         find_ssh
  62         find_sftpsrv
  63         find_sftp
  64         find_sshkeygen
  65         find_httptlssrv
  66         sshversioninfo
  67     );
  68 }
  69
  70 use File::Spec;
  71
  72 use pathhelp qw(
  73     exe_ext
  74     );
  75
  76 #***************************************************************************
  77 # Global variables initialization
  78 #
  79 our $sshdexe         = 'sshd'        .exe_ext('SSH'); # base name and ext of ssh daemon
  80 our $sshexe          = 'ssh'         .exe_ext('SSH'); # base name and ext of ssh client
  81 our $sftpsrvexe      = 'sftp-server' .exe_ext('SSH'); # base name and ext of sftp-server
  82 our $sftpexe         = 'sftp'        .exe_ext('SSH'); # base name and ext of sftp client
  83 our $sshkeygenexe    = 'ssh-keygen'  .exe_ext('SSH'); # base name and ext of ssh-keygen
  84 our $httptlssrvexe   = 'gnutls-serv' .exe_ext('SSH'); # base name and ext of gnutls-serv
  85 our $sshdconfig      = 'curl_sshd_config';       # ssh daemon config file
  86 our $sshconfig       = 'curl_ssh_config';        # ssh client config file
  87 our $sftpconfig      = 'curl_sftp_config';       # sftp client config file
  88 our $sshdlog         = undef;                    # ssh daemon log file
  89 our $sshlog          = undef;                    # ssh client log file
  90 our $sftplog         = undef;                    # sftp client log file
  91 our $sftpcmds        = 'curl_sftp_cmds';         # sftp client commands batch file
  92 our $knownhosts      = 'curl_client_knownhosts'; # ssh knownhosts file
  93 our $hstprvkeyf      = 'curl_host_rsa_key';      # host private key file
  94 our $hstpubkeyf      = 'curl_host_rsa_key.pub';  # host public key file
  95 our $hstpubmd5f      = 'curl_host_rsa_key.pub_md5';  # md5 hash of host public key
  96 our $hstpubsha256f   = 'curl_host_rsa_key.pub_sha256';  # sha256 hash of host public key
  97 our $cliprvkeyf      = 'curl_client_key';        # client private key file
  98 our $clipubkeyf      = 'curl_client_key.pub';    # client public key file
  99
 100
 101 #***************************************************************************
 102 # Absolute paths where to look for sftp-server plugin, when not in PATH
 103 #
 104 our @sftppath = qw(
 105     /usr/lib/openssh
 106     /usr/libexec/openssh
 107     /usr/libexec
 108     /usr/local/libexec
 109     /opt/local/libexec
 110     /usr/lib/ssh
 111     /usr/libexec/ssh
 112     /usr/sbin
 113     /usr/lib
 114     /usr/lib/ssh/openssh
 115     /usr/lib64/ssh
 116     /usr/lib64/misc
 117     /usr/lib/misc
 118     /usr/local/sbin
 119     /usr/freeware/bin
 120     /usr/freeware/sbin
 121     /usr/freeware/libexec
 122     /opt/ssh/sbin
 123     /opt/ssh/libexec
 124     );
 125
 126
 127 #***************************************************************************
 128 # Absolute paths where to look for httptlssrv (gnutls-serv), when not in PATH
 129 #
 130 our @httptlssrvpath = qw(
 131     /usr/sbin
 132     /usr/libexec
 133     /usr/lib
 134     /usr/lib/misc
 135     /usr/lib64/misc
 136     /usr/local/bin
 137     /usr/local/sbin
 138     /usr/local/libexec
 139     /opt/local/bin
 140     /opt/local/sbin
 141     /opt/local/libexec
 142     /usr/freeware/bin
 143     /usr/freeware/sbin
 144     /usr/freeware/libexec
 145     /opt/gnutls/bin
 146     /opt/gnutls/sbin
 147     /opt/gnutls/libexec
 148     );
 149
 150
 151 #***************************************************************************
 152 # Create or overwrite the given file with lines from an array of strings
 153 #
 154 sub dump_array {
 155     my ($filename, @arr) = @_;
 156     my $error;
 157
 158     if(!$filename) {
 159         $error = 'Error: Missing argument 1 for dump_array()';
 160     }
 161     elsif(open(my $textfh, ">", $filename)) {
 162         foreach my $line (@arr) {
 163             $line .= "\n" if($line !~ /\n$/);
 164             print $textfh $line;
 165         }
 166         if(!close($textfh)) {
 167             $error = "Error: cannot close file $filename";
 168         }
 169     }
 170     else {
 171         $error = "Error: cannot write file $filename";
 172     }
 173     return $error;
 174 }
 175
 176
 177 #***************************************************************************
 178 # Display contents of the given file
 179 #
 180 sub display_file {
 181     my $filename = $_[0];
 182     print "=== Start of file $filename\n";
 183     if(open(my $displayfh, "<", "$filename")) {
 184         while(my $line = <$displayfh>) {
 185             print "$line";
 186         }
 187         close $displayfh;
 188     }
 189     print "=== End of file $filename\n";
 190 }
 191
 192
 193 #***************************************************************************
 194 # Display contents of the ssh daemon config file
 195 #
 196 sub display_sshdconfig {
 197     display_file($sshdconfig);
 198 }
 199
 200
 201 #***************************************************************************
 202 # Display contents of the ssh client config file
 203 #
 204 sub display_sshconfig {
 205     display_file($sshconfig);
 206 }
 207
 208
 209 #***************************************************************************
 210 # Display contents of the sftp client config file
 211 #
 212 sub display_sftpconfig {
 213     display_file($sftpconfig);
 214 }
 215
 216
 217 #***************************************************************************
 218 # Display contents of the ssh daemon log file
 219 #
 220 sub display_sshdlog {
 221     die "error: \$sshdlog uninitialized" if(not defined $sshdlog);
 222     display_file($sshdlog);
 223 }
 224
 225
 226 #***************************************************************************
 227 # Display contents of the ssh client log file
 228 #
 229 sub display_sshlog {
 230     die "error: \$sshlog uninitialized" if(not defined $sshlog);
 231     display_file($sshlog);
 232 }
 233
 234
 235 #***************************************************************************
 236 # Display contents of the sftp client log file
 237 #
 238 sub display_sftplog {
 239     die "error: \$sftplog uninitialized" if(not defined $sftplog);
 240     display_file($sftplog);
 241 }
 242
 243
 244 #***************************************************************************
 245 # Find a file somewhere in the given path
 246 #
 247 sub find_file {
 248     my $fn = $_[0];
 249     shift;
 250     my @path = @_;
 251     foreach (@path) {
 252         my $file = File::Spec->catfile($_, $fn);
 253         if(-e $file && ! -d $file) {
 254             return $file;
 255         }
 256     }
 257     return "";
 258 }
 259
 260
 261 #***************************************************************************
 262 # Find an executable file somewhere in the given path
 263 #
 264 sub find_exe_file {
 265     my $fn = $_[0];
 266     shift;
 267     my @path = @_;
 268     my $xext = exe_ext('SSH');
 269     foreach (@path) {
 270         my $file = File::Spec->catfile($_, $fn);
 271         if(-e $file && ! -d $file) {
 272             return $file if(-x $file);
 273             return $file if(($xext) && (lc($file) =~ /\Q$xext\E$/));
 274         }
 275     }
 276     return "";
 277 }
 278
 279
 280 #***************************************************************************
 281 # Find a file in environment path or in our sftppath
 282 #
 283 sub find_file_spath {
 284     my $filename = $_[0];
 285     my @spath;
 286     push(@spath, File::Spec->path());
 287     push(@spath, @sftppath);
 288     return find_file($filename, @spath);
 289 }
 290
 291
 292 #***************************************************************************
 293 # Find an executable file in environment path or in our httptlssrvpath
 294 #
 295 sub find_exe_file_hpath {
 296     my $filename = $_[0];
 297     my @hpath;
 298     push(@hpath, File::Spec->path());
 299     push(@hpath, @httptlssrvpath);
 300     return find_exe_file($filename, @hpath);
 301 }
 302
 303
 304 #***************************************************************************
 305 # Find ssh daemon and return canonical filename
 306 #
 307 sub find_sshd {
 308     return find_file_spath($sshdexe);
 309 }
 310
 311
 312 #***************************************************************************
 313 # Find ssh client and return canonical filename
 314 #
 315 sub find_ssh {
 316     return find_file_spath($sshexe);
 317 }
 318
 319
 320 #***************************************************************************
 321 # Find sftp-server plugin and return canonical filename
 322 #
 323 sub find_sftpsrv {
 324     return find_file_spath($sftpsrvexe);
 325 }
 326
 327
 328 #***************************************************************************
 329 # Find sftp client and return canonical filename
 330 #
 331 sub find_sftp {
 332     return find_file_spath($sftpexe);
 333 }
 334
 335
 336 #***************************************************************************
 337 # Find ssh-keygen and return canonical filename
 338 #
 339 sub find_sshkeygen {
 340     return find_file_spath($sshkeygenexe);
 341 }
 342
 343
 344 #***************************************************************************
 345 # Find httptlssrv (gnutls-serv) and return canonical filename
 346 #
 347 sub find_httptlssrv {
 348     my $p = find_exe_file_hpath($httptlssrvexe);
 349     if($p) {
 350         my @o = `"$p" -l`;
 351         my $found;
 352         for(@o) {
 353             if(/Key exchange: SRP/) {
 354                 $found = 1;
 355                 last;
 356             }
 357         }
 358         return $p if($found);
 359     }
 360     return "";
 361 }
 362
 363
 364 #***************************************************************************
 365 # Return version info for the given ssh client or server binaries
 366 #
 367 sub sshversioninfo {
 368     my $sshbin = $_[0]; # canonical filename
 369     my $major;
 370     my $minor;
 371     my $patch;
 372     my $sshid;
 373     my $versnum;
 374     my $versstr;
 375     my $error;
 376
 377     if(!$sshbin) {
 378         $error = 'Error: Missing argument 1 for sshversioninfo()';
 379     }
 380     elsif(! -x $sshbin) {
 381         $error = "Error: cannot read or execute $sshbin";
 382     }
 383     else {
 384         my $cmd = ($sshbin =~ /$sshdexe$/) ? "\"$sshbin\" -?" : "\"$sshbin\" -V";
 385         $error = "$cmd\n";
 386         foreach my $tmpstr (qx($cmd 2>&1)) {
 387             if($tmpstr =~ /OpenSSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
 388                 $major = $1;
 389                 $minor = $2;
 390                 $patch = $4?$4:0;
 391                 $sshid = 'OpenSSH';
 392                 $versnum = (100*$major) + (10*$minor) + $patch;
 393                 $versstr = "$sshid $major.$minor.$patch";
 394                 $error = undef;
 395                 last;
 396             }
 397             if($tmpstr =~ /OpenSSH[_-]for[_-]Windows[_-](\d+)\.(\d+)(\.(\d+))*/i) {
 398                 $major = $1;
 399                 $minor = $2;
 400                 $patch = $4?$4:0;
 401                 $sshid = 'OpenSSH-Windows';
 402                 $versnum = (100*$major) + (10*$minor) + $patch;
 403                 $versstr = "$sshid $major.$minor.$patch";
 404                 $error = undef;
 405                 last;
 406             }
 407             if($tmpstr =~ /Sun[_-]SSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
 408                 $major = $1;
 409                 $minor = $2;
 410                 $patch = $4?$4:0;
 411                 $sshid = 'SunSSH';
 412                 $versnum = (100*$major) + (10*$minor) + $patch;
 413                 $versstr = "$sshid $major.$minor.$patch";
 414                 $error = undef;
 415                 last;
 416             }
 417             $error .= $tmpstr;
 418         }
 419         chomp $error if($error);
 420     }
 421     return ($sshid, $versnum, $versstr, $error);
 422 }
 423
 424
 425 #***************************************************************************
 426 # End of library
 427 1;