Update of /cvsroot/fink/fink/t/Services
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29059/t/Services
Added Files:
Tag: uidgid
ChangeLog eval_conditional.t execute_nonroot_okay.t
expand_percent.t prepare_script.t
Log Message:
Starting to sync this branch to sort stuff out see if it's worth using, or
restarting it
--- NEW FILE: expand_percent.t ---
#!/usr/bin/perl -w
use strict;
use Test::More 'no_plan';
require_ok('Fink::Services');
my $map = { 'f' => 'm',
'F' => '%f',
'r' => 'st',
'l' => '%F',
'%' => '%%'
};
# basic stuff
is( Fink::Services::expand_percent( 'Fink for life', undef ),
'Fink for life',
'undef map'
);
eval { Fink::Services::expand_percent( 'Fink for li%r', undef ) };
like( $@,
qr/unknown.*expansion/i,
'undef map but try to use expansion'
);
is( Fink::Services::expand_percent( 'Give 110%%, son', undef ),
'Give 110%, son',
'undef map but need percent expansion'
);
is( Fink::Services::expand_percent( 'Fink for life', $map ),
'Fink for life',
'No expansions needed'
);
is( Fink::Services::expand_percent( 'Fink %fo%r li%fe', $map ),
'Fink most lime',
'One pass'
);
is( Fink::Services::expand_percent( '%Fink %fo%r li%fe', $map ),
'mink most lime',
'Two passes'
);
eval { Fink::Services::expand_percent( '%Fink %fo%r %li%fe', $map ) };
like( $@,
qr/too deep/i,
'Three passes is too deep recursion'
);
eval { Fink::Services::expand_percent( 'F%ink for life', $map ) };
like( $@,
qr/unknown.*expansion/i,
'Unknown percent char',
);
# protected percent signs
is( Fink::Services::expand_percent( 'Give 110%%, son', $map ),
'Give 110%, son',
'Simple %%'
);
is( Fink::Services::expand_percent( 'woo %%%% woo', $map ),
'woo %% woo',
'Do not recurse on it'
);
is( Fink::Services::expand_percent( 'printf(%%s)', $map ),
'printf(%s)',
'%% takes precedence over overlapping legal expansion'
);
is( Fink::Services::expand_percent( 'hash %%%rreets', $map ),
'hash %streets',
'Actual expansion following %%'
);
# long keys
is( Fink::Services::expand_percent( 'M%iss%iss%ippi', {qw/iss ith ipp iss/} ),
'Mithithissi',
'Long keys'
);
# braces
is( Fink::Services::expand_percent( 'po%{ta}%{t}o', {qw/ta n t ch/} ),
'poncho',
'Braces'
);
--- NEW FILE: execute_nonroot_okay.t ---
#!/usr/bin/perl -w
use strict;
use Test::More tests=>12;
require_ok('Fink::Services'); # 1
# exported functions
use_ok('Fink::Services','execute'); # 2
# needed for passing 'fink --build-as-nobody' flag to execute()
# (don't really care how it's implemented, but these tests are currently
# written for it being implemented with Fink::Config options)
require_ok('Fink::Config'); # 3
can_ok('Fink::Config','get_option'); # 4
can_ok('Fink::Config','set_options'); # 5
# need a a safe place to create files
# OS X 10.2 comes with perl 5.6.0, but File::Temp isn't in core until 5.6.1
#use File::Temp (qw/ tempdir /);
#my $tmpdir = tempdir( 'execute_nonroot_okay.t_XXXXX',
# DIR => '/tmp', # dir itself be accessible to *all* users
## CLEANUP => 1 # CLEANUP is unsafe (see 'rmtree' below)
# );
# OS X 10.2 mktemp does not have the -p flag implemented
my $tmpdir = `/usr/bin/mktemp -d /tmp/execute_nonroot_okay.t_XXXXX`;
chomp $tmpdir;
if (!defined $tmpdir or !length $tmpdir or !-d $tmpdir) {
print "Bail out! Cannot create scratchdir\n";
die "\n";
}
chmod 0755, $tmpdir; # must have only root be able to write to dir but all read
# Need a world-readable Fink/Services.pm but don't want to go changing
# perms on the whole hierarchy leading to whereever user is running test,
# so make a copy in a known place with known perms.
if (system qq{ mkdir "$tmpdir/Fink" && cp ../perlmod/Fink/Services.pm
"$tmpdir/Fink" }) {
diag "Could not create temp Services.pm; using local copy
instead.\nDepending on permissions and the presence of an existing Fink,
this\nsituation may result in an apparently-missing Services.pm.\n";
} else {
chmod 0755, "$tmpdir/Fink";
chmod 0644, "$tmpdir/Fink/Services.pm";
$ENV{'PERL5LIB'} = defined $ENV{'PERL5LIB'} # so subprocesses see it
? "$tmpdir:$ENV{'PERL5LIB'}"
: $tmpdir;
}
chdir "/tmp"; # set local dir to where user="nobody" can start shells
# 6
Fink::Config::set_options( {'build_as_nobody' => 0} );
cmp_ok( &execute("touch $tmpdir/f1", nonroot_okay=>1),
'==', 0,
'disabling build_as_nobody causes normal execution'
);
# 7
Fink::Config::set_options( {'build_as_nobody' => 1} );
cmp_ok( &execute("touch $tmpdir/f2"),
'==', 0,
'omitting nonroot_okay option causes normal execution'
);
# 8
Fink::Config::set_options( {'build_as_nobody' => 1} );
cmp_ok( &execute("touch $tmpdir/f3", nonroot_okay=>0),
'==', 0,
'false nonroot_okay option causes normal execution'
);
# 9
SKIP: {
Fink::Config::set_options( {'build_as_nobody' => 1} );
skip "You must be non-root for this test", 1 if $> == 0;
# this touch should fail noisily, so redirect
cmp_ok( &execute("touch $tmpdir/f4 > /dev/null 2>&1", nonroot_okay=>1),
'!=', 0,
'try to switch users when not root'
);
}
# 10
SKIP: {
Fink::Config::set_options( {'build_as_nobody' => 1} );
skip "You must be root for this test", 1 if $> != 0;
# this touch should fail noisily, so redirect
cmp_ok( &execute("touch $tmpdir/f5 > /dev/null 2>&1", nonroot_okay=>1,
delete_tempfile=>1),
'!=', 0,
'requires normal user but build_as_nobody enabled'
);
}
# 11
SKIP: {
Fink::Config::set_options( {'build_as_nobody' => 1} );
skip "You must be root for this test", 1 if $> != 0;
my $file = "$tmpdir/f6";
open FOO, ">$file";
close FOO;
chmod 0666, $file; # create a file that all users can touch
cmp_ok( &execute("touch $file", nonroot_okay=>1),
'==', 0,
'user "nobody" can do this and build_as_nobody enabled'
);
}
# 12
SKIP: {
skip "You must be root for this test", 1 if $> != 0;
# this test should use the exact same perl binary as is running
# this test (which is the same as the one to be used to run fink)
Fink::Config::set_options( {'build_as_nobody' => 1} );
cmp_ok( &execute('/usr/bin/perl -e "1;"', nonroot_okay=>1),
'==', 0,
'command is not run under setuid'
);
}
# We cannot use tempdir(CLEANUP=>1) because that works by installing
# an END block to do the cleanup, which breaks us because &execute may
# be implemented with forks: the END block runs when each child ends
# not just at the end of the parent (== this test script). Damn it.
use File::Path (qw/ rmtree /);
rmtree($tmpdir, 0, 1);
--- NEW FILE: ChangeLog ---
2005-1-11 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: execute() may fork a process that needs
to find Services.pm, so make a copy of that file that is
guaranteed to be readable by "nobody".
2005-1-5 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: delete expected tempfile.
2004-12-30 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: rework a test to avoid using "touch" on
a dir.
2004-12-30 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: OS X 10.2 (perl 5.6.0) portability fix:
use /usr/bin/mktemp instead of File::Temp.
2004-12-30 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: Don't use Test tests for test-suite
prereqs. Fix tempdir sanity-check bail-out. More output-hiding
adjustments.
2004-12-28 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: Specify /usr/bin/touch since binutils'
can't touch directories. Don't hide output of tests that should be
silent.
2004-12-28 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: Majorly reworked for new execute().
2004-12-22 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: Explicitly use correct perl interp
2004-12-22 Daniel Macks <[EMAIL PROTECTED]>
* prepare_script.t: Improved test for blank line removal.
2004-12-21 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: Lots of cleanups. Add TODO test for not
script not running in setuid mode.
2004-12-21 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t: execute_nonroot_okay() wrapper merged
into underlying execute(). Extract common parts of some tests. Add
tests to make sure root not dropped when it's not supposed to be.
2004-12-20 Daniel Macks <[EMAIL PROTECTED]>
* execute_script_nonroot_okay.t: function removed so scrap the test.
2004-12-20 Daniel Macks <[EMAIL PROTECTED]>
* prepare_script.t: Wrote a test suite.
2004-11-23 Daniel Macks <[EMAIL PROTECTED]>
* execute_nonroot_okay.t,execute_script_nonroot_okay.t: Wrote some
basic tests.
--- NEW FILE: eval_conditional.t ---
#!/usr/bin/perl -w
use strict;
use Test::More 'no_plan';
BEGIN { use_ok( 'Fink::Services', qw(eval_conditional) ) };
# "str1 op str2" forms
my @stringsets = (
[qw/ a b /],
[qw/ b b /],
[qw/ b a /],
[ 0, 1 ],
[ 2, 10 ]
);
foreach my $optest (
# each list is $op then ref to list of results parallelling @stringsets
[ ">>" => [ 0, 0, 1, 0, 1 ] ],
[ "<<" => [ 1, 0, 0, 1, 0 ] ],
[ ">=" => [ 0, 1, 1, 0, 1 ] ],
[ "<=" => [ 1, 1, 0, 1, 0 ] ],
[ "=" => [ 0, 1, 0, 0, 0 ] ],
[ "!=" => [ 1, 0, 1, 1, 1 ] ]
) {
for( my $setnum=0; $setnum<@stringsets; $setnum++ ) {
my $test = $stringsets[$setnum]->[0] . " " . $optest->[0] . " " .
$stringsets[$setnum]->[1];
cmp_ok( &eval_conditional( $test, "eval_consitional.t" ),
'==', $optest->[1]->[$setnum],
$test
);
}
}
# "str1 op str2" whitespace tests
foreach my $str1 ( "a", " a" ) {
foreach my $op ( "=", " =", "= ", " = " ) {
foreach my $str2 ( "a", "a " ) {
my $test = $str1 . $op . $str2;
cmp_ok( &eval_conditional( $test, "eval_conditional.t" ),
'==', 1,
"'$test'"
);
}
}
}
# "str" forms
foreach my $testitem (
[ "" => 0 ],
[ " " => 0 ],
[ "a" => 1 ],
[ "a " => 1 ],
[ " a" => 1 ],
[ " a " => 1 ],
[ 0 => 1 ] # these are stringified comparisons!
) {
cmp_ok( &eval_conditional( $testitem->[0], "eval_conditional.t" ),
'==', $testitem->[1],
"'$testitem->[0]'"
);
}
# bogus forms
foreach my $testitem (
"a a",
"a=a a"
) {
eval { &eval_conditional( $testitem, "eval_conditional.t" ) };
like( $@,
qr/Error/,
"'$testitem'"
);
}
--- NEW FILE: prepare_script.t ---
#!/usr/bin/perl -w
use strict;
use Test::More 'no_plan';
require_ok('Fink::Services');
can_ok('Fink::Services','prepare_script'); # not exported
my( @script, $script, $result );
my $scriptref = \$script;
$script = 'test1';
eval { $result = &Fink::Services::prepare_script($script) };
isnt($@, '', 'fails for non-ref');
$script = undef;
$result = &Fink::Services::prepare_script($scriptref);
isnt(defined $script, 'undef returns undef');
$script = '';
$result = &Fink::Services::prepare_script($scriptref);
isnt(defined $script, 'blank returns undef');
$script = 'test1';
$result = &Fink::Services::prepare_script($scriptref);
cmp_ok($result, '==', 0, 'simple command returns 0');
is($script, 'test1', 'simple command is unchanged');
$script = "test1\n";
$result = &Fink::Services::prepare_script($scriptref);
is($$scriptref, 'test1', 'removes trailing newline');
cmp_ok($scriptref, 'eq', \$script, 'chomps; changes original scalar');
$script = "#!/bin/sh\ntest1";
$result = &Fink::Services::prepare_script($scriptref);
cmp_ok($result, '==', 1, 'magic-char script returns 1');
like($script, '/\/tmp/', 'magic-char script returns scriptname');
like($script, '/^\//', 'scriptname is absolute path');
ok(-f $script, 'scriptname file exists');
open SCRIPT, "<$script";
@script = <SCRIPT>;
close SCRIPT;
unlink $script;
is($script[-1], "test1\n", 'trailing newline added');
$script = " #!/bin/sh\ntest\\\n test1\n\n# a\nfoo\n";
$result = &Fink::Services::prepare_script($scriptref);
cmp_ok($result, '==', 1, 'whitespace before magic-char is okay');
open SCRIPT, "<$script";
@script = <SCRIPT>;
close SCRIPT;
unlink $script;
cmp_ok(scalar @script, '==', 6, 'read all lines');
is($script[0], "#!/bin/sh\n", 'whitespace befor magic-char is removed');
is($script[1], "test\\\n", 'trailing slash does not cause rejoining');
is($script[2], " test1\n", 'leading whitespace in other lines remains');
is($script[3], "\n", 'blank lines remain');
is($script[4], "# a\n", 'comments remain');
is($script[5], "foo\n", 'no chomp');
$script = " testing\n1, 2, 3\n over\nand out \ncharlie\n";
$result = &Fink::Services::prepare_script($scriptref);
is($script, "testing\n1, 2, 3\nover\nand out \ncharlie", 'leading whitespace
is removed');
$script = "\nhi\n \n\nwocka\nwocka2\n\n wiff\n\n\n \n\n\n";
$result = &Fink::Services::prepare_script($scriptref);
is($script, "hi\nwocka\nwocka2\nwiff", 'blanks are removed');
$script = "Hello\nI am # Sam\n#Sam I am\n # leave now\nwoof";
$result = &Fink::Services::prepare_script($scriptref);
is($script, "Hello\nI am # Sam\nwoof", 'comments are removed');
$script = "I hate\\\nwriting tests";
$result = &Fink::Services::prepare_script($scriptref);
is($script, 'I hate writing tests', 'simple continuation works');
$script = "Tests \\ \n are important";
$result = &Fink::Services::prepare_script($scriptref);
is($script, 'Tests are important', 'continuation handles excess whitespace');
$script = "Windows C:\\DOESNT.TST enough\nbummer";
$result = &Fink::Services::prepare_script($scriptref);
is($script, "Windows C:\\DOESNT.TST enough\nbummer", 'internal backslashes
ignored');
$script = "That's\nbad news\\\nfor\\\nversion x.0 \\\nusers";
$result = &Fink::Services::prepare_script($scriptref);
is($script, "That's\nbad news for version x.0 users", 'multiple-rejoin works');
$script = "Maybe\\\n# woof!";
$result = &Fink::Services::prepare_script($scriptref);
is($script, 'Maybe # woof!', 'rejoin happens before comment removal (simple)');
$script = "Maybe\\\n# woof!\\\nnot?";
$result = &Fink::Services::prepare_script($scriptref);
is($script, 'Maybe # woof! not?', 'rejoin happens before comment removal
(multiple)');
$script = "Maybe\n# woof!\\\nso.";
$result = &Fink::Services::prepare_script($scriptref);
is($script, 'Maybe', 'rejoined comment is fully removed');
$script = 'test1\\';
eval { $result = &Fink::Services::prepare_script($script) };
isnt($@, '', 'fails for trailing backslash');
-------------------------------------------------------
SF email is sponsored by - The IT Product Guide
Read honest & candid reviews on hundreds of IT Products from real users.
Discover which products truly live up to the hype. Start reading now.
http://ads.osdn.com/?ad_id=6595&alloc_id=14396&op=click
_______________________________________________
Fink-commits mailing list
Fink-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/fink-commits
