deploy

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