README.md

@@ -2,6 +2,7 @@ Net::OpenSSH::More
 ==================
 A submodule of Net::OpenSSH focused on giving you some more tools
 for executing common usage patterns of the (quite useful) parent
-module.
+module, but which are basically left "as an exercise for the reader"
+in the parent's POD.
 
 See module POD for more details, and HAPPY HACKING!

lib/Net/OpenSSH/More.pm

@@ -36,7 +36,6 @@ Highlights:
 * Many shortcut methods for common system administration tasks
 * Registration method for commands to run upon DESTROY/before disconnect.
 * Automatic reconnection ability upon connection loss
-* Easy SFTP accessor for file uploads/downloads.
 
 =head1 SYNOPSIS
 
@@ -335,7 +334,8 @@ my $send = sub {
       }
       if ref $line_reader ne 'CODE';
 
-    # TODO make this async so you can stream STDERR as well
+    # TODO make this async so you can stream STDERR *in order*
+    # with STDOUT as well
     # That said, most only care about error if command fails, so...
     my $out;
     $line_reader->( $self, $out, '_out' ) while $out = $pty->getline;
@@ -542,18 +542,150 @@ sub use_persistent_shell {
     return $self->{'_opts'}{'use_persistent_shell'} = $use_shell;
 }
 
+=head2 copy
+
+Copies $SOURCE file on the remote machine to $DEST on the remote machine.
+If you want to sync/copy files from remote to local or vice/versa, use
+the sftp accessor (Net::SFTP::Foreign) instead.
+
+Dies in this module, as this varies on different platforms (GNU/LINUX, Windows, etc.)
+
+=cut
+
+sub copy {
+    die "Unimplemented, use a subclass of this perhaps?";
+}
+
+=head2 B<backup_files (FILES)>
+
+Backs up files which you wish to later restore to their original state. If the file does
+not currently exist then the method will still store a reference for later file deletion.
+This may seem strange at first, but think of it in the context of preserving 'state' before
+a test or scripted action is run. If no file existed prior to action, the way to restore
+that state would be to delete the added file(s).
+
+NOTE: Since copying files on the remote system to another location on the remote system
+is in fact not something implemented by Net::SFTP::Foreign, this is necessarily going
+to be a "non-portable" method -- use the Linux.pm subclass of this if you want to be able
+to actually backup files without dying, or subclass your own for Windows, however they
+choose to implement `copy` with their newfangled(?) SSH daemon.
+
+C<FILES> - ARRAY_REF - File(s) to backup.
+
+C<STASH> - BOOL - mv files on backup instead of cp.  This will make sure FILES arg path no
+                  longer exists at all so a fresh FILE can be written during run.
+
+my $file = '/path/to/file.txt';
+$ssh->backup_files([$file]);
+
+my @files = ( '/path/to/file.txt', '/path/to/file2.txt' );
+$ssh->backup_files(\@files);
+
+=cut
+
+sub backup_files {
+    my ( $self, $files, $stash ) = @_;
+
+    die "[INPUT]: ARRAYREF required by backup_files()." if ( ref $files ne 'ARRAY' );
+
+    # For each file passed in
+    foreach my $file (@$files) {
+
+        # If the file hasn't already been backed up
+        if ( !defined $self->{'file_backups'}{$file} ) {
+
+            # and the file exists
+            if ( $self->sftp->test_e($file) ) {
+
+                # then back it up
+                $self->{'file_backups'}{$file} = time;
+                my $bkup = $file . '.' . $self->{'file_backups'}{$file};
+                if ($stash) {
+                    $self->diag("[INFO] Moving '$file' to '$bkup'");
+                    $self->sftp->rename( $file, $bkup );
+                }
+                else {
+                    $self->diag("[INFO] Backing up '$file' to '$bkup'");
+                    $self->copy( $file, $bkup );    # XXX Probably not that portable, maybe move to Linux.pm somehow?
+                }
+
+                # otherwise if the file to be backed up doesn't exist
+            }
+            else {
+                # then just note that a file may need to be deleted later
+                $self->{'file_backups'}{$file} = '';
+            }
+        }
+    }
+    return;
+}
+
+=head2 B<restore_files (FILES)>
+
+Restores specific file(s) backed up using backup_files(), or all the backup files if none
+are specified, to their previous state.
+
+If the file in question DID NOT exist when backup_files was last invoked for the file,
+then the file will instead be deleted, as that was the state of the file previous to
+actions taken in your test or script.
+
+C<FILES> - (Optional) - ARRAY_REF - File(s) to restore.
+
+my $file = '/path/to/file.txt';
+$ssh->backup_files([$file]);
+$ssh->restore_files();
+
+=cut
+
+sub restore_files {
+    my ( $self, $files ) = @_;
+
+    # If no files were passed in then grab all files that have been backed up
+    $files //= [ keys %{ $self->{'file_backups'} } ];
+    die "[INPUT]: ARRAYREF required by restore_files()." if ( ref $files ne 'ARRAY' );
+
+    # foreach file
+    foreach my $file (@$files) {
+
+        # that has been marked as modified
+        if ( defined $self->{'file_backups'}{$file} ) {
+
+            # if a backup exists
+            if ( $self->{'file_backups'}{$file} ) {
+
+                # then restore the backup
+                my $bkup = $file . '.' . $self->{'file_backups'}{$file};
+                if ( $self->sftp->test_e($bkup) ) {
+                    $self->diag("[INFO] Restoring backup '$file' from '$bkup'");
+                    $self->sftp->rename( $bkup, $file, 'overwrite' => 1 );
+                }
+
+                # otherwise no backup exists we just need to delete the modified file
+            }
+            else {
+                $self->diag("[INFO] Deleting '$file' to restore system state (beforehand the file didn't exist)");
+                $self->sftp->remove($file);
+            }
+        }
+        delete $self->{'file_backups'}{$file};
+    }
+    return;
+}
+
 =head2 DESTROY
 
 Noted in POD only because of some behavior differences between the
 parent module and this. The following actions are taken *before*
 the parent's destructor kicks in:
 * Return early if you aren't the PID which created the object.
