#*************************************************************************** # _ _ ____ _ # Project ___| | | | _ \| | # / __| | | | |_) | | # | (__| |_| | _ <| |___ # \___|\___/|_| \_\_____| # # Copyright (C) 1998 - 2011, Daniel Stenberg, <daniel@haxx.se>, et al. # # This software is licensed as described in the file COPYING, which # you should have received as part of this distribution. The terms # are also available at http://curl.haxx.se/docs/copyright.html. # # You may opt to use, copy, modify, merge, publish, distribute and/or sell # copies of the Software, and permit persons to whom the Software is # furnished to do so, under the terms of the COPYING file. # # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY # KIND, either express or implied. # #*************************************************************************** package sshhelp; use strict; use warnings; use Exporter; use File::Spec; #*************************************************************************** # Global symbols allowed without explicit package name # use vars qw( @ISA @EXPORT_OK $sshdexe $sshexe $sftpsrvexe $sftpexe $sshkeygenexe $httptlssrvexe $sshdconfig $sshconfig $sftpconfig $knownhosts $sshdlog $sshlog $sftplog $sftpcmds $hstprvkeyf $hstpubkeyf $cliprvkeyf $clipubkeyf @sftppath @httptlssrvpath ); #*************************************************************************** # Inherit Exporter's capabilities # @ISA = qw(Exporter); #*************************************************************************** # Global symbols this module will export upon request # @EXPORT_OK = qw( $sshdexe $sshexe $sftpsrvexe $sftpexe $sshkeygenexe $sshdconfig $sshconfig $sftpconfig $knownhosts $sshdlog $sshlog $sftplog $sftpcmds $hstprvkeyf $hstpubkeyf $cliprvkeyf $clipubkeyf display_sshdconfig display_sshconfig display_sftpconfig display_sshdlog display_sshlog display_sftplog dump_array exe_ext find_sshd find_ssh find_sftpsrv find_sftp find_sshkeygen find_httptlssrv logmsg sshversioninfo ); #*************************************************************************** # Global variables initialization # $sshdexe = 'sshd' .exe_ext(); # base name and ext of ssh daemon $sshexe = 'ssh' .exe_ext(); # base name and ext of ssh client $sftpsrvexe = 'sftp-server' .exe_ext(); # base name and ext of sftp-server $sftpexe = 'sftp' .exe_ext(); # base name and ext of sftp client $sshkeygenexe = 'ssh-keygen' .exe_ext(); # base name and ext of ssh-keygen $httptlssrvexe = 'gnutls-serv' .exe_ext(); # base name and ext of gnutls-serv $sshdconfig = 'curl_sshd_config'; # ssh daemon config file $sshconfig = 'curl_ssh_config'; # ssh client config file $sftpconfig = 'curl_sftp_config'; # sftp client config file $sshdlog = undef; # ssh daemon log file $sshlog = undef; # ssh client log file $sftplog = undef; # sftp client log file $sftpcmds = 'curl_sftp_cmds'; # sftp client commands batch file $knownhosts = 'curl_client_knownhosts'; # ssh knownhosts file $hstprvkeyf = 'curl_host_dsa_key'; # host private key file $hstpubkeyf = 'curl_host_dsa_key.pub'; # host public key file $cliprvkeyf = 'curl_client_key'; # client private key file $clipubkeyf = 'curl_client_key.pub'; # client public key file #*************************************************************************** # Absolute paths where to look for sftp-server plugin, when not in PATH # @sftppath = qw( /usr/lib/openssh /usr/libexec/openssh /usr/libexec /usr/local/libexec /opt/local/libexec /usr/lib/ssh /usr/libexec/ssh /usr/sbin /usr/lib /usr/lib/ssh/openssh /usr/lib64/ssh /usr/lib64/misc /usr/lib/misc /usr/local/sbin /usr/freeware/bin /usr/freeware/sbin /usr/freeware/libexec /opt/ssh/sbin /opt/ssh/libexec ); #*************************************************************************** # Absolute paths where to look for httptlssrv (gnutls-serv), when not in PATH # @httptlssrvpath = qw( /usr/sbin /usr/libexec /usr/lib /usr/lib/misc /usr/lib64/misc /usr/local/bin /usr/local/sbin /usr/local/libexec /opt/local/bin /opt/local/sbin /opt/local/libexec /usr/freeware/bin /usr/freeware/sbin /usr/freeware/libexec /opt/gnutls/bin /opt/gnutls/sbin /opt/gnutls/libexec ); #*************************************************************************** # Return file extension for executable files on this operating system # sub exe_ext { if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys' || $^O eq 'dos' || $^O eq 'os2') { return '.exe'; } } #*************************************************************************** # Create or overwrite the given file with lines from an array of strings # sub dump_array { my ($filename, @arr) = @_; my $error; if(!$filename) { $error = 'Error: Missing argument 1 for dump_array()'; } elsif(open(TEXTFH, ">$filename")) { foreach my $line (@arr) { $line .= "\n" unless($line =~ /\n$/); print TEXTFH $line; } if(!close(TEXTFH)) { $error = "Error: cannot close file $filename"; } } else { $error = "Error: cannot write file $filename"; } return $error; } #*************************************************************************** # Display a message # sub logmsg { my ($line) = @_; chomp $line if($line); $line .= "\n"; print "$line"; } #*************************************************************************** # Display contents of the given file # sub display_file { my $filename = $_[0]; print "=== Start of file $filename\n"; if(open(DISPLAYFH, "<$filename")) { while(my $line = <DISPLAYFH>) { print "$line"; } close DISPLAYFH; } print "=== End of file $filename\n"; } #*************************************************************************** # Display contents of the ssh daemon config file # sub display_sshdconfig { display_file($sshdconfig); } #*************************************************************************** # Display contents of the ssh client config file # sub display_sshconfig { display_file($sshconfig); } #*************************************************************************** # Display contents of the sftp client config file # sub display_sftpconfig { display_file($sftpconfig); } #*************************************************************************** # Display contents of the ssh daemon log file # sub display_sshdlog { die "error: \$sshdlog uninitialized" if(not defined $sshdlog); display_file($sshdlog); } #*************************************************************************** # Display contents of the ssh client log file # sub display_sshlog { die "error: \$sshlog uninitialized" if(not defined $sshlog); display_file($sshlog); } #*************************************************************************** # Display contents of the sftp client log file # sub display_sftplog { die "error: \$sftplog uninitialized" if(not defined $sftplog); display_file($sftplog); } #*************************************************************************** # Find a file somewhere in the given path # sub find_file { my $fn = $_[0]; shift; my @path = @_; foreach (@path) { my $file = File::Spec->catfile($_, $fn); if(-e $file && ! -d $file) { return $file; } } } #*************************************************************************** # Find an executable file somewhere in the given path # sub find_exe_file { my $fn = $_[0]; shift; my @path = @_; my $xext = exe_ext(); foreach (@path) { my $file = File::Spec->catfile($_, $fn); if(-e $file && ! -d $file) { return $file if(-x $file); return $file if(($xext) && (lc($file) =~ /\Q$xext\E$/)); } } } #*************************************************************************** # Find a file in environment path or in our sftppath # sub find_file_spath { my $filename = $_[0]; my @spath; push(@spath, File::Spec->path()); push(@spath, @sftppath); return find_file($filename, @spath); } #*************************************************************************** # Find an executable file in environment path or in our httptlssrvpath # sub find_exe_file_hpath { my $filename = $_[0]; my @hpath; push(@hpath, File::Spec->path()); push(@hpath, @httptlssrvpath); return find_exe_file($filename, @hpath); } #*************************************************************************** # Find ssh daemon and return canonical filename # sub find_sshd { return find_file_spath($sshdexe); } #*************************************************************************** # Find ssh client and return canonical filename # sub find_ssh { return find_file_spath($sshexe); } #*************************************************************************** # Find sftp-server plugin and return canonical filename # sub find_sftpsrv { return find_file_spath($sftpsrvexe); } #*************************************************************************** # Find sftp client and return canonical filename # sub find_sftp { return find_file_spath($sftpexe); } #*************************************************************************** # Find ssh-keygen and return canonical filename # sub find_sshkeygen { return find_file_spath($sshkeygenexe); } #*************************************************************************** # Find httptlssrv (gnutls-serv) and return canonical filename # sub find_httptlssrv { return find_exe_file_hpath($httptlssrvexe); } #*************************************************************************** # Return version info for the given ssh client or server binaries # sub sshversioninfo { my $sshbin = $_[0]; # canonical filename my $major; my $minor; my $patch; my $sshid; my $versnum; my $versstr; my $error; if(!$sshbin) { $error = 'Error: Missing argument 1 for sshversioninfo()'; } elsif(! -x $sshbin) { $error = "Error: cannot read or execute $sshbin"; } else { my $cmd = ($sshbin =~ /$sshdexe$/) ? "$sshbin -?" : "$sshbin -V"; $error = "$cmd\n"; foreach my $tmpstr (qx($cmd 2>&1)) { if($tmpstr =~ /OpenSSH[_-](\d+)\.(\d+)(\.(\d+))*/i) { $major = $1; $minor = $2; $patch = $4?$4:0; $sshid = 'OpenSSH'; $versnum = (100*$major) + (10*$minor) + $patch; $versstr = "$sshid $major.$minor.$patch"; $error = undef; last; } if($tmpstr =~ /Sun[_-]SSH[_-](\d+)\.(\d+)(\.(\d+))*/i) { $major = $1; $minor = $2; $patch = $4?$4:0; $sshid = 'SunSSH'; $versnum = (100*$major) + (10*$minor) + $patch; $versstr = "$sshid $major.$minor.$patch"; $error = undef; last; } $error .= $tmpstr; } chomp $error if($error); } return ($sshid, $versnum, $versstr, $error); } #*************************************************************************** # End of library 1;