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