1 #***************************************************************************
3 # Project ___| | | | _ \| |
5 # | (__| |_| | _ <| |___
6 # \___|\___/|_| \_\_____|
8 # Copyright (C) 1998 - 2014, Daniel Stenberg, <daniel@haxx.se>, et al.
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.
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.
18 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
19 # KIND, either express or implied.
21 #***************************************************************************
31 #***************************************************************************
32 # Global symbols allowed without explicit package name
60 #***************************************************************************
61 # Inherit Exporter's capabilities
66 #***************************************************************************
67 # Global symbols this module will export upon request
106 #***************************************************************************
107 # Global variables initialization
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
129 #***************************************************************************
130 # Absolute paths where to look for sftp-server plugin, when not in PATH
149 /usr/freeware/libexec
155 #***************************************************************************
156 # Absolute paths where to look for httptlssrv (gnutls-serv), when not in PATH
158 @httptlssrvpath = qw(
172 /usr/freeware/libexec
179 #***************************************************************************
180 # Return file extension for executable files on this operating system
183 if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys' ||
184 $^O eq 'dos' || $^O eq 'os2') {
190 #***************************************************************************
191 # Create or overwrite the given file with lines from an array of strings
194 my ($filename, @arr) = @_;
198 $error = 'Error: Missing argument 1 for dump_array()';
200 elsif(open(TEXTFH, ">$filename")) {
201 foreach my $line (@arr) {
202 $line .= "\n" unless($line =~ /\n$/);
206 $error = "Error: cannot close file $filename";
210 $error = "Error: cannot write file $filename";
216 #***************************************************************************
221 chomp $line if($line);
227 #***************************************************************************
228 # Display contents of the given file
231 my $filename = $_[0];
232 print "=== Start of file $filename\n";
233 if(open(DISPLAYFH, "<$filename")) {
234 while(my $line = <DISPLAYFH>) {
239 print "=== End of file $filename\n";
243 #***************************************************************************
244 # Display contents of the ssh daemon config file
246 sub display_sshdconfig {
247 display_file($sshdconfig);
251 #***************************************************************************
252 # Display contents of the ssh client config file
254 sub display_sshconfig {
255 display_file($sshconfig);
259 #***************************************************************************
260 # Display contents of the sftp client config file
262 sub display_sftpconfig {
263 display_file($sftpconfig);
267 #***************************************************************************
268 # Display contents of the ssh daemon log file
270 sub display_sshdlog {
271 die "error: \$sshdlog uninitialized" if(not defined $sshdlog);
272 display_file($sshdlog);
276 #***************************************************************************
277 # Display contents of the ssh client log file
280 die "error: \$sshlog uninitialized" if(not defined $sshlog);
281 display_file($sshlog);
285 #***************************************************************************
286 # Display contents of the sftp client log file
288 sub display_sftplog {
289 die "error: \$sftplog uninitialized" if(not defined $sftplog);
290 display_file($sftplog);
294 #***************************************************************************
295 # Find a file somewhere in the given path
302 my $file = File::Spec->catfile($_, $fn);
303 if(-e $file && ! -d $file) {
310 #***************************************************************************
311 # Find an executable file somewhere in the given path
317 my $xext = exe_ext();
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$/));
328 #***************************************************************************
329 # Find a file in environment path or in our sftppath
331 sub find_file_spath {
332 my $filename = $_[0];
334 push(@spath, File::Spec->path());
335 push(@spath, @sftppath);
336 return find_file($filename, @spath);
340 #***************************************************************************
341 # Find an executable file in environment path or in our httptlssrvpath
343 sub find_exe_file_hpath {
344 my $filename = $_[0];
346 push(@hpath, File::Spec->path());
347 push(@hpath, @httptlssrvpath);
348 return find_exe_file($filename, @hpath);
352 #***************************************************************************
353 # Find ssh daemon and return canonical filename
356 return find_file_spath($sshdexe);
360 #***************************************************************************
361 # Find ssh client and return canonical filename
364 return find_file_spath($sshexe);
368 #***************************************************************************
369 # Find sftp-server plugin and return canonical filename
372 return find_file_spath($sftpsrvexe);
376 #***************************************************************************
377 # Find sftp client and return canonical filename
380 return find_file_spath($sftpexe);
384 #***************************************************************************
385 # Find ssh-keygen and return canonical filename
388 return find_file_spath($sshkeygenexe);
392 #***************************************************************************
393 # Find httptlssrv (gnutls-serv) and return canonical filename
395 sub find_httptlssrv {
396 return find_exe_file_hpath($httptlssrvexe);
400 #***************************************************************************
401 # Return version info for the given ssh client or server binaries
404 my $sshbin = $_[0]; # canonical filename
414 $error = 'Error: Missing argument 1 for sshversioninfo()';
416 elsif(! -x $sshbin) {
417 $error = "Error: cannot read or execute $sshbin";
420 my $cmd = ($sshbin =~ /$sshdexe$/) ? "\"$sshbin\" -?" : "\"$sshbin\" -V";
422 foreach my $tmpstr (qx($cmd 2>&1)) {
423 if($tmpstr =~ /OpenSSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
428 $versnum = (100*$major) + (10*$minor) + $patch;
429 $versstr = "$sshid $major.$minor.$patch";
433 if($tmpstr =~ /Sun[_-]SSH[_-](\d+)\.(\d+)(\.(\d+))*/i) {
438 $versnum = (100*$major) + (10*$minor) + $patch;
439 $versstr = "$sshid $major.$minor.$patch";
445 chomp $error if($error);
447 return ($sshid, $versnum, $versstr, $error);
451 #***************************************************************************