modernizing a perl util to upload a file through sftp

Aldebaran has asked for the wisdom of the Perl Monks concerning the following question:

I present with a rough looking perl script that has found new and maybe interesting ways to fail. It has worked previously. It can very well be that this is a version that wasn't supposed to go forward but did. What has changed in the meantime is everything, and I'd like to see if we can cook up something better, but let me start with moderately-abridged output and source in readmore tags. Then I'll pop out some lines and ask questions.

$ ./1.test.1.pl 
title is 1.test.
path1 is /home/hogan/5.scripts/1.test.
abs is /home/hogan/5.scripts/1.test./1.test.1.pl
ini path is /home/hogan/Documents/html_template_data/6.values.ini
$VAR1 = bless( {

                 'my_sftp' => {
                                'key_path' => '/home/hogan/.ssh/id_rsa
+',
                                'domain' => '164.90.158.33',
                                'username' => 'fred',
                                'port' => '22'
                              },

                                }
               }, 'Config::Tiny' );

values are 164.90.158.33 fred  22
OpenSSH_7.6p1 Ubuntu-4ubuntu0.3, OpenSSL 1.0.2n  7 Dec 2017
debug1: Reading configuration data /etc/ssh/ssh_config
...
debug1: Authentication succeeded (publickey).
Authenticated to 164.90.158.33 ([164.90.158.33]:22).
debug1: channel 0: new [client-session]
...
debug1: Sending subsystem: sftp
object created, back with caller
word is 1.test.
dir2 is /var/www/html/perlmonks
1.test.1.html
1.test.3.html
1.test.2.html
1.test.1.css
files are 1.test.1.html 1.test.3.html 1.test.2.html 1.test.1.css
old num is 3
Make rus captions(y/n)?: y
matching are b.txt
rus_munge is /home/hogan/5.scripts/1.test./template_stuff/translations
+/trans.15-10-2020-22-01-35.txt
rus_path is /home/hogan/5.scripts/1.test./template_stuff/ruscaptions/b
+.txt
Get other translations(y/n)?: n
remote_dir is 1.test.4
result is <!DOCTYPE html>
<head>
<meta charset="utf-8">
<link rel="stylesheet" type="text/css" href="/css/1.test.1.css"/>
<title>1.test.</title>
</head>
  <body>
      <div class="wrapper">
  <div class = origin>
  <h3>Portland, Thu Oct 15 22:01:39 2020</h3>
  </div>
<h1>Screenshots for DigitalOcean</h1>

dir is /home/hogan/5.scripts/1.test./template_stuff/captions
dir is /home/hogan/5.scripts/1.test./template_stuff/ruscaptions
tmpl is /home/hogan/5.scripts/1.test./template_stuff/code2.tmpl
Put file to server(y/n)?: y
$VAR1 = {
          'place' => 'Portland',
          'script_file' => '/home/hogan/5.scripts/1.test./1.test.1.pl'
+,
          'refc' => [
                      [
                        'Screenshot from 2020-10-04 11-20-42.png',
                        '<div class="outer">

<p class="hft-paras">Building new site with perl template.</p>
</div>  <!-- end #outer-->
 
',
                        '<div class="outer">

<p class="hft-paras">Neue Site mit Perl-Vorlage erstellen.</p>
</div>  <!-- end #outer-->
 
'
                      ]
                    ],
       ,
          'html_file' => '1.test.4.html',
          'headline' => undef,
          'chapter' => 'for DigitalOcean',
          'print_module' => 0,

          'print_script' => '1',
          'ts' => 'template_system',
          'remote_dir' => '1.test.4',
          'css_file' => '1.test.1.css',

          'image_dir' => '/var/www/html/pmimage',

          'title' => '1.test.',
          'server_dir' => '/var/www/html/perlmonks',
          'book' => 'Screenshots',
          'oibottom' => bless( [
                                 '/home/hogan/5.scripts/1.test./templa
+te_stuff/oibottom.txt',
                                 '/home/hogan/5.scripts/1.test./templa
+te_stuff/oibottom.txt'
                               ], 'Path::Tiny' )
        };
server dir is /var/www/html/perlmonks
execution was here
return1 is Directory /var/www/html/perlmonks already exists!
setcwd2 failed 
path3 is /home/hogan/5.scripts/1.test./template_stuff/1.test.1.css
image dir is /var/www/html/pmimage
parameter array is /var/www/html/pmimage Net::SFTP::Foreign=HASH(0x55e
+cba31fb60) Couldn't create remote directory: Permission denied
Bounce wireless(y/n)?: alarm set for ten in process 22679 and pinging 
+google
PING www.google.com (216.58.217.36) 56(84) bytes of data.
64 bytes from den03s10-in-f36.1e100.net (216.58.217.36): icmp_seq=1 tt
+l=117 time=15.5 ms
...
64 bytes from den03s10-in-f36.1e100.net (216.58.217.36): icmp_seq=14 t
+tl=117 time=11.7 ms
^C
--- www.google.com ping statistics ---
14 packets transmitted, 14 received, 0% packet loss, time 13015ms
rtt min/avg/max/mdev = 11.779/15.660/23.484/3.148 ms
debug1: channel 0: free: client-session, nchannels 1
debug1: fd 0 clearing O_NONBLOCK
debug1: fd 1 clearing O_NONBLOCK
Killed by signal 2.

