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 => 'poletti',
  30    debug    => 0,
  31    dir      => '/tmp/our-deploy',
  32    prompt   => 1,
  33 );
  34 GetOptions(
  35    \%config,            'usage',
  36    'help',              'man',
  37    'version',           'hostname|host|h=s@',
  38    'username|user|u=s', 'password|pass|p=s',
  39    'debug|D!',          'dir|directory|d=s',
  40    'script|s=s',        '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 $config{password} = prompt 'password: ', -e => '*'
  51   unless defined($config{password}) && length($config{password});
  52
  53 ($config{remote} = $config{script}) =~ s{[^\w.-]}{}mxsg;
  54 $config{remote} = catfile($config{dir}, $config{remote});
  55
  56 for my $hostname (@{$config{hostname} || []}) {
  57    eval { operate_on_host($hostname) };
  58    carp $EVAL_ERROR if $EVAL_ERROR;
  59 }
  60
  61 sub operate_on_host {
  62    my ($hostname) = @_;
  63    my $remote = $config{remote};
  64
  65    print "*** OPERATING ON $hostname ***\n";
  66    if ($config{prompt}) {
  67       my $choice =
  68         lc(prompt "$hostname - continue? (Yes | Skip | No) ",
  69          -while => qr/\A[nsy]\z/mxs);
  70       return if $choice eq 's';
  71       exit 0 if $choice eq 'n';
  72    } ## end if ($config{prompt})
  73
  74    # Transfer file into $remote
  75    my $sftp = get_sftp(get_ssh($hostname));
  76    make_path($sftp, $config{dir});
  77    $sftp->put($config{script}, $remote);
  78    croak "no $remote, sorry. Stopped" unless $sftp->do_stat($remote);
  79
  80    # Execute file
  81    my $ssh = get_ssh($hostname);
  82    $|++;
  83    print "$remote ";
  84    my ($out, $err, $exit) = $ssh->cmd($remote);
  85    print "exit = $exit\n";
  86    for ([STDOUT => $out], [STDERR => $err]) {
  87       my ($type, $val) = @$_;
  88       next unless defined $val;
  89       chomp($val);
  90       $val =~ s{^}{|  }gmxs;
  91       print "+ $type\n|\n$val\n|\n+ end of $type\n\n";
  92    } ## end for ([STDOUT => $out], ...
  93
  94 } ## end sub operate_on_host
  95
  96 sub make_path {
  97    my ($sftp, $fullpath) = @_;
  98
  99    my $path = '';
 100    for my $chunk (split m{/}mxs, $fullpath) {
 101       $path .= $chunk . '/';    # works fine with the root
 102       next if $sftp->do_stat($path);
 103       $sftp->do_mkdir($path, Net::SFTP::Attributes->new());
 104    }
 105    croak "no $path, sorry. Stopped" unless $sftp->do_stat($path);
 106
 107    return;
 108 } ## end sub make_path
 109
 110 sub get_ssh {
 111    my ($hostname) = @_;
 112    my $ssh = Net::SSH::Perl->new(
 113       $hostname,
 114       protocol => 2,
 115       debug    => $config{debug}
 116    );
 117    $ssh->config->set(interactive    => 1);     # false!!!
 118    $ssh->config->set(identity_files => []);    # avoid 'em
 119    $ssh->login($config{username}, $config{password}, 'suppress_shell');
 120
 121    return $ssh;
 122 } ## end sub get_ssh
 123
 124 sub get_sftp {
 125    return Net::SFTP::Mine->new(
 126       $config{hostname},
 127       ssh  => shift,
 128       warn => sub { }
 129    );
 130 } ## end sub get_sftp
 131
 132 {
 133    no warnings;
 134
 135    sub Net::SSH::Perl::Auth::KeyboardInt::authenticate {
 136       my $auth = shift;
 137       my $ssh  = $auth->{ssh};
 138       my ($packet);
 139
 140       $packet = $ssh->packet_start(SSH2_MSG_USERAUTH_REQUEST);
 141       $packet->put_str($ssh->config->get('user'));
 142       $packet->put_str("ssh-connection");
 143       $packet->put_str("keyboard-interactive");
 144       $packet->put_str("");    ## language
 145       $packet->put_str("");    ## devices
 146       $packet->send;
 147
 148       $auth->mgr->register_handler(SSH2_MSG_USERAUTH_INFO_REQUEST,
 149          sub {
 150             my $amgr         = shift;
 151             my ($packet)     = @_;
 152             my $name         = $packet->get_str;
 153             my $instructions = $packet->get_str;
 154             $packet->get_str;    ## language
 155
 156             my $prompts = $packet->get_int32;
 157             my $pres = $ssh->packet_start(SSH2_MSG_USERAUTH_INFO_RESPONSE);
 158             $pres->put_int32($prompts);
 159             $pres->put_str($ssh->config->get('pass')) if $prompts;
 160             $pres->send;
 161          }
 162       );
 163
 164       return 1;
 165    } ## end sub Net::SSH::Perl::Auth::KeyboardInt::authenticate
 166 }
 167
 168 package Net::SFTP::Mine;
 169 use base qw( Net::SFTP );
 170 use Net::SSH::Perl::Constants qw( :msg2 );
 171 use Net::SFTP::Constants
 172   qw( :fxp :flags :status :att SSH2_FILEXFER_VERSION );
 173 use Carp;
 174
 175 sub init {
 176    my $sftp  = shift;
 177    my %param = @_;
 178    $sftp->{debug}  = delete $param{debug};
 179    $sftp->{status} = SSH2_FX_OK;
 180
 181    $param{warn} = 1 if not defined $param{warn};    # default
 182    $sftp->{warn_h} = delete $param{warn} || sub { };    # false => ignore
 183    $sftp->{warn_h} = sub { carp $_[1] }    # true  => emit warning
 184      if $sftp->{warn_h} and not ref $sftp->{warn_h};
 185
 186    $sftp->{_msg_id} = 0;
 187
 188    $sftp->{ssh} = delete $param{ssh};
 189
 190    my $channel = $sftp->_open_channel;
 191    $sftp->{channel} = $channel;
 192
 193    $sftp->do_init;
 194
 195    $sftp;
 196 } ## end sub init
 197
 198 __END__
 199
 200 =head1 NAME
 201
 202 deploy - [Una riga di descrizione dello scopo dello script]
 203
 204
 205 =head1 VERSION
 206
 207 See version at beginning of script, variable $VERSION, or call
 208
 209    shell$ deploy --version
 210
 211
 212 =head1 USAGE
 213
 214    deploy [--usage] [--help] [--man] [--version]
 215
 216
 217 =head1 EXAMPLES
 218
 219    shell$ deploy
 220
 221 =for l'autore, da riempire:
 222    Qualche breve esempio con codice che mostri l'utilizzo più comune.
 223    Questa sezione sarà quella probabilmente più letta, perché molti
 224    utenti si annoiano a leggere tutta la documentazione, per cui
 225    è meglio essere il più educativi ed esplicativi possibile.
 226
 227
 228 =head1 DESCRIPTION
 229
 230 =for l'autore, da riempire:
 231    Fornite una descrizione completa del modulo e delle sue caratteristiche.
 232    Aiutatevi a strutturare il testo con le sottosezioni (=head2, =head3)
 233    se necessario.
 234
 235
 236 =head1 OPTIONS
 237
 238 =for l'autore, da riempire:
 239    Una descrizione di tutte le opzioni possibili nella chiamata allo script
 240
 241 =over
 242
 243 =item --help
 244
 245 print a somewhat more verbose help, showing usage, this description of
 246 the options and some examples from the synopsis.
 247
 248 =item --man
 249
 250 print out the full documentation for the script.
 251
 252 =item --usage
 253
 254 print a concise usage line and exit.
 255
 256 =item --version
 257
 258 print the version of the script.
 259
 260 =back
 261
 262 =head1 DIAGNOSTICS
 263
 264 =for l'autore, da riempire:
 265    Elencate qualunque singolo errore o messaggio di avvertimento che
 266    lo script può generare, anche quelli che non "accadranno mai".
 267    Includete anche una spiegazione completa di ciascuno di questi
 268    problemi, una o più possibili cause e qualunque rimedio
 269    suggerito.
 270
 271
 272 =over
 273
 274 =item C<< Error message here, perhaps with %s placeholders >>
 275
 276 [Descrizione di un errore]
 277
 278 =item C<< Another error message here >>
 279
 280 [Descrizione di un errore]
 281
 282 [E così via...]
 283
 284 =back
 285
 286
 287 =head1 CONFIGURATION AND ENVIRONMENT
 288
 289 =for l'autore, da riempire:
 290    Una spiegazione completa di qualunque sistema di configurazione
 291    utilizzato dallo script, inclusi i nomi e le posizioni dei file di
 292    configurazione, il significato di ciascuna variabile di ambiente
 293    utilizzata e proprietà che può essere impostata. Queste descrizioni
 294    devono anche includere dettagli su eventuali linguaggi di configurazione
 295    utilizzati.
 296
 297 deploy requires no configuration files or environment variables.
 298
 299
 300 =head1 DEPENDENCIES
 301
 302 =for l'autore, da riempire:
 303    Una lista di tutti i moduli su cui si basa questo script,
 304    incluse eventuali restrizioni sulle relative versioni, ed una
 305    indicazione se il modulo in questione è parte della distribuzione
 306    standard di Perl, parte della distribuzione del modulo o se
 307    deve essere installato separatamente.
 308
 309 None.
 310
 311
 312 =head1 BUGS AND LIMITATIONS
 313
 314 =for l'autore, da riempire:
 315    Una lista di tutti i problemi conosciuti relativi al modulo,
 316    insime a qualche indicazione sul fatto che tali problemi siano
 317    plausibilmente risolti in una versione successiva. Includete anche
 318    una lista delle restrizioni sulle funzionalità fornite dal
 319    modulo: tipi di dati che non si è in grado di gestire, problematiche
 320    relative all'efficienza e le circostanze nelle quali queste possono
 321    sorgere, limitazioni pratiche sugli insiemi dei dati, casi
 322    particolari che non sono (ancora) gestiti, e così via.
 323
 324 No bugs have been reported.
 325
 326 Please report any bugs or feature requests through http://rt.cpan.org/
 327
 328
 329 =head1 AUTHOR
 330
 331 Flavio Poletti C<flavio@polettix.it>
 332
 333
 334 =head1 LICENCE AND COPYRIGHT
 335
 336 Copyright (c) 2006, Flavio Poletti C<flavio@polettix.it>. All rights reserved.
 337
 338 This script is free software; you can redistribute it and/or
 339 modify it under the same terms as Perl itself. See L<perlartistic>
 340 and L<perlgpl>.
 341
 342 Questo script è software libero: potete ridistribuirlo e/o
 343 modificarlo negli stessi termini di Perl stesso. Vedete anche
 344 L<perlartistic> e L<perlgpl>.
 345
 346
 347 =head1 DISCLAIMER OF WARRANTY
 348
 349 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 350 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 351 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 352 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 353 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 354 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 355 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 356 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 357 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 358
 359 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 360 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 361 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 362 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 363 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 364 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 365 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 366 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 367 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 368 SUCH DAMAGES.
 369
 370 =head1 NEGAZIONE DELLA GARANZIA
 371
 372 Poiché questo software viene dato con una licenza gratuita, non
 373 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
 374 dalle leggi applicabili. A meno di quanto possa essere specificato
 375 altrove, il proprietario e detentore del copyright fornisce questo
 376 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
 377 o implicita, includendo fra l'altro (senza però limitarsi a questo)
 378 eventuali garanzie implicite di commerciabilità e adeguatezza per
 379 uno scopo particolare. L'intero rischio riguardo alla qualità ed
 380 alle prestazioni di questo software rimane a voi. Se il software
 381 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
 382 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
 383
 384 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
 385 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
 386 di copyright, o qualunque altra parte che possa modificare, o redistribuire
 387 questo software così come consentito dalla licenza di cui sopra, potrà
 388 essere considerato responsabile nei vostri confronti per danni, ivi
 389 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
 390 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
 391 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
 392 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
 393 sostenute da voi o da terze parti o un fallimento del software ad
 394 operare con un qualsivoglia altro software. Tale negazione di garanzia
 395 rimane in essere anche se i dententori del copyright, o qualsiasi altra
 396 parte, è stata avvisata della possibilità di tali danneggiamenti.
 397
 398 Se decidete di utilizzare questo software, lo fate a vostro rischio
 399 e pericolo. Se pensate che i termini di questa negazione di garanzia
 400 non si confacciano alle vostre esigenze, o al vostro modo di
 401 considerare un software, o ancora al modo in cui avete sempre trattato
 402 software di terze parti, non usatelo. Se lo usate, accettate espressamente
 403 questa negazione di garanzia e la piena responsabilità per qualsiasi
 404 tipo di danno, di qualsiasi natura, possa derivarne.
 405
 406 =cut