deploy

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 my $VERSION = '0.6.0';
   5 use Carp;
   6 use Pod::Usage qw( pod2usage );
   7 use Getopt::Long qw( :config gnu_getopt );
   8 use English qw( -no_match_vars );
   9 use Net::SSH::Perl;
  10 use Net::SSH::Perl::Auth;
  11 use Net::SFTP;
  12 use Net::SFTP::Attributes;
  13 use IO::Prompt;
  14 use Data::Dumper;
  15 use File::Spec::Functions qw( catfile );
  16
  17 my %config = (
  18    username => 'root',
  19    debug    => 0,
  20    dir      => '/tmp/our-deploy',
  21    prompt   => 1,
  22 );
  23 GetOptions(
  24    \%config,
  25    qw(
  26       usage! help! man! version!
  27
  28       debug|D!
  29       dir|directory|d=s
  30       password|pass|p:s
  31       prompt|P!
  32       script|s=s
  33       username|user|u=s
  34    )
  35 );
  36 pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
  37   if $config{version};
  38 pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
  39 pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
  40   if $config{help};
  41 pod2usage(-verbose => 2) if $config{man};
  42
  43 # Script implementation here
  44 my @hostnames = @ARGV;
  45 @ARGV = ();
  46
  47 $config{password} = prompt 'password: ', -e => '*'
  48   unless exists $config{password};
  49
  50 ($config{remote} = $config{script}) =~ s{[^\w.-]}{}mxsg;
  51 $config{remote} = catfile($config{dir}, $config{remote});
  52
  53 for my $hostname (@hostnames) {
  54    eval { operate_on_host($hostname) };
  55    carp $EVAL_ERROR if $EVAL_ERROR;
  56 }
  57
  58 sub operate_on_host {
  59    my ($hostname) = @_;
  60    my $remote = $config{remote};
  61
  62    print "*** OPERATING ON $hostname ***\n";
  63    if ($config{prompt}) {
  64       my $choice = lc(prompt "$hostname - continue? (Yes | Skip | No) ",
  65          -while => qr/\A[nsy]\z/mxs);
  66       return if $choice eq 's';
  67       exit 0 if $choice eq 'n';
  68    } ## end if ($config{prompt})
  69
  70    # Transfer file into $remote
  71    my $sftp = get_sftp($hostname);
  72    make_path($sftp, $config{dir});
  73    $sftp->put($config{script}, $remote);
  74    croak "no $remote, sorry. Stopped" unless $sftp->do_stat($remote);
  75
  76    # Execute file
  77    my $ssh = get_ssh($hostname);
  78    $|++;
  79    print "$remote ";
  80    my ($out, $err, $exit) = $ssh->cmd($remote);
  81    print "exit = $exit\n";
  82    for ([STDOUT => $out], [STDERR => $err]) {
  83       my ($type, $val) = @$_;
  84       next unless defined $val;
  85       $val =~ s{\s+\z}{}mxs;
  86       $val =~ s{^}{|  }gmxs;
  87       print "+ $type\n|\n$val\n|\n+ end of $type\n\n";
  88    } ## end for ([STDOUT => $out], ...
  89
  90    return;
  91 } ## end sub operate_on_host
  92
  93 sub make_path {
  94    my ($sftp, $fullpath) = @_;
  95
  96    my $path = '';
  97    for my $chunk (split m{/}mxs, $fullpath) {
  98       $path .= $chunk . '/';    # works fine with the root
  99       next if $sftp->do_stat($path);
 100       $sftp->do_mkdir($path, Net::SFTP::Attributes->new());
 101    }
 102    croak "no $path, sorry. Stopped" unless $sftp->do_stat($path);
 103
 104    return;
 105 } ## end sub make_path
 106
 107 sub get_ssh {
 108    my ($hostname) = @_;
 109    my $ssh = Net::SSH::Perl->new(
 110       $hostname,
 111       protocol => 2,
 112       debug    => $config{debug}
 113    );
 114    $ssh->login($config{username}, $config{password}, 'suppress_shell');
 115
 116    return $ssh;
 117 } ## end sub get_ssh
 118
 119 sub get_sftp {
 120    my ($hostname) = @_;
 121    return Net::SFTP->new(
 122       $hostname,
 123       warn => sub { },
 124       user => $config{username},
 125       password => $config{password},
 126       ssh_args => {
 127          protocol => 2,
 128          debug => $config{debug},
 129       }
 130    );
 131 } ## end sub get_sftp
 132
 133 __END__
 134
 135 =head1 NAME
 136
 137 deploy - deploy a script on one or more remote hosts, via ssh
 138
 139 =head1 VERSION
 140
 141 See version at beginning of script, variable $VERSION, or call
 142
 143    shell$ deploy --version
 144
 145 =head1 USAGE
 146
 147    deploy [--usage] [--help] [--man] [--version]
 148
 149    deploy [--debug|-D] [--dir|--directory|-d <dirname>]
 150           [--password|--pass|-p] [--prompt|-P]
 151           [--script|-s <scriptname>] [--username|--user|-u]
 152
 153 =head1 EXAMPLES
 154
 155    shell$ deploy
 156
 157    # Upload deploy-script.pl and execute it on each server listed
 158    # in file "targets"
 159    shell$ deploy -s deploy-script.pl `cat targets`
 160
 161    # ... without bugging me prompting confirmations...
 162    shell$ deploy -s deploy-script.pl --no-prompt `cat targets`
 163
 164 =head1 DESCRIPTION
 165
 166 This utility allows you to I<deploy> a script to one or more remote
 167 hosts. Thus, you can provide a script that will be uploaded (via
 168 B<sftp>) to the remote host and executed (via B<ssh>).
 169
 170 Before operations start for each host you will be prompted for
 171 continuation: you can choose to go, skip or quit. You can disable
 172 this by specifying C<--no-prompt>.
 173
 174 By default, directory C</tmp/our-deploy> on the target system will be
 175 used. You can provide your own working directory path on the target system
 176 via the C<--dir|--directory|-d> option. The directory will be created
 177 if it does not exist.
 178
 179 For logging in, you can provide your own username/password pair directly
 180 on the command line. Note that this utility explicitly avoids public
 181 key authentication in favour of username/password authentication. Don't
 182 ask me why, this may change in the future. Anyway, you're not obliged
 183 to provide either on the command line: the username defaults to C<root>,
 184 and you'll be prompted to provide a password if you don't put any
 185 on the command line. The prompt does not show the password on the terminal.
 186
 187 By default, L<Net::SSH::Perl> will try to use public/private key
 188 authentication. If you're confident that this method will work, you can
 189 just hit enter when requested for a password, or you can pass
 190 C<-p> without a password on the command line (you can actually pass
 191 every password you can think of, it will be ignored).
 192
 193 =head1 OPTIONS
 194
 195 =over
 196
 197 =item --debug | -D
 198
 199 turns on debug mode, which should print out more stuff during operations.
 200 You should not need it as a user.
 201
 202 =item --dir | --directory | -d <dirname>
 203
 204 specify the working directory on the target system. This is the
 205 directory into which the deploy script will be uploaded. It will
 206 be created if it does not exist.
 207
 208 Defaults to C</tmp/our-deploy>.
 209
 210 =item --help
 211
 212 print a somewhat more verbose help, showing usage, this description of
 213 the options and some examples from the synopsis.
 214
 215 =item --man
 216
 217 print out the full documentation for the script.
 218
 219 =item --password | --pass | -p <password>
 220
 221 you can specify the password on the command line, even if it's probably
 222 best B<NOT> to do so and wait for the program to prompt you one.
 223
 224 By default, you'll be prompted a password and this will not be written
 225 on the terminal.
 226
 227 =item --prompt | -P
 228
 229 this option enables prompting before operations are started on each
 230 host. When the prompt is enabled, you're presented with three choices:
 231
 232 =over
 233
 234 =item -
 235
 236 B<Yes> continue deployment on the given host;
 237
 238 =item -
 239
 240 B<Skip> skip this host;
 241
 242 =item -
 243
 244 B<No> stop deployment and exit.
 245
 246 =back
 247
 248 One letter suffices. By default, C<Yes> is assumed.
 249
 250 By default this option is I<always> active, so you're probably
 251 interested in C<--no-prompt> to disable it.
 252
 253 =item --script | -s <scriptname>
 254
 255 set the script/program to upload and execute. This script will be uploaded
 256 to the target system (see C<--directory|-d> above), but the name of the
 257 script will be sanitised (only alphanumeric, C<_>, C<.> and C<-> will
 258 be retained), so be careful if you have to look for the uploaded
 259 script later.
 260
 261 =item --usage
 262
 263 print a concise usage line and exit.
 264
 265 =item --username | --user | -u <username>
 266
 267 specify the user name to use for logging into the remote host(s).
 268
 269 Defaults to C<root>.
 270
 271 =item --version
 272
 273 print the version of the script.
 274
 275 =back
 276
 277 =head1 DIAGNOSTICS
 278
 279 =over
 280
 281 =item C<< no %s, sorry. Stopped at... >>
 282
 283 The given element is not available on the target system.
 284
 285 In case of the directory, this means that the automatic creation
 286 process did not work for any reason. In case of the script, this
 287 means that the file upload did not work.
 288
 289 =back
 290
 291
 292 =head1 CONFIGURATION AND ENVIRONMENT
 293
 294 deploy requires no configuration files or environment variables.
 295
 296
 297 =head1 DEPENDENCIES
 298
 299 =over
 300
 301 =item -
 302
 303 L<IO::Prompt>
 304
 305 =item -
 306
 307 L<Net::SFTP>
 308
 309 =item -
 310
 311 L<Net::SSH::Perl>
 312
 313 =back
 314
 315
 316 =head1 BUGS AND LIMITATIONS
 317
 318 No bugs have been reported.
 319
 320 Please report any bugs or feature requests through http://rt.cpan.org/
 321
 322
 323 =head1 AUTHOR
 324
 325 Flavio Poletti C<flavio@polettix.it>
 326
 327
 328 =head1 LICENCE AND COPYRIGHT
 329
 330 Copyright (c) 2007-2008, Flavio Poletti C<flavio@polettix.it>.
 331 All rights reserved.
 332
 333 This script is free software; you can redistribute it and/or
 334 modify it under the same terms as Perl itself. See L<perlartistic>
 335 and L<perlgpl>.
 336
 337 Questo script è software libero: potete ridistribuirlo e/o
 338 modificarlo negli stessi termini di Perl stesso. Vedete anche
 339 L<perlartistic> e L<perlgpl>.
 340
 341
 342 =head1 DISCLAIMER OF WARRANTY
 343
 344 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 345 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 346 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 347 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 348 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 349 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 350 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 351 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 352 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 353
 354 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 355 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 356 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 357 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 358 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 359 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 360 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 361 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 362 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 363 SUCH DAMAGES.
 364
 365 =head1 NEGAZIONE DELLA GARANZIA
 366
 367 Poiché questo software viene dato con una licenza gratuita, non
 368 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
 369 dalle leggi applicabili. A meno di quanto possa essere specificato
 370 altrove, il proprietario e detentore del copyright fornisce questo
 371 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
 372 o implicita, includendo fra l'altro (senza però limitarsi a questo)
 373 eventuali garanzie implicite di commerciabilità e adeguatezza per
 374 uno scopo particolare. L'intero rischio riguardo alla qualità ed
 375 alle prestazioni di questo software rimane a voi. Se il software
 376 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
 377 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
 378
 379 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
 380 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
 381 di copyright, o qualunque altra parte che possa modificare, o redistribuire
 382 questo software così come consentito dalla licenza di cui sopra, potrà
 383 essere considerato responsabile nei vostri confronti per danni, ivi
 384 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
 385 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
 386 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
 387 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
 388 sostenute da voi o da terze parti o un fallimento del software ad
 389 operare con un qualsivoglia altro software. Tale negazione di garanzia
 390 rimane in essere anche se i dententori del copyright, o qualsiasi altra
 391 parte, è stata avvisata della possibilità di tali danneggiamenti.
 392
 393 Se decidete di utilizzare questo software, lo fate a vostro rischio
 394 e pericolo. Se pensate che i termini di questa negazione di garanzia
 395 non si confacciano alle vostre esigenze, o al vostro modo di
 396 considerare un software, o ancora al modo in cui avete sempre trattato
 397 software di terze parti, non usatelo. Se lo usate, accettate espressamente
 398 questa negazione di garanzia e la piena responsabilità per qualsiasi
 399 tipo di danno, di qualsiasi natura, possa derivarne.
 400
 401 =cut