view release on metacpan or  search on metacpan

lib/App/Shotgun/Target/SFTP.pm  view on Meta::CPAN

}
use strict;
use warnings;

# ABSTRACT: App::Shotgun target for SFTP servers

use MooseX::POE::SweetArgs;
use POE::Component::Generic;

# argh, we need to fool Test::Apocalypse::Dependencies!
# Also, this will let dzil autoprereqs pick it up without actually loading it...
if ( 0 ) {
	require Net::SFTP::Foreign;
	require Expect; # to make sure SFTP can handle passwords
}

with qw(
	App::Shotgun::Target
	MooseX::LogDispatch
);


has port => (
	isa => 'Int',
	is => 'ro',
	default => 22,
);


has username => (
	isa => 'Str',
	is => 'ro',
	required => 1,
);


has password => (
	isa => 'Str',
	is => 'ro',
	predicate => '_has_password',
);

# the poco-generic sftp subprocess
has sftp => (
	isa => 'Maybe[POE::Component::Generic]',
	is => 'rw',
	init_arg => undef,
);

# the master told us to shutdown
event shutdown => sub {
	my $self = shift;

	# remove the timeout timer
	$poe_kernel->delay( 'timeout_event' );

	# tell poco-generic to shutdown
	if ( defined $self->sftp ) {
		# TODO ARGH poco-generic NEEDS TO SHUTDOWN NOW
		# the problem is that it does a "graceful" shutdown
		# but the ssh process is stuck on password prompt
		# and everything freezes....
		$self->sftp->{'wheel'}->kill( 'KILL' );
		$poe_kernel->call( $self->sftp->session_id, 'shutdown' );
		$self->sftp( undef );
	}
};

sub START {
	my $self = shift;

	# spawn poco-generic
	$self->sftp( POE::Component::Generic->spawn(
		'alt_fork'		=> 1,	# conserve memory by using exec
		'package'		=> 'Net::SFTP::Foreign',
		'methods'		=> [ qw( error setcwd mkdir put ) ],

		'object_options'	=> [
			host => $self->hostname,
			port => $self->port,

			user => $self->username,
			( $self->_has_password ? ( password => $self->password ) : () ),

			timeout => 120,
		],

#		( 'debug' => 1, 'error' => 'sftp_generic_error' ),
	) );

	# set a timer in case the password negotiation/whatever doesnt work
	$poe_kernel->delay( 'timeout_event' => 120 );

	# check for connection error
	$self->sftp->error( { 'event' => 'sftp_connect' } );

	return;
}

event timeout_event => sub {
	my $self = shift;

	$self->error( "[" . $self->name . "] CONNECT error: timed out" );

	return;
};

event sftp_generic_error => sub {
	my( $self, $err ) = @_;

	# TODO poco-generic sucks for not properly shutting down
	return if ! defined $self->sftp;

	if( $err->{stderr} ) {
		# $err->{stderr} is a line that was printed to the
		# sub-processes' STDERR.  99% of the time that means from
		# your code.
		warn "Got stderr: $err->{stderr}";
	} else {
		# Wheel error.  See L<POE::Wheel::Run/ErrorEvent>
		# $err->{operation}

lib/App/Shotgun/Target/SFTP.pm  view on Meta::CPAN

	}

	return;
};

event sftp_mkdir_error => sub {
	my( $self, $response ) = @_;

	$self->error( "[" . $self->name . "] MKDIR(" . $response->{'data'} . ") error: " . $response->{'result'}[0] );

	return;
};

event sftp_put => sub {
	my( $self, $response ) = @_;

	# TODO poco-generic sucks for not properly shutting down
	return if ! defined $self->sftp;

	# success?
	if ( $response->{'result'}[0] ) {
		# we're finally done with this transfer!
		$self->xferdone( $self );
	} else {
		$self->sftp->error( { 'event' => 'sftp_put_error', 'data' => $response->{'data'} } );
	}

	return;
};

event sftp_put_error => sub {
	my( $self, $response ) = @_;

	$self->error( "[" . $self->name . "] XFER(" . $response->{'data'} . ") error: " . $response->{'result'}[0] );

	return;
};

no MooseX::POE::SweetArgs;
__PACKAGE__->meta->make_immutable;
1;


__END__
=pod

=head1 NAME

App::Shotgun::Target::SFTP - App::Shotgun target for SFTP servers

=head1 VERSION

version 0.001

=head1 DESCRIPTION

Implements the SFTP ( FTP via SSH ) target.

Note: It is recommended to have ssh certificates set up for passwordless authentication. If you supply a password, L<Net::SFTP::Foreign>
will attempt to use L<Expect> to do the interaction, but you must have L<Expect> installed. Otherwise the connection will hang at the
password prompt and nothing will work!

=head1 ATTRIBUTES

=head2 port

The port to connect on the server.

The default is: 22

=head2 username

The username to login to the server with.

Required.

=head2 password

The password to login to the server with. Please see the note in L</DESCRIPTION> for more information.

The default is: none ( use ssh certificates )

=for Pod::Coverage process_put START

=head1 AUTHORS

=over 4

=item *

Torsten Raudssus <torsten@raudssus.de>

=item *

Apocalypse <APOCAL@cpan.org>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Raudssus Social Software L<http://www.raudssus.de/>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut