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
 207 =head1 VERSION
 208
 209 See version at beginning of script, variable $VERSION, or call
 210
 211    shell$ deploy --version
 212
 213
 214 =head1 USAGE
 215
 216    deploy [--usage] [--help] [--man] [--version]
 217
 218    deploy [--debug|-D] [--dir|--directory|-d <dirname>]
 219           [--password|--pass|-p] [--prompt|-P]
 220           [--script|-s <scriptname>] [--username|--user|-u]
 221
 222 =head1 EXAMPLES
 223
 224    shell$ deploy
 225
 226    # Upload deploy-script.pl and execute it on each server listed
 227    # in file "targets"
 228    shell$ deploy -s deploy-script.pl `cat targets`
 229
 230 =head1 DESCRIPTION
 231
 232 This utility allows you to I<deploy> a script to one or more remote
 233 hosts. Thus, you can provide a script that will be uploaded (via
 234 B<sftp>) to the remote host and executed (via B<ssh>).
 235
 236 Before operations start for each host you will be prompted for
 237 continuation: you can choose to go, skip or quit. You can disable
 238 this by specifying C<--no-prompt>.
 239
 240 By default, directory C</tmp/our-deploy> on the target system will be
 241 used. You can provide your own working directory path on the target system
 242 via the C<--dir|--directory|-d> option. The directory will be created
 243 if it does not exist.
 244
 245 For logging in, you can provide your own username/password pair directly
 246 on the command line. Note that this utility explicitly avoids public
 247 key authentication in favour of username/password authentication. Don't
 248 ask me why, this may change in the future. Anyway, you're not obliged
 249 to provide either on the command line: the username defaults to C<root>,
 250 and you'll be prompted to provide a password if you don't put any
 251 on the command line. The prompt does not show the password on the terminal.
 252
 253 =head1 OPTIONS
 254
 255 =over
 256
 257 =item --debug | -D
 258
 259 turns on debug mode, which should print out more stuff during operations.
 260 You should not need it as a user.
 261
 262 =item --dir | --directory | -d <dirname>
 263
 264 specify the working directory on the target system. This is the
 265 directory into which the deploy script will be uploaded. It will
 266 be created if it does not exist.
 267
 268 Defaults to C</tmp/our-deploy>.
 269
 270 =item --help
 271
 272 print a somewhat more verbose help, showing usage, this description of
 273 the options and some examples from the synopsis.
 274
 275 =item --man
 276
 277 print out the full documentation for the script.
 278
 279 =item --password | --pass | -p <password>
 280
 281 you can specify the password on the command line, even if it's probably
 282 best B<NOT> to do so and wait for the program to prompt you one.
 283
 284 By default, you'll be prompted a password and this will not be written
 285 on the terminal.
 286
 287 =item --prompt | -P
 288
 289 this option enables prompting before operations are started on each
 290 host. When the prompt is enabled, you're presented with three choices:
 291
 292 =over
 293
 294 =item -
 295
 296 B<Yes> continue deployment on the given host;
 297
 298 =item -
 299
 300 B<Skip> skip this host;
 301
 302 =item -
 303
 304 B<No> stop deployment and exit.
 305
 306 =back
 307
 308 One letter suffices. By default, C<Yes> is assumed.
 309
 310 By default this option is I<always> active, so you're probably
 311 interested in C<--no-prompt> to disable it.
 312
 313 =item --script | -s <scriptname>
 314
 315 set the script/program to upload and execute. This script will be uploaded
 316 to the target system (see C<--directory|-d> above), but the name of the
 317 script will be sanitised (only alphanumeric, C<_>, C<.> and C<-> will
 318 be retained), so be careful if you have to look for the uploaded
 319 script later.
 320
 321 =item --usage
 322
 323 print a concise usage line and exit.
 324
 325 =item --username | --user | -u <username>
 326
 327 specify the user name to use for logging into the remote host(s).
 328
 329 Defaults to C<root>.
 330
 331 =item --version
 332
 333 print the version of the script.
 334
 335 =back
 336
 337 =head1 DIAGNOSTICS
 338
 339 =over
 340
 341 =item C<< no %s, sorry. Stopped at... >>
 342
 343 The given element is not available on the target system.
 344
 345 In case of the directory, this means that the automatic creation
 346 process did not work for any reason. In case of the script, this
 347 means that the file upload did not work.
 348
 349 =back
 350
 351
 352 =head1 CONFIGURATION AND ENVIRONMENT
 353
 354 deploy requires no configuration files or environment variables.
 355
 356
 357 =head1 DEPENDENCIES
 358
 359 =over
 360
 361 =item -
 362
 363 L<IO::Prompt>
 364
 365 =item -
 366
 367 L<Log::Log4perl>
 368
 369 =item -
 370
 371 L<Net::SFTP>
 372
 373 =item -
 374
 375 L<Net::SSH::Perl>
 376
 377 =item -
 378
 379 L<version>, but you should find it if you're using version 5.10
 380
 381 =back
 382
 383
 384 =head1 BUGS AND LIMITATIONS
 385
 386 No bugs have been reported.
 387
 388 Please report any bugs or feature requests through http://rt.cpan.org/
 389
 390
 391 =head1 AUTHOR
 392
 393 Flavio Poletti C<flavio@polettix.it>
 394
 395
 396 =head1 LICENCE AND COPYRIGHT
 397
 398 Copyright (c) 2007-2008, Flavio Poletti C<flavio@polettix.it>.
 399 All rights reserved.
 400
 401 This script is free software; you can redistribute it and/or
 402 modify it under the same terms as Perl itself. See L<perlartistic>
 403 and L<perlgpl>.
 404
 405 Questo script è software libero: potete ridistribuirlo e/o
 406 modificarlo negli stessi termini di Perl stesso. Vedete anche
 407 L<perlartistic> e L<perlgpl>.
 408
 409
 410 =head1 DISCLAIMER OF WARRANTY
 411
 412 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 413 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 414 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 415 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 416 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 417 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 418 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 419 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 420 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 421
 422 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 423 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 424 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 425 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 426 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 427 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 428 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 429 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 430 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 431 SUCH DAMAGES.
 432
 433 =head1 NEGAZIONE DELLA GARANZIA
 434
 435 Poiché questo software viene dato con una licenza gratuita, non
 436 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
 437 dalle leggi applicabili. A meno di quanto possa essere specificato
 438 altrove, il proprietario e detentore del copyright fornisce questo
 439 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
 440 o implicita, includendo fra l'altro (senza però limitarsi a questo)
 441 eventuali garanzie implicite di commerciabilità e adeguatezza per
 442 uno scopo particolare. L'intero rischio riguardo alla qualità ed
 443 alle prestazioni di questo software rimane a voi. Se il software
 444 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
 445 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
 446
 447 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
 448 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
 449 di copyright, o qualunque altra parte che possa modificare, o redistribuire
 450 questo software così come consentito dalla licenza di cui sopra, potrà
 451 essere considerato responsabile nei vostri confronti per danni, ivi
 452 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
 453 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
 454 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
 455 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
 456 sostenute da voi o da terze parti o un fallimento del software ad
 457 operare con un qualsivoglia altro software. Tale negazione di garanzia
 458 rimane in essere anche se i dententori del copyright, o qualsiasi altra
 459 parte, è stata avvisata della possibilità di tali danneggiamenti.
 460
 461 Se decidete di utilizzare questo software, lo fate a vostro rischio
 462 e pericolo. Se pensate che i termini di questa negazione di garanzia
 463 non si confacciano alle vostre esigenze, o al vostro modo di
 464 considerare un software, o ancora al modo in cui avete sempre trattato
 465 software di terze parti, non usatelo. Se lo usate, accettate espressamente
 466 questa negazione di garanzia e la piena responsabilità per qualsiasi
 467 tipo di danno, di qualsiasi natura, possa derivarne.
 468
 469 =cut