App-Smbxfer

 view release on metacpan or  search on metacpan

lib/App/Smbxfer.pm  view on Meta::CPAN

use Carp;

use Exporter;
use Getopt::Long;
use IO::Prompt;
use Filesys::SmbClient;

# Exports...
use base qw( Exporter );
our @EXPORT_OK = qw(
    credentials             do_smb_transfer          parse_smb_spec
    create_smb_dir_path     create_local_dir_path    smb_element_type
    smb_upload              smb_download
);

__PACKAGE__->run unless caller;

#######

sub usage {
    qq{

lib/App/Smbxfer.pm  view on Meta::CPAN

sub options {
    qq{
OPTIONS
    Usage information:
    --usage|help

    Command-line options:
    --options

    Name of file containing credentials (standard smb credentials file):
    --cred <credentials-filename>
    
    Transfer directory <local-name>:
    --recursive

    Create parent directories:
    --parents

}
}

lib/App/Smbxfer.pm  view on Meta::CPAN

    ( defined $usage ) && die usage;
    ( defined $options ) && die options;
    
    my ( $source, $dest ) = @ARGV;
    die usage unless defined $source && defined $dest;
     
    # Ensure that exactly one of source/dest is in "SMB path spec" format...
    ($dest =~ m|^//|) xor ($source =~ m|^//|) or die usage;
    
    # Get access credentials for SMB connection...
    my ($username, $password, $domain) = credentials($cred);
    
    # Prepare SMB connection object...
    my $smb = Filesys::SmbClient->new(
        username => $username, password => $password, workgroup => $domain
    );

    # Determine if source is local (not in "SMB path spec" format)...
    my $source_is_local = ($source !~ m|^//|);

    my ($local_path, $remote_smb_path_spec) = validated_paths(

lib/App/Smbxfer.pm  view on Meta::CPAN

        LOCAL_PATH =>        $local_path,
        SMB_PATH_SPEC =>     $remote_smb_path_spec,
        SOURCE_IS_LOCAL =>   $source_is_local,
        RECURSIVE =>         $recursive,
        CREATE_PARENTS =>    $create_parents
    );
}

#########################

sub credentials {
    my ($credentials_filename) = @_;

    my ($username, $password, $domain);

    if ($credentials_filename) {
        # Read access credentials from file formatted using standard smbmount
        # syntax...
        open( my $credentials, '<', "$credentials_filename" )
            or croak "cannot open credentials file: $!";
    
        my @lines;
        while( <$credentials> ){
            my ($value) = (m/.*=\s+?(.*)$/);
            push @lines, $value;
        }
        close $credentials;
        ($username, $password, $domain) = @lines;
    }
    else {
        # Getting credentials interactively...
        $username = prompt( "username? " );
        $password = prompt( "password? ", -e => '*' );
        $domain =   prompt( "domain? " );
    }

    return $username, $password, $domain;
}

#########################

lib/App/Smbxfer.pm  view on Meta::CPAN

Prints command-line usage information.

=head2 options

Prints command-line options.

=head2 run

"main() method" for running module as a command-line program.

=head2 credentials

    my ($username, $password, $domain) = credentials( $credentials_file );

Load SMB access credentials from the specified filename, which should be
formatted as expected by the smb* suite of tools (smbclient, etc.)

=head2 validated_paths

    my ($local_path, $remote_smb_path_spec) = validated_paths(
        SMB => $smb,
        SOURCE => $source,
        DEST => $dest,
        SOURCE_IS_LOCAL => $whether_or_not_source_is_local_path
    );

lib/App/Smbxfer.pm  view on Meta::CPAN

    Smbxfer <options> <local-name> //<server>/<share>[/<path>/<filename>]


  OPTIONS
    Usage information:
    --usage|help

    Command-line options:
    --options

    Name of file containing credentials (standard smb credentials file):
    --cred <credentials-filename>
    
    Transfer directory <local-name>:
    --recursive

    Create parent directories:
    --parents


=head1 PROGRAM: REQUIRED ARGUMENTS

As in the 'cp' command, two arguments are required: the source and the
destination, in that order.


=head1 PROGRAM: OPTIONS

This program can be given an option, '--cred', that specifies the path to a
filename containing Samba access credentials, explained in the CONFIGURATION AND
ENVIRONMENT section.
   
For recursive transfers, the '--recursive' flag is supported.  The '--parents'
flag causes the entire directory structure from the source path argument to be
replicated at the destination.  If the source path argument is a relative path,
only the dirs in the path as specified will be created at the destination.  For
the entire path from root to be created, specify an absolute path for the
source path.

For usage and options information, try ('--usage' or '--help') and

lib/App/Smbxfer.pm  view on Meta::CPAN

=head1 PROGRAM: DIAGNOSTICS

=over

=item C<< Invalid options! >>

Command-line options were not recognized.  C<< --usage >> and C<< --options >> provide
succinct information to resolve.


=item C<< cannot open credentials file: ... >>

The specified Samba access credentials file could not be opened.


=item C<< Error: SMB specification F< smb path spec > not found >>

Could not connect to the indicated Samba server/share/path.


=item C<< source OR destination must be in "SMB path spec" format >>

Exactly one of the source and destination must be formatted in "SMB path

lib/App/Smbxfer.pm  view on Meta::CPAN

=item C<< SMB error: cannot unlink: ... >>

Remote Samba error while trying to delete a file.


=back


=head1 PROGRAM: CONFIGURATION AND ENVIRONMENT

The credentials file that can be used via the '--cred' option should be in the
same format used by smbclient.  This file looks as follows:

    username = <username>
    password = <password>
    domain = <domain>
 

=head1 PROGRAM: NON-TRIVIAL DEPENDENCIES

Filesys::SmbClient