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; 12use Data::Dumper; 13 14BEGIN { 15 my $tlib = $0; 16 $tlib =~ s|/[^/]*$|/lib|; 17 push(@INC, $tlib); 18} 19use t::Support; 20 21if (t::Support::should_skip()) { 22 plan skip_all => 'Tests unsupported on this OS/filesystem'; 23} else { 24 plan tests => 42; 25} 26 27use File::Temp qw(tempfile); 28use File::Path; 29use File::ExtAttr qw(setfattr getfattr delfattr listfattrns); 30use IO::File; 31 32my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); 33my ($fh, $filename) = tempfile( DIR => $TESTDIR ); 34 35close $fh or die "can't close $filename $!"; 36 37# Create a directory. 38my $dirname = "$filename.dir"; 39eval { mkpath($dirname); }; 40if ($@) { 41 warn "Couldn't create $dirname: $@"; 42} 43 44#todo: try wierd characters in here? 45# try unicode? 46my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; 47my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; 48 49my $key2 = $key.'2'; 50my $key3 = $key.'3'; 51 52my @ns; 53 54########################## 55# Filename-based tests # 56########################## 57 58foreach ( $filename, $dirname ) { 59 print "# using $_\n"; 60 61#for (1..30000) { #checking memory leaks 62 63 #will die if xattr stuff doesn't work at all 64 setfattr($_, "$key", $val, { namespace => 'user' }) 65 or die "setfattr failed on filename $_: $!"; 66 67 #set it 68 is (setfattr($_, "$key", $val, { namespace => 'user' }), 1); 69 70 #read it back 71 is (getfattr($_, "$key", { namespace => 'user' }), $val); 72 73 #set another 74 is (setfattr($_, "$key2", $val, { namespace => 'user' }), 1); 75 76 #read it back 77 is (getfattr($_, "$key2", { namespace => 'user' }), $val); 78 79 #set yet another 80 is (setfattr($_, "$key3", $val, { namespace => 'user' }), 1); 81 82 #read it back 83 is (getfattr($_, "$key3", { namespace => 'user' }), $val); 84 85 #check user namespace exists now 86 @ns = listfattrns($_); 87 is (grep(/^user$/, @ns), 1); 88 89 #delete them 90 ok (delfattr($_, "$key", { namespace => 'user' })); 91 ok (delfattr($_, "$key2", { namespace => 'user' })); 92 ok (delfattr($_, "$key3", { namespace => 'user' })); 93 94 #check that they're gone 95 is (getfattr($_, "$key", { namespace => 'user' }), undef); 96 is (getfattr($_, "$key2", { namespace => 'user' }), undef); 97 is (getfattr($_, "$key3", { namespace => 'user' }), undef); 98 99 #check user namespace doesn't exist now 100 SKIP: { 101 skip "Unremoveable user attributes prevent testing namespace removal", 102 1 if t::Support::has_system_attrs($_); 103 104 @ns = listfattrns($_); 105 is (grep(/^user$/, @ns), 0); 106 } 107#} 108} 109 110########################## 111# IO::Handle-based tests # 112########################## 113 114$fh = new IO::File("<$filename") or die "Unable to open $filename"; 115 116print "# using file descriptor ".$fh->fileno()."\n"; 117 118#for (1..30000) { #checking memory leaks 119 120 #will die if xattr stuff doesn't work at all 121 setfattr($fh, "$key", $val, { namespace => 'user' }) 122 or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; 123 124 #set it 125 is (setfattr($fh, "$key", $val, { namespace => 'user' }), 1); 126 127 #read it back 128 is (getfattr($fh, "$key", { namespace => 'user' }), $val); 129 130 #set another 131 is (setfattr($fh, "$key2", $val, { namespace => 'user' }), 1); 132 133 #read it back 134 is (getfattr($fh, "$key2", { namespace => 'user' }), $val); 135 136 #set yet another 137 is (setfattr($fh, "$key3", $val, { namespace => 'user' }), 1); 138 139 #read it back 140 is (getfattr($fh, "$key3", { namespace => 'user' }), $val); 141 142 #check user namespace exists now 143 @ns = listfattrns($fh); 144 is (grep(/^user$/, @ns), 1); 145 146 #delete them 147 ok (delfattr($fh, "$key", { namespace => 'user' })); 148 ok (delfattr($fh, "$key2", { namespace => 'user' })); 149 ok (delfattr($fh, "$key3", { namespace => 'user' })); 150 151 #check that it's gone 152 is (getfattr($fh, "$key", { namespace => 'user' }), undef); 153 is (getfattr($fh, "$key2", { namespace => 'user' }), undef); 154 is (getfattr($fh, "$key3", { namespace => 'user' }), undef); 155 156 #check user namespace doesn't exist now 157 SKIP: { 158 skip "Unremoveable user attributes prevent testing namespace removal", 159 1 if t::Support::has_system_attrs($fh); 160 161 @ns = listfattrns($fh); 162 is (grep(/^user$/, @ns), 0); 163 } 164#} 165#print STDERR "done\n"; 166#<STDIN>; 167 168END { 169 unlink $filename if $filename; 170 rmdir $dirname if $dirname; 171}; 172