Skip to content

Commit

Permalink
Item10058: Don't rewrite bash shebang, also
Browse files Browse the repository at this point in the history 
fix up unit tests to verify rewriting

git-svn-id: http://svn.foswiki.org/branches/Release01x01@10028 0b4bb1d4-4e5a-0410-9cc4-b2b747904278
  • Loading branch information
GeorgeClark authored and GeorgeClark committed Nov 22, 2010
1 parent 81c9318 commit d75e683
Show file tree
Hide file tree
Showing 3 changed files with 139 additions and 62 deletions.
147 changes: 105 additions & 42 deletions UnitTestContrib/test/unit/ConfigureTests.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,14 +44,15 @@ sub set_up {
$webObject = Foswiki::Meta->new( $this->{session}, $this->{sandbox_web} );
$webObject->populateNewWeb();
$this->{sandbox_subweb} = 'Testsandboxweb1234/Subweb';
$webObject = Foswiki::Meta->new( $this->{session}, $this->{sandbox_subweb} );
$webObject =
Foswiki::Meta->new( $this->{session}, $this->{sandbox_subweb} );
$webObject->populateNewWeb();
$this->{tempdir} = $Foswiki::cfg{TempfileDir} . '/test_ConfigureTests';
mkpath( $this->{tempdir} );
$this->{scriptdir} = $Foswiki::cfg{TempfileDir} . '/bin';
$this->{scriptdir} = $Foswiki::cfg{TempfileDir} . '/bin';
$Foswiki::cfg{ScriptDir} = $this->{scriptdir};
$this->{toolsdir} = $Foswiki::cfg{TempfileDir} . '/tools';
$Foswiki::cfg{ToolsDir} = $this->{toolsdir};
$this->{toolsdir} = $Foswiki::cfg{TempfileDir} . '/tools';
$Foswiki::cfg{ToolsDir} = $this->{toolsdir};

$Foswiki::cfg{TrashWebName} = $this->{trash_web};
$Foswiki::cfg{SandboxWebName} = $this->{sandbox_web};
Expand Down Expand Up @@ -768,8 +769,8 @@ sub test_Util_getPerlLocation {
$Foswiki::cfg{ScriptDir} = "$tempdir/";
my $holdsfx = $Foswiki::cfg{ScriptSuffix};

_doLocationTest( $this, $tempdir, '',
'' ); # Test with missing bin/configure file
_doLocationTest( $this, $tempdir, '', '' )
; # Test with missing bin/configure file

_doLocationTest( $this, $tempdir, "#!/usr/bin/perl -w -T ",
"/usr/bin/perl" );
Expand Down Expand Up @@ -810,7 +811,8 @@ sub test_Util_getPerlLocation {
Test file data
DONE

$this->assert_str_equals( '/a/b/perl', Foswiki::Configure::Util::getPerlLocation("$tempdir/loctestf"));
$this->assert_str_equals( '/a/b/perl',
Foswiki::Configure::Util::getPerlLocation("$tempdir/loctestf") );

$Foswiki::cfg{ScriptSuffix} = ".pl";
_doLocationTest( $this, $tempdir, "#!/usr/bin/perl -wT ", "/usr/bin/perl" );
Expand All @@ -823,7 +825,7 @@ DONE
sub _doLocationTest {
my $this = shift;
my $tempdir = shift;
my $shebang = shift;
my $shebang = shift;
my $expected = shift;

if ($shebang) {
Expand All @@ -844,34 +846,71 @@ sub test_Util_rewriteShebang {
my $tempdir = $this->{tempdir} . '/test_util_rewriteShebang';
mkpath($tempdir);

# Template File Shebang to write Expected line
# Target Script File New Shebang Expected line
_doRewriteTest( $this, $tempdir, '#!/usr/bin/perl -wT',
'C:\asdf\perl.exe', '#! C:\asdf\perl.exe -wT' );
_doRewriteTest( $this, $tempdir, '#!/usr/bin/perl -wT',
'/usr/bin/perl', '#! /usr/bin/perl -wT' );
_doRewriteTest( $this, $tempdir, '#! /usr/bin/perl -wT',
'/usr/bin/perl', '#! /usr/bin/perl -wT' );
_doRewriteTest( $this, $tempdir, '#! /usr/bin/perl ',
'/usr/bin/perl', '#! /usr/bin/perl -wT' );
_doRewriteTest( $this, $tempdir, '#! /usr/bin/perl',
'/usr/bin/perl', '#! /usr/bin/perl -wT' );
_doRewriteTest( $this, $tempdir, '#! /usr/bin/perl',
'/usr/bin/perl', '#! /usr/bin/perl -wT' );
'/usr/bin/perl', '#! /usr/bin/perl ' );
_doRewriteTest( $this, $tempdir, '#! /usr/bin/perl -wT ',
'/my/bin/perl', '#! /my/bin/perl -wT ' );
_doRewriteTest(
$this, $tempdir,
'#!/usr/bin/perl -wT',
'C:\Program Files\Active State\perl.exe',
'#! C:\Program Files\Active State\perl.exe -wT'
);
_doRewriteTest( $this, $tempdir,
'#! C:\Program Files\Active State\perl.exe -wT',
'/usr/bin/perl', '#! /usr/bin/perl -wT' );

# Negative testing
_doRewriteTest( $this, $tempdir, '#! ', '/usr/bin/perl', '#! /bin/sh',
'Not a perl script' );
_doRewriteTest( $this, $tempdir, '#! /bin/sh', '/usr/bin/perl',
'#! /bin/sh', 'Not a perl script' );
_doRewriteTest( $this, $tempdir, '#!/bin/sh', '/usr/bin/perl', '#!/bin/sh',
'Not a perl script' );
_doRewriteTest( $this, $tempdir, '#! /bin/sh ', '/usr/bin/perl',
'#! /bin/sh ', 'Not a perl script' );
_doRewriteTest( $this, $tempdir, '#! /bin/sh ', '', '#! /bin/sh ',
'Missing Shebang' );
_doRewriteTest( $this, $tempdir, '#perl', '/usr/bin/perl', '',
'Not a perl script' );
_doRewriteTest(
$this, $tempdir, "asdf\n#!/usr/bin/perl", '/usr/bin/perl',
'#! /bin/sh What a perl',
'Not a perl script'
);
_doRewriteTest(
$this, $tempdir, "\n#!/usr/bin/perl", '/usr/bin/perl',
'#! /bin/sh What a perl',
'Not a perl script'
);
_doRewriteTest(
$this, $tempdir, "\n#! /usr/bin/perl -wT",
'/usr/bin/perl',
'#! /bin/sh What a perl',
'Not a perl script'
);

my $err = Foswiki::Configure::Util::rewriteShebang(
"$tempdir/missing$Foswiki::cfg{ScriptSuffix}",
"/usr/shebang" );
$this->assert_str_equals( 'Not a file', $err );

}

sub _doRewriteTest {
my $this = shift;
my $tempdir = shift;
my $testline = shift;
my $this = shift;
my $tempdir = shift;
my $testline = shift;
my $shebang = shift;
my $expected = shift;
my $expected = shift;
my $errReturn = shift;

open( my $fh, '>', "$tempdir/myscript$Foswiki::cfg{ScriptSuffix}" )
|| die "Unable to open \n $! \n\n ";
Expand All @@ -885,26 +924,38 @@ DONE
my $err = Foswiki::Configure::Util::rewriteShebang(
"$tempdir/myscript$Foswiki::cfg{ScriptSuffix}", "$shebang" );

_testShebang($this, "$Foswiki::cfg{ScriptDir}/myscript$Foswiki::cfg{ScriptSuffix}", "$expected");

if ($errReturn) {
$this->assert_str_equals( $errReturn, $err );
}
else {
$this->assert_str_equals( '', $err );
_testShebang( $this, "$tempdir/myscript$Foswiki::cfg{ScriptSuffix}",
"$expected" );
}
}

sub _testShebang {
my $this = shift;
my $testfile = shift;
my $expected = shift;

open( my $bfh, '<',
"$testfile" )
|| return '';
my $ShebangLine = <$bfh>;
chomp $ShebangLine;
close $bfh;
my $ShebangLine = '';

#my $bfh;

if ( open( my $bfh, '<', "$testfile" ) ) {

$ShebangLine = <$bfh>;
chomp $ShebangLine;
close $bfh;
}
else {
die "Open failed $! ";
}

$this->assert_str_equals( $expected, $ShebangLine );
}


sub _makefile {
my $path = shift;
my $file = shift;
Expand Down Expand Up @@ -1081,10 +1132,12 @@ DONE
#! /usr/bin/perl
Test file data
DONE
_makefile( "$tempdir/pub/Sandbox/Subweb/TestTopic43", "file3.att", <<'DONE');
_makefile( "$tempdir/pub/Sandbox/Subweb/TestTopic43", "file3.att",
<<'DONE');
Test file data
DONE
_makefile( "$tempdir/pub/Sandbox/Subweb/TestTopic43/subdir-1.2.3", "file4.att", <<'DONE');
_makefile( "$tempdir/pub/Sandbox/Subweb/TestTopic43/subdir-1.2.3",
"file4.att", <<'DONE');
Test file data
DONE
}
Expand Down Expand Up @@ -1166,11 +1219,20 @@ Installed: MyPlugin_installer
'Unexpected number of files installed'
); # and 5 files installed

_testShebang($this, "$Foswiki::cfg{ScriptDir}/shbtest1", '#! /my/bin/perl');
_testShebang($this, "$Foswiki::cfg{ToolsDir}/shbtest2", '#! /my/bin/perl');

# Verify that we don't change shebang in attachments
_testShebang($this, "$Foswiki::cfg{PubDir}/Sandbox/TestTopic1/file.att", '#! /usr/bin/perl');
_testShebang(
$this,
"$Foswiki::cfg{ScriptDir}/shbtest1",
'#! /my/bin/perl'
);
_testShebang( $this, "$Foswiki::cfg{ToolsDir}/shbtest2",
'#! /my/bin/perl' );

# Verify that we don't change shebang in attachments
_testShebang(
$this,
"$Foswiki::cfg{PubDir}/$this->{sandbox_web}/TestTopic1/file.att",
'#! /usr/bin/perl'
);

$pkg->finish();
undef $pkg;
Expand Down Expand Up @@ -1456,9 +1518,9 @@ sub test_Util_createArchive_shellZip {
_makePackage( "$tempdir/$extbkup", $extension );

eval {
local (*STDOUT, *STDERR);
local ( *STDOUT, *STDERR );
use File::Spec;
my $blah = system('zip -v >' . File::Spec->devnull() . ' 2>&1');
my $blah = system( 'zip -v >' . File::Spec->devnull() . ' 2>&1' );

#print "zip returns $? ($blah) \n";
die $! unless ( $? == 0 );
Expand All @@ -1484,7 +1546,7 @@ sub test_Util_createArchive_shellZip {
'zip' );
$this->assert( ( -f $file ),
"$file does not appear to exist - Create zip archive" );
$this->assert( (! -e "$tempdir/$extbkup" ),
$this->assert( ( !-e "$tempdir/$extbkup" ),
"$tempdir was not removed by the archive operation" );

unlink "$tempdir/$extbkup"; # Clean up old files if left behind
Expand All @@ -1506,9 +1568,10 @@ sub test_Util_createArchive_shellTar {
_makePackage( "$tempdir/$extbkup", $extension );

eval {
local (*STDOUT, *STDERR);
local ( *STDOUT, *STDERR );
use File::Spec;
my $blah = system('tar --version >' . File::Spec->devnull() . ' 2>&1');
my $blah =
system( 'tar --version >' . File::Spec->devnull() . ' 2>&1' );

#print "tar returns $? ($blah) \n";
die $! unless ( $? == 0 );
Expand All @@ -1534,7 +1597,7 @@ sub test_Util_createArchive_shellTar {
'tar' );
$this->assert( ( -f $file ),
"$file does not appear to exist - Create tar archive" );
$this->assert( (! -e "$tempdir/$extbkup" ),
$this->assert( ( !-e "$tempdir/$extbkup" ),
"$tempdir was not removed by the archive operation" );

unlink($file); # Cleanup for next test
Expand Down Expand Up @@ -1580,7 +1643,7 @@ sub test_Util_createArchive_perlTar {
'Ptar' );
$this->assert( ( -f $file ),
"$file does not appear to exist - Create Archive::Tar archive" );
$this->assert( (! -e "$tempdir/$extbkup" ),
$this->assert( ( !-e "$tempdir/$extbkup" ),
"$tempdir was not removed by the archive operation" );

unlink "$tempdir/$extbkup"; # Clean up old files if left behind
Expand Down Expand Up @@ -1625,7 +1688,7 @@ sub test_Util_createArchive_perlZip {
'Pzip' );
$this->assert( ( -f $file ),
"$file does not appear to exist - Create Archive::Zip archive" );
$this->assert( (! -e "$tempdir/$extbkup" ),
$this->assert( ( !-e "$tempdir/$extbkup" ),
"$tempdir was not removed by the archive operation" );

unlink "$tempdir/$extbkup"; # Clean up old files if left behind
Expand Down
1 change: 1 addition & 0 deletions core/lib/Foswiki/Configure/Package.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -483,6 +483,7 @@ sub install {

# Everything else
$err = _moveFile( $this, "$dir/$file", "$target", $perms );

$errors .= $err if ($err);
$feedback .= "${simulated}Installed: $file\n";
next;
Expand Down
53 changes: 33 additions & 20 deletions core/lib/Foswiki/Configure/Util.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,9 @@ sub mapTarget {
}
elsif ( $file =~ s#^locale/#$Foswiki::cfg{LocalesDir}/# ) {
}
elsif ( $file =~ s#^bin/(\w+)$#$Foswiki::cfg{ScriptDir}/$1$Foswiki::cfg{ScriptSuffix}# ) {
elsif ( $file =~
s#^bin/(\w+)$#$Foswiki::cfg{ScriptDir}/$1$Foswiki::cfg{ScriptSuffix}# )
{

#This makes a couple of bad assumptions
#2. that any file going into there _is_ a script - making installing the
Expand Down Expand Up @@ -542,15 +544,15 @@ specified, defaults to the configure script

sub getPerlLocation {

my $file = shift || "$Foswiki::cfg{ScriptDir}/configure$Foswiki::cfg{ScriptSuffix}";
my $file = shift
|| "$Foswiki::cfg{ScriptDir}/configure$Foswiki::cfg{ScriptSuffix}";

local $/ = "\n";
open( my $fh, '<',
"$file" )
open( my $fh, '<', "$file" )
|| return "";
my $Shebang = <$fh>;
chomp $Shebang;
$Shebang =~ s/^#\!\s*(.*?)\s?(:?\s-.*)?$/$1/;
($Shebang) = $Shebang =~ m/^#\!\s*(.*?perl.*?)\s?(?:\s-.*?)?$/;
$Shebang =~ s/\s+$//;
close($fh);
return $Shebang;
Expand All @@ -566,30 +568,41 @@ with the specified script name.
=cut

sub rewriteShebang {
my $file = shift;
my $file = shift;
my $newShebang = shift;

return unless ( -f $file );
return unless $newShebang;
return 'Not a file' unless ( -f $file );
return 'Missing Shebang' unless $newShebang;

local $/ = undef;
open( my $fh, '<', $file ) || return "Rewrite shebang failed: $!";
my $contents = <$fh>;
close $fh;

my $firstline = substr( $contents, 0, index( $contents, "\n" ) );
( my $match ) = $firstline =~ m/^#\!\s*(.*?perl.*?)\s?(?:\s-.*?)?$/ms;
$match = '' unless $match;

return "Not a perl script" unless ($match);

# Note: space inserted after #! - needed on some flavors of Unix
if ( $contents =~ s/^#!\s*\S+/#! $newShebang/s ) {
my $mode = ( stat($file) )[2];
$file =~ /(.*)/;
$file = $1;
chmod( oct(600), "$file" );
open( my $fh, '>', $file ) || return "Rewrite shebang failed: $!";
print $fh $contents;
close $fh;
$mode =~ /(.*)/;
$mode = $1;
chmod( $mode, "$file" );
}
my $perlIdx = index( $contents, $match );
substr( $contents, $perlIdx, length($match) ) =
( substr( $contents, $perlIdx - 1, 1 ) eq ' ' ? '' : ' ' )
. "$newShebang";

my $mode = ( stat($file) )[2];
$file =~ /(.*)/;
$file = $1;
chmod( oct(600), "$file" );
open( $fh, '>', $file ) || return "Rewrite shebang failed: $!";
print $fh $contents;
close $fh;
$mode =~ /(.*)/;
$mode = $1;
chmod( $mode, "$file" );

return '';
}

1;
Expand Down

0 comments on commit d75e683

Please sign in to comment.