$
[download]

The script has been useful in the past for exotic connection problems, but I'm afraid there's significant glitches. The first caller looks like this:

  # upload images
  my $image_dir = $vars{"image_dir"};
  say "image dir is $image_dir";
  my $return2 = createDir( $image_dir, $sftp );
  say "return2 is $return2";
[download]

That's not too scary. But then we go find createDir

sub createDir {
  use 5.011;
  use Net::SFTP::Foreign;
  my ( $dirName, $sftp ) = @_;
  if ( $sftp->test_e($dirName) ) {
    if ( !$sftp->test_d($dirName) ) {
     


  print "Remove file(y/n)?: ";
  my $prompt1 = <STDIN>;
  chomp $prompt1;

  if ( $prompt1 eq ( "y" | "Y" ) ) {
    if ( fork() == 0 ) {

      # arm the alarm clock
      alarm(35);
      say "you got 35 seconds for process $$";

      # create a child process
      my $return3 = $sftp->remove($dirName);
      say "return3 is $return3";
      createDir($dirName, $sftp);
      say "process $$ executed here";
      

      exit(0);
    }
  }
 #end if that tests  !$sftp->test_d($dirName) next brace
    }

    if ( $sftp->test_d($dirName) ) {
      say "execution was here";
      return "Directory $dirName already exists!";
    }
    else {
      say "Can't create $dirName because there's a file in the way!";
      handleDirCreateError( @_, $sftp->error );
    }
  }
  my $success = $sftp->mkdir($dirName)
    or handleDirCreateError( @_, $sftp->error );
  return $success;
}
[download]

Then it's down a rabbit hole with handleDirCreateError

sub handleDirCreateError {
  use 5.011;
  use Net::SFTP::Foreign;
  my ( $dirName, $sftp, $error ) = @_;
  say "parameter array is @_";
  if ( fork() == 0 ) {

    # arm the alarm clock
    alarm(10);
    say "alarm set for ten in process $$ and pinging google";
    # create a child process
    my $trial = system("ping www.google.com");
    say "trial is $trial";
    exit(0);
  }
  print "Bounce wireless(y/n)?: ";
  my $prompt1 = <STDIN>;
  chomp $prompt1;

  if ( $prompt1 eq ( "y" | "Y" ) ) {
    if ( fork() == 0 ) {

      # arm the alarm clock
      alarm(35);
      say "alarm set for 35 in process $$ and restarting network";

      # create a child process

      my $trial2 = system("sudo service network-manager restart");
      say "trial2 is $trial2";
      sleep 30;
      say "sleeping 30";
      exit(0);
    }
  }
  print "Do you think you're ready now(y/n)?: ";
  my $prompt2 = <STDIN>;
  chomp $prompt2;

  if ( $prompt2 eq ( "y" | "Y" ) ) {

    my $return2 = createDir( $dirName, $sftp );
    say "return2 is $return2";
  }

  else {
    say "$error was too much this time: ceasing execution";
    die;
  }
  return "execution shouldn't get here";
}
[download]

parameter array is /var/www/html/pmimage Net::SFTP::Foreign=HASH(0x55ecba31fb60) Couldn't create remote directory: Permission denied

Q1) Is there a perl remedy for this? I seem to be able to upload files but not create directories.

Q2) If the answer to Q1 is no, then, [OT] Is there a unix remedy?

  if ( fork() == 0 ) {

    # arm the alarm clock
    alarm(10);
    say "alarm set for ten in process $$ and pinging google";
    # create a child process
    my $trial = system("ping www.google.com");
    say "trial is $trial";
    exit(0);
  }
[download]

The system call never relinquishes control. Q3) Is it said to be blocking?

Q4) What do these indicate when I hit control-C?

debug1: fd 0 clearing O_NONBLOCK
debug1: fd 1 clearing O_NONBLOCK
[download]

Thanks for your comment,

Comment on modernizing a perl util to upload a file through sftp Select or Download Code

