CMakeLua/Utilities/cmcurl-7.19.0/tests/sshhelp.pm

   1 #***************************************************************************
   2 #                                  _   _ ____  _
   3 #  Project                     ___| | | |  _ \| |
   4 #                             / __| | | | |_) | |
   5 #                            | (__| |_| |  _ <| |___
   6 #                             \___|\___/|_| \_\_____|
   7 #
   8 # Copyright (C) 1998 - 2008, 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 # $Id: sshhelp.pm,v 1.1.1.1 2008-09-23 16:32:06 hoffman Exp $
  22 #***************************************************************************
  23
  24 package sshhelp;
  25
  26 use strict;
  27 #use warnings;
  28 use Exporter;
  29 use File::Spec;
  30
  31
  32 #***************************************************************************
  33 # Global symbols allowed without explicit package name
  34 #
  35 use vars qw(
  36     @ISA
  37     @EXPORT_OK
  38     $sshdexe
  39     $sshexe
  40     $sftpsrvexe
  41     $sftpexe
  42     $sshkeygenexe
  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     );
  57
  58
  59 #***************************************************************************
  60 # Inherit Exporter's capabilities
  61 #
  62 @ISA = qw(Exporter);
  63
  64
  65 #***************************************************************************
  66 # Global symbols this module will export upon request
  67 #
  68 @EXPORT_OK = qw(
  69     $sshdexe
  70     $sshexe
  71     $sftpsrvexe
  72     $sftpexe
  73     $sshkeygenexe
  74     $sshdconfig
  75     $sshconfig
  76     $sftpconfig
  77     $knownhosts
  78     $sshdlog
  79     $sshlog
  80     $sftplog
  81     $sftpcmds
  82     $hstprvkeyf
  83     $hstpubkeyf
  84     $cliprvkeyf
  85     $clipubkeyf
  86     display_sshdconfig
  87     display_sshconfig
  88     display_sftpconfig
  89     display_sshdlog
  90     display_sshlog
  91     display_sftplog
  92     dump_array
  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      = 'log/sshd.log';           # ssh daemon log file
 115 $sshlog       = 'log/ssh.log';            # ssh client log file
 116 $sftplog      = 'log/sftp.log';           # 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     display_file($sshdlog);
 244 }
 245
 246
 247 #***************************************************************************
 248 # Display contents of the ssh client log file
 249 #
 250 sub display_sshlog {
 251     display_file($sshlog);
 252 }
 253
 254
 255 #***************************************************************************
 256 # Display contents of the sftp client log file
 257 #
 258 sub display_sftplog {
 259     display_file($sftplog);
 260 }
 261
 262
 263 #***************************************************************************
 264 # Find a file somewhere in the given path
 265 #
 266 sub find_file {
 267     my $fn = $_[0];
 268     shift;
 269     my @path = @_;
 270     foreach (@path) {
 271         my $file = File::Spec->catfile($_, $fn);
 272         if(-e $file) {
 273             return $file;
 274         }
 275     }
 276 }
 277
 278
 279 #***************************************************************************
 280 # Find a file in environment path or in our sftppath
 281 #
 282 sub find_sfile {
 283     my $filename = $_[0];
 284     my @spath;
 285     push(@spath, File::Spec->path());
 286     push(@spath, @sftppath);
 287     return find_file($filename, @spath);
 288 }
 289
 290
 291 #***************************************************************************
 292 # Find ssh daemon and return canonical filename
 293 #
 294 sub find_sshd {
 295     return find_sfile($sshdexe);
 296 }
 297
 298
 299 #***************************************************************************
 300 # Find ssh client and return canonical filename
 301 #
 302 sub find_ssh {
 303     return find_sfile($sshexe);
 304 }
 305
 306
 307 #***************************************************************************
 308 # Find sftp-server plugin and return canonical filename
 309 #
 310 sub find_sftpsrv {
 311     return find_sfile($sftpsrvexe);
 312 }
 313
 314
 315 #***************************************************************************
 316 # Find sftp client and return canonical filename
 317 #
 318 sub find_sftp {
 319     return find_sfile($sftpexe);
 320 }
 321
 322
 323 #***************************************************************************
 324 # Find ssh-keygen and return canonical filename
 325 #
 326 sub find_sshkeygen {
 327     return find_sfile($sshkeygenexe);
 328 }
 329
 330
 331 #***************************************************************************
 332 # Return version info for the given ssh client or server binaries
 333 #
 334 sub sshversioninfo {
 335     my $sshbin = $_[0]; # canonical filename
 336     my $major;
 337     my $minor;
 338     my $patch;
 339     my $sshid;
 340     my $versnum;
 341     my $versstr;
 342     my $error;
 343
 344     if(!$sshbin) {
 345         $error = 'Error: Missing argument 1 for sshversioninfo()';
 346     }
 347     elsif(! -x $sshbin) {
 348         $error = "Error: cannot read or execute $sshbin";
 349     }
 350     else {
 351         my $cmd = ($sshbin =~ /$sshdexe$/) ? "$sshbin -?" : "$sshbin -V";
 352         $error = "$cmd\n";
 353         foreach my $tmpstr (qx($cmd 2>&1)) {
 354             if($tmpstr =~ /OpenSSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
 355                 $major = $1;
 356                 $minor = $2;
 357                 $patch = $4?$4:0;
 358                 $sshid = 'OpenSSH';
 359                 $versnum = (100*$major) + (10*$minor) + $patch;
 360                 $versstr = "$sshid $major.$minor.$patch";
 361                 $error = undef;
 362                 last;
 363             }
 364             if($tmpstr =~ /Sun[_-]SSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
 365                 $major = $1;
 366                 $minor = $2;
 367                 $patch = $4?$4:0;
 368                 $sshid = 'SunSSH';
 369                 $versnum = (100*$major) + (10*$minor) + $patch;
 370                 $versstr = "$sshid $major.$minor.$patch";
 371                 $error = undef;
 372                 last;
 373             }
 374             $error .= $tmpstr;
 375         }
 376         chomp $error if($error);
 377     }
 378     return ($sshid, $versnum, $versstr, $error);
 379 }
 380
 381
 382 #***************************************************************************
 383 # End of library
 384 1;
 385