1 #*************************************************************************** 2 # _ _ ____ _ 3 # Project ___| | | | _ \| | 4 # / __| | | | |_) | | 5 # | (__| |_| | _ <| |___ 6 # \___|\___/|_| \_\_____| 7 # 8 # Copyright (C) 1998 - 2014, Daniel Stenberg, <daniel (at] 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 $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_rsa_key'; # host private key file 124 $hstpubkeyf = 'curl_host_rsa_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 455
