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