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