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