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