1#*************************************************************************** 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) 1998 - 2014, 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 23package sshhelp; 24 25use strict; 26use warnings; 27use Exporter; 28use File::Spec; 29 30 31#*************************************************************************** 32# Global symbols allowed without explicit package name 33# 34use 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# 182sub 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# 193sub 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# 219sub 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# 230sub 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# 246sub display_sshdconfig { 247 display_file($sshdconfig); 248} 249 250 251#*************************************************************************** 252# Display contents of the ssh client config file 253# 254sub display_sshconfig { 255 display_file($sshconfig); 256} 257 258 259#*************************************************************************** 260# Display contents of the sftp client config file 261# 262sub display_sftpconfig { 263 display_file($sftpconfig); 264} 265 266 267#*************************************************************************** 268# Display contents of the ssh daemon log file 269# 270sub 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# 279sub 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# 288sub 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# 297sub 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# 313sub 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# 331sub 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# 343sub 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# 355sub find_sshd { 356 return find_file_spath($sshdexe); 357} 358 359 360#*************************************************************************** 361# Find ssh client and return canonical filename 362# 363sub find_ssh { 364 return find_file_spath($sshexe); 365} 366 367 368#*************************************************************************** 369# Find sftp-server plugin and return canonical filename 370# 371sub find_sftpsrv { 372 return find_file_spath($sftpsrvexe); 373} 374 375 376#*************************************************************************** 377# Find sftp client and return canonical filename 378# 379sub find_sftp { 380 return find_file_spath($sftpexe); 381} 382 383 384#*************************************************************************** 385# Find ssh-keygen and return canonical filename 386# 387sub find_sshkeygen { 388 return find_file_spath($sshkeygenexe); 389} 390 391 392#*************************************************************************** 393# Find httptlssrv (gnutls-serv) and return canonical filename 394# 395sub 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# 403sub 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 4531; 454 455