6 use Pod
::Usage
qw( pod2usage );
7 use Getopt
::Long
qw( :config gnu_getopt );
8 use English
qw( -no_match_vars );
10 use Net
::SSH
::Perl
::Auth
;
12 use File
::Spec
::Functions
qw( catfile );
15 username
=> $ENV{USER
} || 'root',
17 dir
=> '/tmp/our-deploy',
19 sftp
=> 1, # try to use sftp possibly
24 usage! help! man! version!
33 commandline|command-line|S=s
40 pod2usage
(message
=> "$0 $VERSION", -verbose
=> 99, -sections
=> ' ', -noperldoc
=> 1)
42 pod2usage
(-verbose
=> 99, -sections
=> 'USAGE', -noperldoc
=> 1) if $config{usage
};
43 pod2usage
(-verbose
=> 99, -sections
=> 'USAGE|EXAMPLES|OPTIONS', -noperldoc
=> 1)
45 pod2usage
(-verbose
=> 2, -noperldoc
=> 1) if $config{man
};
47 pod2usage
(-verbose
=> 99, -sections
=> 'USAGE', -noperldoc
=> 1,
48 message
=> "Only one allowed between --stdout and --stderr\n")
49 if $config{stdout
} && $config{stderr
};
51 pod2usage
(-verbose
=> 99, -sections
=> 'USAGE', -noperldoc
=> 1,
52 message
=> "IO::Prompt not available, re-run with --no-prompt\n")
53 if $config{prompt
} && ! eval { require IO
::Prompt
; 1 };
55 # Script implementation here
56 my @hostnames = @ARGV;
59 if (exists $config{password
}) {
60 $config{interactive
} = 1;
61 $config{identity_files
} = [];
62 if (! $config{password
}) {
63 pod2usage
(-verbose
=> 99, -sections
=> 'USAGE', -noperldoc
=> 1,
64 message
=> "IO::Prompt not available, set password :(\n")
65 unless eval { require IO
::Prompt
; 1 };
66 $config{password
} = IO
::Prompt
::prompt
('password: ', -e
=> '*');
70 if ($config{commandline
}) {
71 pod2usage
(-verbose
=> 99, -sections
=> 'USAGE',
72 message
=> 'use only one of "script" and "command-line"')
73 if exists $config{script
};
74 $config{remote
} = $config{commandline
};
77 ($config{remote
} = $config{script
}) =~ s{[^\w.-]}{}mxsg;
78 $config{remote
} = catfile
($config{dir
}, $config{remote
});
81 for my $hostname (@hostnames) {
82 eval { operate_on_host
($hostname) };
83 carp
$EVAL_ERROR if $EVAL_ERROR;
88 my $remote = $config{remote
};
89 my $json = $config{json
};
90 my $ffh = $json ? \
*STDERR
: \
*STDOUT
;
92 hostname
=> $hostname,
95 $record{script
} = $config{script
} if $config{script
};
97 if ($config{prompt
}) {
98 print {$ffh} "*** OPERATING ON $hostname ***\n";
99 my $choice = lc(IO
::Prompt
::prompt
("$hostname - continue? (Yes | Skip | Quit) ",
100 -while => qr/\A[qsy]\z/mxs));
101 return if $choice eq 's';
102 exit 0 if $choice eq 'q';
103 } ## end if ($config{prompt})
106 print {$ffh} $hostname, $config{script
} ?
" $remote " : " cmd[$remote] ";
108 # Transfer file into $remote, if any
109 transfer_script
($hostname) if $config{script
};
112 my $ssh = get_ssh
($hostname);
113 my $qremote = $config{script
} ? shell_quote
($remote) : $remote;
114 @record{qw
< stdout stderr
exit >} = my ($out, $err, $exit)
115 = $ssh->cmd($qremote);
116 print {$ffh} "exit=$exit\n";
120 print {*STDOUT
} JSON
::PP
::encode_json
(\
%record), "\n";
122 elsif ($config{stdout
} && defined $out) {
123 print {*STDOUT
} $out;
125 elsif ($config{stderr
} && defined $err) {
126 print {*STDOUT
} $err;
129 for ([STDOUT
=> $out], [STDERR
=> $err]) {
130 my ($type, $val) = @
$_;
131 next unless defined $val;
132 $val =~ s{\s+\z}{}mxs;
133 $val =~ s{^}{$type }gmxs;
134 print {*STDOUT
} $val, "\n\n";
135 } ## end for ([STDOUT => $out], ...
139 } ## end sub operate_on_host
142 map { $_ => $config{$_} } grep { exists $config{$_} } qw( interactive identity_files password );
149 my $ssh = Net
::SSH
::Perl
->new(
152 debug
=> $config{debug
},
155 $ssh->login($config{username
}, $config{password
}, 'suppress_shell');
160 sub transfer_script
{
163 # first try with Net::SFTP, then fallback onto SSH
165 ($config{sftp
} && eval { transfer_script_sftp
($hostname); 1 })
166 || transfer_script_ssh
($hostname)
172 my @caller = caller 1;
173 $string =~ s{'}{'\\''}gmxs;
174 return "'" . $string . "'";
177 sub transfer_script_sftp
{
181 my $sftp = Net
::SFTP
->new(
184 user
=> $config{username
},
185 password
=> $config{password
},
188 debug
=> $config{debug
},
189 compression
=> $config{compress
},
190 user
=> $config{username
},
194 $sftp->do_stat('.') or die 'whatever';
196 make_path_sftp
($sftp, $config{dir
});
197 $sftp->put($config{script
}, $config{remote
});
198 croak
"no $config{remote}, sorry. Stopped"
199 unless $sftp->do_stat($config{remote
});
205 my ($sftp, $fullpath) = @_;
206 require Net
::SFTP
::Attributes
;
209 for my $chunk (split m{/}mxs, $fullpath) {
210 $path .= $chunk . '/'; # works fine with the root
211 next if $sftp->do_stat($path);
212 $sftp->do_mkdir($path, Net
::SFTP
::Attributes
->new());
214 croak
"no $fullpath, sorry. Stopped" unless $sftp->do_stat($fullpath);
217 } ## end sub make_path
219 sub transfer_script_ssh
{
221 my $ssh = get_ssh
($hostname);
223 make_path_ssh
($ssh, $config{dir
});
225 my $mode = (stat $config{script
})[2]
226 or croak
"cannot stat('$config{script}'), sorry. Stopped";
227 $mode = sprintf '%04o', $mode & 07777;
229 open my $fh, '<', $config{script
}
230 or croak
"open('$config{script}'): $OS_ERROR, sorry. Stopped";
232 local $/; # slurp mode
236 my $qremote = shell_quote
($config{remote
});
237 my ($out, $err, $exit) = $ssh->cmd("cat - >$qremote", $script);
238 ($out, $err, $exit) = $ssh->cmd("chmod $mode $qremote") unless $exit;
239 croak
"no $config{remote}, sorry. Stopped"
240 if $exit || !test_path_ssh
($ssh, -e
=> $config{remote
});
246 my ($ssh, $fullpath) = @_;
247 my $dir = shell_quote
($fullpath);
248 my ($out, $err, $exit) = $ssh->cmd("mkdir -p $dir");
249 croak
"no $fullpath, sorry. Stopped"
250 unless test_path_ssh
($ssh, -d
=> $fullpath);
254 my ($ssh, $test, $path) = @_;
255 my $qpath = shell_quote
($path);
256 my ($out, $err, $exit) = $ssh->cmd("test $test $qpath");
268 deploy - deploy a script on one or more remote hosts, via ssh
272 See version at beginning of script, variable $VERSION, or call
274 shell$ deploy --version
278 deploy [--usage] [--help] [--man] [--version]
280 deploy [--command-line|-S <string>] [--debug|-D]
281 [--dir|--directory|-d <dirname>] [--json|--no-json]
282 [--password|--pass|-p] [--prompt|-P|--no-prompt]
283 [--script|-s <scriptname>] [--stderr|-E] [--stdout|-O]
284 [--username|--user|-u]
290 # Upload deploy-script.pl and execute it on each server listed
292 shell$ deploy -s deploy-script.pl `cat targets`
294 # ... without bugging me prompting confirmations...
295 shell$ deploy -s deploy-script.pl --no-prompt `cat targets`
297 # Execute a one-shot command remotely. Note UPPERCASE "s"
298 shell$ deploy -S 'ls -l /' `cat targets`
302 This utility allows you to I<deploy> a script to one or more remote
303 hosts. Thus, you can provide a script that will be uploaded (via
304 B<sftp>) to the remote host and executed (via B<ssh>).
306 Before operations start for each host you will be prompted for
307 continuation: you can choose to go, skip or quit. You can disable
308 this by specifying C<--no-prompt>.
310 By default, directory C</tmp/our-deploy> on the target system will be
311 used. You can provide your own working directory path on the target system
312 via the C<--dir|--directory|-d> option. The directory will be created
313 if it does not exist.
315 For logging in, you can provide your own username/password pair directly
316 on the command line. Note that this utility explicitly avoids public
317 key authentication in favour of username/password authentication. Don't
318 ask me why, this may change in the future. Anyway, you're not obliged
319 to provide either on the command line: the username defaults to C<root>,
320 and you'll be prompted to provide a password if you don't put any
321 on the command line but specify the C<--password|-p> option without a value.
322 The prompt does not show the password on the terminal.
324 By default, L<Net::SSH::Perl> will try to use public/private key
325 authentication. If you're confident that this method will work, you can
326 just hit enter when requested for a password, or you can pass
327 C<-p> without a password on the command line (you can actually pass
328 every password you can think of, it will be ignored).
330 Starting from version 0.7.0, L<deploy> is also able to let you execute a
331 one-shot command remotely via the C<--command-line|-S> option; this lets
332 you avoid uploading a script and execute it and eases your life a bit if
333 you have to launch a single command, e.g.:
335 shell$ deploy -S 'ls /path/to/whatever' `cat targets`
337 In this case, nothing will be created in the target directory.
341 As of version 0.8.0, a new output format C<json> is available. If the
342 associated option is enabled (it's disabled by default), then for each
343 host where actions are taken a line is printed on the standard output,
344 with a JSON representation of an object containing the main data:
350 the hostname where the command was run;
354 full path of the remote script or command executed. Whether it is a command
355 or a script can be seen by checking the presence of the C<script> key
360 optionally present, set to whatever is passed with option C<script>
364 the execution exit code;
370 whatever is received from remote process execution on the standard output
371 and error channels respectively.
375 This is the best way to get something easily parseable. Otherwise...
377 The normal output format is geared at easing parsing by other programs. It
378 is compound of the following parts:
384 a single line specifing the hostname/ip, with the following format:
386 *** OPERATING ON <hostname> ***
390 a single line reporting the exit code from the remote process, with the
393 </path/to/deployed/program> exit = <exit-code>
395 in case a script is uploaded, or the following format:
397 cmd[<command to be executed>] exit = <exit-code>
399 in case a single one-shot command is sent (see option C<--command-line|-S>).
403 0 or more lines starting with C<STDOUT > (note the space);
407 0 or more lines starting with C<STDERR > (note the space).
411 If any of L</--stderr> or L</--stdout> are present, then the relevant
412 channel is printed on STDOUT immediately after the first two lines of the
413 format above, unchanged.
417 Suppose to have the following script F<bar.sh> to deploy:
423 echo 'How are you all?!?'
425 If you don't provide any of L</--stderr> or L</--stdout>, you will have
428 *** OPERATING ON foo.example.com ***
429 /tmp/our-deploy/bar.sh exit = 0
431 STDOUT How are you all?!?
432 STDERR ls: baz: No such file or directory
434 If you pass L<--stderr> you will get:
436 *** OPERATING ON foo.example.com ***
437 /tmp/our-deploy/bar.sh exit = 0
438 ls: baz: No such file or directory
440 If you pass L<--stdout> you will get:
442 *** OPERATING ON foo.example.com ***
443 /tmp/our-deploy/bar.sh exit = 0
451 =item --command-line | -S
453 set a one-shot command to be executed instead of a script to be uploaded
454 and then executed. This option is incompatible with C<--script|-s>, because
455 with this you're requesting to execute a one-shot command, while with
456 that you're requesting to upload a file and then execute it.
460 turns on debug mode, which should print out more stuff during operations.
461 You should not need it as a user.
463 =item --dir | --directory | -d <dirname>
465 specify the working directory on the target system. This is the
466 directory into which the deploy script will be uploaded. It will
467 be created if it does not exist.
469 Defaults to C</tmp/our-deploy>.
473 print a somewhat more verbose help, showing usage, this description of
474 the options and some examples from the synopsis.
476 =item --json | -j | --no-json
478 turn to JSON output. This is disabled by default. C<--no-json> can be
479 useful if you change the script to enable JSON output by default.
483 print out the full documentation for the script.
485 =item --password | --pass | -p <password>
487 you can specify the password on the command line, even if it's probably
488 best B<NOT> to do so and wait for the program to prompt you one.
490 By default, you'll be prompted a password and this will not be written
495 this option enables prompting before operations are started on each
496 host. When the prompt is enabled, you're presented with three choices:
502 B<Yes> continue deployment on the given host;
506 B<Skip> skip this host;
510 B<No> stop deployment and exit.
514 One letter suffices. By default, C<Yes> is assumed.
516 By default this option is I<always> active, so you're probably
517 interested in C<--no-prompt> to disable it.
519 =item --script | -s <scriptname>
521 set the script/program to upload and execute. This script will be uploaded
522 to the target system (see C<--directory|-d> above), but the name of the
523 script will be sanitised (only alphanumeric, C<_>, C<.> and C<-> will
524 be retained), so be careful if you have to look for the uploaded
527 This option is incompatible with C<--command-line|-S>.
531 select only the STDERR channel from the responses got via SSH. This
532 option cannot be used with L</--stdout>.
536 select only the STDOUT channel from the responses got via SSH. This
537 option cannot be used with L</--stderr>.
541 print a concise usage line and exit.
543 =item --username | --user | -u <username>
545 specify the user name to use for logging into the remote host(s).
551 print the version of the script.
559 =item C<< no %s, sorry. Stopped at... >>
561 The given element is not available on the target system.
563 In case of the directory, this means that the automatic creation
564 process did not work for any reason. In case of the script, this
565 means that the file upload did not work.
570 =head1 CONFIGURATION AND ENVIRONMENT
572 deploy requires no configuration files or environment variables.
594 =head1 BUGS AND LIMITATIONS
596 No bugs have been reported.
598 Please report any bugs or feature requests through http://rt.cpan.org/
603 Flavio Poletti C<flavio@polettix.it>
606 =head1 LICENCE AND COPYRIGHT
608 Copyright (c) 2007-2008, Flavio Poletti C<flavio@polettix.it>.
611 This script is free software; you can redistribute it and/or
612 modify it under the same terms as Perl itself. See L<perlartistic>
615 Questo script è software libero: potete ridistribuirlo e/o
616 modificarlo negli stessi termini di Perl stesso. Vedete anche
617 L<perlartistic> e L<perlgpl>.
620 =head1 DISCLAIMER OF WARRANTY
622 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
623 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
624 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
625 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
626 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
627 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
628 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
629 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
630 NECESSARY SERVICING, REPAIR, OR CORRECTION.
632 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
633 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
634 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
635 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
636 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
637 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
638 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
639 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
640 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
643 =head1 NEGAZIONE DELLA GARANZIA
645 Poiché questo software viene dato con una licenza gratuita, non
646 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
647 dalle leggi applicabili. A meno di quanto possa essere specificato
648 altrove, il proprietario e detentore del copyright fornisce questo
649 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
650 o implicita, includendo fra l'altro (senza però limitarsi a questo)
651 eventuali garanzie implicite di commerciabilità e adeguatezza per
652 uno scopo particolare. L'intero rischio riguardo alla qualità ed
653 alle prestazioni di questo software rimane a voi. Se il software
654 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
655 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
657 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
658 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
659 di copyright, o qualunque altra parte che possa modificare, o redistribuire
660 questo software così come consentito dalla licenza di cui sopra, potrà
661 essere considerato responsabile nei vostri confronti per danni, ivi
662 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
663 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
664 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
665 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
666 sostenute da voi o da terze parti o un fallimento del software ad
667 operare con un qualsivoglia altro software. Tale negazione di garanzia
668 rimane in essere anche se i dententori del copyright, o qualsiasi altra
669 parte, è stata avvisata della possibilità di tali danneggiamenti.
671 Se decidete di utilizzare questo software, lo fate a vostro rischio
672 e pericolo. Se pensate che i termini di questa negazione di garanzia
673 non si confacciano alle vostre esigenze, o al vostro modo di
674 considerare un software, o ancora al modo in cui avete sempre trattato
675 software di terze parti, non usatelo. Se lo usate, accettate espressamente
676 questa negazione di garanzia e la piena responsabilità per qualsiasi
677 tipo di danno, di qualsiasi natura, possa derivarne.