deploy

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 my $VERSION = '0.7.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       script => $config{script}
  88    );
  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>]
 275           [--password|--pass|-p] [--prompt|-P]
 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 The normal output format is geared at easing parsing by other programs. It
 335 is compound of the following parts:
 336
 337 =over
 338
 339 =item *
 340
 341 a single line specifing the hostname/ip, with the following format:
 342
 343    *** OPERATING ON <hostname> ***
 344
 345 =item *
 346
 347 a single line reporting the exit code from the remote process, with the
 348 following format:
 349
 350    </path/to/deployed/program> exit = <exit-code>
 351
 352 in case a script is uploaded, or the following format:
 353
 354    cmd[<command to be executed>] exit = <exit-code>
 355
 356 in case a single one-shot command is sent (see option C<--command-line|-S>).
 357
 358 =item *
 359
 360 0 or more lines starting with C<STDOUT > (note the space);
 361
 362 =item *
 363
 364 0 or more lines starting with C<STDERR > (note the space).
 365
 366 =back
 367
 368 If any of L</--stderr> or L</--stdout> are present, then the relevant
 369 channel is printed on STDOUT immediately after the first two lines of the
 370 format above, unchanged.
 371
 372 =head2 Example Runs
 373
 374 Suppose to have the following script F<bar.sh> to deploy:
 375
 376    #!/bin/bash
 377
 378    echo 'Hi there!'
 379    ls baz
 380    echo 'How are you all?!?'
 381
 382 If you don't provide any of L</--stderr> or L</--stdout>, you will have
 383 something like this:
 384
 385    *** OPERATING ON foo.example.com ***
 386    /tmp/our-deploy/bar.sh exit = 0
 387    STDOUT Hi there!
 388    STDOUT How are you all?!?
 389    STDERR ls: baz: No such file or directory
 390
 391 If you pass L<--stderr> you will get:
 392
 393    *** OPERATING ON foo.example.com ***
 394    /tmp/our-deploy/bar.sh exit = 0
 395    ls: baz: No such file or directory
 396
 397 If you pass L<--stdout> you will get:
 398
 399    *** OPERATING ON foo.example.com ***
 400    /tmp/our-deploy/bar.sh exit = 0
 401    Hi there!
 402    How are you all?!?
 403
 404 =head1 OPTIONS
 405
 406 =over
 407
 408 =item --command-line | -S
 409
 410 set a one-shot command to be executed instead of a script to be uploaded
 411 and then executed. This option is incompatible with C<--script|-s>, because
 412 with this you're requesting to execute a one-shot command, while with
 413 that you're requesting to upload a file and then execute it.
 414
 415 =item --debug | -D
 416
 417 turns on debug mode, which should print out more stuff during operations.
 418 You should not need it as a user.
 419
 420 =item --dir | --directory | -d <dirname>
 421
 422 specify the working directory on the target system. This is the
 423 directory into which the deploy script will be uploaded. It will
 424 be created if it does not exist.
 425
 426 Defaults to C</tmp/our-deploy>.
 427
 428 =item --help
 429
 430 print a somewhat more verbose help, showing usage, this description of
 431 the options and some examples from the synopsis.
 432
 433 =item --man
 434
 435 print out the full documentation for the script.
 436
 437 =item --password | --pass | -p <password>
 438
 439 you can specify the password on the command line, even if it's probably
 440 best B<NOT> to do so and wait for the program to prompt you one.
 441
 442 By default, you'll be prompted a password and this will not be written
 443 on the terminal.
 444
 445 =item --prompt | -P
 446
 447 this option enables prompting before operations are started on each
 448 host. When the prompt is enabled, you're presented with three choices:
 449
 450 =over
 451
 452 =item -
 453
 454 B<Yes> continue deployment on the given host;
 455
 456 =item -
 457
 458 B<Skip> skip this host;
 459
 460 =item -
 461
 462 B<No> stop deployment and exit.
 463
 464 =back
 465
 466 One letter suffices. By default, C<Yes> is assumed.
 467
 468 By default this option is I<always> active, so you're probably
 469 interested in C<--no-prompt> to disable it.
 470
 471 =item --script | -s <scriptname>
 472
 473 set the script/program to upload and execute. This script will be uploaded
 474 to the target system (see C<--directory|-d> above), but the name of the
 475 script will be sanitised (only alphanumeric, C<_>, C<.> and C<-> will
 476 be retained), so be careful if you have to look for the uploaded
 477 script later.
 478
 479 This option is incompatible with C<--command-line|-S>.
 480
 481 =item --stderr | -E
 482
 483 select only the STDERR channel from the responses got via SSH. This
 484 option cannot be used with L</--stdout>.
 485
 486 =item --stdout | -O
 487
 488 select only the STDOUT channel from the responses got via SSH. This
 489 option cannot be used with L</--stderr>.
 490
 491 =item --usage
 492
 493 print a concise usage line and exit.
 494
 495 =item --username | --user | -u <username>
 496
 497 specify the user name to use for logging into the remote host(s).
 498
 499 Defaults to C<root>.
 500
 501 =item --version
 502
 503 print the version of the script.
 504
 505 =back
 506
 507 =head1 DIAGNOSTICS
 508
 509 =over
 510
 511 =item C<< no %s, sorry. Stopped at... >>
 512
 513 The given element is not available on the target system.
 514
 515 In case of the directory, this means that the automatic creation
 516 process did not work for any reason. In case of the script, this
 517 means that the file upload did not work.
 518
 519 =back
 520
 521
 522 =head1 CONFIGURATION AND ENVIRONMENT
 523
 524 deploy requires no configuration files or environment variables.
 525
 526
 527 =head1 DEPENDENCIES
 528
 529 =over
 530
 531 =item -
 532
 533 L<IO::Prompt>
 534
 535 =item -
 536
 537 L<Net::SFTP>
 538
 539 =item -
 540
 541 L<Net::SSH::Perl>
 542
 543 =back
 544
 545
 546 =head1 BUGS AND LIMITATIONS
 547
 548 No bugs have been reported.
 549
 550 Please report any bugs or feature requests through http://rt.cpan.org/
 551
 552
 553 =head1 AUTHOR
 554
 555 Flavio Poletti C<flavio@polettix.it>
 556
 557
 558 =head1 LICENCE AND COPYRIGHT
 559
 560 Copyright (c) 2007-2008, Flavio Poletti C<flavio@polettix.it>.
 561 All rights reserved.
 562
 563 This script is free software; you can redistribute it and/or
 564 modify it under the same terms as Perl itself. See L<perlartistic>
 565 and L<perlgpl>.
 566
 567 Questo script è software libero: potete ridistribuirlo e/o
 568 modificarlo negli stessi termini di Perl stesso. Vedete anche
 569 L<perlartistic> e L<perlgpl>.
 570
 571
 572 =head1 DISCLAIMER OF WARRANTY
 573
 574 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 575 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 576 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 577 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 578 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 579 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 580 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 581 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 582 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 583
 584 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 585 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 586 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 587 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 588 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 589 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 590 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 591 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 592 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 593 SUCH DAMAGES.
 594
 595 =head1 NEGAZIONE DELLA GARANZIA
 596
 597 Poiché questo software viene dato con una licenza gratuita, non
 598 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
 599 dalle leggi applicabili. A meno di quanto possa essere specificato
 600 altrove, il proprietario e detentore del copyright fornisce questo
 601 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
 602 o implicita, includendo fra l'altro (senza però limitarsi a questo)
 603 eventuali garanzie implicite di commerciabilità e adeguatezza per
 604 uno scopo particolare. L'intero rischio riguardo alla qualità ed
 605 alle prestazioni di questo software rimane a voi. Se il software
 606 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
 607 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
 608
 609 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
 610 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
 611 di copyright, o qualunque altra parte che possa modificare, o redistribuire
 612 questo software così come consentito dalla licenza di cui sopra, potrà
 613 essere considerato responsabile nei vostri confronti per danni, ivi
 614 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
 615 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
 616 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
 617 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
 618 sostenute da voi o da terze parti o un fallimento del software ad
 619 operare con un qualsivoglia altro software. Tale negazione di garanzia
 620 rimane in essere anche se i dententori del copyright, o qualsiasi altra
 621 parte, è stata avvisata della possibilità di tali danneggiamenti.
 622
 623 Se decidete di utilizzare questo software, lo fate a vostro rischio
 624 e pericolo. Se pensate che i termini di questa negazione di garanzia
 625 non si confacciano alle vostre esigenze, o al vostro modo di
 626 considerare un software, o ancora al modo in cui avete sempre trattato
 627 software di terze parti, non usatelo. Se lo usate, accettate espressamente
 628 questa negazione di garanzia e la piena responsabilità per qualsiasi
 629 tipo di danno, di qualsiasi natura, possa derivarne.
 630
 631 =cut