tests/sshhelp.pm

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