Annotation of embedaddon/curl/tests/sshhelp.pm, revision 1.1.1.1
1.1 misho 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:
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: $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: #
185: sub 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: #
203: sub 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: #
229: sub 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: #
240: sub 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: #
256: sub display_sshdconfig {
257: display_file($sshdconfig);
258: }
259:
260:
261: #***************************************************************************
262: # Display contents of the ssh client config file
263: #
264: sub display_sshconfig {
265: display_file($sshconfig);
266: }
267:
268:
269: #***************************************************************************
270: # Display contents of the sftp client config file
271: #
272: sub display_sftpconfig {
273: display_file($sftpconfig);
274: }
275:
276:
277: #***************************************************************************
278: # Display contents of the ssh daemon log file
279: #
280: sub 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: #
289: sub 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: #
298: sub 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: #
307: sub 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: #
323: sub 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: #
341: sub 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: #
353: sub 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: #
365: sub find_sshd {
366: return find_file_spath($sshdexe);
367: }
368:
369:
370: #***************************************************************************
371: # Find ssh client and return canonical filename
372: #
373: sub find_ssh {
374: return find_file_spath($sshexe);
375: }
376:
377:
378: #***************************************************************************
379: # Find sftp-server plugin and return canonical filename
380: #
381: sub find_sftpsrv {
382: return find_file_spath($sftpsrvexe);
383: }
384:
385:
386: #***************************************************************************
387: # Find sftp client and return canonical filename
388: #
389: sub find_sftp {
390: return find_file_spath($sftpexe);
391: }
392:
393:
394: #***************************************************************************
395: # Find ssh-keygen and return canonical filename
396: #
397: sub find_sshkeygen {
398: return find_file_spath($sshkeygenexe);
399: }
400:
401:
402: #***************************************************************************
403: # Find httptlssrv (gnutls-serv) and return canonical filename
404: #
405: sub 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: #
413: sub 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
473: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to sshhelp.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests