deploy

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