Use in-memory file as argument in SFTP - perl

I need to open an SFTP connection in Perl and I need to use a dsa key file but I can't actually store the file on the hard disk for security reasons. I am trying to use Net::SFTP.
my $sftp = Net::SFTP->new(
$host, user=>"$userid",
ssh_args => {
identity_files => [ $pathToInMemoryKeyFile ]
}
);
I think I know how to get a string represented as an in memory file handle but I don't know how to get the path of that file handle such that I can pass it in as one of the ssh_args. Does anybody have any suggestions?
Thanks!

I've looked through the various options of doing SFTP (Net::SFTP hasn't been updated since 2005, Net::SFTP::Foreign is more up to date) and they all do key authentication via a file.
Net::SFTP is backed by Net::SSH::Perl which is a pure Perl SSH implementation. You can do some patching to make it do what you want. I'm going to sketch it out for you.
Patch or put a wrapper around Net::SSH::Perl::Auth::PublicKey->authenticate to look for a new configuration key. Let's call it identity_keys.
sub authenticate {
my $auth = shift;
my $ssh = $auth->{ssh};
my $sent = 0;
if (my $agent = $auth->mgr->agent) {
do {
$sent = $auth->_auth_agent;
} until $sent || $agent->num_left <= 0;
}
return $sent if $sent;
##### This is the new bit which tries any keys passed in. ######
my $ik = $ssh->config->get('identity_keys') || [];
for my $key (#$ik) {
return 1 if $auth->_auth_key($key);
}
my $if = $ssh->config->get('identity_files') || [];
my $idx = $auth->{_identity_idx} || 0;
for my $f (#$if[$idx..$#$if]) {
$auth->{_identity_idx}++;
return 1 if $auth->_auth_identity($f);
}
}
auth_key would be a copy of _auth_identity but calling Net::SSH::Perl::Key->read_private_key which would be the guts of Net::SSH::Perl::Key->read_private_pem minus opening and reading the key from a file. read_private_pem would then be gutted to use read_private_key.
Alternatively, use an ssh-agent. It holds the decrypted private key in memory, so you can immediately wipe it from the disk.

Related

"sh: 1: file: not found" thrown in Perl

