1#!perl -w 2 3# Before `make install' is performed this script should be runnable with 4# `make test'. After `make install' it should work as `perl Linux-xattr.t' 5 6########################## 7 8# change 'tests => 2' to 'tests => last_test_to_print'; 9 10use strict; 11use Test::More; 12 13BEGIN { 14 my $tlib = $0; 15 $tlib =~ s|/[^/]*$|/lib|; 16 push(@INC, $tlib); 17} 18use t::Support; 19 20if (t::Support::should_skip()) { 21 plan skip_all => 'Tests unsupported on this OS/filesystem'; 22} else { 23 plan tests => 18; 24} 25 26use File::Temp qw(tempfile); 27use File::Path; 28use File::ExtAttr qw(setfattr getfattr delfattr listfattrns); 29use IO::File; 30 31my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); 32my ($fh, $filename) = tempfile( DIR => $TESTDIR ); 33 34close $fh or die "can't close $filename $!"; 35 36# Create a directory. 37my $dirname = "$filename.dir"; 38eval { mkpath($dirname); }; 39if ($@) { 40 warn "Couldn't create $dirname: $@"; 41} 42 43#todo: try wierd characters in here? 44# try unicode? 45my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; 46my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; 47 48my @ns; 49 50########################## 51# Filename-based tests # 52########################## 53 54foreach ( $filename, $dirname ) { 55 print "# using $_\n"; 56 57#for (1..30000) { #checking memory leaks 58 59 #will die if xattr stuff doesn't work at all 60 setfattr($_, "$key", $val, { namespace => 'user' }) 61 or die "setfattr failed on filename $_: $!"; 62 63 #set it 64 is (setfattr($_, "$key", $val, { namespace => 'user' }), 1); 65 66 #check user namespace exists now 67 @ns = listfattrns($_); 68 is (grep(/^user$/, @ns), 1); 69 print '# '.join(' ', @ns)."\n"; 70 71 #read it back 72 is (getfattr($_, "$key", { namespace => 'user' }), $val); 73 74 #delete it 75 ok (delfattr($_, "$key", { namespace => 'user' })); 76 77 #check that it's gone 78 is (getfattr($_, "$key", { namespace => 'user' }), undef); 79 80 #check user namespace doesn't exist now 81 SKIP: { 82 skip "Unremoveable user attributes prevent testing namespace removal", 83 1 if t::Support::has_system_attrs($_); 84 85 @ns = listfattrns($_); 86 is (grep(/^user$/, @ns), 0); 87 } 88#} 89} 90 91########################## 92# IO::Handle-based tests # 93########################## 94 95$fh = new IO::File("<$filename") or die "Unable to open $filename"; 96 97print "# using file descriptor ".$fh->fileno()."\n"; 98 99#for (1..30000) { #checking memory leaks 100 101 #will die if xattr stuff doesn't work at all 102 setfattr($fh, "$key", $val, { namespace => 'user' }) 103 or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; 104 105 #set it 106 is (setfattr($fh, "$key", $val, { namespace => 'user' }), 1); 107 108 #check user namespace exists now 109 @ns = listfattrns($fh); 110 is (grep(/^user$/, @ns), 1); 111 print '# '.join(' ', @ns)."\n"; 112 113 #read it back 114 is (getfattr($fh, "$key", { namespace => 'user' }), $val); 115 116 #delete it 117 ok (delfattr($fh, "$key", { namespace => 'user' })); 118 119 #check that it's gone 120 is (getfattr($fh, "$key", { namespace => 'user' }), undef); 121 122 #check user namespace doesn't exist now 123 SKIP: { 124 skip "Unremoveable user attributes prevent testing namespace removal", 125 1 if t::Support::has_system_attrs($fh); 126 127 @ns = listfattrns($fh); 128 is (grep(/^user$/, @ns), 0); 129 } 130#} 131#print STDERR "done\n"; 132#<STDIN>; 133 134END { 135 unlink $filename if $filename; 136 rmdir $dirname if $dirname; 137}; 138