tests/sshhelp.pm

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