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