So this is an issue I see thrown around on several coding help-sites that always have a slight variation. I'm not entirely familiar with what it means, and what's even more curious is that this error is thrown midway through a larger Upload.pm script, and does not cause any sort of fatal error. It gets tossed into my error log somewhere during this unless conditional snippet
# If this is the first slice, validate the file extension and mime-type. Mime-type of following slices should be "application/octet-stream".
unless ( defined $response{'error'} ) {
if ( $slice->{'index'} == 1 ) {
my ($filename, $directory, $extension) = fileparse($path.$parent_file, qr/\.[^.]*/);
unless ( is_valid_filetype($slice->{'tmp_file'}, $extension) ) {
$response{'error'} = "Invalid file type.";
$response{'retry'} = 0;
}
}
}
Now, let me be perfectly honest. I don't really understand the error message, and I could really use some help understanding it, as well as solving it.
Our Perl based web app has refused to let us upload files correctly since upgrading to Debian Bullseye, and I've been stuck debugging this code I didn't write for a few days now. I'm wondering if the upgrade depreciated some Perl modules, or if the directories to said modules are no longer working?
I'm testing this in a Ubuntu based Docker environment running Debian Bullseye on an Apache 2 server.
If you need any more context, clarification, etc, please let me know.
is_valid_filetype() looks like this:
sub is_valid_filetype
{
my ($tmp_file, $extension) = #_;
if ( $tmp_file && $extension ) {
# Get temp file's actual mime-type.
my $mime = qx/file --mime-type -b '${tmp_file}'/;
$mime =~ s/^\s+|\s+$//g;
# Get valid mime-types matching this extension.
my $dbh = JobTracker::Common::dbh or die("DBH not available.");
my $mime_types = $dbh->selectrow_array('SELECT `mime_types` FROM `valid_files` WHERE `extension` = ?', undef, substr($extension, 1));
if ( $mime && $mime_types ) {
if ( $mime_types !~ /,/ ) {
# Single valid mime-type for this extension.
if ( $mime eq $mime_types ) {
return 1;
}
} else {
# Multiple valid mime-types for this extension.
my %valid_mimes = map { $_ => 1 } split(/,/, $mime_types);
if ( defined $valid_mimes{$mime} ) {
return 1;
}
}
}
}
return 0;
}
It's a message from sh (not Perl). It concerns an error on line 1 of the script, which was apparently an attempt to run the file utility. But sh couldn't find it.
The code in question executes this command using
qx/file --mime-type -b '${tmp_file}'/
Install file or adjust the PATH so it can be found.
Note that this code suffers from a code injection bug. It will fail if the string in $tmp_path contains a single quote ('), possibly resulting in the unintentional execution of code.
Fixed:
use String::ShellQuote qw( shell_quote );
my $cmd = shell_quote( "file", "--mime-type", "-b", $tmp_file" );
qx/$cmd/
Debian Bullseye was reading our CSV files as the wrong mime-type. It was interpreting the file command as application/csv, despite obviously not being an application.
This may be an actual bug in Bullseye, because both my boss and I have scoured the internet with no lucky finding anyone else with this issue. I may even report to Bullseye's devs for further awareness.
The fix was manually adding in our own mime-types that interpreted this file correctly.
It took us dumping the tmp directory to confirm the files existed, and triple checking I had my modules installed.
This was such a weird and crazy upstream issue that either of us could not have imaged it would be the file type interpretation at an OS level in Bullseye.
I really hope this helps someone, saves them the time it took us to find this.

How come Catalyst::Controller::WrapCGI doesn't get any post data?

Whenever I POST something to a page with Catalyst::Controller::WrapCGI I notice that my old CGI script doesn't get any POST data.. Data inside the body of the HTTP request. What am I doing wrong and how do I fix this?
In my case, this was because I was using Catalyst::Controller::WrapCGI v0.35 and Catalyst::Controller::REST. This created a problem.. My configuration looked like this,
package MyApp::Controller::REST;
__PACKAGE__->config(namespace => '');
BEGIN { extends 'Catalyst::Controller::REST' }
and
package MyApp::Controller::Root;
__PACKAGE__->config(namespace => '');
BEGIN { extends 'Catalyst::Controller::WrapCGI' }
However, Catalyst::Controller::REST installs a begin action on line 298
sub begin : ActionClass('Deserialize') { }
And, that -- in my case -- was delegating to Catalyst::Action::Deserialize::JSON which is smart enough to seek($body,0,0) but too dumb and inconsiderate to do that for the next guy down the chain.... Code below from here
if(openhandle $body) {
seek($body, 0, 0); # in case something has already read from it
while ( defined( my $line = <$body> ) ) {
$rbody .= $line;
}
}
And, to make matters even worse, the next guy down the chain in this example is Catalyst::Controller::WrapCGI which not just fails to clean up for the next guy, but fails to set it up for itself (code from here),
if ($body) { # Slurp from body filehandle
local $/; $body_content = <$body>;
}
That should look like (at the very least)
if ($body) { # Slurp from body filehandle
local $/;
seek($body,0,0);
$body_content = <$body>;
}
That's why we can't have nice things... I opened a bug in C:C:WrapCGI to get this resolved.

Perl Net::SSH::Any with Key Exchange

I need to be able to use Perl to determine the version of python running on remote servers which I have key exchanges with. To try to accomplish this, I've been using Net::SSH::Any but want to use a key exchange instead of specifying the password in the script. I've looked at cpan's example which specifies the password.
The following is a snippet from my Perl code, which I'm trying to determine if python 2.6 is installed on the remote server.
my $ssh = Net::SSH::Any->new( $curIP, 'root' );
my #out = $ssh->capture("python -V");
my $outSize = #out;
my $ver26 = 0;
for ( my $j = 0; $j < $outSize; $j++ ) {
if ( index( $out[$j], "2.6." ) != -1 ) {
$ver26 = 1;
}
}
When I run this, it complains and says a host needs to be specified:
mandatory parameter host missing at ./GenerateConfig.pl line 162
I modified the code to look similar to how this is done in a different post (How can I FTP a file with an SSH key instead of a password, in Perl?) but it also fails:
my $ssh = Net::SSH::Any->new( $curIP, {'root'} );
my #out = $ssh->capture("python -V");
my $outSize = #out;
my $ver26 = 0;
for ( my $j = 0; $j < $outSize; $j++ ) {
if ( index( $out[$j], "2.6." ) != -1 ) {
$ver26 = 1;
}
}
How can I do this, or is there an alternative to accomplish the same thing?
According to the documentation for Net::SSH::Any, you need to pass it the hostname and pairs of options:
my $ssh = Net::SSH::Any->new($curIP, user => 'root');

What does this perl crash means?

Can someone tell me what this means?
if (not defined $config{'crontab'}) {
die "no crontab defined!";
}
I want to open a file crontab.txt but the perl script crashes at this line and I don't really know any perl.
EDIT 1
It goes like this:
sub main()
{
my %config = %{getCommandLineOptions()};
my $programdir = File::Spec->canonpath ( (fileparse ( Win32::GetFullPathName($PROGRAM_NAME) ))[1] );
my $logdir = File::Spec->catdir ($programdir, 'logs');
$logfile = File::Spec->catfile ($logdir, 'cronw.log');
configureLogger($logfile);
$log = get_logger("cronw::cronService-pl");
# if --exec option supplied, we are being invoked to execute a job
if ($config{exec}) {
execJob(decodeArgs($config{exec}), decodeArgs($config{args}));
return;
}
my $cronfile = $config{'crontab'};
$log->info('starting service');
$log->debug('programdir: '.$programdir);
$log->debug('logfile: '.$logfile);
if (not defined $config{'crontab'}) {
$log->error("no crontab defined!\n");
die "no crontab defined!";
# fixme: crontab detection?
}
$log->debug('crontab: '.$config{'crontab'});
And I'm trying to load this 'crontab.txt' file...
sub getCommandLineOptions()
{
my $clParser = new Getopt::Long::Parser config => ["gnu_getopt", "pass_through"];
my %config = ();
my #parameter = ( 'crontab|cronfile=s',
'exec=s',
'args=s',
'v|verbose'
);
$clParser->getoptions (\%config, #parameter);
if (scalar (#ARGV) != 0) { $config{'unknownParameter'} = $true; }
return \%config;
}
Probably I have to give the script an argument
Probably I have to give the script an argument
I would say so.
$ script --cronfile=somefile
That code looks to see whether there is a key 'crontab' in the hash %config. If not, then it calls die and terminates.
If that's not what you expect to happen, then somewhere else in your script there should be something that is setting $config{'crontab'}, but there is not currently enough information in your question to determine what that might be.
Probably the file path of crontab.txt is expected in %config hash, pointed by the 'crontab' key, but isn't there! If so, a DIRTY solution CAN BE:
$config{'crontab'}='FULLPATH/crontab.txt';
#if (not defined $config{'crontab'}) {
# die "no crontab defined!";
#}
but this may not work because there is something like $config{'prefix'} and what you will try to open is the path represented by the concatenation of both, or just because in $config{'crontab'} is expected any other value than full path!

How can my previously untainted data become tainted again?

I have a bit of a mystery here that I am not quite understanding the root cause of. I am getting an 'Insecure dependency in unlink while running with -T switch' when trying to invoke unlink from a script. That is not the mystery, as I realize that this means Perl is saying I am trying to use tainted data. The mystery is that this data was previously untainted in another script that saved it to disk without any problems.
Here's how it goes... The first script creates a binary file name using the following
# For the binary file upload
my $extensioncheck = '';
my $safe_filename_characters = "a-zA-Z0-9_.";
if ( $item_photo )
{
# Allowable File Type Check
my ( $name, $path, $extension ) = fileparse ( $item_photo, '\..*' );
$extensioncheck = lc($extension);
if (( $extensioncheck ne ".jpg" ) && ( $extensioncheck ne ".jpeg" ) &&
( $extensioncheck ne ".png" ) && ( $extensioncheck ne ".gif" ))
{
die "Your photo file is in a prohibited file format.";
}
# Rename file to Ad ID for adphoto directory use and untaint
$item_photo = join "", $adID, $extensioncheck;
$item_photo =~ tr/ /_/;
$item_photo =~ s/[^$safe_filename_characters]//g;
if ( $item_photo =~ /^([$safe_filename_characters]+)$/ ) { $item_photo = $1; }
else { die "Filename contains invalid characters"; }
}
$adID is generated by the script itself using a localtime(time) function, so it should not be tainted. $item_photo is reassigned using $adID and $extensioncheck BEFORE the taint check, so the new $item_photo is now untainted. I know this because $item_photo itself has no problem with unlink itself latter in the script. $item_photo is only used long enough to create three other image files using ImageMagick before it's tossed using the unlink function. The three filenames created from the ImageMagick processing of $item_photo are created simply like so.
$largepicfilename = $adID . "_large.jpg";
$adpagepicfilename = $adID . "_adpage.jpg";
$thumbnailfilename = $adID . "_thumbnail.jpg";
The paths are prepended to the new filenames to create the URLs, and are defined at the top of the script, so they can't be tainted as well. The URLs for these files are generated like so.
my $adpageURL = join "", $adpages_dir_URL, $adID, '.html';
my $largepicURL = join "", $adphotos_dir_URL, $largepicfilename;
my $adpagepicURL = join "", $adphotos_dir_URL, $adpagepicfilename;
my $thumbnailURL = join "", $adphotos_dir_URL, $thumbnailfilename;
Then I write them to the record, knowing everything is untainted.
Now comes the screwy part. In a second script I read these files in to be deleted using the unlink function, and this is where I am getting my 'Insecue dependency' flag.
# Read in the current Ad Records Database
open (ADRECORDS, $adrecords_db) || die("Unable to Read Ad Records Database");
flock(ADRECORDS, LOCK_SH);
seek (ADRECORDS, 0, SEEK_SET);
my #adrecords_data = <ADRECORDS>;
close(ADRECORDS);
# Find the Ad in the Ad Records Database
ADRECORD1:foreach $AdRecord(#adrecords_data)
{
chomp($AdRecord);
my($adID_In, $adpageURL_In, $largepicURL_In, $adpagepicURL_In, $thumbnailURL_In)=split(/\|/,$AdRecord);
if ($flagadAdID ne $adID_In) { $AdRecordArrayNum++; next ADRECORD1 }
else
{
#Delete the Ad Page and Ad Page Images
unlink ("$adpageURL_In");
unlink ("$largepicURL_In");
unlink ("$adpagepicURL_In");
unlink ("$thumbnailURL_In");
last ADRECORD1;
}
}
I know I can just untaint them again, or even just blow them on through knowing that the data is safe, but that is not the point. What I want is to understand WHY this is happening in the first place, as I am not understanding how this previously untainted data is now being seen as tainted. Any help to enlighten where I am missing this connection would be truly appreciated, because I really want to understand this rather than just write the hack to fix it.
Saving data to a file doesn't save any "tainted" bit with the data. It's just data, coming from an external source, so when Perl reads it it becomes automatically tainted. In your second script, you will have to explicitly untaint the data.
After all, some other malicious program could have changed the data in the file before the second script has a chance to read it.