From 6a60ebba9e3af4cae3a1b8392f012f88702ba697 Mon Sep 17 00:00:00 2001 From: Flavio Poletti Date: Thu, 17 Mar 2011 16:55:44 +0100 Subject: [PATCH] moved handling all with sub-tars to speed up extraction --- deployable | 157 ++++++++++++++++++++++++++++++++++++++----------------------- remote | 91 +++++++++++++++++++++-------------- 2 files changed, 155 insertions(+), 93 deletions(-) diff --git a/deployable b/deployable index def4ce5..5563025 100755 --- a/deployable +++ b/deployable @@ -81,6 +81,7 @@ print {$out_fh} get_remote_script(); # If a tarfile was given, simply put it and exit if (@{$config{tarfile}}) { + croak "UNSUPPORTED"; open my $fh, '<', $config{tarfile} or croak "open('$config{tarfile}'): $OS_ERROR"; print {$out_fh} <$fh>; @@ -90,71 +91,108 @@ if (@{$config{tarfile}}) { } # Where all the data will be kept -my $tar = Archive::Tar->new(); +my $tar = get_tar(\%config, @ARGV); -{ # Add a configuration file +# Save tar file, it will close the filehandle as well +$tar->write($out_fh); + +# Set as executable +if ($config{output} ne '-') { + chmod oct(755), $config{output} + or carp "chmod(0755, '$config{output}'): $OS_ERROR"; +} + +sub get_tar { + my ($config, @ARGV) = @_; + + my $tar = Archive::Tar->new(); + + # Add a configuration file to the main tar my %general_configuration; for my $name (qw( workdir cleanup bundle deploy )) { - $general_configuration{$name} = $config{$name} - if exists $config{$name}; + $general_configuration{$name} = $config->{$name} + if exists $config->{$name}; } - $tar->add_data('deployable/config.pl', Dumper \%general_configuration); + $tar->add_data('config.pl', Dumper \%general_configuration); # FIXME + + my $here_tar = get_here_tar(@ARGV); + $tar->add_data('here.tar', data_from($here_tar)); + + my $root_tar = get_root_tar(@{$config}{qw( rootdir root )}); + $tar->add_data('root.tar', data_from($root_tar)); + + return $tar; +} + +sub data_from { + my ($tar) = @_; + my $buffer = ''; + open my $fh, '>', \$buffer or die "open() on internal variable: $OS_ERROR"; + binmode $fh; + $tar->write($fh); # closes $fh + return $buffer; } # Process files and directories. All these will be reported in the # extraction directory, i.e. basename() will be applied to them. For # directories, they will be re-created -for my $file (@ARGV) { - croak "'$file' not readable" unless -r $file; - if (-d $file) { - print {*STDERR} "processing directory '$file'\n"; - save_directory($tar, '.', '.', 'here'); - } ## end if (-d $file) - else { - print {*STDERR} "processing file '$file'\n"; - save_file($tar, $file, 'here'); - } ## end else [ if (-d $file) -} ## end for my $file (@ARGV) - -# heredir-s are directories that are extracted directly into the ex dir -for my $heredir (@{$config{heredir}}) { - croak "'$heredir' not readable" unless -r $heredir; - print {*STDERR} "processing here-directory '$heredir'\n"; - save_directory($tar, $heredir, '.', 'here'); -} ## end for my $heredir (@{$config... - -# rootdir-s are directories that will go under root -for my $rootdir (@{$config{rootdir}}) { - croak "'$rootdir' not readable" unless -r $rootdir; - print {*STDERR} "processing root-directory '$rootdir'\n"; - save_directory($tar, '.', $rootdir, 'root'); +sub get_here_tar { + my @ARGV = @_; + my $tar = Archive::Tar->new(); + + for my $file (@ARGV) { + croak "'$file' not readable" unless -r $file; + if (-d $file) { + print {*STDERR} "processing directory '$file'\n"; + save_directory($tar, '.', '.'); + } ## end if (-d $file) + else { + print {*STDERR} "processing file '$file'\n"; + $tar->add_files($file); + } ## end else [ if (-d $file) + } ## end for my $file (@ARGV) + + # heredir-s are directories that are extracted directly into the ex dir + for my $heredir (@{$config{heredir}}) { + croak "'$heredir' not readable" unless -r $heredir; + print {*STDERR} "processing here-directory '$heredir'\n"; + save_directory($tar, $heredir, '.'); + } ## end for my $heredir (@{$config... + + return $tar; } -# root-s are directories whose contents go under root -for my $root (@{$config{root}}) { - croak "'$root' not readable" unless -r $root; - print {*STDERR} "processing root-directory '$root'\n"; - save_directory($tar, $root, '.', 'root'); -} +sub get_root_tar { + my ($rootdirs, $roots) = @_; + my $tar = Archive::Tar->new(); -# Save tar file, it will close the filehandle as well -$tar->write($out_fh); + # rootdir-s are directories that will go under root + for my $rootdir (@$rootdirs) { + croak "'$rootdir' not readable" unless -r $rootdir; + print {*STDERR} "processing root-directory '$rootdir'\n"; + save_directory($tar, '.', $rootdir); + } -# Set as executable -if ($config{output} ne '-') { - chmod oct(755), $config{output} - or carp "chmod(0755, '$config{output}'): $OS_ERROR"; + # root-s are directories whose contents go under root + for my $root (@$roots) { + croak "'$root' not readable" unless -r $root; + print {*STDERR} "processing root-directory '$root'\n"; + save_directory($tar, $root, '.'); + } + + return $tar; } { my $cwd; sub save_directory { - my ($tar, $localstart, $localdir, $remotestart) = @_; + my ($tar, $localstart, $localdir) = @_; $cwd ||= cwd(); chdir $localstart; - save_file($tar, $_, $remotestart) for File::Find::Rule->file()->in($localdir); + $tar->add_files($_) + for File::Find::Rule->file()->in($localdir); chdir $cwd; @@ -162,15 +200,6 @@ if ($config{output} ne '-') { } ## end sub save_directory } -sub save_file { - my ($tar, $filename, $remotestart) = @_; - - my ($ftar) = $tar->add_files($filename); - $ftar->rename("$remotestart/$filename"); - - return; -} ## end sub save_file - sub get_remote_script { open my $fh, '<', $config{remote} or croak "open('$config{remote}'): $OS_ERROR"; @@ -477,19 +506,19 @@ as follows: =over -=item B<< deployable/config.pl >> (file) +=item B<< config.pl >> (file) will be Ced, expecting to receive a reference to an anonymous hash with the configurations; -=item B<< here >> (directory) +=item B<< here.tar >> (tar file) -will be normally deployed into the working directory in the target -system; +will be normally extracted into the working/temporary directory in the +target system; -=item B<< root >> (directory) +=item B<< root.tar >> (tar file) -will be normally deployed under C in the target system. +will be normally extracted under C in the target system. =back @@ -551,6 +580,12 @@ print final options and exit print a list of files that are shipped in the deploy script +=item B<< --heretar | --here-tar | -H >> + +print out the tar file that contains all the files that would be +extracted in the temporary directory, useful to redirect to file or +pipe to the tar program + =item B<< --inspect >> just extract all the stuff into for inspection. Implies @@ -558,6 +593,12 @@ C<--no-deploy>, C<--no-tempdir>, ignores C<--bundle> (as a consequence of C<--no-deploy>), disables C<--cleanup> and sets the working directory to C +=item B<< --rootar | --root-tar | -R >> + +print out the tar file that contains all the files that would be +extracted in the root directory, useful to redirect to file or +pipe to the tar program + =item B<--show | --show-options | -s> print configured options and exit diff --git a/remote b/remote index 03ed2b2..f62e311 100755 --- a/remote +++ b/remote @@ -12,6 +12,7 @@ use File::Spec::Functions qw( file_name_is_absolute catfile ); use File::Basename qw( dirname ); use POSIX qw( strftime ); use Getopt::Long qw( :config gnu_getopt ); +use Cwd qw( getcwd ); # *** NOTE *** LEAVE EMPTY LINE ABOVE @@ -33,7 +34,9 @@ GetOptions( deploy! dryrun|dry-run|n! filelist|list|l! + heretar|here-tar|H! inspect|i=s + roottar|root-tar|R! show|show-options|s! tar|t! tempdir! @@ -53,16 +56,32 @@ if ($config{tar}) { exit 0; } ## end if ($config{tar}) -my $tar_package = eval { +my $TAR_PACKAGE = eval { require Archive::Tar; 'Archive::Tar'; } || 'Pseudo::Archive::Tar'; -my $tar = $tar_package->new(); +my $tar = $TAR_PACKAGE->new(); $tar->read(\*DATA); +if ($config{roottar}) { + my ($root_tar) = $tar->get_files('root.tar'); + binmode STDOUT; + print {*STDOUT} $root_tar->get_content(); + exit 0; +} + +if ($config{heretar}) { + my ($here_tar) = $tar->get_files('here.tar'); + binmode STDOUT; + print {*STDOUT} $here_tar->get_content(); + exit 0; +} + if ($config{filelist}) { - local $\ = "\n"; - print for $tar->list_files(); + my $root_tar = get_sub_tar($tar, 'root.tar'); + print "root $_\n" for $root_tar->list_files(); + my $here_tar = get_sub_tar($tar, 'here.tar'); + print "here $_\n" for $here_tar->list_files(); exit 0; } @@ -117,6 +136,19 @@ carp $EVAL_ERROR if $EVAL_ERROR; # Get back so that cleanup can successfully happen, if requested chdir '..' if defined $tempdir; + +sub get_sub_tar { + my ($tar, $filename) = @_; + my ($file) = $tar->get_files($filename); + my $contents = $file->get_content(); + open my $fh, '<', \$contents + or die "open() on internal variable: $OS_ERROR"; + + my $subtar = $TAR_PACKAGE->new(); + $subtar->read($fh); + return $subtar; +} + sub execute_deploy_programs { my @deploy_programs = @{$config{deploy} || []}; @@ -152,7 +184,7 @@ sub execute_deploy_programs { sub get_config { my ($tar) = @_; - my ($file) = $tar->get_files('deployable/config.pl'); + my ($file) = $tar->get_files('config.pl'); return unless $file && $file->has_content(); my $config = eval 'my ' . $file->get_content() or return; @@ -163,41 +195,20 @@ sub get_config { sub save_files { my ($tar) = @_; - for my $file ($tar->get_files()) { - my ($area, $full_path) = split /\//mxs, $file->full_path(), 2; - next unless $area eq 'root' || $area eq 'here'; - - my $dirprefix = - $area eq 'here' ? '.' - : $config{inspect} ? $area - : ''; - my $real_path = join('/', $dirprefix, $full_path); - - print {*STDERR} - "### Extracting $full_path in '$area' => $real_path\n"; - if ($file->is_dir()) { - mkpath($real_path); - } - else { - mkpath(dirname $real_path); - write_file($real_path, $file->get_content()); - } + my $here_tar = get_sub_tar($tar, 'here.tar'); + $here_tar->extract(); - chmod $file->mode(), $real_path; - } ## end for my $file ($tar->get_files... + my $root_dir = $config{inspect} ? 'root' : '/'; + mkpath $root_dir unless -d $root_dir; + my $cwd = getcwd(); + chdir $root_dir; + my $root_tar = get_sub_tar($tar, 'root.tar'); + $root_tar->extract(); + chdir $cwd; return; } ## end sub save_files -sub write_file { - my $filename = shift; - open my $fh, '>', $filename or croak "open('$filename'): $OS_ERROR"; - binmode $fh; - print {$fh} @_; - close $fh; - return; -} ## end sub write_file - sub usage { print {*STDOUT} <<"END_OF_USAGE" ; $0 version $VERSION @@ -229,12 +240,22 @@ present configuration (except in "--show-options"): * --filelist | --list | -l print a list of files that are shipped in the deploy script +* --heretar | --here-tar | -H + print out the tar file that contains all the files that would be + extracted in the temporary directory, useful to redirect to file or + pipe to the tar program + * --inspect | -i just extract all the stuff into for inspection. Implies --no-deploy, --no-tempdir, ignores --bundle (as a consequence of --no-deploy), disables --cleanup and sets the working directory to +* --roottar | --root-tar | -R + print out the tar file that contains all the files that would be + extracted in the root directory, useful to redirect to file or + pipe to the tar program + * --show | --show-options | -s print configured options and exit -- 2.11.4.GIT