Replies are listed 'Best First'.
Re: modernizing a perl util to upload a file through sftp by marto (Cardinal) on Oct 16, 2020 at 09:27 UTC
`Couldn't create remote directory: Permission denied` Q1) This isn't a perl problem, it's a permissions problem. Remove perl from the equation, test this by manually doing what your script does, as the same user. Resolve as appropriate.	[reply] [d/l]
Re^2: modernizing a perl util to upload a file through sftp by Aldebaran (Curate) on Oct 17, 2020 at 08:43 UTC
Q1) This isn't a perl problem, it's a permissions problem. This perl script lacks permission. Getting it done on the command line looks like this: `$ ssh fred@164.90.158.33 fred@fourth:/var/www/html$ cd pm_image/ fred@fourth:/var/www/html/pm_image$ mkdir larry fred@fourth:/var/www/html/pm_image$ ll total 12 drwxr-xr-x 3 fred fred 4096 Oct 16 18:04 ./ drwxr-xr-x 7 root root 4096 Oct 8 00:04 ../ drwxrwxr-x 2 fred fred 4096 Oct 16 18:04 larry/ fred@fourth:/var/www/html/pm_image$` [download] fred is part of the sudo group, if it matters: `fred@fourth:~$ groups fred fred : fred sudo fred@fourth:~$` [download] I thought I might find something here: Perl SFTP do_mkdir not able to create directory. Is this maybe where I need to be grubbing? Net::SFTP::Foreign::Attributes I added the password back into the Config file. It gets populated by `get_tiny` like so: sub get_tiny { use 5.011; use warnings; use Net::SFTP::Foreign; use Config::Tiny; use Data::Dumper; my $ini_path = qw( /home/hogan/Documents/html_template_data/6.values +.ini ); say "ini path is $ini_path"; my $sub_hash = "my_sftp"; my $Config = Config::Tiny->new; $Config = Config::Tiny->read( $ini_path, 'utf8' ); say Dumper $Config; # -> is optional between brackets my $domain = $Config->{$sub_hash}{'domain'}; my $username = $Config->{$sub_hash}{'username'}; my $password = $Config->{$sub_hash}{'password'}; my $port = $Config->{$sub_hash}{'port'}; #dial up the server say "values are $domain $username $port"; my $sftp = Net::SFTP::Foreign->new( $domain, more => '-v', user => $username, port => $port, password => $password ) or die "Can't connect: $!\n"; return $sftp; } [download] Doesn't help me out: `server dir is /var/www/html/perlmonks parameter array is /var/www/html/perlmonks Net::SFTP::Foreign=HASH(0x5 +6550258f450) SSH slave exited unexpectedly with error code 255` [download] Do I have to wrap something like this? `$ scp -pr /source/directory user@host:the/target/directory`	[reply] [d/l] [select]
Re^3: modernizing a perl util to upload a file through sftp by marto (Cardinal) on Oct 17, 2020 at 17:04 UTC
`/var/www/html/pm_image` [download] is not the same as `/var/www/html/pmimage` [download] From modernizing a perl util to upload a file through sftp. Ensure your paths are what you think they should be.	[reply] [d/l] [select]
Re: modernizing a perl util to upload a file through sftp (updated) by AnomalousMonk (Archbishop) on Oct 16, 2020 at 07:21 UTC
Not pertinent to your questions, but `if ( $prompt1 eq ( "y" \| "Y" ) ) { ... }` in a few places caught my eye. The bitwise-or of `'y'` (ASCII 0x79) and `'Y'` (ASCII 0x59) is `'y'`, so `'Y'` will never match. `Win8 Strawberry 5.8.9.5 (32) Fri 10/16/2020 3:14:29 C:\@Work\Perl\monks >perl -Mstrict -Mwarnings my $Y_bitwise_or_y = 'Y' \| 'y'; printf "'%s' %#x \n", $Y_bitwise_or_y, ord $Y_bitwise_or_y; ^Z 'y' 0x79` [download] A common alternative is `if ($prompt1 =~ /y/i) { ... }` Update: Well, actually... `/y/i` matches something like `'funky'`. IMHO, a better alternative is `if ($prompt1 =~ m{ \A y }xmsi) { ... }` This case-insensitively matches `'y' 'yy'` (I sometimes double-hit keys) `'yes' 'yup' 'ya'` etc. OTOH, `m{ \A y \Z }xmsi` exactly matches only `'y' 'Y'` with or without a newline at the end. Give a man a fish: `<%-{-{-{-<`	[reply] [d/l] [select]
Re: modernizing a perl util to upload a file through sftp by perlfan (Parson) on Oct 16, 2020 at 08:38 UTC
If possible, I recommend using an `ssh` and `scp` based approach - particularly using `scp` to create the directory structure on the remote host you want. Secondly, in my experience `system("ping $host")` is not sufficent and you should not be using alarm when `ping` has a commandline arguments (`-c NUMBER`) that says send NUMBER pings then quit. There are also flags for timeout (`-t`) and wait (`-i`).Net::Ping is also a good option for this. So `ctrl-c` is necessary because `ping` runs for ever without a flag like `-c`. Further more, if you want to use alarm (maybe as an extreme safety measure), it requires you set a handler for `$SIG{ALRM}`. Again, check out the examples in alarm.	[reply] [d/l] [select]