deploy

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 my $VERSION = '0.8.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 Data::Dumper;
  12 use File::Spec::Functions qw( catfile );
  13
  14 my %config = (
  15    username => $ENV{USER} || 'root',
  16    debug    => 0,
  17    dir      => '/tmp/our-deploy',
  18    prompt   => 1,
  19    sftp     => 1, # try to use sftp possibly
  20 );
  21 GetOptions(
  22    \%config,
  23    qw(
  24      usage! help! man! version!
  25
  26      compress|c!
  27      debug|D!
  28      dir|directory|d=s
  29      json|j!
  30      password|pass|p=s
  31      prompt|P!
  32      script|s=s
  33      commandline|command-line|S=s
  34      sftp!
  35      stderr|E!
  36      stdout|O!
  37      username|user|u=s
  38      )
  39 );
  40 pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ', -noperldoc => 1)
  41   if $config{version};
  42 pod2usage(-verbose => 99, -sections => 'USAGE', -noperldoc => 1) if $config{usage};
  43 pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS', -noperldoc => 1)
  44   if $config{help};
  45 pod2usage(-verbose => 2, -noperldoc => 1) if $config{man};
  46
  47 pod2usage(-verbose => 99, -sections => 'USAGE', -noperldoc => 1,
  48    message => "Only one allowed between --stdout and --stderr\n")
  49    if $config{stdout} && $config{stderr};
  50
  51 pod2usage(-verbose => 99, -sections => 'USAGE', -noperldoc => 1,
  52    message => "IO::Prompt not available, re-run with --no-prompt\n")
  53    if $config{prompt} && ! eval { require IO::Prompt; 1 };
  54
  55 # Script implementation here
  56 my @hostnames = @ARGV;
  57 @ARGV = ();
  58
  59 if (exists $config{password}) {
  60    $config{interactive} = 1;
  61    $config{identity_files} = [];
  62    if (! $config{password}) {
  63       pod2usage(-verbose => 99, -sections => 'USAGE', -noperldoc => 1,
  64             message => "IO::Prompt not available, set password :(\n")
  65          unless eval { require IO::Prompt; 1 };
  66       $config{password} = IO::Prompt::prompt('password: ', -e => '*');
  67    }
  68 }
  69
  70 if ($config{commandline}) {
  71    pod2usage(-verbose => 99, -sections => 'USAGE',
  72       message => 'use only one of "script" and "command-line"')
  73       if exists $config{script};
  74    $config{remote} = $config{commandline};
  75 }
  76 else {
  77    ($config{remote} = $config{script}) =~ s{[^\w.-]}{}mxsg;
  78    $config{remote} = catfile($config{dir}, $config{remote});
  79 }
  80
  81 for my $hostname (@hostnames) {
  82    eval { operate_on_host($hostname) };
  83    carp $EVAL_ERROR if $EVAL_ERROR;
  84 }
  85
  86 sub operate_on_host {
  87    my ($hostname) = @_;
  88    my $remote = $config{remote};
  89    my $json = $config{json};
  90    my $ffh = $json ? \*STDERR : \*STDOUT;
  91    my %record = (
  92       hostname => $hostname,
  93       remote => $remote,
  94    );
  95    $record{script} = $config{script} if $config{script};
  96
  97    if ($config{prompt}) {
  98       print {$ffh} "*** OPERATING ON $hostname ***\n";
  99       my $choice = lc(IO::Prompt::prompt("$hostname - continue? (Yes | Skip | Quit) ",
 100          -while => qr/\A[qsy]\z/mxs));
 101       return if $choice eq 's';
 102       exit 0 if $choice eq 'q';
 103    } ## end if ($config{prompt})
 104
 105    $|++;
 106    print {$ffh} $hostname, $config{script} ? " $remote " : " cmd[$remote] ";
 107
 108    # Transfer file into $remote, if any
 109    transfer_script($hostname) if $config{script};
 110
 111    # Execute
 112    my $ssh = get_ssh($hostname);
 113    my $qremote = $config{script} ? shell_quote($remote) : $remote;
 114    @record{qw< stdout stderr exit >} = my ($out, $err, $exit)
 115       = $ssh->cmd($qremote);
 116    print {$ffh} "exit=$exit\n";
 117
 118    if ($json) {
 119       require JSON::PP;
 120       print {*STDOUT} JSON::PP::encode_json(\%record), "\n";
 121    }
 122    elsif ($config{stdout} && defined $out) {
 123       print {*STDOUT} $out;
 124    }
 125    elsif ($config{stderr} && defined $err) {
 126       print {*STDOUT} $err;
 127    }
 128    else {
 129       for ([STDOUT => $out], [STDERR => $err]) {
 130          my ($type, $val) = @$_;
 131          next unless defined $val;
 132          $val =~ s{\s+\z}{}mxs;
 133          $val =~ s{^}{$type }gmxs;
 134          print {*STDOUT} $val, "\n\n";
 135       } ## end for ([STDOUT => $out], ...
 136    }
 137
 138    return;
 139 } ## end sub operate_on_host
 140
 141 sub _get_optionals {
 142    map { $_ => $config{$_} } grep { exists $config{$_} } qw( interactive identity_files password );
 143 }
 144
 145 sub get_ssh {
 146    my ($hostname) = @_;
 147    my %optional;
 148
 149    my $ssh = Net::SSH::Perl->new(
 150       $hostname,
 151       protocol => 2,
 152       debug    => $config{debug},
 153       _get_optionals(),
 154    );
 155    $ssh->login($config{username}, $config{password}, 'suppress_shell');
 156
 157    return $ssh;
 158 } ## end sub get_ssh
 159
 160 sub transfer_script {
 161    my ($hostname) = @_;
 162
 163    # first try with Net::SFTP, then fallback onto SSH
 164    return(
 165       ($config{sftp} && eval { transfer_script_sftp($hostname); 1 })
 166       || transfer_script_ssh($hostname)
 167    );
 168 }
 169
 170 sub shell_quote {
 171    my ($string) = @_;
 172    my @caller = caller 1;
 173    $string =~ s{'}{'\\''}gmxs;
 174    return "'" . $string . "'";
 175 }
 176
 177 sub transfer_script_sftp {
 178    my ($hostname) = @_;
 179
 180    require Net::SFTP;
 181    my $sftp = Net::SFTP->new(
 182       $hostname,
 183       warn     => sub { },
 184       user     => $config{username},
 185       password => $config{password},
 186       ssh_args => {
 187          protocol    => 2,
 188          debug       => $config{debug},
 189          compression => $config{compress},
 190          user        => $config{username},
 191          _get_optionals(),
 192       }
 193    );
 194    $sftp->do_stat('.') or die 'whatever';
 195
 196    make_path_sftp($sftp, $config{dir});
 197    $sftp->put($config{script}, $config{remote});
 198    croak "no $config{remote}, sorry. Stopped"
 199       unless $sftp->do_stat($config{remote});
 200
 201    return;
 202 }
 203
 204 sub make_path_sftp {
 205    my ($sftp, $fullpath) = @_;
 206    require Net::SFTP::Attributes;
 207
 208    my $path = '';
 209    for my $chunk (split m{/}mxs, $fullpath) {
 210       $path .= $chunk . '/';    # works fine with the root
 211       next if $sftp->do_stat($path);
 212       $sftp->do_mkdir($path, Net::SFTP::Attributes->new());
 213    }
 214    croak "no $fullpath, sorry. Stopped" unless $sftp->do_stat($fullpath);
 215
 216    return;
 217 } ## end sub make_path
 218
 219 sub transfer_script_ssh {
 220    my ($hostname) = @_;
 221    my $ssh = get_ssh($hostname);
 222
 223    make_path_ssh($ssh, $config{dir});
 224
 225    my $mode = (stat $config{script})[2]
 226       or croak "cannot stat('$config{script}'), sorry. Stopped";
 227    $mode = sprintf '%04o', $mode & 07777;
 228    my $script = do {
 229       open my $fh, '<', $config{script}
 230          or croak "open('$config{script}'): $OS_ERROR, sorry. Stopped";
 231       binmode $fh, ':raw';
 232       local $/; # slurp mode
 233       <$fh>;
 234    };
 235
 236    my $qremote = shell_quote($config{remote});
 237    my ($out, $err, $exit) = $ssh->cmd("cat - >$qremote", $script);
 238    ($out, $err, $exit) = $ssh->cmd("chmod $mode $qremote") unless $exit;
 239    croak "no $config{remote}, sorry. Stopped"
 240       if $exit || !test_path_ssh($ssh, -e => $config{remote});
 241
 242    return;
 243 }
 244
 245 sub make_path_ssh {
 246    my ($ssh, $fullpath) = @_;
 247    my $dir = shell_quote($fullpath);
 248    my ($out, $err, $exit) = $ssh->cmd("mkdir -p $dir");
 249    croak "no $fullpath, sorry. Stopped"
 250       unless test_path_ssh($ssh, -d => $fullpath);
 251 }
 252
 253 sub test_path_ssh {
 254    my ($ssh, $test, $path) = @_;
 255    my $qpath = shell_quote($path);
 256    my ($out, $err, $exit) = $ssh->cmd("test $test $qpath");
 257    return $exit == 0;
 258 }
 259
 260 __END__
 261
 262 =pod
 263
 264 =encoding utf8
 265
 266 =head1 NAME
 267
 268 deploy - deploy a script on one or more remote hosts, via ssh
 269
 270 =head1 VERSION
 271
 272 See version at beginning of script, variable $VERSION, or call
 273
 274    shell$ deploy --version
 275
 276 =head1 USAGE
 277
 278    deploy [--usage] [--help] [--man] [--version]
 279
 280    deploy [--command-line|-S <string>] [--debug|-D]
 281           [--dir|--directory|-d <dirname>] [--json|--no-json]
 282           [--password|--pass|-p] [--prompt|-P|--no-prompt]
 283           [--script|-s <scriptname>] [--stderr|-E] [--stdout|-O]
 284           [--username|--user|-u]
 285
 286 =head1 EXAMPLES
 287
 288    shell$ deploy
 289
 290    # Upload deploy-script.pl and execute it on each server listed
 291    # in file "targets"
 292    shell$ deploy -s deploy-script.pl `cat targets`
 293
 294    # ... without bugging me prompting confirmations...
 295    shell$ deploy -s deploy-script.pl --no-prompt `cat targets`
 296
 297    # Execute a one-shot command remotely. Note UPPERCASE "s"
 298    shell$ deploy -S 'ls -l /' `cat targets`
 299
 300 =head1 DESCRIPTION
 301
 302 This utility allows you to I<deploy> a script to one or more remote
 303 hosts. Thus, you can provide a script that will be uploaded (via
 304 B<sftp>) to the remote host and executed (via B<ssh>).
 305
 306 Before operations start for each host you will be prompted for
 307 continuation: you can choose to go, skip or quit. You can disable
 308 this by specifying C<--no-prompt>.
 309
 310 By default, directory C</tmp/our-deploy> on the target system will be
 311 used. You can provide your own working directory path on the target system
 312 via the C<--dir|--directory|-d> option. The directory will be created
 313 if it does not exist.
 314
 315 For logging in, you can provide your own username/password pair directly
 316 on the command line. Note that this utility explicitly avoids public
 317 key authentication in favour of username/password authentication. Don't
 318 ask me why, this may change in the future. Anyway, you're not obliged
 319 to provide either on the command line: the username defaults to C<root>,
 320 and you'll be prompted to provide a password if you don't put any
 321 on the command line but specify the C<--password|-p> option without a value.
 322 The prompt does not show the password on the terminal.
 323
 324 By default, L<Net::SSH::Perl> will try to use public/private key
 325 authentication. If you're confident that this method will work, you can
 326 just hit enter when requested for a password, or you can pass
 327 C<-p> without a password on the command line (you can actually pass
 328 every password you can think of, it will be ignored).
 329
 330 Starting from version 0.7.0, L<deploy> is also able to let you execute a
 331 one-shot command remotely via the C<--command-line|-S> option; this lets
 332 you avoid uploading a script and execute it and eases your life a bit if
 333 you have to launch a single command, e.g.:
 334
 335    shell$ deploy -S 'ls /path/to/whatever' `cat targets`
 336
 337 In this case, nothing will be created in the target directory.
 338
 339 =head2 Output Format
 340
 341 As of version 0.8.0, a new output format C<json> is available. If the
 342 associated option is enabled (it's disabled by default), then for each
 343 host where actions are taken a line is printed on the standard output,
 344 with a JSON representation of an object containing the main data:
 345
 346 =over
 347
 348 =item C<hostname>
 349
 350 the hostname where the command was run;
 351
 352 =item C<remote>
 353
 354 full path of the remote script or command executed. Whether it is a command
 355 or a script can be seen by checking the presence of the C<script> key
 356 below
 357
 358 =item C<script>
 359
 360 optionally present, set to whatever is passed with option C<script>
 361
 362 =item C<exit>
 363
 364 the execution exit code;
 365
 366 =item C<stdout>
 367
 368 =item C<stderr>
 369
 370 whatever is received from remote process execution on the standard output
 371 and error channels respectively.
 372
 373 =back
 374
 375 This is the best way to get something easily parseable. Otherwise...
 376
 377 The normal output format is geared at easing parsing by other programs. It
 378 is compound of the following parts:
 379
 380 =over
 381
 382 =item *
 383
 384 a single line specifing the hostname/ip, with the following format:
 385
 386    *** OPERATING ON <hostname> ***
 387
 388 =item *
 389
 390 a single line reporting the exit code from the remote process, with the
 391 following format:
 392
 393    </path/to/deployed/program> exit = <exit-code>
 394
 395 in case a script is uploaded, or the following format:
 396
 397    cmd[<command to be executed>] exit = <exit-code>
 398
 399 in case a single one-shot command is sent (see option C<--command-line|-S>).
 400
 401 =item *
 402
 403 0 or more lines starting with C<STDOUT > (note the space);
 404
 405 =item *
 406
 407 0 or more lines starting with C<STDERR > (note the space).
 408
 409 =back
 410
 411 If any of L</--stderr> or L</--stdout> are present, then the relevant
 412 channel is printed on STDOUT immediately after the first two lines of the
 413 format above, unchanged.
 414
 415 =head2 Example Runs
 416
 417 Suppose to have the following script F<bar.sh> to deploy:
 418
 419    #!/bin/bash
 420
 421    echo 'Hi there!'
 422    ls baz
 423    echo 'How are you all?!?'
 424
 425 If you don't provide any of L</--stderr> or L</--stdout>, you will have
 426 something like this:
 427
 428    *** OPERATING ON foo.example.com ***
 429    /tmp/our-deploy/bar.sh exit = 0
 430    STDOUT Hi there!
 431    STDOUT How are you all?!?
 432    STDERR ls: baz: No such file or directory
 433
 434 If you pass L<--stderr> you will get:
 435
 436    *** OPERATING ON foo.example.com ***
 437    /tmp/our-deploy/bar.sh exit = 0
 438    ls: baz: No such file or directory
 439
 440 If you pass L<--stdout> you will get:
 441
 442    *** OPERATING ON foo.example.com ***
 443    /tmp/our-deploy/bar.sh exit = 0
 444    Hi there!
 445    How are you all?!?
 446
 447 =head1 OPTIONS
 448
 449 =over
 450
 451 =item --command-line | -S
 452
 453 set a one-shot command to be executed instead of a script to be uploaded
 454 and then executed. This option is incompatible with C<--script|-s>, because
 455 with this you're requesting to execute a one-shot command, while with
 456 that you're requesting to upload a file and then execute it.
 457
 458 =item --debug | -D
 459
 460 turns on debug mode, which should print out more stuff during operations.
 461 You should not need it as a user.
 462
 463 =item --dir | --directory | -d <dirname>
 464
 465 specify the working directory on the target system. This is the
 466 directory into which the deploy script will be uploaded. It will
 467 be created if it does not exist.
 468
 469 Defaults to C</tmp/our-deploy>.
 470
 471 =item --help
 472
 473 print a somewhat more verbose help, showing usage, this description of
 474 the options and some examples from the synopsis.
 475
 476 =item --json | -j | --no-json
 477
 478 turn to JSON output. This is disabled by default. C<--no-json> can be
 479 useful if you change the script to enable JSON output by default.
 480
 481 =item --man
 482
 483 print out the full documentation for the script.
 484
 485 =item --password | --pass | -p <password>
 486
 487 you can specify the password on the command line, even if it's probably
 488 best B<NOT> to do so and wait for the program to prompt you one.
 489
 490 By default, you'll be prompted a password and this will not be written
 491 on the terminal.
 492
 493 =item --prompt | -P
 494
 495 this option enables prompting before operations are started on each
 496 host. When the prompt is enabled, you're presented with three choices:
 497
 498 =over
 499
 500 =item -
 501
 502 B<Yes> continue deployment on the given host;
 503
 504 =item -
 505
 506 B<Skip> skip this host;
 507
 508 =item -
 509
 510 B<No> stop deployment and exit.
 511
 512 =back
 513
 514 One letter suffices. By default, C<Yes> is assumed.
 515
 516 By default this option is I<always> active, so you're probably
 517 interested in C<--no-prompt> to disable it.
 518
 519 =item --script | -s <scriptname>
 520
 521 set the script/program to upload and execute. This script will be uploaded
 522 to the target system (see C<--directory|-d> above), but the name of the
 523 script will be sanitised (only alphanumeric, C<_>, C<.> and C<-> will
 524 be retained), so be careful if you have to look for the uploaded
 525 script later.
 526
 527 This option is incompatible with C<--command-line|-S>.
 528
 529 =item --stderr | -E
 530
 531 select only the STDERR channel from the responses got via SSH. This
 532 option cannot be used with L</--stdout>.
 533
 534 =item --stdout | -O
 535
 536 select only the STDOUT channel from the responses got via SSH. This
 537 option cannot be used with L</--stderr>.
 538
 539 =item --usage
 540
 541 print a concise usage line and exit.
 542
 543 =item --username | --user | -u <username>
 544
 545 specify the user name to use for logging into the remote host(s).
 546
 547 Defaults to C<root>.
 548
 549 =item --version
 550
 551 print the version of the script.
 552
 553 =back
 554
 555 =head1 DIAGNOSTICS
 556
 557 =over
 558
 559 =item C<< no %s, sorry. Stopped at... >>
 560
 561 The given element is not available on the target system.
 562
 563 In case of the directory, this means that the automatic creation
 564 process did not work for any reason. In case of the script, this
 565 means that the file upload did not work.
 566
 567 =back
 568
 569
 570 =head1 CONFIGURATION AND ENVIRONMENT
 571
 572 deploy requires no configuration files or environment variables.
 573
 574
 575 =head1 DEPENDENCIES
 576
 577 =over
 578
 579 =item -
 580
 581 L<IO::Prompt>
 582
 583 =item -
 584
 585 L<Net::SFTP>
 586
 587 =item -
 588
 589 L<Net::SSH::Perl>
 590
 591 =back
 592
 593
 594 =head1 BUGS AND LIMITATIONS
 595
 596 No bugs have been reported.
 597
 598 Please report any bugs or feature requests through http://rt.cpan.org/
 599
 600
 601 =head1 AUTHOR
 602
 603 Flavio Poletti C<flavio@polettix.it>
 604
 605
 606 =head1 LICENCE AND COPYRIGHT
 607
 608 Copyright (c) 2007-2008, Flavio Poletti C<flavio@polettix.it>.
 609 All rights reserved.
 610
 611 This script is free software; you can redistribute it and/or
 612 modify it under the same terms as Perl itself. See L<perlartistic>
 613 and L<perlgpl>.
 614
 615 Questo script è software libero: potete ridistribuirlo e/o
 616 modificarlo negli stessi termini di Perl stesso. Vedete anche
 617 L<perlartistic> e L<perlgpl>.
 618
 619
 620 =head1 DISCLAIMER OF WARRANTY
 621
 622 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 623 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 624 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 625 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 626 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 627 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 628 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 629 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 630 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 631
 632 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 633 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 634 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 635 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 636 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 637 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 638 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 639 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 640 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 641 SUCH DAMAGES.
 642
 643 =head1 NEGAZIONE DELLA GARANZIA
 644
 645 Poiché questo software viene dato con una licenza gratuita, non
 646 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
 647 dalle leggi applicabili. A meno di quanto possa essere specificato
 648 altrove, il proprietario e detentore del copyright fornisce questo
 649 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
 650 o implicita, includendo fra l'altro (senza però limitarsi a questo)
 651 eventuali garanzie implicite di commerciabilità e adeguatezza per
 652 uno scopo particolare. L'intero rischio riguardo alla qualità ed
 653 alle prestazioni di questo software rimane a voi. Se il software
 654 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
 655 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
 656
 657 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
 658 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
 659 di copyright, o qualunque altra parte che possa modificare, o redistribuire
 660 questo software così come consentito dalla licenza di cui sopra, potrà
 661 essere considerato responsabile nei vostri confronti per danni, ivi
 662 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
 663 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
 664 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
 665 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
 666 sostenute da voi o da terze parti o un fallimento del software ad
 667 operare con un qualsivoglia altro software. Tale negazione di garanzia
 668 rimane in essere anche se i dententori del copyright, o qualsiasi altra
 669 parte, è stata avvisata della possibilità di tali danneggiamenti.
 670
 671 Se decidete di utilizzare questo software, lo fate a vostro rischio
 672 e pericolo. Se pensate che i termini di questa negazione di garanzia
 673 non si confacciano alle vostre esigenze, o al vostro modo di
 674 considerare un software, o ancora al modo in cui avete sempre trattato
 675 software di terze parti, non usatelo. Se lo usate, accettate espressamente
 676 questa negazione di garanzia e la piena responsabilità per qualsiasi
 677 tipo di danno, di qualsiasi natura, possa derivarne.
 678
 679 =cut