From ec4663b70097677b6511fa7316d1facda8db728a Mon Sep 17 00:00:00 2001 From: Flavio Poletti Date: Fri, 8 Aug 2008 16:51:55 +0200 Subject: [PATCH] Added "safenet" fallback to tar if Archive::Tar is not available --- remote | 206 +++++++++++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 176 insertions(+), 30 deletions(-) diff --git a/remote b/remote index d8326d7..6448e4b 100755 --- a/remote +++ b/remote @@ -14,31 +14,30 @@ use POSIX qw( strftime ); use Getopt::Long qw( :config gnu_getopt ); # *** NOTE *** LEAVE EMPTY LINE ABOVE -use Archive::Tar; my %default_config = ( # default values workdir => '/tmp/our-deploy', cleanup => 1, - deploy => 1, + deploy => 1, tempdir => 1, ); my %config; GetOptions( \%config, qw( - usage|help|man! - version! - - bundle|all-exec|X! - cleanup|c! - deploy! - dryrun|dry-run|n! - filelist|list|l! - inspect|i=s - show|show-options|s! - tar|t! - tempdir! - workdir|work-directory|deploy-directory|w=s + usage|help|man! + version! + + bundle|all-exec|X! + cleanup|c! + deploy! + dryrun|dry-run|n! + filelist|list|l! + inspect|i=s + show|show-options|s! + tar|t! + tempdir! + workdir|work-directory|deploy-directory|w=s ), ); @@ -52,9 +51,13 @@ if ($config{tar}) { print {*STDOUT} $buffer; } exit 0; -} +} ## end if ($config{tar}) -my $tar = Archive::Tar->new(); +my $tar_package = eval { + require Archive::Tar; + 'Archive::Tar'; +} || 'Pseudo::Archive::Tar'; +my $tar = $tar_package->new(); $tar->read(\*DATA); if ($config{filelist}) { @@ -74,11 +77,11 @@ if ($config{show}) { %config = (%script_config, %config); if ($config{inspect}) { - $config{cleanup} = 0; - $config{'deploy'} = 0; + $config{cleanup} = 0; + $config{'deploy'} = 0; $config{'tempdir'} = 0; - $config{workdir} = $config{inspect}; -} + $config{workdir} = $config{inspect}; +} ## end if ($config{inspect}) if ($config{dryrun}) { require Data::Dumper; @@ -102,9 +105,9 @@ if ($config{'tempdir'}) { # Only if allowed "### Created and got into temporary directory '$tempdir'\n"; print {*STDERR} "### (will clean it up later)\n" if $config{cleanup}; print {*STDERR} "\n"; -} ## end if ($config{'tempdir'... +} ## end if ($config{'tempdir'}) -eval { # Not really needed, but you know... +eval { # Not really needed, but you know... $ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin'; save_files($tar); execute_deploy_programs() if $config{'deploy'}; @@ -126,7 +129,7 @@ sub execute_deploy_programs { next unless ((-f $item) || (-l $item)) && (-x $item); $flag_for{$item} = 1; push @deploy_programs, $item; - } ## end while (my $item = readdir... + } ## end for my $item (sort readdir... closedir $dh; } ## end if ($config{bundle}) @@ -164,11 +167,14 @@ sub save_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 $dirprefix = + $area eq 'here' ? '.' + : $config{inspect} ? $area + : ''; my $real_path = join('/', $dirprefix, $full_path); - print {*STDERR} "### Extracting $full_path in '$area' => $real_path\n"; + print {*STDERR} + "### Extracting $full_path in '$area' => $real_path\n"; if ($file->is_dir()) { mkpath($real_path); } @@ -178,19 +184,19 @@ sub save_files { } chmod $file->mode(), $real_path; - } + } ## end for my $file ($tar->get_files... return; } ## end sub save_files sub write_file { my $filename = shift; - open my $fh, '>', $filename or croak "open('$filename'): $OS_ERROR"; + 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" ; @@ -254,4 +260,144 @@ sub version { exit 1; } +package Pseudo::Archive::Tar; +use strict; +use warnings; +use IPC::Open3 qw( open3 ); +use Symbol qw( gensym ); +use English qw( -no_match_vars ); +use IO::Select; + +sub new { + my $package = shift; + my $self = bless {@_}, $package; + return $self; +} + +sub _interact_with_program { + my ($self, @command) = @_; + + my ($in, $out, $err); + $err = gensym(); + my $pid = open3($in, $out, $err, @command) or die "open3(): $OS_ERROR"; + binmode $in; + binmode $out; + + my $offset = 0; # for taking stuff from $self->{_programfile} + my $to_select = IO::Select->new($in); + my $from_select = IO::Select->new($out, $err); + my @result; + while ($from_select->exists($out)) { + if ($to_select->can_write(0)) { + my $nwritten = syswrite $in, $self->{_programfile}, 4096, $offset + or die "print(): $OS_ERROR"; + + $offset += $nwritten; + if ($offset == length($self->{_programfile})) { + $to_select->remove($in); + undef $in; + } + } ## end if ($to_select->can_write... + for my $reader ($from_select->can_read(0)) { + my $nread = sysread $reader, my $buffer, 4096; + die "read(): $OS_ERROR" unless defined $nread; + if ($nread == 0) { + $from_select->remove($reader); + next; + } + die "got something from tar's STDERR: $buffer..." + if $reader == $err; + push @result, $buffer; + } ## end for my $reader ($from_select... + } ## end while ($from_select->exists... + die 'could not pipe all data to tar' if $in; + + return join '', @result; +} ## end sub _interact_with_program + +sub _transform_mode { + my ($mode) = @_; + my ($sticky, $user, $group, $other) = unpack 'A A3 A3 A3', $mode; + $sticky = 0; + my $sticky_mask = 4; + for my $rwx ($user, $group, $other) { + my ($r, $w, $x) = split //, $rwx; + my $v = 0; + $v |= 1 if $x eq 'x'; + $v |= 1 && $sticky |= $sticky_mask if lc($x) eq 's'; + $v |= 2 if $w eq 'w'; + $v |= 4 if $r eq 'r'; + $rwx = $v; + $sticky_mask >>= 1; + } ## end for my $rwx ($user, $group... + return oct(join '', $sticky, $user, $group, $other); +} ## end sub _transform_mode + +sub _refresh_list { + my $self = shift; + + my $filelist = $self->_interact_with_program(qw( tar tvf - )); + + my @files; + for my $line (split /\n/, $filelist) { + my ($mode, $ug, $size, $date1, $date2, $filename) = + split /\s+/, $line, 6; + push @files, + Pseudo::Archive::Tar::File->new( + mode => _transform_mode($mode), + is_dir => (substr($mode, 0, 1) eq 'd'), + name => $filename, + size => $size, + _parent => $self, + ); + } ## end for my $line (split /\n/... + + $self->{_files} = \@files; + return; +} ## end sub _refresh_list + +sub read { + my ($self, $handle) = @_; + local $/; + binmode $handle; + $self->{_tarfile} = <$handle>; + $self->_refresh_list(); + return; +} ## end sub read + +sub list_files { + my $self = shift; + my @files = map { $_->full_path() } @{$self->{_files}}; + return @files if wantarray; + return \@files; +} ## end sub list_files + +sub get_files { + my $self = shift; + return @{$self->{_files}} unless @_; + my $target = shift; + return grep { $target eq $_->full_path() } @{$self->{_files}}; +} ## end sub get_files + +package Pseudo::Archive::Tar::File; +use Scalar::Util qw( weaken ); + +sub new { + my $package = shift; + my $self = bless {@_}, $package; + weaken $self->{_parent}; + return $self; +} ## end sub new + +sub full_path { return $_[0]->{name}; } +sub mode { return $_[0]->{mode}; } +sub has_content { return $_[0]->{size}; } +sub is_dir { return $_[0]->{is_dir}; } + +sub get_content { + my $self = shift; + return $self->{_parent} + ->_interact_with_program(qw( tar xOf - ), $self->{name}); +} + __END__ -- 2.11.4.GIT