remote

   1 #!/usr/bin/env perl
   2 # *** NOTE *** LEAVE THIS MODULE LIST AS A PARAGRAPH
   3 use strict;
   4 use warnings;
   5 use 5.006_002;
   6 our $VERSION = '0.0.3';
   7 use English qw( -no_match_vars );
   8 use Fatal qw( close chdir opendir closedir );
   9 use File::Temp qw( tempdir );
  10 use File::Path qw( mkpath );
  11 use File::Spec::Functions qw( file_name_is_absolute splitpath catfile );
  12 use File::Basename qw( basename dirname );
  13 use POSIX qw( strftime );
  14 use Getopt::Long qw( :config gnu_getopt );
  15 use Cwd qw( getcwd );
  16
  17 # *** NOTE *** LEAVE EMPTY LINE ABOVE
  18 use Archive::Tar;
  19
  20 my %default_config = (    # default values
  21    workdir => '/tmp/our-deploy',
  22    cleanup => 1,
  23 );
  24 my %config;
  25 GetOptions(
  26    \%config,               'usage|help|man',
  27    'version',              'cleanup|c!',
  28    'dryrun|dry-run',       'no-deploy!',
  29    'show|show-options|s!', 'workdir|work-directory|deploy-directory|w=s',
  30    'no-tempdir!',          'bundle|all-exec|X!',
  31    'inspect|i=s',          'filelist!',
  32    'tar!',
  33 );
  34
  35 usage()   if $config{usage};
  36 version() if $config{version};
  37
  38 if ($config{tar}) {
  39    binmode DATA;
  40    binmode STDOUT;
  41    while (read DATA, my $buffer, 4096) {
  42       print {*STDOUT} $buffer;
  43    }
  44    exit 0;
  45 }
  46
  47 my $tar = Archive::Tar->new();
  48 $tar->read(\*DATA);
  49
  50 if ($config{filelist}) {
  51    local $\ = "\n";
  52    print for $tar->list_files();
  53    exit 0;
  54 }
  55
  56 my %script_config = (%default_config, get_config($tar));
  57 if ($config{show}) {
  58    require Data::Dumper;
  59    print {*STDOUT} Data::Dumper::Dumper(\%script_config);
  60    exit 1;
  61 }
  62
  63 # Merge configurations and go on
  64 %config = (%script_config, %config);
  65
  66 if ($config{inspect}) {
  67    $config{cleanup} = 0;
  68    $config{'no-deploy'} = 1;
  69    $config{'no-tempdir'} = 1;
  70    $config{workdir} = $config{inspect};
  71 }
  72
  73 if ($config{dryrun}) {
  74    require Data::Dumper;
  75    print {*STDOUT} Data::Dumper::Dumper(\%config);
  76    exit 1;
  77 }
  78
  79 # go into the working directory, creating any intermediate if needed
  80 mkpath($config{workdir});
  81 chdir($config{workdir});
  82 print {*STDERR} "### Got into working directory '$config{workdir}'\n\n";
  83
  84 my $tempdir;
  85 if (!$config{'no-tempdir'}) {    # Only if not prohibited
  86    my $now = strftime('%Y-%m-%d_%H-%M-%S', localtime);
  87    $tempdir =
  88      tempdir($now . 'X' x 10, DIR => '.', CLEANUP => $config{cleanup});
  89
  90    chdir $tempdir;
  91    print {*STDERR}
  92      "### Created and got into temporary directory '$tempdir'\n";
  93    print {*STDERR} "### (will clean it up later)\n" if $config{cleanup};
  94    print {*STDERR} "\n";
  95 } ## end if (!$config{'no-tempdir'...
  96
  97 eval {                           # Not really needed, but you know...
  98    $ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin';
  99    save_files($tar);
 100    execute_deploy_programs() unless $config{'no-deploy'};
 101 };
 102 carp $EVAL_ERROR if $EVAL_ERROR;
 103
 104 # Get back so that cleanup can successfully happen, if requested
 105 chdir '..' if defined $tempdir;
 106
 107 sub execute_deploy_programs {
 108    my @deploy_programs = @{$config{deploy} || []};
 109
 110    if ($config{bundle}) { # add all executable scripts in current directory
 111       print {*STDERR} "### Auto-deploying all executables in main dir\n\n";
 112       my %flag_for = map { $_ => 1 } @deploy_programs;
 113       opendir my $dh, '.';
 114       for my $item (sort readdir $dh) {
 115          next if $flag_for{$item};
 116          next unless ((-f $item) || (-l $item)) && (-x $item);
 117          $flag_for{$item} = 1;
 118          push @deploy_programs, $item;
 119       } ## end while (my $item = readdir...
 120       closedir $dh;
 121    } ## end if ($config{bundle})
 122
 123  DEPLOY:
 124    for my $deploy (@deploy_programs) {
 125       $deploy = catfile('.', $deploy)
 126         unless file_name_is_absolute($deploy);
 127       if (!-x $deploy) {
 128          print {*STDERR} "### Skipping '$deploy', not executable\n\n";
 129          next DEPLOY;
 130       }
 131       print  {*STDERR} "### Executing '$deploy'...\n";
 132       system {$deploy} $deploy;
 133       print  {*STDERR} "\n";
 134    } ## end for my $deploy (@deploy_programs)
 135
 136    return;
 137 } ## end sub execute_deploy_programs
 138
 139 sub get_config {
 140    my ($tar) = @_;
 141
 142    my ($file) = $tar->get_files('deployable/config.pl');
 143    return unless $file && $file->has_content();
 144
 145    my $config = eval 'my ' . $file->get_content() or return;
 146    return $config unless wantarray;
 147    return %$config;
 148 } ## end sub get_config
 149
 150 sub save_files {
 151    my ($tar) = @_;
 152
 153    for my $file ($tar->get_files()) {
 154       my ($area, $full_path) = split /\//mxs, $file->full_path(), 2;
 155       next unless $area eq 'root' || $area eq 'here';
 156
 157       my $dirprefix = $area eq 'here' ? '.'
 158          : $config{inspect} ? $area : '';
 159       my $real_path = join('/', $dirprefix, $full_path);
 160
 161       print {*STDERR} "### Extracting $full_path in '$area' => $real_path\n";
 162       if ($file->is_dir()) {
 163          mkpath($real_path);
 164       }
 165       else {
 166          mkpath(dirname $real_path);
 167          write_file($real_path, $file->get_content());
 168       }
 169
 170       chmod $file->mode(), $real_path;
 171    }
 172
 173    return;
 174 } ## end sub save_files
 175
 176 sub write_file {
 177    my $filename = shift;
 178    open my $fh, '>', $filename or croak "open('$filename'): $OS_ERROR";
 179    binmode $fh;
 180    print {$fh} @_;
 181    close $fh;
 182    return;
 183 }
 184
 185 sub usage {
 186    print {*STDOUT} <<"END_OF_USAGE" ;
 187 $0 version $VERSION
 188
 189 More or less, this script is intended to be launched without parameters.
 190 Anyway, you can also set the following options, which will override any
 191 present configuration (except in "--show-options"):
 192
 193 * --usage | --man | --help
 194     print these help lines and exit
 195
 196 * --version
 197     print script version and exit
 198
 199 * --bundle | --all-exec | -X
 200     treat all executables in the main deployment directory as scripts
 201     to be executed
 202
 203 * --cleanup | --no-cleanup
 204     perform / don't perform temporary directory cleanup after work done
 205
 206 * --dryrun | --dry-run
 207     print final options and exit
 208
 209 * --filelist
 210     print a list of files that are shipped in the deploy script
 211
 212 * --inspect <dirname>
 213     just extract all the stuff into <dirname> for inspection. Implies
 214     --no-deploy, --no-tempdir, ignores --bundle (as a consequence of
 215     --no-deploy), disables --cleanup and sets the working directory
 216     to <dirname>
 217
 218 * --no-deploy
 219     prevent execution of deploy scripts (they are executed by default)
 220
 221 * --no-tempdir
 222     execute directly in workdir (see below), without creating the
 223     temporary directory
 224
 225 * --show-options | -s
 226     print configured options and exit
 227
 228 * --tar
 229     print out the tar file that contains all the shipped files
 230
 231 * --workdir | -w
 232     working base directory (a temporary subdirectory will be created
 233     there anyway)
 234
 235 END_OF_USAGE
 236    exit 1;
 237 } ## end sub usage
 238
 239 sub version {
 240    print "$0 version $VERSION\n";
 241    exit 1;
 242 }
 243
 244 __END__