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