+* Restore any files backed up with backup_files earlier.
 
 =cut
 
 sub DESTROY {
     my ($self) = @_;
-    return                                                       if !$self->{'_perl_pid'} || $$ != $self->{'_perl_pid'} || $disable_destructor;
+    return if !$self->{'_perl_pid'} || $$ != $self->{'_perl_pid'} || $disable_destructor;
+    $self->restore_files();
     $ENV{SSH_AUTH_SOCK} = $self->{'_opts'}{'_restore_auth_sock'} if $self->{'_opts'}{'_restore_auth_sock'};
     $self->{'persistent_shell'}->close()                         if $self->{'persistent_shell'};
 
@@ -585,6 +717,7 @@ Command is specifed as a LIST, as that's the easiest way to ensure escaping is d
 
 $opts HASHREF:
 C<no_stderr> - Boolean - Whether or not to discard STDERR.
+C<use_operistent_shell> - Boolean - Whether or not to use the persistent shell.
 
 C<command> - LIST of components combined together to make a shell command.
 
@@ -592,7 +725,7 @@ Returns LIST STDOUT, STDERR, and exit code from executed command.
 
     my ($out,$err,$ret) = $ssh->cmd(qw{ip addr show});
 
-If use_persistent_shell was truthy in the constructor,
+If use_persistent_shell was truthy in the constructor (or you override via opts HR),
 then commands are executed in a persistent Expect session to cut down on forks,
 and in general be more efficient.
 
@@ -625,7 +758,8 @@ sub cmd {
     $die_no_trace->( 'No command specified', 'PEBCAK' ) if !@command;
 
     my $ret;
-    if ( $self->{'_opts'}{'use_persistent_shell'} ) {
+    $opts->{'use_persistent_shell'} = $self->{'_opts'}{'use_persistent_shell'} if !exists $opts->{'use_persistent_shell'};
+    if ( $opts->{'use_persistent_shell'} ) {
         $ret = $do_persistent_command->( $self, \@command, $opts->{'no_stderr'} );
     }
     else {
@@ -669,7 +803,7 @@ C<MOD> - File mode.
 C<OWN> - File owner. Defaults to the user you connected as.
 C<GRP> - File group. Defaults to OWN.
 
-Returns true if all actions are successful, otherwise confess the error.
+Returns true if all actions are successful, otherwise warn/die about the error.
 
     $ssh->write($filename,$content,'600','root');
 
@@ -768,6 +902,36 @@ sub eval_full {
     return wantarray ? @{ $result->{data} } : $result->{data}[0];
 }
 
+=head3 cmd_stream
+
+Pretty much the same as running cmd() with one important caveat --
+all output is formatted with the configured prefix and *streams* to STDOUT.
+Useful for remote test harness building.
+Returns (exit_code), as in this context that should be all you care about.
+
+You may be asking, "well then why not use system?" That does not support
+the prefixing I'm doing here. Essentially we provide a custom line reader
+to 'send' which sends the output to STDOUT via 'diag' as well as doing
+the "default" behavior (append the line to the relevant output vars).
+
+NOTE: This uses send() exclusively, and will never invoke the persistent shell,
+so if you want that, don't use this.
+
+=cut
+
+sub cmd_stream {
+    my ( $self, @cmd ) = @_;
+    my $line_reader = sub {
+        my ( $self, $out, $stash_param ) = @_;
+        $out =~ s/[\r\n]{1,2}$//;
+        $self->diag($out);
+        $self->{$stash_param} .= "$out\n";
+
+        return;
+    };
+    return $send->( $self, $line_reader, @cmd );
+}
+
 =head1 AUTHORS
 
 Thomas Andrew "Andy" Baugh <andy@troglodyne.net>

lib/Net/OpenSSH/More/Linux.pm

@@ -7,9 +7,19 @@ use parent 'Net::OpenSSH::More';
 
 use File::Slurper ();
 
+=head1 NAME
+
+Net::OpenSSH::More::Linux
+
+=head1 DESCRIPTION
+
+This module contains useful methods to complement the parent's when in use on
+all linux environments.
+
 =head1 ASSUMPTIONS
 
 This module assumes that both the local and remote machine are some variant of GNU/Linux.
+Don't use this if that's not the case.
 
 =cut
 
@@ -52,7 +62,7 @@ sub get_primary_adapter {
             File::Slurper::read_text('/proc/net/route');
         }
         else {
-            $self->cmd( "cat /proc/net/route" );
+            $self->cmd("cat /proc/net/route");
         }
     };
     foreach my $line ( split( /\n/, $proc_route_path ) ) {
@@ -103,4 +113,15 @@ sub get_local_ips {
     );
 }
 
+=head2 copy
+
+Effectively the same thing as `cp $SOURCE $DEST` on the remote server.
+
+=cut
+
+sub copy {
+    my ( $self, $SOURCE, $DEST ) = @_;
+    return $self->send("cp -a $SOURCE $DEST");
+}
+
 1;

t/Net-OpenSSH-More-Linux.t

@@ -35,7 +35,7 @@ subtest_streamed "Common tests using mocks" => sub {
         'DESTROY'      => undef,
     );
     my $obj = Net::OpenSSH::More::Linux->new( 'host' => 'localhost', retry_max => 1 );
-    is( ref $obj,           'Net::OpenSSH::More::Linux', "Got right ref type for object upon instantiation" );
+    is( ref $obj, 'Net::OpenSSH::More::Linux', "Got right ref type for object upon instantiation" );
 };
 
 done_testing();