• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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
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    $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#
185sub 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#
203sub 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#
229sub 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#
240sub 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#
256sub display_sshdconfig {
257    display_file($sshdconfig);
258}
259
260
261#***************************************************************************
262# Display contents of the ssh client config file
263#
264sub display_sshconfig {
265    display_file($sshconfig);
266}
267
268
269#***************************************************************************
270# Display contents of the sftp client config file
271#
272sub display_sftpconfig {
273    display_file($sftpconfig);
274}
275
276
277#***************************************************************************
278# Display contents of the ssh daemon log file
279#
280sub 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#
289sub 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#
298sub 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#
307sub 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#
323sub 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#
341sub 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#
353sub 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#
365sub find_sshd {
366    return find_file_spath($sshdexe);
367}
368
369
370#***************************************************************************
371# Find ssh client and return canonical filename
372#
373sub find_ssh {
374    return find_file_spath($sshexe);
375}
376
377
378#***************************************************************************
379# Find sftp-server plugin and return canonical filename
380#
381sub find_sftpsrv {
382    return find_file_spath($sftpsrvexe);
383}
384
385
386#***************************************************************************
387# Find sftp client and return canonical filename
388#
389sub find_sftp {
390    return find_file_spath($sftpexe);
391}
392
393
394#***************************************************************************
395# Find ssh-keygen and return canonical filename
396#
397sub find_sshkeygen {
398    return find_file_spath($sshkeygenexe);
399}
400
401
402#***************************************************************************
403# Find httptlssrv (gnutls-serv) and return canonical filename
404#
405sub 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#
413sub 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
4731;
474