From: Flavio Poletti <flavio@polettix.it>
Date: Fri, 8 Aug 2008 17:27:51 +0000 (+0200)
Subject: Sanitised deploy script.
X-Git-Url: https://repo.or.cz/w/deployable.git/commitdiff_plain/f92f71a131508910e4854df535aee0848d00979c

Sanitised deploy script.
---

diff --git a/deploy b/deploy
index cf7574a..ae711e2 100755
--- a/deploy
+++ b/deploy
@@ -1,10 +1,10 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
+my $VERSION = '0.6.0';
 use Carp;
 use Pod::Usage qw( pod2usage );
 use Getopt::Long qw( :config gnu_getopt );
-use version; my $VERSION = qv('0.0.1');
 use English qw( -no_match_vars );
 use Net::SSH::Perl;
 use Net::SSH::Perl::Auth;
@@ -12,13 +12,8 @@ use Net::SFTP;
 use Net::SFTP::Attributes;
 use IO::Prompt;
 use Data::Dumper;
-use File::Basename qw( basename );
 use File::Spec::Functions qw( catfile );
 
-# Integrated logging facility
-use Log::Log4perl qw( :easy );
-Log::Log4perl->easy_init($INFO);
-
 my %config = (
    username => 'root',
    debug    => 0,
@@ -26,14 +21,19 @@ my %config = (
    prompt   => 1,
 );
 GetOptions(
-   \%config,            'usage',
-   'help',              'man',
-   'version',           'username|user|u=s',
-   'password|pass|p=s', 'debug|D!',
-   'dir|directory|d=s', 'script|s=s',
-   'prompt|P!',
+   \%config,
+   qw(
+      usage! help! man! version!
+
+      debug|D!
+      dir|directory|d=s 
+      password|pass|p:s 
+      prompt|P!
+      script|s=s
+      username|user|u=s
+   )
 );
-pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => '')
+pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
   if $config{version};
 pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
 pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
@@ -45,7 +45,7 @@ my @hostnames = @ARGV;
 @ARGV = ();
 
 $config{password} = prompt 'password: ', -e => '*'
-  unless defined($config{password}) && length($config{password});
+  unless exists $config{password};
 
 ($config{remote} = $config{script}) =~ s{[^\w.-]}{}mxsg;
 $config{remote} = catfile($config{dir}, $config{remote});
@@ -68,7 +68,7 @@ sub operate_on_host {
    } ## end if ($config{prompt})
 
    # Transfer file into $remote
-   my $sftp = get_sftp(get_ssh($hostname));
+   my $sftp = get_sftp($hostname);
    make_path($sftp, $config{dir});
    $sftp->put($config{script}, $remote);
    croak "no $remote, sorry. Stopped" unless $sftp->do_stat($remote);
@@ -87,6 +87,7 @@ sub operate_on_host {
       print "+ $type\n|\n$val\n|\n+ end of $type\n\n";
    } ## end for ([STDOUT => $out], ...
 
+   return;
 } ## end sub operate_on_host
 
 sub make_path {
@@ -116,28 +117,19 @@ sub get_ssh {
 } ## end sub get_ssh
 
 sub get_sftp {
-   return Net::SFTP::Mine->new(
-      $config{hostname},
-      ssh  => shift,
-      warn => sub { }
+   my ($hostname) = @_;
+   return Net::SFTP->new(
+      $hostname,
+      warn => sub { },
+      user => $config{username},
+      password => $config{password},
+      ssh_args => {
+         protocol => 2,
+         debug => $config{debug},
+      }
    );
 } ## end sub get_sftp
 
-
-package Net::SFTP::Mine;
-use base qw( Net::SFTP );
-
-sub init {
-   my $sftp  = shift;
-   my %param = @_;
-   my $ssh = delete $param{ssh};
-
-   no warnings 'redefine';
-   local *Net::SSH::Perl::new = sub { return $ssh };
-   local *Net::SSH::Perl::login = sub { print {*STDERR} "fake login\n"};
-   return $sftp->SUPER::init(%param);
-} ## end sub init
-
 __END__
 
 =head1 NAME
@@ -150,7 +142,6 @@ See version at beginning of script, variable $VERSION, or call
 
    shell$ deploy --version
 
-
 =head1 USAGE
 
    deploy [--usage] [--help] [--man] [--version]
@@ -167,6 +158,9 @@ See version at beginning of script, variable $VERSION, or call
    # in file "targets"
    shell$ deploy -s deploy-script.pl `cat targets`
 
+   # ... without bugging me prompting confirmations...
+   shell$ deploy -s deploy-script.pl --no-prompt `cat targets`
+
 =head1 DESCRIPTION
 
 This utility allows you to I<deploy> a script to one or more remote 
@@ -190,6 +184,12 @@ to provide either on the command line: the username defaults to C<root>,
 and you'll be prompted to provide a password if you don't put any
 on the command line. The prompt does not show the password on the terminal.
 
+By default, L<Net::SSH::Perl> will try to use public/private key
+authentication. If you're confident that this method will work, you can
+just hit enter when requested for a password, or you can pass
+C<-p> without a password on the command line (you can actually pass
+every password you can think of, it will be ignored).
+
 =head1 OPTIONS
 
 =over
@@ -304,20 +304,12 @@ L<IO::Prompt>
 
 =item -
 
-L<Log::Log4perl>
-
-=item -
-
 L<Net::SFTP>
 
 =item -
 
 L<Net::SSH::Perl>
 
-=item -
-
-L<version>, but you should find it if you're using version 5.10
-
 =back