File-ExtAttr-1.09/0000755000076400007640000000000011154446426012366 5ustar richrichFile-ExtAttr-1.09/Changes0000644000076400007640000001430311154445531013656 0ustar richrichRevision history for Perl extension File::ExtAttr. 1.09 2009-03-07 - (richdawe) Add note to README about needing to install package that provides the headers and . - (richdawe) Fix RT #31970: "OS X: setfattr fails to set empty value". According to the CPAN Testers results, this works on Mac OS X 10.5. Skip the "empty" tests on Mac OS X 10.4 and earlier. Document issue. - (richdawe) Fix #34394: "Test suite should skip on filesystems with no xattr support when run non-interactively" on Linux. When run interactively, it will suggest what you need to do, to get the test suite to pass. - (richdawe) Fix RT #37889: "Crash when operating on a closed file handle on Solaris". This was due to using an uninitialised directory handle. 1.08 2008-08-19 - (richdawe) Add a typemap for usage of "const char *" in the XS. This may help fix the build with Perl 5.6.x or earlier. - (richdawe) Remove NetBSD 3.x from list of supported OSes, since File::ExtAttr's test suite will never pass on it. - (richdawe) Update Makefile.PL to fail more gracefully when the build pre-requisites are not present. On Linux use Devel::CheckLib to check for libattr. Also exit more gracefully if libattr's headers are not present. - (richdawe) OpenBSD isn't supported, so bail gracefully in Makefile.PL on that platform. - (richdawe) Make sure that the errno value from any failed system calls is propagated into $! (#32679, #32680). - (richdawe) File::ExtAttr no longer generate noisy warnings when an xattr system call fails. All error reporting is now via the function return values and $!. - (richdawe) Operations with non-default or non-"user" namespaces will now fail with EOPNOTSUPP instead of ENOATTR on Mac OS X, *BSD and Solaris. This behaviour matches the behaviour on Linux. - (richdawe) Added a note to the documentation about Solaris extensible system attributes, which are different to extended file attributes. 1.07 2007-12-15 - (richdawe) Bugfix: When the attribute value was empty, getfattr() returned garbage. Fixed. (Reported by Joe Stewart -- thanks!) - (richdawe) Change my contact details. 1.06 2007-11-04 - (richdawe) Bugfix: Builds and works again on Mac OS X 10.4 (Tiger). - (richdawe) Fix typo in t/33nslong.t, which caused it to fail on Mac OS X. 1.05 2007-08-13 - (richdawe) Fix META.yml so that it's valid. Add a test using Test::YAML::Meta to the test suite, to validate META.yml. - (richdawe) Fix RT #27864: "Tests fail with nl_NL locale set". - (richdawe) Add test cases for setting attributes on directories, by filename. - (richdawe) Bugfix: Fix a memory leak in getfattr(). The memory was leaked when the function failed, e.g.: if it was called with the name of a non-existent attribute. 1.04 2007-05-06 - (richdawe) OpenBSD does not support extended attributes -- fail the build on OpenBSD; documentation updates. - (richdawe) Really fix build for NetBSD 3.x. Update the test suite to skip tests on NetBSD 3.1 or earlier, since NetBSD 4.0 is the first version to actually have filesystem support for extended attributes. 1.03 2007-04-27 - (richdawe) Fix RT #26542: "Tests fail with taint-mode and ATTR_TEST_DIR set"; also document ATTR_TEST_DIR. - (richdawe) Build fix for NetBSD, OpenBSD: Use strerror() if strerror_r() is not available. 1.02 2007-04-06 - (richdawe) Fix listfattr() so it works on Linux. Thanks to rafl and Jonathan Rockway for the patch! - (richdawe) Add test cases for listfattr(). - (richdawe) Fix warning in listfattr(), listfattrns() when operating on a file handle. 1.01 2006-10-02 - (richdawe) Fix brown paper bag bugs in MANIFEST that broke the build. 1.00 2006-10-02 - (richdawe) Add support for Solaris 10. - (richdawe) Add support for File::ExtAttr::Tie on *BSD. - (richdawe) API change: Namespace and the create/replace flag are now passed via a hash. This breaks API compatibility for both File::ExtAttr and File::ExtAttr::Tie. One API change remains: using exceptions rather than warnings to report errors. - (richdawe) Fix RT #21214: "ISO C90 forbids mixed declarations and code" NOTE: This relase has not been built or tested on Mac OS X. 0.05 2006-05-27 - (richdawe) Add support for FreeBSD 6.0. This may also work with NetBSD >= 4.0 and OpenBSD > 3.8. - (richdawe) All *fattr functions now take some optional flags. - (richdawe) Add File::ExtAttr::Tie for tied access to extattrs; thanks to David Leadbeater! 0.04 2006-01-20 - (richdawe) Add Mac OS X support; thanks to Jonathan Rockway! - (richdawe) Add a check to Makefile.PL for libattr's headers on Linux. - (richdawe) Requirement on Perl 5.8.5 is spurious; remove it. 0.03 2006-01-01 - (richdawe) Rename to File::ExtAttr from Linux::xattr - (richdawe) Bugfix: XATTR_* were not found correctly in XS. - (richdawe) Bugfix: Off-by-one buffer overflow in XS for getfattr(). - (richdawe) Split the tests up, to make them more granular. - (richdawe) Final parameter of setfattr() is now optional. - (richdawe) Support specifying file using an IO::Handle. 0.02 2005-11-15 - (kg) changing to use system functions instead of compatability functions - (kg) fixing strlen stuff in get and set - (kg) exporting constants 0.01 Wed Nov 9 08:57:42 2005 - original version; created by h2xs 1.23 with options -O -n Linux::xattr Linux-xattr/mylib/xattrlib.h File-ExtAttr-1.09/flags.c0000644000076400007640000000435510510270402013615 0ustar richrich#include #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "flags.h" /* * Convert the 'create' and/or 'replace' attributes into a value, * so they can be mapped to O_CREATE/O_EXCL values by the caller. */ File_ExtAttr_setflags_t File_ExtAttr_flags2setflags (struct hv *flags) { const size_t CREATE_KEYLEN = strlen(CREATE_KEY); const size_t REPLACE_KEYLEN = strlen(REPLACE_KEY); SV **psv_ns; File_ExtAttr_setflags_t ret = SET_CREATEIFNEEDED; /* * ASSUMPTION: Perl layer must ensure that create & replace * aren't used at the same time. */ if (flags && (psv_ns = hv_fetch(flags, CREATE_KEY, CREATE_KEYLEN, 0))) ret = SvIV(*psv_ns) ? SET_CREATE : SET_CREATEIFNEEDED; if (flags && (psv_ns = hv_fetch(flags, REPLACE_KEY, REPLACE_KEYLEN, 0))) ret = SvIV(*psv_ns) ? SET_REPLACE : SET_CREATEIFNEEDED; return ret; } /* * For platforms that don't support namespacing attributes * (Mac OS X, Solaris), provide some smart default behaviour * for the 'namespace' attribute for cross-platform compatibility. */ int File_ExtAttr_valid_default_namespace (struct hv *flags) { const size_t NAMESPACE_KEYLEN = strlen(NAMESPACE_KEY); SV **psv_ns; int ok = 1; /* Default is valid */ if (flags && (psv_ns = hv_fetch(flags, NAMESPACE_KEY, NAMESPACE_KEYLEN, 0))) { /* * Undefined => default. Otherwise treat "user" as if it were valid, * for compatibility with the default on Linux and *BSD. * An empty namespace (i.e.: zero-length) is not the same as the default. */ if (SvOK(*psv_ns)) { char *s; STRLEN len = 0; s = SvPV(*psv_ns, len); if (len) ok = (memcmp(NAMESPACE_USER, s, len) == 0); else ok = 0; } } return ok; } /* * Mac OS X and Solaris doesn't support namespacing attributes. * So if there are any attributes, call this function, * to return the namespace "user". */ ssize_t File_ExtAttr_default_listxattrns (char *buf, const size_t buflen) { ssize_t ret = 0; if (buflen >= sizeof(NAMESPACE_USER)) { memcpy(buf, NAMESPACE_USER, sizeof(NAMESPACE_USER)); ret = sizeof(NAMESPACE_USER); } else if (buflen == 0) { ret = sizeof(NAMESPACE_USER); } else { ret = -1; errno = ERANGE; } return ret; } File-ExtAttr-1.09/extattr_bsd.c0000644000076400007640000002037011025166560015052 0ustar richrich#include "extattr_os.h" #ifdef EXTATTR_BSD #include #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "flags.h" static int valid_namespace (struct hv *flags, int *pattrnamespace) { const size_t NAMESPACE_KEYLEN = strlen(NAMESPACE_KEY); SV **psv_ns; char *ns = NULL; int ok = 1; /* Default is valid */ int attrnamespace = EXTATTR_NAMESPACE_USER; if (flags && (psv_ns = hv_fetch(flags, NAMESPACE_KEY, NAMESPACE_KEYLEN, 0))) { /* * Undefined => default. Otherwise "user" and "system" are valid. */ if (SvOK(*psv_ns)) { char *s; STRLEN len = 0; s = SvPV(*psv_ns, len); if (len) { if (memcmp(NAMESPACE_USER, s, len) == 0) attrnamespace = EXTATTR_NAMESPACE_USER; else if (memcmp(NAMESPACE_SYSTEM, s, len) == 0) attrnamespace = EXTATTR_NAMESPACE_SYSTEM; else ok = 0; } else { ok = 0; } } } if (ok) *pattrnamespace = attrnamespace; return ok; } /* Helper to convert number of bytes written into success/failure code. */ static inline int bsd_extattr_set_succeeded (const int expected, const int actual) { int ret = 0; if (actual == -1) { ret = -errno; } else if (actual != expected) { /* Pretend there's not enough space for the data. */ ret = -ENOBUFS; } return ret; } int bsd_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { int attrnamespace = -1; int ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { File_ExtAttr_setflags_t setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: case SET_REPLACE: /* Default behaviour */ break; case SET_CREATE: /* * This needs to be emulated, since the default *BSD calls * don't provide a way of failing if the attribute exists. * This emulation is inherently racy. */ { ssize_t sz = extattr_get_file(path, attrnamespace, attrname, NULL, 0); if (sz >= 0) { /* Attribute already exists => fail. */ ret = -EEXIST; } } break; } } if (ret == 0) { ret = extattr_set_file(path, attrnamespace, attrname, attrvalue, slen); ret = bsd_extattr_set_succeeded(slen, ret); } return ret; } int bsd_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { int attrnamespace = -1; int ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { File_ExtAttr_setflags_t setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: case SET_REPLACE: /* Default behaviour */ break; case SET_CREATE: /* * This needs to be emulated, since the default *BSD calls * don't provide a way of failing if the attribute exists. * This emulation is inherently racy. */ { ssize_t sz = extattr_get_fd(fd, attrnamespace, attrname, NULL, 0); if (sz >= 0) { /* Attribute already exists => fail. */ ret = -EEXIST; } } break; } } if (ret == 0) { ret = extattr_set_fd(fd, attrnamespace, attrname, attrvalue, slen); ret = bsd_extattr_set_succeeded(slen, ret); } return ret; } int bsd_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int attrnamespace = -1; int ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { ret = extattr_get_file(path, attrnamespace, attrname, attrvalue, slen); if (ret < 0) { ret = -errno; } } return ret; } int bsd_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int attrnamespace = -1; int ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { ret = extattr_get_fd(fd, attrnamespace, attrname, attrvalue, slen); if (ret < 0) { ret = -errno; } } return ret; } int bsd_removexattr (const char *path, const char *attrname, struct hv *flags) { int attrnamespace = -1; int ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { ret = extattr_delete_file(path, attrnamespace, attrname); if (ret < 0) { ret = -errno; } } return ret; } int bsd_fremovexattr (const int fd, const char *attrname, struct hv *flags) { int attrnamespace = -1; int ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { ret = extattr_delete_fd(fd, attrnamespace, attrname); if (ret < 0) { ret = -errno; } } return ret; } /* Convert the BSD-style list to a nul-separated list. */ static void reformat_list (char *buf, const ssize_t len) { ssize_t pos = 0; ssize_t attrlen; while (pos < len) { attrlen = (unsigned char) buf[pos]; memmove(buf + pos, buf + pos + 1, attrlen); buf[pos + attrlen] = '\0'; pos += attrlen + 1; } } ssize_t bsd_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags) { int attrnamespace = -1; ssize_t ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { ret = extattr_list_file(path, attrnamespace, /* To get the length on *BSD, pass NULL here. */ buflen ? buf : NULL, buflen); if (buflen && (ret > 0)) reformat_list(buf, ret); if (ret < 0) { ret = -errno; } } return ret; } ssize_t bsd_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags) { int attrnamespace = -1; ssize_t ret = 0; if (!valid_namespace(flags, &attrnamespace)) { ret = -EOPNOTSUPP; } if (ret == 0) { ret = extattr_list_fd(fd, attrnamespace, /* To get the length on *BSD, pass NULL here. */ buflen ? buf : NULL, buflen); if (buflen && (ret > 0)) reformat_list(buf, ret); if (ret < 0) { ret = -errno; } } return ret; } static ssize_t listxattrns (char *buf, const size_t buflen, const int iHasUser, const int iHasSystem) { size_t len = 0; ssize_t ret = 0; if (iHasUser) len += sizeof(NAMESPACE_USER); if (iHasSystem) len += sizeof(NAMESPACE_SYSTEM); if (buflen >= len) { char *p = buf; if (iHasUser) { memcpy(p, NAMESPACE_USER, sizeof(NAMESPACE_USER)); p += sizeof(NAMESPACE_USER); } if (iHasSystem) { memcpy(p, NAMESPACE_SYSTEM, sizeof(NAMESPACE_SYSTEM)); p += sizeof(NAMESPACE_SYSTEM); } ret = len; } else if (buflen == 0) { ret = len; } else { ret = -ERANGE; } return ret; } ssize_t bsd_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags) { int iHasUser = 0; int iHasSystem = 0; ssize_t ret = 0; ret = extattr_list_file(path, EXTATTR_NAMESPACE_USER, NULL, 0); if (ret > 0) iHasUser = 1; if (ret >= 0) { ret = extattr_list_file(path, EXTATTR_NAMESPACE_SYSTEM, NULL, 0); if (ret > 0) iHasSystem = 1; /* * XXX: How do we cope with EPERM? Throw an exception. * For now ignore it, although this could cause problems. */ if (ret == -1 && errno == EPERM) ret = 0; } if (ret >= 0) ret = listxattrns(buf, buflen, iHasUser, iHasSystem); return ret; } ssize_t bsd_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags) { int iHasUser = 0; int iHasSystem = 0; ssize_t ret; ret = extattr_list_fd(fd, EXTATTR_NAMESPACE_USER, NULL, 0); if (ret > 0) iHasUser = 1; if (ret >= 0) { ret = extattr_list_fd(fd, EXTATTR_NAMESPACE_SYSTEM, NULL, 0); if (ret > 0) iHasSystem = 1; /* * XXX: How do we cope with EPERM? Throw an exception. * For now ignore it, although this could cause problems. */ if (ret == -1 && errno == EPERM) ret = 0; } if (ret >= 0) ret = listxattrns(buf, buflen, iHasUser, iHasSystem); return ret; } #endif /* EXTATTR_BSD */ File-ExtAttr-1.09/ppport.h0000644000076400007640000007223710617323514014071 0ustar richrich /* ppport.h -- Perl/Pollution/Portability Version 2.011 * * Automatically Created by Devel::PPPort on Wed Nov 9 08:57:42 2005 * * Do NOT edit this file directly! -- Edit PPPort.pm instead. * * Version 2.x, Copyright (C) 2001, Paul Marquess. * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. * This code may be used and distributed under the same license as any * version of Perl. * * This version of ppport.h is designed to support operation with Perl * installations back to 5.004, and has been tested up to 5.8.1. * * If this version of ppport.h is failing during the compilation of this * module, please check if a newer version of Devel::PPPort is available * on CPAN before sending a bug report. * * If you are using the latest version of Devel::PPPort and it is failing * during compilation of this module, please send a report to perlbug@perl.com * * Include all following information: * * 1. The complete output from running "perl -V" * * 2. This file. * * 3. The name & version of the module you were trying to build. * * 4. A full log of the build that failed. * * 5. Any other information that you think could be relevant. * * * For the latest version of this code, please retreive the Devel::PPPort * module from CPAN. * */ /* * In order for a Perl extension module to be as portable as possible * across differing versions of Perl itself, certain steps need to be taken. * Including this header is the first major one, then using dTHR is all the * appropriate places and using a PL_ prefix to refer to global Perl * variables is the second. * */ /* If you use one of a few functions that were not present in earlier * versions of Perl, please add a define before the inclusion of ppport.h * for a static include, or use the GLOBAL request in a single module to * produce a global definition that can be referenced from the other * modules. * * Function: Static define: Extern define: * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL * */ /* To verify whether ppport.h is needed for your module, and whether any * special defines should be used, ppport.h can be run through Perl to check * your source code. Simply say: * * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc] * * The result will be a list of patches suggesting changes that should at * least be acceptable, if not necessarily the most efficient solution, or a * fix for all possible problems. It won't catch where dTHR is needed, and * doesn't attempt to account for global macro or function definitions, * nested includes, typemaps, etc. * * In order to test for the need of dTHR, please try your module under a * recent version of Perl that has threading compiled-in. * */ /* #!/usr/bin/perl @ARGV = ("*.xs") if !@ARGV; %badmacros = %funcs = %macros = (); $replace = 0; foreach () { $funcs{$1} = 1 if /Provide:\s+(\S+)/; $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; $replace = $1 if /Replace:\s+(\d+)/; $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; } foreach $filename (map(glob($_),@ARGV)) { unless (open(IN, "<$filename")) { warn "Unable to read from $file: $!\n"; next; } print "Scanning $filename...\n"; $c = ""; while () { $c .= $_; } close(IN); $need_include = 0; %add_func = (); $changes = 0; $has_include = ($c =~ /#.*include.*ppport/m); foreach $func (keys %funcs) { if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { if ($c !~ /\b$func\b/m) { print "If $func isn't needed, you don't need to request it.\n" if $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); } else { print "Uses $func\n"; $need_include = 1; } } else { if ($c =~ /\b$func\b/m) { $add_func{$func} =1 ; print "Uses $func\n"; $need_include = 1; } } } if (not $need_include) { foreach $macro (keys %macros) { if ($c =~ /\b$macro\b/m) { print "Uses $macro\n"; $need_include = 1; } } } foreach $badmacro (keys %badmacros) { if ($c =~ /\b$badmacro\b/m) { $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; $need_include = 1; } } if (scalar(keys %add_func) or $need_include != $has_include) { if (!$has_include) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). "#include \"ppport.h\"\n"; $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; } elsif (keys %add_func) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; } if (!$need_include) { print "Doesn't seem to need ppport.h.\n"; $c =~ s/^.*#.*include.*ppport.*\n//m; } $changes++; } if ($changes) { open(OUT,">/tmp/ppport.h.$$"); print OUT $c; close(OUT); open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); while () { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } close(DIFF); unlink("/tmp/ppport.h.$$"); } else { print "Looks OK\n"; } } __DATA__ */ #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # define PERL_PATCHLEVEL_H_IMPLICIT # include # endif # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) # include # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) /* It is very unlikely that anyone will try to use this with Perl 6 (or greater), but who knows. */ #if PERL_REVISION != 5 # error ppport.h only works with Perl version 5 #endif /* PERL_REVISION != 5 */ #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ # define PL_Sv Sv # define PL_compiling compiling # define PL_copline copline # define PL_curcop curcop # define PL_curstash curstash # define PL_defgv defgv # define PL_dirty dirty # define PL_dowarn dowarn # define PL_hints hints # define PL_na na # define PL_perldb perldb # define PL_rsfp_filters rsfp_filters # define PL_rsfpv rsfp # define PL_stdingv stdingv # define PL_sv_no sv_no # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes /* Replace: 0 */ #endif #if defined(HASATTRIBUTE) # if !defined(PERL_UNUSED_DECL) # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif # else # define PERL_UNUSED_DECL # endif #endif #ifndef dNOOP # define NOOP (void)0 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL #endif #ifndef dTHR # define dTHR dNOOP #endif #ifndef dTHX # define dTHX dNOOP # define dTHXa(x) dNOOP # define dTHXoa(x) dNOOP #endif #ifndef pTHX # define pTHX void # define pTHX_ # define aTHX # define aTHX_ #endif #ifndef dAX # define dAX I32 ax = MARK - PL_stack_base + 1 #endif #ifndef dITEMS # define dITEMS I32 items = SP - MARK #endif /* IV could also be a quad (say, a long long), but Perls * capable of those should have IVSIZE already. */ #if !defined(IVSIZE) && defined(LONGSIZE) # define IVSIZE LONGSIZE #endif #ifndef IVSIZE # define IVSIZE 4 /* A bold guess, but the best we can make. */ #endif #ifndef UVSIZE # define UVSIZE IVSIZE #endif #ifndef NVTYPE # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) # define NVTYPE long double # else # define NVTYPE double # endif typedef NVTYPE NV; #endif #ifndef INT2PTR #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV # define INT2PTR(any,d) (any)(d) #else # if PTRSIZE == LONGSIZE # define PTRV unsigned long # else # define PTRV unsigned # endif # define INT2PTR(any,d) (any)(PTRV)(d) #endif #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) #define PTR2NV(p) NUM2PTR(NV,p) #if PTRSIZE == LONGSIZE # define PTR2ul(p) (unsigned long)(p) #else # define PTR2ul(p) INT2PTR(unsigned long,p) #endif #endif /* !INT2PTR */ #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif #ifndef gv_stashpvn # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) #endif #ifndef newRV_inc /* Replace: 1 */ # define newRV_inc(sv) newRV(sv) /* Replace: 0 */ #endif /* DEFSV appears first in 5.004_56 */ #ifndef DEFSV # define DEFSV GvSV(PL_defgv) #endif #ifndef SAVE_DEFSV # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif #ifndef newRV_noinc # ifdef __GNUC__ # define newRV_noinc(sv) \ ({ \ SV *nsv = (SV*)newRV(sv); \ SvREFCNT_dec(sv); \ nsv; \ }) # else # if defined(USE_THREADS) static SV * newRV_noinc (SV * sv) { SV *nsv = (SV*)newRV(sv); SvREFCNT_dec(sv); return nsv; } # else # define newRV_noinc(sv) \ (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) # endif # endif #endif /* Provide: newCONSTSUB */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) #if defined(NEED_newCONSTSUB) static #else extern void newCONSTSUB(HV * stash, char * name, SV *sv); #endif #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) void newCONSTSUB(stash,name,sv) HV *stash; char *name; SV *sv; { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) /* before 5.003_22 */ start_subparse(), #else # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) /* 5.003_22 */ start_subparse(0), # else /* 5.003_23 onwards */ start_subparse(FALSE, 0), # endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* newCONSTSUB */ #ifndef START_MY_CXT /* * Boilerplate macros for initializing and accessing interpreter-local * data from C. All statics in extensions should be reworked to use * this, if you want to make the extension thread-safe. See ext/re/re.xs * for an example of the use of these macros. * * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. * 4. Use the MY_CXT_INIT macro such that it is called exactly once * (typically put in the BOOT: section). * 5. Use the members of the my_cxt_t structure everywhere as * MY_CXT.member. * 6. Use the dMY_CXT macro (a declaration) in all the functions that * access MY_CXT. */ #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ #define START_MY_CXT #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) #else /* >= perl5.004_68 */ #define dMY_CXT_SV \ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ sizeof(MY_CXT_KEY)-1, TRUE) #endif /* < perl5.004_68 */ /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ dMY_CXT_SV; \ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ dMY_CXT_SV; \ /* newSV() allocates one more than needed */ \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT * is used. Use is similar to pTHX, aTHX etc. */ #define pMY_CXT my_cxt_t *my_cxtp #define pMY_CXT_ pMY_CXT, #define _pMY_CXT ,pMY_CXT #define aMY_CXT my_cxtp #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT #else /* single interpreter */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP #define MY_CXT my_cxt #define pMY_CXT void #define pMY_CXT_ #define _pMY_CXT #define aMY_CXT #define aMY_CXT_ #define _aMY_CXT #endif #endif /* START_MY_CXT */ #ifndef IVdf # if IVSIZE == LONGSIZE # define IVdf "ld" # define UVuf "lu" # define UVof "lo" # define UVxf "lx" # define UVXf "lX" # else # if IVSIZE == INTSIZE # define IVdf "d" # define UVuf "u" # define UVof "o" # define UVxf "x" # define UVXf "X" # endif # endif #endif #ifndef NVef # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ # define NVef PERL_PRIeldbl # define NVff PERL_PRIfldbl # define NVgf PERL_PRIgldbl # else # define NVef "e" # define NVff "f" # define NVgf "g" # endif #endif #ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ # define AvFILLp AvFILL #endif #ifdef SvPVbyte # if PERL_REVISION == 5 && PERL_VERSION < 7 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ # undef SvPVbyte # define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) static char * my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); return SvPV(sv,*lp); } # endif #else # define SvPVbyte SvPV #endif #ifndef SvPV_nolen # define SvPV_nolen(sv) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX(sv) : sv_2pv_nolen(sv)) static char * sv_2pv_nolen(pTHX_ register SV *sv) { STRLEN n_a; return sv_2pv(sv, &n_a); } #endif #ifndef get_cv # define get_cv(name,create) perl_get_cv(name,create) #endif #ifndef get_sv # define get_sv(name,create) perl_get_sv(name,create) #endif #ifndef get_av # define get_av(name,create) perl_get_av(name,create) #endif #ifndef get_hv # define get_hv(name,create) perl_get_hv(name,create) #endif #ifndef call_argv # define call_argv perl_call_argv #endif #ifndef call_method # define call_method perl_call_method #endif #ifndef call_pv # define call_pv perl_call_pv #endif #ifndef call_sv # define call_sv perl_call_sv #endif #ifndef eval_pv # define eval_pv perl_eval_pv #endif #ifndef eval_sv # define eval_sv perl_eval_sv #endif #ifndef PERL_SCAN_GREATER_THAN_UV_MAX # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 #endif #ifndef PERL_SCAN_SILENT_ILLDIGIT # define PERL_SCAN_SILENT_ILLDIGIT 0x04 #endif #ifndef PERL_SCAN_ALLOW_UNDERSCORES # define PERL_SCAN_ALLOW_UNDERSCORES 0x01 #endif #ifndef PERL_SCAN_DISALLOW_PREFIX # define PERL_SCAN_DISALLOW_PREFIX 0x02 #endif #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) #define I32_CAST #else #define I32_CAST (I32*) #endif #ifndef grok_hex static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_hex(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_hex(string, len, flags, result) \ _grok_hex((string), (len), (flags), (result)) #endif #ifndef grok_oct static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_oct(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_oct(string, len, flags, result) \ _grok_oct((string), (len), (flags), (result)) #endif #if !defined(grok_bin) && defined(scan_bin) static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_bin(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_bin(string, len, flags, result) \ _grok_bin((string), (len), (flags), (result)) #endif #ifndef IN_LOCALE # define IN_LOCALE \ (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) #endif #ifndef IN_LOCALE_RUNTIME # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) #endif #ifndef IN_LOCALE_COMPILETIME # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) #endif #ifndef IS_NUMBER_IN_UV # define IS_NUMBER_IN_UV 0x01 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 # define IS_NUMBER_NOT_INT 0x04 # define IS_NUMBER_NEG 0x08 # define IS_NUMBER_INFINITY 0x10 # define IS_NUMBER_NAN 0x20 #endif #ifndef grok_numeric_radix # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send) #define grok_numeric_radix Perl_grok_numeric_radix bool Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) { #ifdef USE_LOCALE_NUMERIC #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) if (PL_numeric_radix_sv && IN_LOCALE) { STRLEN len; char* radix = SvPV(PL_numeric_radix_sv, len); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #else /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix * must manually be requested from locale.h */ #include struct lconv *lc = localeconv(); char *radix = lc->decimal_point; if (radix && IN_LOCALE) { STRLEN len = strlen(radix); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #endif /* PERL_VERSION */ #endif /* USE_LOCALE_NUMERIC */ /* always try "." if numeric radix didn't match because * we may have data from different locales mixed */ if (*sp < send && **sp == '.') { ++*sp; return TRUE; } return FALSE; } #endif /* grok_numeric_radix */ #ifndef grok_number #define grok_number Perl_grok_number int Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) { const char *s = pv; const char *send = pv + len; const UV max_div_10 = UV_MAX / 10; const char max_mod_10 = UV_MAX % 10; int numtype = 0; int sawinf = 0; int sawnan = 0; while (s < send && isSPACE(*s)) s++; if (s == send) { return 0; } else if (*s == '-') { s++; numtype = IS_NUMBER_NEG; } else if (*s == '+') s++; if (s == send) return 0; /* next must be digit or the radix separator or beginning of infinity */ if (isDIGIT(*s)) { /* UVs are at least 32 bits, so the first 9 decimal digits cannot overflow. */ UV value = *s - '0'; /* This construction seems to be more optimiser friendly. (without it gcc does the isDIGIT test and the *s - '0' separately) With it gcc on arm is managing 6 instructions (6 cycles) per digit. In theory the optimiser could deduce how far to unroll the loop before checking for overflow. */ if (++s < send) { int digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { /* Now got 9 digits, so need to check each time for overflow. */ digit = *s - '0'; while (digit >= 0 && digit <= 9 && (value < max_div_10 || (value == max_div_10 && digit <= max_mod_10))) { value = value * 10 + digit; if (++s < send) digit = *s - '0'; else break; } if (digit >= 0 && digit <= 9 && (s < send)) { /* value overflowed. skip the remaining digits, don't worry about setting *valuep. */ do { s++; } while (s < send && isDIGIT(*s)); numtype |= IS_NUMBER_GREATER_THAN_UV_MAX; goto skip_value; } } } } } } } } } } } } } } } } } } numtype |= IS_NUMBER_IN_UV; if (valuep) *valuep = value; skip_value: if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT; while (s < send && isDIGIT(*s)) /* optional digits after the radix */ s++; } } else if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ /* no digits before the radix means we need digits after it */ if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); if (valuep) { /* integer approximation is valid - it's 0. */ *valuep = 0; } } else return 0; } else if (*s == 'I' || *s == 'i') { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; s++; if (s < send && (*s == 'I' || *s == 'i')) { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; s++; if (s == send || (*s != 'T' && *s != 't')) return 0; s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; s++; } sawinf = 1; } else if (*s == 'N' || *s == 'n') { /* XXX TODO: There are signaling NaNs and quiet NaNs. */ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; sawnan = 1; } else return 0; if (sawinf) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; } else if (sawnan) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; } else if (s < send) { /* we can have an optional exponent part */ if (*s == 'e' || *s == 'E') { /* The only flag we keep is sign. Blow away any "it's UV" */ numtype &= IS_NUMBER_NEG; numtype |= IS_NUMBER_NOT_INT; s++; if (s < send && (*s == '-' || *s == '+')) s++; if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); } else return 0; } } while (s < send && isSPACE(*s)) s++; if (s >= send) return numtype; if (len == 10 && memEQ(pv, "0 but true", 10)) { if (valuep) *valuep = 0; return IS_NUMBER_IN_UV; } return 0; } #endif /* grok_number */ #ifndef PERL_MAGIC_sv # define PERL_MAGIC_sv '\0' #endif #ifndef PERL_MAGIC_overload # define PERL_MAGIC_overload 'A' #endif #ifndef PERL_MAGIC_overload_elem # define PERL_MAGIC_overload_elem 'a' #endif #ifndef PERL_MAGIC_overload_table # define PERL_MAGIC_overload_table 'c' #endif #ifndef PERL_MAGIC_bm # define PERL_MAGIC_bm 'B' #endif #ifndef PERL_MAGIC_regdata # define PERL_MAGIC_regdata 'D' #endif #ifndef PERL_MAGIC_regdatum # define PERL_MAGIC_regdatum 'd' #endif #ifndef PERL_MAGIC_env # define PERL_MAGIC_env 'E' #endif #ifndef PERL_MAGIC_envelem # define PERL_MAGIC_envelem 'e' #endif #ifndef PERL_MAGIC_fm # define PERL_MAGIC_fm 'f' #endif #ifndef PERL_MAGIC_regex_global # define PERL_MAGIC_regex_global 'g' #endif #ifndef PERL_MAGIC_isa # define PERL_MAGIC_isa 'I' #endif #ifndef PERL_MAGIC_isaelem # define PERL_MAGIC_isaelem 'i' #endif #ifndef PERL_MAGIC_nkeys # define PERL_MAGIC_nkeys 'k' #endif #ifndef PERL_MAGIC_dbfile # define PERL_MAGIC_dbfile 'L' #endif #ifndef PERL_MAGIC_dbline # define PERL_MAGIC_dbline 'l' #endif #ifndef PERL_MAGIC_mutex # define PERL_MAGIC_mutex 'm' #endif #ifndef PERL_MAGIC_shared # define PERL_MAGIC_shared 'N' #endif #ifndef PERL_MAGIC_shared_scalar # define PERL_MAGIC_shared_scalar 'n' #endif #ifndef PERL_MAGIC_collxfrm # define PERL_MAGIC_collxfrm 'o' #endif #ifndef PERL_MAGIC_tied # define PERL_MAGIC_tied 'P' #endif #ifndef PERL_MAGIC_tiedelem # define PERL_MAGIC_tiedelem 'p' #endif #ifndef PERL_MAGIC_tiedscalar # define PERL_MAGIC_tiedscalar 'q' #endif #ifndef PERL_MAGIC_qr # define PERL_MAGIC_qr 'r' #endif #ifndef PERL_MAGIC_sig # define PERL_MAGIC_sig 'S' #endif #ifndef PERL_MAGIC_sigelem # define PERL_MAGIC_sigelem 's' #endif #ifndef PERL_MAGIC_taint # define PERL_MAGIC_taint 't' #endif #ifndef PERL_MAGIC_uvar # define PERL_MAGIC_uvar 'U' #endif #ifndef PERL_MAGIC_uvar_elem # define PERL_MAGIC_uvar_elem 'u' #endif #ifndef PERL_MAGIC_vstring # define PERL_MAGIC_vstring 'V' #endif #ifndef PERL_MAGIC_vec # define PERL_MAGIC_vec 'v' #endif #ifndef PERL_MAGIC_utf8 # define PERL_MAGIC_utf8 'w' #endif #ifndef PERL_MAGIC_substr # define PERL_MAGIC_substr 'x' #endif #ifndef PERL_MAGIC_defelem # define PERL_MAGIC_defelem 'y' #endif #ifndef PERL_MAGIC_glob # define PERL_MAGIC_glob '*' #endif #ifndef PERL_MAGIC_arylen # define PERL_MAGIC_arylen '#' #endif #ifndef PERL_MAGIC_pos # define PERL_MAGIC_pos '.' #endif #ifndef PERL_MAGIC_backref # define PERL_MAGIC_backref '<' #endif #ifndef PERL_MAGIC_ext # define PERL_MAGIC_ext '~' #endif #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ File-ExtAttr-1.09/inc/0000755000076400007640000000000011154446426013137 5ustar richrichFile-ExtAttr-1.09/inc/Devel/0000755000076400007640000000000011154446426014176 5ustar richrichFile-ExtAttr-1.09/inc/Devel/CheckLib.pm0000644000076400007640000002017310760242114016171 0ustar richrich# $Id: CheckLib.pm,v 1.1 2008/02/24 10:17:48 richdawe Exp $ package Devel::CheckLib; use strict; use vars qw($VERSION @ISA @EXPORT); $VERSION = '0.3'; use Config; use File::Spec; use File::Temp; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(assert_lib check_lib_or_exit); # localising prevents the warningness leaking out of this module local $^W = 1; # use warnings is a 5.6-ism _findcc(); # bomb out early if there's no compiler =head1 NAME Devel::CheckLib - check that a library is available =head1 DESCRIPTION Devel::CheckLib is a perl module that checks whether a particular C library is available, and dies if it is not. =head1 SYNOPSIS # in a Makefile.PL or Build.PL use lib qw(inc); use Devel::CheckLib; check_lib_or_exit( lib => 'jpeg' ); check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] ); # or prompt for path to library and then do this: check_lib_or_exit( lib => 'jpeg', libpath => $additional_path ); =head1 HOW IT WORKS You pass named parameters to a function describing how to build and link to the library. Currently the only parameter supported is 'lib', which can be a string or an arrayref of several libraries. In the future, expect us to add something for checking that header files are available as well. It works by trying to compile this: int main(void) { return 0; } and linking it to the specified libraries. If something pops out the end which looks executable, then we know that it worked. =head1 FUNCTIONS All of these take the same named parameters and are exported by default. To avoid exporting them, C. =head2 assert_lib Takes several named parameters. The value of C must be either a string with the name of a single library or a reference to an array of strings of library names. Depending on the compiler found, library names will be fed to the compiler either as C<-l> arguments or as C<.lib> file names. (E.g. C<-ljpeg> or C) Likewise, C must if provided either be a string or an array of strings representing additional paths to search for libraries. C must be a C-style space-seperated list of libraries (each preceded by '-l') and directories (preceded by '-L'). This will die with an error message if any of the libraries listed can not be found. B: dying in a Makefile.PL or Build.PL may provoke a 'FAIL' report from CPAN Testers' automated smoke testers. Use C instead. =head2 check_lib_or_exit This behaves exactly the same as C except that instead of dieing, it warns (with exactly the same error message) and exits. This is intended for use in Makefile.PL / Build.PL when you might want to prompt the user for various paths and things before checking that what they've told you is sane. If a library isn't found, it exits with an exit value of 0 to avoid causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this result -- which is what you want if an external library dependency is not available. =cut sub check_lib_or_exit { eval 'assert_lib(@_)'; if($@) { warn $@; exit; } } sub assert_lib { my %args = @_; my (@libs, @libpaths); @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) if $args{lib}; @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) if $args{libpath}; # work-a-like for Makefile.PL's "LIBS" argument if(defined($args{LIBS})) { foreach my $arg (split(/\s+/, $args{LIBS})) { die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-l/i); push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2); } } my @cc = _findcc(); my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c', UNLINK => 1 ); print $ch "int main(void) { return 0; }\n"; close($ch); my @missing; for my $lib ( @libs ) { my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; my @libpath = map { q{/libpath:} . Win32::GetShortPathName($_) } @libpaths; @sys_cmd = (@cc, $cfile, "${lib}.lib", "/Fe$exefile", "/link", @libpath ); } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland my @libpath = map { "-L$_" } @libpaths; @sys_cmd = (@cc, "-o$exefile", "-l$lib", @libpath, $cfile); } else { # Unix-ish # gcc, Sun, AIX (gcc, cc) my @libpath = map { "-L$_" } @libpaths; @sys_cmd = (@cc, $cfile, "-o", "$exefile", "-l$lib", @libpath); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $lib if $rv != 0 || ! -x $exefile; _cleanup_exe($exefile); } unlink $cfile; my $miss_string = join( q{, }, map { qq{'$_'} } @missing ); die("Can't build and link to $miss_string\n") if @missing; } sub _cleanup_exe { my ($exefile) = @_; my $ofile = $exefile; $ofile =~ s/$Config{_exe}$/$Config{_o}/; unlink $exefile if -f $exefile; unlink $ofile if -f $ofile; unlink "$exefile\.manifest" if -f "$exefile\.manifest"; return } sub _findcc { my @paths = split(/$Config{path_sep}/, $ENV{PATH}); my @cc = split(/\s+/, $Config{cc}); return @cc if -x $cc[0]; foreach my $path (@paths) { my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe}; return ($compiler, @cc[1 .. $#cc]) if -x $compiler; } die("Couldn't find your C compiler\n"); } # code substantially borrowed from IPC::Run3 sub _quiet_system { my (@cmd) = @_; # save handles local *STDOUT_SAVE; local *STDERR_SAVE; open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT"; open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR"; # redirect to nowhere local *DEV_NULL; open DEV_NULL, ">" . File::Spec->devnull or die "CheckLib: $! opening handle to null device"; open STDOUT, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDOUT to null handle"; open STDERR, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDERR to null handle"; # run system command my $rv = system(@cmd); # restore handles open STDOUT, ">&" . fileno STDOUT_SAVE or die "CheckLib: $! restoring STDOUT handle"; open STDERR, ">&" . fileno STDERR_SAVE or die "CheckLib: $! restoring STDERR handle"; return $rv; } =head1 PLATFORMS SUPPORTED You must have a C compiler installed. We check for C<$Config{cc}>, both literally as it is in Config.pm and also in the $PATH. It has been tested with varying degrees on rigourousness on: =over =item gcc (on Linux, *BSD, Solaris, Cygwin) =item Sun's compiler tools on Solaris =item IBM's tools on AIX =item Microsoft's tools on Windows =item MinGW on Windows (with Strawberry Perl) =item Borland's tools on Windows =back =head1 WARNINGS, BUGS and FEEDBACK This is a very early release intended primarily for feedback from people who have discussed it. The interface may change and it has not been adequately tested. Feedback is most welcome, including constructive criticism. Bug reports should be made using L or by email. When submitting a bug report, please include the output from running: perl -V perl -MDevel::CheckLib =head1 SEE ALSO L =head1 AUTHORS David Cantrell Edavid@cantrell.org.ukE David Golden Edagolden@cpan.orgE Thanks to the cpan-testers-discuss mailing list for prompting us to write it in the first place; to Chris Williams for help with Borland support. =head1 COPYRIGHT and LICENCE Copyright 2007 David Cantrell. Portions copyright 2007 David Golden. This module is free-as-in-speech software, and may be used, distributed, and modified under the same conditions as perl itself. =head1 CONSPIRACY This module is also free-as-in-mason software. =cut 1; File-ExtAttr-1.09/extattr_bsd.h0000644000076400007640000000243610510305612015051 0ustar richrich#ifndef EXTATTR_BSD_H #define EXTATTR_BSD_H #include #include #include struct hv; int bsd_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int bsd_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int bsd_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int bsd_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int bsd_removexattr (const char *path, const char *attrname, struct hv *flags); int bsd_fremovexattr (const int fd, const char *attrname, struct hv *flags); ssize_t bsd_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t bsd_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags); ssize_t bsd_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t bsd_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags); #endif /* EXTATTR_BSD_H */ File-ExtAttr-1.09/Makefile.PL0000644000076400007640000000627111154445531014342 0ustar richrichuse lib qw(inc); use ExtUtils::MakeMaker; use Devel::CheckLib; use Cwd; use File::Temp qw/tempdir/; use IO::File; use strict; # Check whether we have and on Linux. # Suggest what the user needs to install, to get these files. if ($^O eq 'linux') { check_lib_or_exit( lib => [qw(attr)] ); } my @DIRS = qw(. /usr/include); if ($^O eq 'linux') { my %headers = ( 'attr/attributes.h' => 0, 'attr/xattr.h' => 0, ); my $incdir; my $missing = 0; foreach $incdir (@DIRS) { foreach (keys %headers) { $headers{$_}++ if (-r "$incdir/$_"); } } foreach (keys %headers) { if ($headers{$_} == 0) { warn "<$_> not found; perhaps you need to install libattr-devel"; $missing++; } } exit(0) if ($missing > 0); } # OpenBSD does not support extended attributes. if ($^O eq 'openbsd') { warn 'OpenBSD does not support extended attributes'; die "OS unsupported"; } # Check whether extended attributes are supported on this filesystem. # If we're running non-interactive there is no point failing all the tests, # because the machine is not set up correctly. if ($^O eq 'linux') { my $basedir = $ENV{ATTR_TEST_DIR} || getcwd(); my $template .= "$basedir/XXXXXXXX"; my $dir = tempdir($template, CLEANUP => 1); my $file = "$dir/testfile"; my $fh = new IO::File(">$file") or die "Unable to open $file: $!"; undef $fh; my $output = `setfattr -n user.foo -v foo $file 2>&1`; if ($output =~ /command not found/i) { warn "Please install the attr package (containing the setfattr program)"; exit(0) if ($ENV{AUTOMATED_TESTING}); } if ($output =~ /Operation not supported/i) { warn "To run the tests, you need mount the filesystem containing $basedir with the user_xattr option"; warn "Alternatively set the environment variable ATTR_TEST_DIR to point at a filesystem where user_xattr is enabled"; exit(0) if ($ENV{AUTOMATED_TESTING}); } } # TODO: Check filesystem on other operating systems # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'File::ExtAttr', VERSION_FROM => 'lib/File/ExtAttr.pm', # finds $VERSION PREREQ_PM => { # e.g., Module::Name => 1.1 'Carp' => 0, 'Scalar::Util' => 0 }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/File/ExtAttr.pm', # retrieve abstract from module AUTHOR => 'Kevin M. Goess ' .', Richard Dawe ') : ()), # Don't actually need -lattr on Linux. # LIBS => ['-lattr'], # e.g., '-lm' OBJECT => '$(O_FILES)', DEFINE => '', # e.g., '-DHAVE_SOMETHING' INC => join(' ', map { "-I$_" } @DIRS), # 'MYEXTLIB' => 'mylib/libxattrlib$(LIB_EXT)', # Un-comment this if you add C files to link with later: # OBJECT => '$(O_FILES)', # link all the C files too # Hand-roll META.yml and MANIFEST. NO_META => 1, ); File-ExtAttr-1.09/.cvsignore0000644000076400007640000000014410403112714014347 0ustar richrich.cvsignore Makefile blib const-c.inc const-xs.inc pm_to_blib ppport.h ExtAttr.bs ExtAttr.c *.tar.gz File-ExtAttr-1.09/flags.h0000644000076400007640000000121310510270402013610 0ustar richrich#ifndef EXTATTR_FLAGS_H #define EXTATTR_FLAGS_H #include struct hv; typedef enum { SET_CREATEIFNEEDED = 0, SET_CREATE, SET_REPLACE } File_ExtAttr_setflags_t; static const char NAMESPACE_KEY[] = "namespace"; static const char NAMESPACE_USER[] = "user"; static const char NAMESPACE_SYSTEM[] = "system"; static const char CREATE_KEY[] = "create"; static const char REPLACE_KEY[] = "replace"; File_ExtAttr_setflags_t File_ExtAttr_flags2setflags (struct hv *flags); int File_ExtAttr_valid_default_namespace (struct hv *flags); ssize_t File_ExtAttr_default_listxattrns (char *buf, const size_t buflen); #endif /* EXTATTR_FLAGS_H */ File-ExtAttr-1.09/TODO0000644000076400007640000000222111040335002013030 0ustar richrichtodo: * utf8 * check that partition supports it, especially in unit test * docs, explain user_xattr, mount -o remount * change to use section 2 calls instead of section 3 * buffer size, reuse buffer? * symbolic link handling (O_NOFOLLOW on Mac OS X) * Check it can be used with Perl 5.6.x * Test setting attributes on directories, as suggested at Brum.pm * Factor out common code from the tests * Refactor the buffer allocation into a common function in ExtAttr.xs * Remove dependency on libattr on Linux - just define ENOATTR -> ENODATA? (Feels a bit evil to do that.) * Unite somehow with File::Attributes (which is for file systems without xattrs)? * Document pre-reqs for test suite: Test::Distribution, Test::Pod::Coverage, Test::YAML::Meta. Include these in a .spec file that we can include with distro * Disallow nuls in the attribute names. The list handling will break if we allow this. (Alternative is to make the portable listxattr follow the BSD API, where the separator is a length byte.) * Support new extensible system attributes (and its API) on Solaris? See the PSARC referenced in the docs and its fgetattr, etc. implementation. File-ExtAttr-1.09/MANIFEST.SKIP0000644000076400007640000000031510660044475014262 0ustar richrichconst-c.inc const-xs.inc ExtAttr.bs ExtAttr.c ExtAttr.o extattr_bsd.o extattr_linux.o extattr_macosx.o extattr_solaris.o flags.o helpers.o CVS Makefile$ Makefile.old .cvsignore ^blib/ .tar.gz pm_to_blib File-ExtAttr-1.09/extattr_macosx.h0000644000076400007640000000273310510270402015571 0ustar richrich#ifndef EXTATTR_MACOSX_H #define EXTATTR_MACOSX_H #include #include struct hv; int macosx_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int macosx_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int macosx_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int macosx_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int macosx_removexattr (const char *path, const char *attrname, struct hv *flags); int macosx_fremovexattr (const int fd, const char *attrname, struct hv *flags); ssize_t macosx_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t macosx_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags); ssize_t macosx_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t macosx_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags); #endif /* EXTATTR_MACOSX_H */ File-ExtAttr-1.09/portable.h0000644000076400007640000001322310776112017014343 0ustar richrich#ifndef EXTATTR_PORTABLE_H #define EXTATTR_PORTABLE_H /* OS detection */ #include "extattr_os.h" struct hv; /* * Portable extattr functions. When these fail, they should return * -errno, i.e.: < 0 indicates failure. */ static inline int portable_setxattr (const char *path, const char *attrname, const void *attrvalue, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_setxattr(path, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_BSD) return bsd_setxattr(path, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_setxattr(path, attrname, attrvalue, slen, flags); #else return linux_setxattr(path, attrname, attrvalue, slen, flags); #endif } static inline int portable_fsetxattr (const int fd, const char *attrname, const void *attrvalue, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_fsetxattr(fd, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_BSD) return bsd_fsetxattr(fd, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_fsetxattr(fd, attrname, attrvalue, slen, flags); #else return linux_fsetxattr(fd, attrname, attrvalue, slen, flags); #endif } static inline int portable_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_getxattr(path, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_BSD) return bsd_getxattr(path, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_getxattr(path, attrname, attrvalue, slen, flags); #else return linux_getxattr(path, attrname, attrvalue, slen, flags); #endif } static inline int portable_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_fgetxattr(fd, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_BSD) return bsd_fgetxattr(fd, attrname, attrvalue, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_fgetxattr(fd, attrname, attrvalue, slen, flags); #else return linux_fgetxattr(fd, attrname, attrvalue, slen, flags); #endif } static inline ssize_t portable_lenxattr (const char *path, const char *attrname, struct hv *flags) { #ifdef EXTATTR_BSD /* XXX: flags? Namespace? */ return extattr_get_file(path, EXTATTR_NAMESPACE_USER, attrname, NULL, 0); #else /* XXX: Can BSD use this too? Maybe once namespacing sorted. */ return portable_getxattr(path, attrname, NULL, 0, flags); #endif } static inline int portable_flenxattr (int fd, const char *attrname, struct hv *flags) { #ifdef EXTATTR_BSD /* XXX: flags? Namespace? */ return extattr_get_fd(fd, EXTATTR_NAMESPACE_USER, attrname, NULL, 0); #else /* XXX: Can BSD use this too? Maybe once namespacing sorted. */ return portable_fgetxattr(fd, attrname, NULL, 0, flags); #endif } static inline int portable_removexattr (const char *path, const char *name, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_removexattr(path, name, flags); #elif defined(EXTATTR_BSD) return bsd_removexattr(path, name, flags); #elif defined(EXTATTR_SOLARIS) return solaris_removexattr(path, name, flags); #else return linux_removexattr(path, name, flags); #endif } static inline int portable_fremovexattr (const int fd, const char *name, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_fremovexattr(fd, name, flags); #elif defined(EXTATTR_BSD) return bsd_fremovexattr(fd, name, flags); #elif defined(EXTATTR_SOLARIS) return solaris_fremovexattr(fd, name, flags); #else return linux_fremovexattr(fd, name, flags); #endif } static inline int portable_listxattr(const char *path, char *buf, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_listxattr(path, buf, slen, flags); #elif defined(EXTATTR_BSD) return bsd_listxattr(path, buf, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_listxattr(path, buf, slen, flags); #else return linux_listxattr(path, buf, slen, flags); #endif } static inline int portable_flistxattr(const int fd, char *buf, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_flistxattr(fd, buf, slen, flags); #elif defined(EXTATTR_BSD) return bsd_flistxattr(fd, buf, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_flistxattr(fd, buf, slen, flags); #else return linux_flistxattr(fd, buf, slen, flags); #endif } static inline int portable_listxattrns(const char *path, char *buf, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_listxattrns(path, buf, slen, flags); #elif defined(EXTATTR_BSD) return bsd_listxattrns(path, buf, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_listxattrns(path, buf, slen, flags); #else return linux_listxattrns(path, buf, slen, flags); #endif } static inline int portable_flistxattrns(const int fd, char *buf, const size_t slen, struct hv *flags) { #ifdef EXTATTR_MACOSX return macosx_flistxattrns(fd, buf, slen, flags); #elif defined(EXTATTR_BSD) return bsd_flistxattrns(fd, buf, slen, flags); #elif defined(EXTATTR_SOLARIS) return solaris_flistxattrns(fd, buf, slen, flags); #else return linux_flistxattrns(fd, buf, slen, flags); #endif } #endif /* EXTATTR_PORTABLE_H */ File-ExtAttr-1.09/ExtAttr.xs0000644000076400007640000001537310776113026014342 0ustar richrich#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include "portable.h" #define MAX_INITIAL_VALUELEN_VARNAME "File::ExtAttr::MAX_INITIAL_VALUELEN" /* Richard, fixme! */ MODULE = File::ExtAttr PACKAGE = File::ExtAttr PROTOTYPES: ENABLE int _setfattr (path, attrname, attrvalueSV, flags = 0) const char *path const char *attrname SV * attrvalueSV HV * flags PREINIT: STRLEN slen; char * attrvalue; int rc; CODE: attrvalue = SvPV(attrvalueSV, slen); rc = portable_setxattr(path, attrname, attrvalue, slen, flags); if (rc < 0) errno = -rc; RETVAL = (rc == 0); OUTPUT: RETVAL int _fsetfattr (fd, attrname, attrvalueSV, flags = 0) int fd const char *attrname SV * attrvalueSV HV * flags PREINIT: STRLEN slen; char * attrvalue; int rc; CODE: attrvalue = SvPV(attrvalueSV, slen); rc = portable_fsetxattr(fd, attrname, attrvalue, slen, flags); if (rc < 0) errno = -rc; RETVAL = (rc == 0); OUTPUT: RETVAL SV * _getfattr(path, attrname, flags = 0) const char *path const char *attrname HV * flags PREINIT: char * attrvalue; int attrlen; ssize_t buflen; CODE: buflen = portable_lenxattr(path, attrname, flags); if (buflen <= 0) buflen = SvIV(get_sv(MAX_INITIAL_VALUELEN_VARNAME, FALSE)); attrvalue = NULL; Newz(1, attrvalue, buflen, char); attrlen = portable_getxattr(path, attrname, attrvalue, buflen, flags); if (attrlen < 0){ //key not found, just return undef if(errno == ENOATTR){ Safefree(attrvalue); errno = -attrlen; XSRETURN_UNDEF; //return undef }else{ Safefree(attrvalue); errno = -attrlen; XSRETURN_UNDEF; } } RETVAL = newSVpv(attrvalue, attrlen); Safefree(attrvalue); OUTPUT: RETVAL SV * _fgetfattr(fd, attrname, flags = 0) int fd const char *attrname HV * flags PREINIT: char * attrvalue; int attrlen; ssize_t buflen; CODE: buflen = portable_flenxattr(fd, attrname, flags); if (buflen <= 0) buflen = SvIV(get_sv(MAX_INITIAL_VALUELEN_VARNAME, FALSE)); attrvalue = NULL; Newz(1, attrvalue, buflen, char); attrlen = portable_fgetxattr(fd, attrname, attrvalue, buflen, flags); if (attrlen < 0){ //key not found, just return undef if(errno == ENOATTR){ Safefree(attrvalue); errno = -attrlen; XSRETURN_UNDEF; //return undef }else{ Safefree(attrvalue); errno = -attrlen; XSRETURN_UNDEF; } } RETVAL = newSVpv(attrvalue, attrlen); Safefree(attrvalue); OUTPUT: RETVAL int _delfattr (path, attrname, flags = 0) const char *path const char *attrname HV * flags PREINIT: int rc; CODE: rc = portable_removexattr(path, attrname, flags); if (rc < 0) errno = -rc; RETVAL = (rc == 0); OUTPUT: RETVAL int _fdelfattr (fd, attrname, flags = 0) int fd const char *attrname HV * flags PREINIT: int rc; CODE: rc = portable_fremovexattr(fd, attrname, flags); if (rc < 0) errno = -rc; RETVAL = (rc == 0); OUTPUT: RETVAL void _listfattr (path, fd, flags = 0) const char *path int fd HV * flags PREINIT: ssize_t size, ret; char *namebuf = NULL; char *nameptr; PPCODE: if(fd == -1) size = portable_listxattr(path, NULL, 0, flags); else size = portable_flistxattr(fd, NULL, 0, flags); if (size < 0) { errno = -(int) size; XSRETURN_UNDEF; } else if (size == 0) { XSRETURN_EMPTY; } namebuf = malloc(size); if (fd == -1) ret = portable_listxattr(path, namebuf, size, flags); else ret = portable_flistxattr(fd, namebuf, size, flags); // There could be a race condition here, if someone adds a new // attribute between the two listxattr calls. However it just means we // might return ERANGE. if (ret < 0) { free(namebuf); errno = -ret; XSRETURN_UNDEF; } else if (ret == 0) { free(namebuf); XSRETURN_EMPTY; } nameptr = namebuf; while(nameptr < namebuf + ret) { char *endptr = nameptr; while(*endptr++ != '\0'); // endptr will now point one past the end.. XPUSHs(sv_2mortal(newSVpvn(nameptr, endptr - nameptr - 1))); // nameptr could now point past the end of namebuf nameptr = endptr; } free(namebuf); void _listfattrns (path, fd, flags = 0) const char *path int fd HV * flags PREINIT: ssize_t size, ret; char *namebuf = NULL; char *nameptr; PPCODE: if(fd == -1) size = portable_listxattrns(path, NULL, 0, flags); else size = portable_flistxattrns(fd, NULL, 0, flags); if (size < 0) { errno = -(int) size; XSRETURN_UNDEF; } else if (size == 0) { XSRETURN_EMPTY; } namebuf = malloc(size); if (fd == -1) ret = portable_listxattrns(path, namebuf, size, flags); else ret = portable_flistxattrns(fd, namebuf, size, flags); // There could be a race condition here, if someone adds a new // attribute between the two listxattr calls. However it just means we // might return ERANGE. if (ret < 0) { free(namebuf); errno = -ret; XSRETURN_UNDEF; } else if (ret == 0) { free(namebuf); XSRETURN_EMPTY; } nameptr = namebuf; while(nameptr < namebuf + ret) { char *endptr = nameptr; while(*endptr++ != '\0'); // endptr will now point one past the end.. XPUSHs(sv_2mortal(newSVpvn(nameptr, endptr - nameptr - 1))); // nameptr could now point past the end of namebuf nameptr = endptr; } free(namebuf); File-ExtAttr-1.09/META.yml0000644000076400007640000000043311101344412013617 0ustar richrich# http://module-build.sourceforge.net/META-spec.html name: File-ExtAttr version: 1.09 version_from: lib/File/ExtAttr.pm installdirs: site requires: Carp: 0 Scalar::Util: 0 license: perl distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 File-ExtAttr-1.09/lib/0000755000076400007640000000000011154446426013134 5ustar richrichFile-ExtAttr-1.09/lib/File/0000755000076400007640000000000011154446426014013 5ustar richrichFile-ExtAttr-1.09/lib/File/ExtAttr.pm0000644000076400007640000002572711153672114015753 0ustar richrichpackage File::ExtAttr; =head1 NAME File::ExtAttr - Perl extension for accessing extended attributes of files =head1 SYNOPSIS use File::ExtAttr ':all'; use IO::File; # Manipulate the extended attributes of files. setfattr('foo.txt', 'colour', 'red') || die; my $colour = getfattr('bar.txt', 'colour'); if (defined($colour)) { print $colour; delfattr('bar.txt', 'colour'); } # Manipulate the extended attributes of a file via a file handle. my $fh = new IO::File(' $ns }); print join(',', @attrs)."\n"; } =head1 DESCRIPTION File::ExtAttr is a Perl module providing access to the extended attributes of files. Extended attributes are metadata associated with a file. Examples are access control lists (ACLs) and other security parameters. But users can add their own key=value pairs. Extended attributes may not be supported by your operating system. This module is aimed at Linux, Unix or Unix-like operating systems (e.g.: Mac OS X, FreeBSD, NetBSD, Solaris). Extended attributes may also not be supported by your filesystem or require special options to be enabled for a particular filesystem. E.g.: mount -o user_xattr /dev/hda1 /some/path =head2 Supported OSes =over 4 =item Linux =item Mac OS X =item FreeBSD 5.0 and later =item NetBSD 4.0 and later =item Solaris 10 and later =back =head2 Unsupported OSes =over 4 =item OpenBSD =back =head2 Namespaces Some implementations of extended attributes support namespacing. In those implementations, the attribute is referred to by namespace and attribute name. =over 4 =item Linux The primary namespaces are C for user programs; C, C and C for file security/access-control. See L for more details. Namespaces on Linux are described by a string, but only certain values are supported by filesystems. In general C, C, C and C are supported, by others may be supported -- e.g.: C on JFS. File::Extattr will be able to access any of these. =item FreeBSD, NetBSD *BSD have two namespaces: C and C. Namespaces on *BSD are described by an integer. File::ExtAttr will only be able to access attributes in C and C. =item Mac OS X OS X has no support for namespaces. =item Solaris Solaris has no support for namespaces. =back =head2 Flags The functions take a hash reference as their final parameter, which can specify flags to modify the behaviour of the functions. The flags specific to a function are documented in the function's description. All functions support a C flag. E.g.: use File::ExtAttr ':all'; use IO::File; # Manipulate the extended attributes of files. setfattr('foo.txt', 'colour', 'red') || die; my $colour = getfattr('bar.txt', 'colour', { namespace => 'user'); If no namespace is specified, the default namespace will be used. On Linux and *BSD the default namespace will be C. =cut use strict; use warnings; use Carp; use Scalar::Util; require Exporter; use AutoLoader; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use File::ExtAttr ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( getfattr setfattr delfattr listfattr listfattrns ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '1.09'; #this is used by getxattr(), needs documentation $File::ExtAttr::MAX_INITIAL_VALUELEN = 255; require XSLoader; XSLoader::load('File::ExtAttr', $VERSION); # Preloaded methods go here. =head1 METHODS =over 4 =cut sub _is_fh { my $file = shift; my $is_fh = 0; eval { # TODO: Does this work with Perl 5.005, 5.6.x? # Relies on autovivification of filehandles? $is_fh = 1 if ($file->isa('IO::Handle')); # TODO: Does this work with Perl 5.005, 5.6.x? # Better solution for detecting a file handle? $is_fh = 1 if (openhandle($file)); }; return $is_fh; } =item getfattr([$filename | $filehandle], $attrname, [\%flags]) Return the value of the attribute named C<$attrname> for the file named C<$filename> or referenced by the open filehandle C<$filehandle> (which should be an IO::Handle or subclass thereof). If no attribute is found, returns C. Otherwise gives a warning. =cut sub getfattr { my $file = shift; return _is_fh($file) # File handle ? _fgetfattr($file->fileno(), @_) # Filename : _getfattr($file, @_); } =item setfattr([$filename | $filehandle], $attrname, $attrval, [\%flags]) Set the attribute named C<$attrname> with the value C<$attrval> for the file named C<$filename> or referenced by the open filehandle C<$filehandle> (which should be an IO::Handle or subclass thereof). C<%flags> allows control of whether the attribute should be created or should replace an existing attribute's value. If the key C is true, setfattr will fail if the attribute already exists. If the key C is true, setfattr will fail if the attribute does not already exist. If neither is specified, then the attribute will be created (if necessary) or silently replaced. If the attribute could not be set, a warning is issued. Note that C cannot be implemented in a race-free manner on *BSD. If your code relies on the C behaviour, it may be insecure on *BSD. =cut sub setfattr { my ($file, $attrname, $attrval, $flagsref) = @_; die "Only one of the 'create' and 'replace' options can be passed to setfattr" if ($flagsref->{create} && $flagsref->{replace}); return _is_fh($file) # File handle ? _fsetfattr($file->fileno(), $attrname, $attrval, $flagsref) # Filename : _setfattr($file, $attrname, $attrval, $flagsref); } =item delfattr([$filename | $filehandle], $attrname, [\%flags]) Delete the attribute named C<$attrname> for the file named C<$filename> or referenced by the open filehandle C<$filehandle> (which should be an IO::Handle or subclass thereof). Returns true on success, otherwise false and a warning is issued. =cut sub delfattr { my $file = shift; return _is_fh($file) # File handle ? _fdelfattr($file->fileno(), @_) # Filename : _delfattr($file, @_); } =item listfattr([$filename | $filehandle], [\%flags]) Return an array of the attributes on the file named C<$filename> or referenced by the open filehandle C<$filehandle> (which should be an IO::Handle or subclass thereof). Returns undef on failure and $! will be set. =cut sub listfattr { my $file = shift; return _is_fh($file) # File handle ? _listfattr('', $file->fileno(), @_) # Filename : _listfattr($file, -1, @_); } =item listfattrns([$filename | $filehandle], [\%flags]) Return an array containing the namespaces of attributes on the file named C<$filename> or referenced by the open filehandle C<$filehandle> (which should be an IO::Handle or subclass thereof). Returns undef on failure and $! will be set. =cut sub listfattrns { my $file = shift; return _is_fh($file) # File handle ? _listfattrns('', $file->fileno(), @_) # Filename : _listfattrns($file, -1, @_); } =back =cut # TODO: l* functions =head1 EXPORT None by default. You can request that C, C, C and C be exported using the tag ":all". =head2 Exportable constants None =head1 BUGS You cannot set empty attributes on Mac OS X 10.4 and earlier. This is a bug in Darwin, rather than File::ExtAttr. =head1 SEE ALSO The latest version of this software should be available from its home page: L L provides access to extended attributes on OS/2. Eiciel, L, is an access control list (ACL) editor for GNOME; the ACLs are stored in extended attributes. Various low-level APIs exist for manipulating extended attributes: =over 4 =item Linux getattr(2), attr(5) L L =item OpenBSD OpenBSD 3.7 supported extended attributes, although support was never built into the default GENERIC kernel. Its support was documented in the C man page: L Support was removed in OpenBSD 3.8 -- see the CVS history for the include file C. L =item FreeBSD FreeBSD >= 5.0 supports extended attributes. extattr(2) L =item NetBSD NetBSD >= 3.0 supports extended attributes, but you'll need to use NetBSD >= 4.0 to get UFS filesystem support for them. L L =item Mac OS X getxattr(2) L L =item Solaris attropen(3C), fsattr(5) L L Solaris also has extensible system attributes, which are used by Solaris's CIFS support on ZFS, and have a confusingly similar name to extended file attributes. These system attributes are stored in extended file attributes called SUNWattr_ro and SUNWattr_rw. See PSARC 2007/315 for more details: L =back =head1 AUTHOR Kevin M. Goess, Ekgoess@ensenda.comE Richard Dawe, Erichdawe@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2005 by Kevin M. Goess Copyright (C) 2005, 2006, 2007, 2008 by Richard Dawe This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available. =cut 1; __END__ File-ExtAttr-1.09/lib/File/ExtAttr/0000755000076400007640000000000011154446426015406 5ustar richrichFile-ExtAttr-1.09/lib/File/ExtAttr/Tie.pm0000644000076400007640000000531310724067661016471 0ustar richrichpackage File::ExtAttr::Tie; =head1 NAME File::ExtAttr::Tie - Tie interface to extended attributes of files =head1 SYNOPSIS use File::ExtAttr::Tie; use Data::Dumper; tie %a, "File::ExtAttr::Tie", "/Applications (Mac OS 9)/Sherlock 2", { namespace => 'user' }; print Dumper \%a; produces: $VAR1 = { 'com.apple.FinderInfo' => 'APPLfndf!?', 'com.apple.ResourceFork' => '?p?p5I' }; =head1 DESCRIPTION File::ExtAttr::Tie provides access to extended attributes of a file through a tied hash. Creating a new key creates a new extended attribute associated with the file. Modifying the value or removing a key likewise modifies/removes the extended attribute. Internally this module uses the File::ExtAttr module. So it has the same restrictions as that module in terms of OS support. =head1 METHODS =over 4 =item tie "File::ExtAttr::Tie", $filename, [\%flags] The flags are the same optional flags as in File::ExtAttr. Any flags given here will be passed to all operations on the tied hash. Only the C flag makes sense. The hash will be tied to the default namespace, if no flags are given. =back =cut use strict; use base qw(Tie::Hash); use File::ExtAttr qw(:all); our $VERSION = '0.01'; sub TIEHASH { my($class, $file, $flags) = @_; my $self = bless { file => $file }, ref $class || $class; $self->{flags} = defined($flags) ? $flags : {}; return $self; } sub STORE { my($self, $name, $value) = @_; return undef unless setfattr($self->{file}, $name, $value, $self->{flags}); $value; } sub FETCH { my($self, $name) = @_; return getfattr($self->{file}, $name, $self->{flags}); } sub FIRSTKEY { my($self) = @_; $self->{each_list} = [listfattr($self->{file}, $self->{flags})]; shift @{$self->{each_list}}; } sub NEXTKEY { my($self) = @_; shift @{$self->{each_list}}; } sub EXISTS { my($self, $name) = @_; return getfattr($self->{file}, $name, $self->{flags}) ne undef; } sub DELETE { my($self, $name) = @_; # XXX: Race condition my $value = getfattr($self->{file}, $name, $self->{flags}); return $value if delfattr($self->{file}, $name, $self->{flags}); undef; } sub CLEAR { my($self) = @_; for(listfattr($self->{file})) { delfattr($self->{file}, $_, $self->{flags}); } } #sub SCALAR { } =head1 SEE ALSO L =head1 AUTHOR David Leadbeater, L Documentation by Richard Dawe, Erichdawe@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006 by David Leadbeater This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available. 1; __END__ File-ExtAttr-1.09/extattr_linux.c0000644000076400007640000002206610776112017015445 0ustar richrich#include "extattr_os.h" #ifdef EXTATTR_LINUX #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "flags.h" static void * memstr (void *buf, const char *str, const size_t buflen) { void *p = buf; size_t len = buflen; const size_t slen = strlen(str); /* Ignore empty strings and buffers. */ if ((slen == 0) || (buflen == 0)) p = NULL; while (p && (len >= slen)) { /* * Find the first character of the string, then see if the rest * matches. */ p = memchr(p, str[0], len); if (!p) break; if (memcmp(p, str, slen) == 0) break; /* Next! */ ++p; --len; } return p; } static char * flags2namespace (struct hv *flags) { const char *NAMESPACE_DEFAULT = NAMESPACE_USER; const size_t NAMESPACE_KEYLEN = strlen(NAMESPACE_KEY); SV **psv_ns; char *ns = NULL; if (flags && (psv_ns = hv_fetch(flags, NAMESPACE_KEY, NAMESPACE_KEYLEN, 0))) { char *s; STRLEN len; s = SvPV(*psv_ns, len); ns = malloc(len + 1); if (ns) { strncpy(ns, s, len); ns[len] = '\0'; } } else { ns = strdup(NAMESPACE_DEFAULT); } return ns; } static char * qualify_attrname (const char *attrname, struct hv *flags) { char *res = NULL; char *pNS; size_t reslen; pNS = flags2namespace(flags); if (pNS) { reslen = strlen(pNS) + strlen(attrname) + 2; /* pNS + "." + attrname + nul */ res = malloc(reslen); } if (res) snprintf(res, reslen, "%s.%s", pNS, attrname); if (pNS) free(pNS); return res; } int linux_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { int ret; char *q; File_ExtAttr_setflags_t setflags; int xflags = 0; setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: break; case SET_CREATE: xflags |= XATTR_CREATE; break; case SET_REPLACE: xflags |= XATTR_REPLACE; break; } q = qualify_attrname(attrname, flags); if (q) { ret = setxattr(path, q, attrvalue, slen, xflags); if (ret == -1) ret = -errno; free(q); } else { ret = -ENOMEM; } return ret; } int linux_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { int ret; char *q; File_ExtAttr_setflags_t setflags; int xflags = 0; setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: break; case SET_CREATE: xflags |= XATTR_CREATE; break; case SET_REPLACE: xflags |= XATTR_REPLACE; break; } q = qualify_attrname(attrname, flags); if (q) { ret = fsetxattr(fd, q, attrvalue, slen, xflags); if (ret == -1) ret = -errno; free(q); } else { ret = -ENOMEM; } return ret; } int linux_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int ret; char *q; q = qualify_attrname(attrname, flags); if (q) { ret = getxattr(path, q, attrvalue, slen); if (ret == -1) ret = -errno; free(q); } else { ret = -ENOMEM; } return ret; } int linux_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int ret; char *q; q = qualify_attrname(attrname, flags); if (q) { ret = fgetxattr(fd, q, attrvalue, slen); if (ret == -1) ret = -errno; free(q); } else { ret = -ENOMEM; } return ret; } int linux_removexattr (const char *path, const char *attrname, struct hv *flags) { int ret; char *q; /* XXX: Other flags? */ q = qualify_attrname(attrname, flags); if (q) { ret = removexattr(path, q); if (ret == -1) ret = -errno; free(q); } else { ret = -ENOMEM; } return ret; } int linux_fremovexattr (const int fd, const char *attrname, struct hv *flags) { int ret; char *q; /* XXX: Other flags? */ q = qualify_attrname(attrname, flags); if (q) { ret = fremovexattr(fd, q); if (ret == -1) ret = -errno; free(q); } else { ret = -ENOMEM; } return ret; } static ssize_t attrlist2list (char *sbuf, const size_t slen, char *buf, const size_t buflen, const int iWantNames, const char *pWantNS) { ssize_t sbuiltlen = 0; ssize_t spos = 0; int ret = -1; for (spos = 0; (spos < slen); ) { const char *psrc; char *pNS, *pname; int src_len; /* Get the namespace. */ pNS = &sbuf[spos]; pname = strchr(pNS, '.'); if (!pname) break; /* Point spos at the next attribute. */ spos += strlen(pNS) + 1; *pname = '\0'; ++pname; if (iWantNames) { psrc = pname; /* Name list wanted. Check this is in the right namespace. */ if (strcmp(pNS, pWantNS) != 0) continue; } else { psrc = pNS; /* * Namespace list wanted. Check we haven't already seen * this namespace. */ if (memstr(sbuf, pNS, sbuiltlen) != NULL) continue; } /* * We build the results in sbuf. So sbuf will contain the list * returned by listxattr and the list of namespaces. * We shift the namespaces from the list to the start of the buffer. */ src_len = strlen(psrc) + 1; memmove(&sbuf[sbuiltlen], psrc, src_len); sbuiltlen += src_len; } if (buflen == 0) { /* Return what space is required. */ ret = sbuiltlen; } else if (sbuiltlen <= buflen) { memcpy(buf, sbuf, sbuiltlen); ret = sbuiltlen; } else { ret = -ERANGE; } return ret; } /* XXX: More common code below */ /* XXX: Just return a Perl list? */ ssize_t linux_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags) { char *pNS; ssize_t ret = 0; pNS = flags2namespace(flags); if (!pNS) { ret = -ENOMEM; } /* * Get a buffer of nul-delimited "namespace.attribute"s, * then extract the attributes into buf. */ if (ret == 0) { ssize_t slen; slen = listxattr(path, buf, 0); if (slen == -1) { ret = -errno; } else if (slen >= 0) { char *sbuf; sbuf = malloc(slen); if (sbuf) { slen = listxattr(path, sbuf, slen); if (slen >= 0) { ret = attrlist2list(sbuf, slen, buf, buflen, 1, pNS); } else { ret = -errno; } } else { ret = -errno; slen = 0; } if (sbuf) free(sbuf); } } if (pNS) free(pNS); return ret; } ssize_t linux_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags) { char *pNS; ssize_t ret = 0; pNS = flags2namespace(flags); if (!pNS) { ret = -ENOMEM; } /* * Get a buffer of nul-delimited "namespace.attribute"s, * then extract the attributes into buf. */ if (ret == 0) { ssize_t slen; slen = flistxattr(fd, buf, 0); if (slen == -1) { ret = -errno; } else if (slen >= 0) { char *sbuf; sbuf = malloc(slen); if (sbuf) { slen = flistxattr(fd, sbuf, slen); if (slen >= 0) { ret = attrlist2list(sbuf, slen, buf, buflen, 1, pNS); } else { ret = -errno; } } else { ret = -errno; } if (sbuf) free(sbuf); } } if (pNS) free(pNS); return ret; } ssize_t linux_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags) { ssize_t slen; ssize_t ret; /* * Get a buffer of nul-delimited "namespace.attribute"s, * then extract the namespaces into buf. */ slen = listxattr(path, buf, 0); if (slen >= 0) { char *sbuf; sbuf = malloc(slen); if (sbuf) { slen = listxattr(path, sbuf, slen); if (slen >= 0) { ret = attrlist2list(sbuf, slen, buf, buflen, 0, NULL); } else { ret = -errno; } } else { ret = -errno; } if (sbuf) free(sbuf); } else { ret = -errno; } return ret; } ssize_t linux_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags) { ssize_t slen; ssize_t ret; /* * Get a buffer of nul-delimited "namespace.attribute"s, * then extract the namespaces into buf. */ slen = flistxattr(fd, buf, 0); if (slen >= 0) { char *sbuf; sbuf = malloc(slen); if (sbuf) { slen = flistxattr(fd, sbuf, slen); if (slen >= 0) { ret = attrlist2list(sbuf, slen, buf, buflen, 0, NULL); } else { ret = -errno; } } else { ret = -errno; } if (sbuf) free(sbuf); } else { ret = -errno; } return ret; } #endif /* EXTATTR_LINUX */ File-ExtAttr-1.09/MANIFEST0000644000076400007640000000136211040335002013476 0ustar richrichChanges inc/Devel/CheckLib.pm Makefile.PL MANIFEST MANIFEST.SKIP ppport.h README TODO ExtAttr.xs typemap portable.h flags.c flags.h extattr_bsd.h extattr_bsd.c extattr_linux.h extattr_linux.c extattr_macosx.h extattr_macosx.c extattr_os.h extattr_solaris.h extattr_solaris.c t/lib/t/Support.pm t/00load.t t/01distribution.t t/02load-all.t t/03pod-coverage.t t/04yaml-meta.t t/11basic.t t/12empty.t t/13long.t t/14optional.t t/15create.t t/16replace.t t/17createreplace.t t/18list.t t/20tie-basic.t t/22tie-nonuser.t t/30nsbasic.t t/31nsmultiple.t t/32nsnonuser.t t/33nslong.t t/39nsempty.t t/80memleakget.t t/81closed.t lib/File/ExtAttr.pm lib/File/ExtAttr/Tie.pm META.yml Module meta-data (added by MakeMaker) .cvsignore File-ExtAttr-1.09/extattr_solaris.h0000644000076400007640000000312410510267042015754 0ustar richrich#ifndef EXTATTR_SOLARIS_H #define EXTATTR_SOLARIS_H #include #include #include /* * XXX: FIXME: Need to distinguish file non-existence and attribute * non-existence. Need to choose an unused error code somehow. */ #ifndef ENOATTR #define ENOATTR ENOENT #endif struct hv; int solaris_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int solaris_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int solaris_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int solaris_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int solaris_removexattr (const char *path, const char *attrname, struct hv *flags); int solaris_fremovexattr (const int fd, const char *attrname, struct hv *flags); ssize_t solaris_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t solaris_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags); ssize_t solaris_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t solaris_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags); #endif /* EXTATTR_SOLARIS_H */ File-ExtAttr-1.09/extattr_linux.h0000644000076400007640000000340010507722036015441 0ustar richrich#ifndef EXTATTR_LINUX_H #define EXTATTR_LINUX_H #include #include #include struct hv; int linux_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int linux_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags); int linux_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int linux_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags); int linux_removexattr (const char *path, const char *attrname, struct hv *flags); int linux_fremovexattr (const int fd, const char *attrname, struct hv *flags); ssize_t linux_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t linux_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags); ssize_t linux_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags); ssize_t linux_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags); #endif /* EXTATTR_LINUX_H */ File-ExtAttr-1.09/extattr_os.h0000644000076400007640000000125610713305032014722 0ustar richrich#ifndef EXTATTR_OS_H #define EXTATTR_OS_H /* OS detection */ #include #if defined(__MACH__) && defined(__APPLE__) #define EXTATTR_MACOSX #endif #if defined(BSD) && !defined(EXTATTR_MACOSX) #define EXTATTR_BSD #endif #if defined(sun) || defined(__sun) #if defined(__SVR4) || defined(__svr4__) #define EXTATTR_SOLARIS #endif #endif #if defined(linux) #define EXTATTR_LINUX #endif /* Include appropriate header for this OS, defaulting to Linux-style */ #if defined(EXTATTR_BSD) #include "extattr_bsd.h" #elif defined(EXTATTR_MACOSX) #include "extattr_macosx.h" #elif defined(EXTATTR_SOLARIS) #include "extattr_solaris.h" #else #include "extattr_linux.h" #endif #endif File-ExtAttr-1.09/typemap0000644000076400007640000000005510732767545014001 0ustar richrich# basic C types const char * T_PV File-ExtAttr-1.09/README0000644000076400007640000000375211101344412013235 0ustar richrichFile-ExtAttr version 1.09 ========================= File::ExtAttr is a Perl module providing access to the extended attributes of files. Extended attributes are metadata associated with a file. Examples are access control lists (ACLs) and other security parameters. But users can add their own key=value pairs. Extended attributes may not be supported by your operating system. This module is aimed at Linux, Unix or Unix-like operating systems (e.g.: Mac OS X, FreeBSD, NetBSD). Extended attributes may also not be supported by your filesystem or require special options to be enabled for a particular filesystem (e.g. "mount -o user_xattr /dev/hda1 /some/path"). Please see the POD documentation for more detailed information ("perldoc File::ExtAttr"). INSTALLATION To install this module type the following: perl Makefile.PL make make test make install Installation requires a C compiler. "make test" will fail if the filesystem you are building and running the test suite does not support extended attributes. You can use the "ATTR_TEST_DIR" environment variable to make the test suite use a different file system, e.g.: mkdir -p /path/to/somewhere/with/extattr/test-dir export ATTR_TEST_DIR=/path/to/somewhere/with/extattr/test-dir make test DEPENDENCIES On Linux, you will need to install the package that provides the header files and . On Fedora you can install these as follows: yum -y install libattr-devel This module requires these other modules: Carp Scalar::Util This module's test suite is enhanced by the presence of the following modules: Test::Distribution Test::Pod File::Find::Rule Module::CoreList COPYRIGHT AND LICENCE Copyright (C) 2005 by Kevin M. Goess Copyright (C) 2005, 2006, 2007, 2008 by Richard Dawe This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available. File-ExtAttr-1.09/extattr_macosx.c0000644000076400007640000001133711007027305015570 0ustar richrich#include "extattr_os.h" #ifdef EXTATTR_MACOSX #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "flags.h" int macosx_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { int ok = 1; File_ExtAttr_setflags_t setflags = 0; int xflags = 0; int ret = -1; setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: break; case SET_CREATE: xflags |= XATTR_CREATE; break; case SET_REPLACE: xflags |= XATTR_REPLACE; break; } if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = setxattr(path, attrname, attrvalue, slen, 0, xflags); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } int macosx_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { int ok = 1; File_ExtAttr_setflags_t setflags; int xflags = 0; int ret = -1; setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: break; case SET_CREATE: xflags |= XATTR_CREATE; break; case SET_REPLACE: xflags |= XATTR_REPLACE; break; } if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = fsetxattr(fd, attrname, attrvalue, slen, 0, xflags); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } int macosx_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int ok = 1; int xflags = 0; int ret = -1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = getxattr(path, attrname, attrvalue, slen, 0, xflags); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } int macosx_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int ok = 1; int xflags = 0; int ret = -1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = fgetxattr(fd, attrname, attrvalue, slen, 0, xflags); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } int macosx_removexattr (const char *path, const char *attrname, struct hv *flags) { int ok = 1; int xflags = 0; int ret = -1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = removexattr(path, attrname, xflags); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } int macosx_fremovexattr (const int fd, const char *attrname, struct hv *flags) { int ok = 1; int xflags = 0; int ret = -1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = fremovexattr(fd, attrname, xflags); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } ssize_t macosx_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags) { int ok = 1; int ret = -1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = listxattr(path, buf, buflen, 0 /* XXX: flags? */); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } ssize_t macosx_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags) { int ok = 1; int ret = -1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ret = -errno; ok = 0; } if (ok) { ret = flistxattr(fd, buf, buflen, 0 /* XXX: flags? */); if (ret < 0) { ret = -errno; ok = 0; } } return ret; } ssize_t macosx_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags) { ssize_t ret = listxattr(path, NULL, 0, 0 /* XXX: flags? */); if (ret > 0) { ret = File_ExtAttr_default_listxattrns(buf, buflen); } else if (ret < 0) { ret = -errno; } return ret; } ssize_t macosx_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags) { ssize_t ret = flistxattr(fd, NULL, 0, 0 /* XXX: flags? */); if (ret > 0) { ret = File_ExtAttr_default_listxattrns(buf, buflen); } else if (ret < 0) { ret = -errno; } return ret; } #endif /* EXTATTR_MACOSX */ File-ExtAttr-1.09/extattr_solaris.c0000644000076400007640000002030111153667427015762 0ustar richrich#include "extattr_os.h" #ifdef EXTATTR_SOLARIS #include #include #include #include #include #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "flags.h" static const mode_t ATTRMODE = S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP; static int writexattr (const int attrfd, const char *attrvalue, const size_t slen) { int ok = 1; if (ftruncate(attrfd, 0) == -1) ok = 0; if (ok && (write(attrfd, attrvalue, slen) != slen)) ok = 0; return ok ? 0 : -errno; } static int readclose (const int attrfd, void *attrvalue, const size_t slen) { int sz = 0; int saved_errno = 0; int ok = 1; if (attrfd == -1) ok = 0; if (ok) { if (slen) { sz = read(attrfd, attrvalue, slen); } else { /* Request to see how much data is there. */ struct stat sbuf; if (fstat(attrfd, &sbuf) == 0) sz = sbuf.st_size; else sz = -1; } if (sz == -1) ok = 0; } if (!ok) saved_errno = errno; if ((attrfd >= 0) && (close(attrfd) == -1) && !saved_errno) saved_errno = errno; if (saved_errno) errno = saved_errno; return ok ? sz : -errno; } static int unlinkclose (const int attrdirfd, const char *attrname) { int sz = 0; int saved_errno = 0; int ok = 1; if (attrdirfd == -1) ok = 0; if (ok && (unlinkat(attrdirfd, attrname, 0) == -1)) ok = 0; if (!ok) saved_errno = errno; if ((attrdirfd >= 0) && (close(attrdirfd) == -1) && !saved_errno) saved_errno = errno; if (saved_errno) errno = saved_errno; return ok ? sz : -errno; } static ssize_t listclose (const int attrdirfd, char *buf, const size_t buflen) { int saved_errno = 0; int ok = 1; ssize_t len = 0; DIR *dirp; if (attrdirfd == -1) ok = 0; if (ok) { dirp = fdopendir(attrdirfd); if (dirp == NULL) { ok = 0; } } if (ok) { struct dirent *de; while ((de = readdir(dirp))) { const size_t namelen = strlen(de->d_name); /* Ignore "." and ".." entries */ if (!strcmp(de->d_name, ".") || !strcmp(de->d_name, "..")) continue; if (buflen) { /* Check for space, then copy directory name + nul into list. */ if ((len + namelen + 1) > buflen) { saved_errno = errno = ERANGE; ok = 0; break; } else { strcpy(buf + len, de->d_name); len += namelen; buf[len] = '\0'; ++len; } } else { /* Seeing how much space is needed? */ len += namelen + 1; } } } if (!ok) saved_errno = errno; if ((attrdirfd >= 0) && (close(attrdirfd) == -1) && !saved_errno) saved_errno = errno; if (dirp && (closedir(dirp) == -1) && !saved_errno) saved_errno = errno; if (saved_errno) errno = saved_errno; return ok ? len : -errno; } static int hasattrclose (const int attrdirfd) { int saved_errno = 0; int ret = 0; /* Not by default */ DIR *dirp = NULL; if (attrdirfd == -1) ret = -1; if (ret >= 0) { dirp = fdopendir(attrdirfd); if (dirp == NULL) { ret = -1; } } if (ret >= 0) { struct dirent *de; while ((de = readdir(dirp))) { /* Ignore "." and ".." entries */ if (!strcmp(de->d_name, ".") || !strcmp(de->d_name, "..")) continue; /* Found a file */ ret = 1; break; } } if (ret == -1) saved_errno = errno; if ((attrdirfd >= 0) && (close(attrdirfd) == -1) && !saved_errno) saved_errno = errno; if (dirp && (closedir(dirp) == -1) && !saved_errno) saved_errno = errno; if (saved_errno) errno = saved_errno; return (ret >= 0) ? ret : -errno; } int solaris_setxattr (const char *path, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { /* XXX: Support overwrite/no overwrite flags */ int saved_errno = 0; int ok = 1; File_ExtAttr_setflags_t setflags; int openflags = O_RDWR; int attrfd = -1; setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: openflags |= O_CREAT; break; case SET_CREATE: openflags |= O_CREAT | O_EXCL; break; case SET_REPLACE: break; } if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ok = 0; } if (ok) attrfd = attropen(path, attrname, openflags, ATTRMODE); /* XXX: More common code? */ if (ok && (attrfd == -1)) ok = 0; if (ok && (writexattr(attrfd, attrvalue, slen) == -1)) ok = 0; if (!ok) saved_errno = errno; if ((attrfd >= 0) && (close(attrfd) == -1) && !saved_errno) saved_errno = errno; if (saved_errno) errno = saved_errno; return ok ? 0 : -errno; } int solaris_fsetxattr (const int fd, const char *attrname, const char *attrvalue, const size_t slen, struct hv *flags) { /* XXX: Support overwrite/no overwrite flags */ int saved_errno = 0; int ok = 1; int openflags = O_RDWR | O_XATTR; File_ExtAttr_setflags_t setflags; int attrfd = -1; setflags = File_ExtAttr_flags2setflags(flags); switch (setflags) { case SET_CREATEIFNEEDED: openflags |= O_CREAT; break; case SET_CREATE: openflags |= O_CREAT | O_EXCL; break; case SET_REPLACE: break; } if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ok = 0; } if (ok) attrfd = openat(fd, attrname, openflags, ATTRMODE); /* XXX: More common code? */ if (ok && (attrfd == -1)) ok = 0; if (ok && (writexattr(attrfd, attrvalue, slen) == -1)) ok = 0; if (!ok) saved_errno = errno; if ((attrfd >= 0) && (close(attrfd) == -1) && !saved_errno) saved_errno = errno; if (saved_errno) errno = saved_errno; return ok ? 0 : -errno; } int solaris_getxattr (const char *path, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int attrfd = -1; int ok = 1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ok = 0; } if (ok) attrfd = attropen(path, attrname, O_RDONLY); return ok ? readclose(attrfd, attrvalue, slen) : -errno; } int solaris_fgetxattr (const int fd, const char *attrname, void *attrvalue, const size_t slen, struct hv *flags) { int attrfd = -1; int ok = 1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ok = 0; } if (ok) attrfd = openat(fd, attrname, O_RDONLY|O_XATTR); return ok ? readclose(attrfd, attrvalue, slen) : -errno; } int solaris_removexattr (const char *path, const char *attrname, struct hv *flags) { int attrdirfd = -1; int ok = 1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ok = 0; } if (ok) attrdirfd = attropen(path, ".", O_RDONLY); return ok ? unlinkclose(attrdirfd, attrname) : -errno; } int solaris_fremovexattr (const int fd, const char *attrname, struct hv *flags) { int attrdirfd = -1; int ok = 1; if (!File_ExtAttr_valid_default_namespace(flags)) { errno = EOPNOTSUPP; ok = 0; } if (ok) attrdirfd = openat(fd, ".", O_RDONLY|O_XATTR); return ok ? unlinkclose(attrdirfd, attrname) : -errno; } ssize_t solaris_listxattr (const char *path, char *buf, const size_t buflen, struct hv *flags) { int attrdirfd = attropen(path, ".", O_RDONLY); return listclose(attrdirfd, buf, buflen); } ssize_t solaris_flistxattr (const int fd, char *buf, const size_t buflen, struct hv *flags) { int attrdirfd = openat(fd, ".", O_RDONLY|O_XATTR); return listclose(attrdirfd, buf, buflen); } ssize_t solaris_listxattrns (const char *path, char *buf, const size_t buflen, struct hv *flags) { int attrdirfd; ssize_t ret; attrdirfd = attropen(path, ".", O_RDONLY); ret = hasattrclose(attrdirfd); if (ret > 0) ret = File_ExtAttr_default_listxattrns(buf, buflen); return ret; } ssize_t solaris_flistxattrns (const int fd, char *buf, const size_t buflen, struct hv *flags) { int attrdirfd; ssize_t ret; attrdirfd = openat(fd, ".", O_RDONLY|O_XATTR); ret = hasattrclose(attrdirfd); if (ret > 0) ret = File_ExtAttr_default_listxattrns(buf, buflen); return ret; } #endif /* EXTATTR_SOLARIS */ File-ExtAttr-1.09/t/0000755000076400007640000000000011154446426012631 5ustar richrichFile-ExtAttr-1.09/t/11basic.t0000755000076400007640000000453210776112017014243 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 12; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($_, "$key", $val) or die "setfattr failed on filename $_: $!"; #set it is (setfattr($_, "$key", $val), 1); #read it back is (getfattr($_, "$key"), $val); #delete it ok (delfattr($_, "$key")); #check that it's gone is (getfattr($_, "$key"), undef); #} } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($fh, "$key", $val) or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; #set it is (setfattr($fh, "$key", $val), 1); #read it back is (getfattr($fh, "$key"), $val); #delete it ok (delfattr($fh, "$key")); #check that it's gone is (getfattr($fh, "$key"), undef); #} #print STDERR "done\n"; #; # todo: Add support for IO::Dir handles, and test here. END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/02load-all.t0000755000076400007640000000021110614310725014632 0ustar richrich#!perl -w use strict; use Test::More tests => 2; BEGIN { use_ok( 'File::ExtAttr', ':all' ); use_ok( 'File::ExtAttr::Tie' ); } File-ExtAttr-1.09/t/15create.t0000755000076400007640000000424010776112020014417 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; use Errno; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 16; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #create it is (setfattr($_, "$key", $val, { create => 1 }), 1); #create it again -- should fail is (setfattr($_, "$key", $val, { create => 1 }), 0); #read it back is (getfattr($_, "$key"), $val); #delete it ok (delfattr($_, "$key")); #check that it's gone is (getfattr($_, "$key"), undef); } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #create it is (setfattr($fh, "$key", $val, { create => 1 }), 1); #create it again -- should fail my $ret = setfattr($fh, "$key", $val, { create => 1 }); my $err = int $!; is ($ret, 0); is ($err, $!{EEXIST}); #read it back is (getfattr($fh, "$key"), $val); #delete it ok (delfattr($fh, "$key")); #check that it's gone is (getfattr($fh, "$key"), undef); END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/22tie-nonuser.t0000755000076400007640000000435211040335003015417 0ustar richrich#!perl -w use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 40; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr::Tie; use File::ExtAttr qw(getfattr); my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } foreach ( $filename, $dirname ) { print "# using $_\n"; my %extattr; my @ks; tie %extattr, 'File::ExtAttr::Tie', $_, { namespace => 'nonuser' }; # ok()? # Check there are no user extattrs. @ks = keys(%extattr); @ks = t::Support::filter_system_attrs(@ks); ok(scalar(@ks) == 0); # Test multiple attributes. my %test_attrs = ( 'foo' => '123', 'bar' => '456' ); my $k; my $err; foreach $k (sort(keys(%test_attrs))) { my $v = $test_attrs{$k}; # Check that creation works. $extattr{$k} = $v; $err = int $!; is ($err, $!{EOPNOTSUPP}); is(getfattr($_, "$k"), undef); # Check that updating works. $extattr{$k} = "$v$v"; $err = int $!; is ($err, $!{EOPNOTSUPP}); is(getfattr($_, "$k"), undef); $extattr{$k} = $v; $err = int $!; is ($err, $!{EOPNOTSUPP}); is(getfattr($_, "$k"), undef); # Check that deletion works. delete $extattr{$k}; is(getfattr($_, "$k"), undef); } # Recreate the keys and check that they're all in the hash. foreach $k (sort(keys(%test_attrs))) { my $v = $test_attrs{$k}; # Check that creation works. $extattr{$k} = $v; $err = int $!; is ($err, $!{EOPNOTSUPP}); is(getfattr($_, "$k"), undef); } # Check there are only our extattrs. @ks = keys(%extattr); @ks = t::Support::filter_system_attrs(@ks); ok(scalar(@ks) == 0); print '# '.join(' ', @ks)."\n"; } END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/14optional.t0000755000076400007640000000306110776112020015000 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ######################### # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 8; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; foreach ( $filename, $dirname ) { print "# using $_\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($_, "$key", $val) or die "setfattr failed on $_: $!"; #set it is (setfattr($_, "$key", $val), 1); #read it back is (getfattr($_, "$key"), $val); #delete it ok (delfattr($_, "$key")); #check that it's gone is (getfattr($_, "$key"), undef); #} } END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/17createreplace.t0000755000076400007640000000365010776112020015761 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 6; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #create and replace it -- should fail undef $@; eval { setfattr($_, "$key", $val, { create => 1, replace => 1 }); }; isnt ($@, undef); #check that it's not been created is (getfattr($_, "$key"), undef); } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; my $key2 = $key.'2'; #create and replace it -- should fail undef $@; eval { setfattr($fh, $key2, $val, { create => 1, replace => 1 }); }; isnt ($@, undef); #check that it's not been created is (getfattr($fh, $key2), undef); END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/20tie-basic.t0000755000076400007640000000375111040335003015007 0ustar richrich#!perl -w use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 24; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr::Tie; use File::ExtAttr qw(getfattr); my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } foreach ( $filename, $dirname ) { print "# using $_\n"; my %extattr; my @ks; tie %extattr, 'File::ExtAttr::Tie', $_; # ok()? # Check there are no user extattrs. @ks = keys(%extattr); @ks = t::Support::filter_system_attrs(@ks); ok(scalar(@ks) == 0); # Test multiple attributes. my %test_attrs = ( 'foo' => '123', 'bar' => '456' ); my $k; foreach $k (sort(keys(%test_attrs))) { my $v = $test_attrs{$k}; # Check that creation works. $extattr{$k} = $v; is(getfattr($_, "$k"), $v); # Check that updating works. $extattr{$k} = "$v$v"; is(getfattr($_, "$k"), "$v$v"); $extattr{$k} = $v; is(getfattr($_, "$k"), $v); # Check that deletion works. delete $extattr{$k}; is(getfattr($_, "$k"), undef); } # Recreate the keys and check that they're all in the hash. foreach $k (sort(keys(%test_attrs))) { my $v = $test_attrs{$k}; # Check that creation works. $extattr{$k} = $v; is(getfattr($_, "$k"), $v); } # Check there are only our extattrs. @ks = keys(%extattr); @ks = t::Support::filter_system_attrs(@ks); ok(scalar(@ks) == scalar(keys(%test_attrs))); print '# '.join(' ', @ks)."\n"; } END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/80memleakget.t0000755000076400007640000000430110776112020015267 0ustar richrich#!perl -w use strict; use Test::More; # DEBUG: When debugging with valgrind or top, uncomment this stub for is(). # Otherwise the test results will be stored by Test::More, "distorting" # the picture of memory usage -- it will include the memory usage # of both File::ExtAttr and Test::More. # # sub is {} BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 6000; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { die "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; my $key2 = $key.'2'; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; setfattr($_, $key, $val) or die "setfattr failed on filename $_: $!"; for (my $i = 0; $i < 1000; $i++) { # Check for the existing attribute. is(getfattr($_, $key), $val); # Check for the non-existing attribute. is(getfattr($_, $key2), undef); } # DEBUG: Uncomment when debugging. #sleep(5); } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; setfattr($fh, $key, $val) or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; for (my $i = 0; $i < 1000; $i++) { # Check for the existing attribute. is(getfattr($fh, $key), $val); # Check for the non-existing attribute. is(getfattr($fh, $key2), undef); } # DEBUG: Uncomment when debugging. #sleep(5); END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/39nsempty.t0000755000076400007640000000454610776112020014672 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # Test an explicitly empty namespace use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 18; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #set it - should fail my $ret = setfattr($_, "$key", $val, { namespace => '' }); my $err = int $!; is ($ret, 0); is ($err, $!{EOPNOTSUPP}); #read it back - should be missing is (getfattr($_, "$key", { namespace => '' }), undef); #delete it - should fail $ret = delfattr($_, "$key", { namespace => '' }); $err = int $!; is ($ret, 0); is ($err, $!{EOPNOTSUPP}); #check that it's gone is (getfattr($_, "$key", { namespace => '' }), undef); } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; my $ret = setfattr($fh, "$key", $val, { namespace => '' }); my $err = int $!; is ($ret, 0); is ($err, $!{EOPNOTSUPP}); #read it back - should be missing is (getfattr($fh, "$key", { namespace => '' }), undef); #delete it - should fail $ret = delfattr($fh, "$key", { namespace => '' }); $err = int $!; is ($ret, 0); is ($err, $!{EOPNOTSUPP}); #check that it's gone is (getfattr($fh, "$key", { namespace => '' }), undef); END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/12empty.t0000755000076400007640000000467511153672114014330 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; use Config; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } elsif (($Config{osname} eq 'darwin') && ($Config{osvers} =~ m/^[0-8]\./)) { plan skip_all => "Mac OS X 10.4 and earlier don't support empty values"; } else { plan tests => 12; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = ''; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($_, "$key", $val) or die "setfattr failed on filename $_: $!"; #set it is (setfattr($_, "$key", $val), 1); #read it back is (getfattr($_, "$key"), $val); #delete it ok (delfattr($_, "$key")); #check that it's gone is (getfattr($_, "$key"), undef); #} } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($fh, "$key", $val) or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; #set it is (setfattr($fh, "$key", $val), 1); #read it back is (getfattr($fh, "$key"), $val); #delete it ok (delfattr($fh, "$key")); #check that it's gone is (getfattr($fh, "$key"), undef); #} #print STDERR "done\n"; #; # todo: Add support for IO::Dir handles, and test here. END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/13long.t0000755000076400007640000000702710776112017014125 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ######################### # change 'tests => 2' to 'tests => last_test_to_print'; # XXX: Refactor the common bits between this and 11basic.t # into Test::Class classes? use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 24; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $longval = 'A' x $File::ExtAttr::MAX_INITIAL_VALUELEN; my $longval2 = 'A' x ($File::ExtAttr::MAX_INITIAL_VALUELEN + 11); ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #for (1..30000) { #checking memory leaks #check a really big one, bigger than $File::ExtAttr::MAX_INITIAL_VALUELEN #Hmmm, 3991 is the biggest number that doesn't generate "no space left on device" #on my /var partition, and 920 is the biggest for my loopback partition. #What's up with that? #setfattr($_, "$key-2", ('x' x 3991)) or die "setfattr failed on $_: $!"; setfattr($_, "$key", $longval) or die "setfattr failed on $_: $!"; #set it is (setfattr($_, "$key", $longval), 1); #read it back is (getfattr($_, "$key"), $longval); #delete it ok (delfattr($_, "$key")); #check that it's gone is (getfattr($_, "$key"), undef); #set it is (setfattr($_, "$key", $longval2), 1); #read it back is (getfattr($_, "$key"), $longval2); #delete it ok (delfattr($_, "$key")); #check that it's gone is (getfattr($_, "$key"), undef); #} } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #for (1..30000) { #checking memory leaks #check a really big one, bigger than $File::ExtAttr::MAX_INITIAL_VALUELEN #Hmmm, 3991 is the biggest number that doesn't generate "no space left on device" #on my /var partition, and 920 is the biggest for my loopback partition. #What's up with that? #setfattr($filename, "$key-2", ('x' x 3991)) or die "setfattr failed on $filename: $!"; setfattr($fh, "$key", $longval) or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; #set it is (setfattr($fh, "$key", $longval), 1); #read it back is (getfattr($fh, "$key"), $longval); #delete it ok (delfattr($fh, "$key")); #check that it's gone is (getfattr($fh, "$key"), undef); #set it is (setfattr($fh, "$key", $longval2), 1); #read it back is (getfattr($fh, "$key"), $longval2); #delete it ok (delfattr($fh, "$key")); #check that it's gone is (getfattr($fh, "$key"), undef); #} #print STDERR "done\n"; #; # todo: Add support for IO::Dir handles, and test here. END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/lib/0000755000076400007640000000000011154446426013377 5ustar richrichFile-ExtAttr-1.09/t/lib/t/0000755000076400007640000000000011154446426013642 5ustar richrichFile-ExtAttr-1.09/t/lib/t/Support.pm0000644000076400007640000000150511040335003015633 0ustar richrichpackage t::Support; use strict; use Config; use File::ExtAttr qw/listfattr/; sub should_skip { # NetBSD 3.1 and earlier don't support xattrs. # See . if ($^O eq 'netbsd') { my @t = split(/\./, $Config{osvers}); return 1 if ($t[0] <= 3); } return 0; } sub filter_system_attrs { my @attrs = @_; if ($^O eq 'solaris') { # Filter out container for extensible system attributes on Solaris. @attrs = grep { ! /^SUNWattr_r[ow]$/ } @attrs; } return @attrs; } # Check to see whether the file has unremovable system attributes. sub has_system_attrs { my ($h) = @_; my $ret = 0; if ($^O eq 'solaris') { my @attrs = listfattr($h); if (scalar(grep { /^SUNWattr_r[ow]$/ } @attrs) > 0) { $ret = 1; } } return $ret; } 1; File-ExtAttr-1.09/t/16replace.t0000755000076400007640000000406610776112020014576 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 15; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #create it is (setfattr($_, "$key", $val, { create => 1 }), 1); #replace it is (setfattr($_, "$key", $val, { replace => 1 }), 1); #read it back is (getfattr($_, "$key"), $val); #delete it ok (delfattr($_, "$key")); #check that it's gone is (getfattr($_, "$key"), undef); } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #create it is (setfattr($fh, "$key", $val, { create => 1 }), 1); #replace it is (setfattr($fh, "$key", $val, { replace => 1 }), 1); #read it back is (getfattr($fh, "$key"), $val); #delete it ok (delfattr($fh, "$key")); #check that it's gone is (getfattr($fh, "$key"), undef); END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/03pod-coverage.t0000755000076400007640000000034010614310725015524 0ustar richrich#!perl -w use strict; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok( { also_private => [ qr/^constant$/ ] } ); File-ExtAttr-1.09/t/81closed.t0000755000076400007640000000155511040335003014427 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; use Data::Dumper; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 1; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr listfattrns); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # This shouldn't crash. my @ns = listfattrns($fh); ok 1; END { unlink $filename if $filename; }; File-ExtAttr-1.09/t/04yaml-meta.t0000755000076400007640000000023510637177077015063 0ustar richrich#!perl -w use strict; use Test::More; eval "use Test::YAML::Meta"; plan skip_all => "Test::YAML::Meta required for testing META.yml" if $@; meta_yaml_ok(); File-ExtAttr-1.09/t/01distribution.t0000755000076400007640000000032710507721744015703 0ustar richrich#!perl -w use strict; use Test::More; BEGIN { eval { require Test::Distribution; }; if($@) { plan skip_all => 'Test::Distribution not installed'; } else { import Test::Distribution; } } File-ExtAttr-1.09/t/33nslong.t0000755000076400007640000000764410776112020014467 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ######################### # change 'tests => 2' to 'tests => last_test_to_print'; # XXX: Refactor the common bits between this and 11basic.t # into Test::Class classes? use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 24; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $longval = 'A' x $File::ExtAttr::MAX_INITIAL_VALUELEN; my $longval2 = 'A' x ($File::ExtAttr::MAX_INITIAL_VALUELEN + 11); ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #for (1..30000) { #checking memory leaks #check a really big one, bigger than $File::ExtAttr::MAX_INITIAL_VALUELEN #Hmmm, 3991 is the biggest number that doesn't generate "no space left on device" #on my /var partition, and 920 is the biggest for my loopback partition. #What's up with that? #setfattr($_, "$key-2", ('x' x 3991)) or die "setfattr failed on $_: $!"; setfattr($_, "$key", $longval, { namespace => 'user' }) or die "setfattr failed on $_: $!"; #set it is (setfattr($_, "$key", $longval, { namespace => 'user' }), 1); #read it back is (getfattr($_, "$key", { namespace => 'user' }), $longval); #delete it ok (delfattr($_, "$key", { namespace => 'user' })); #check that it's gone is (getfattr($_, "$key", { namespace => 'user' }), undef); #set it is (setfattr($_, "$key", $longval2, { namespace => 'user' }), 1); #read it back is (getfattr($_, "$key", { namespace => 'user' }), $longval2); #delete it ok (delfattr($_, "$key", { namespace => 'user' })); #check that it's gone is (getfattr($_, "$key", { namespace => 'user' }), undef); #} } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #for (1..30000) { #checking memory leaks #check a really big one, bigger than $File::ExtAttr::MAX_INITIAL_VALUELEN #Hmmm, 3991 is the biggest number that doesn't generate "no space left on device" #on my /var partition, and 920 is the biggest for my loopback partition. #What's up with that? #setfattr($filename, "$key-2", ('x' x 3991)) or die "setfattr failed on $filename: $!"; setfattr($fh, "$key", $longval, { namespace => 'user' }) or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; #set it is (setfattr($fh, "$key", $longval, { namespace => 'user' }), 1); #read it back is (getfattr($fh, "$key", { namespace => 'user' }), $longval); #delete it ok (delfattr($fh, "$key", { namespace => 'user' })); #check that it's gone is (getfattr($fh, "$key", { namespace => 'user' }), undef); #set it is (setfattr($fh, "$key", $longval2, { namespace => 'user' }), 1); #read it back is (getfattr($fh, "$key", { namespace => 'user' }), $longval2); #delete it ok (delfattr($fh, "$key", { namespace => 'user' })); #check that it's gone is (getfattr($fh, "$key", { namespace => 'user' }), undef); #} #print STDERR "done\n"; #; END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/00load.t0000755000076400007640000000024110614310725014065 0ustar richrich#!perl -w use strict; use Test::More tests => 1; BEGIN { use_ok( 'File::ExtAttr' ); } diag( "Testing File::ExtAttr $File::ExtAttr::VERSION, Perl $], $^X" ); File-ExtAttr-1.09/t/31nsmultiple.t0000755000076400007640000001063011040335003015337 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; use Data::Dumper; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 42; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr listfattrns); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; my $key2 = $key.'2'; my $key3 = $key.'3'; my @ns; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($_, "$key", $val, { namespace => 'user' }) or die "setfattr failed on filename $_: $!"; #set it is (setfattr($_, "$key", $val, { namespace => 'user' }), 1); #read it back is (getfattr($_, "$key", { namespace => 'user' }), $val); #set another is (setfattr($_, "$key2", $val, { namespace => 'user' }), 1); #read it back is (getfattr($_, "$key2", { namespace => 'user' }), $val); #set yet another is (setfattr($_, "$key3", $val, { namespace => 'user' }), 1); #read it back is (getfattr($_, "$key3", { namespace => 'user' }), $val); #check user namespace exists now @ns = listfattrns($_); is (grep(/^user$/, @ns), 1); #delete them ok (delfattr($_, "$key", { namespace => 'user' })); ok (delfattr($_, "$key2", { namespace => 'user' })); ok (delfattr($_, "$key3", { namespace => 'user' })); #check that they're gone is (getfattr($_, "$key", { namespace => 'user' }), undef); is (getfattr($_, "$key2", { namespace => 'user' }), undef); is (getfattr($_, "$key3", { namespace => 'user' }), undef); #check user namespace doesn't exist now SKIP: { skip "Unremoveable user attributes prevent testing namespace removal", 1 if t::Support::has_system_attrs($_); @ns = listfattrns($_); is (grep(/^user$/, @ns), 0); } #} } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($fh, "$key", $val, { namespace => 'user' }) or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; #set it is (setfattr($fh, "$key", $val, { namespace => 'user' }), 1); #read it back is (getfattr($fh, "$key", { namespace => 'user' }), $val); #set another is (setfattr($fh, "$key2", $val, { namespace => 'user' }), 1); #read it back is (getfattr($fh, "$key2", { namespace => 'user' }), $val); #set yet another is (setfattr($fh, "$key3", $val, { namespace => 'user' }), 1); #read it back is (getfattr($fh, "$key3", { namespace => 'user' }), $val); #check user namespace exists now @ns = listfattrns($fh); is (grep(/^user$/, @ns), 1); #delete them ok (delfattr($fh, "$key", { namespace => 'user' })); ok (delfattr($fh, "$key2", { namespace => 'user' })); ok (delfattr($fh, "$key3", { namespace => 'user' })); #check that it's gone is (getfattr($fh, "$key", { namespace => 'user' }), undef); is (getfattr($fh, "$key2", { namespace => 'user' }), undef); is (getfattr($fh, "$key3", { namespace => 'user' }), undef); #check user namespace doesn't exist now SKIP: { skip "Unremoveable user attributes prevent testing namespace removal", 1 if t::Support::has_system_attrs($fh); @ns = listfattrns($fh); is (grep(/^user$/, @ns), 0); } #} #print STDERR "done\n"; #; END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/18list.t0000755000076400007640000000545111040335003014130 0ustar richrich#!perl -w use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 213; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr listfattr); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } my %vals; for (my $i = 0; $i < 10; ++$i) { $vals{"key$i"} = "val$i"; } ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; foreach my $k (keys %vals) { # create it is (setfattr($_, $k, $vals{$k}, { create => 1 }), 1); # create it again -- should fail my $ret = setfattr($_, $k, $vals{$k}, { create => 1 }); my $err = int $!; is ($ret, 0); is ($err, $!{EEXIST}); # read it back is (getfattr($_, $k), $vals{$k}); } # Check that the list contains all the attributes. my @attrs = listfattr($_); @attrs = sort(t::Support::filter_system_attrs(@attrs)); my @ks = sort keys %vals; check_attrs(\@attrs, \@ks); # Clean up for next round of testing foreach my $k (keys %vals) { # delete it ok (delfattr($_, $k)); # check that it's gone is (getfattr($_, $k), undef); } } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; foreach (keys %vals) { # create it is (setfattr($fh, $_, $vals{$_}, { create => 1 }), 1); # create it again -- should fail my $ret = setfattr($fh, $_, $vals{$_}, { create => 1 }); my $err = int $!; is ($ret, 0); is ($err, $!{EEXIST}); # read it back is (getfattr($fh, $_), $vals{$_}); } # Check that the list contains all the attributes. my @attrs = listfattr($fh); @attrs = sort(t::Support::filter_system_attrs(@attrs)); my @ks = sort keys %vals; check_attrs(\@attrs, \@ks); # Clean up for next round of testing foreach (keys %vals) { # delete it ok (delfattr($filename, $_)); # check that it's gone is (getfattr($filename, $_), undef); } END { unlink $filename if $filename; rmdir $dirname if $dirname; }; sub check_attrs { my @attrs = @{ $_[0] }; my @ks = @{ $_[1] }; is(scalar @attrs, scalar @ks); for (my $i = 0; $i < scalar @attrs; ++$i) { is($attrs[$i], $ks[$i]); } } File-ExtAttr-1.09/t/32nsnonuser.t0000755000076400007640000000273110776113027015220 0ustar richrich#!perl -w # -*-perl-*- # Test that creating non-"user."-prefixed attributes fails. # XXX: Probably Linux-specific use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 8; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr); my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; foreach ( $filename, $dirname ) { print "# using $_\n"; #set it setfattr($_, "$key", $val, { namespace => 'nonuser' }); my $err = int $!; is ($err, $!{EOPNOTSUPP}); #read it back is (getfattr($_, "$key", { namespace => 'nonuser' }), undef); #delete it delfattr($_, "$key", { namespace => 'nonuser' }); $err = int $!; is ($err, $!{EOPNOTSUPP}); #check that it's gone is (getfattr($_, "$key", { namespace => 'nonuser' }), undef); } END { unlink $filename if $filename; rmdir $dirname if $dirname; }; File-ExtAttr-1.09/t/30nsbasic.t0000755000076400007640000000644611040335003014576 0ustar richrich#!perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-xattr.t' ########################## # change 'tests => 2' to 'tests => last_test_to_print'; use strict; use Test::More; BEGIN { my $tlib = $0; $tlib =~ s|/[^/]*$|/lib|; push(@INC, $tlib); } use t::Support; if (t::Support::should_skip()) { plan skip_all => 'Tests unsupported on this OS/filesystem'; } else { plan tests => 18; } use File::Temp qw(tempfile); use File::Path; use File::ExtAttr qw(setfattr getfattr delfattr listfattrns); use IO::File; my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); my ($fh, $filename) = tempfile( DIR => $TESTDIR ); close $fh or die "can't close $filename $!"; # Create a directory. my $dirname = "$filename.dir"; eval { mkpath($dirname); }; if ($@) { warn "Couldn't create $dirname: $@"; } #todo: try wierd characters in here? # try unicode? my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; my @ns; ########################## # Filename-based tests # ########################## foreach ( $filename, $dirname ) { print "# using $_\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($_, "$key", $val, { namespace => 'user' }) or die "setfattr failed on filename $_: $!"; #set it is (setfattr($_, "$key", $val, { namespace => 'user' }), 1); #check user namespace exists now @ns = listfattrns($_); is (grep(/^user$/, @ns), 1); print '# '.join(' ', @ns)."\n"; #read it back is (getfattr($_, "$key", { namespace => 'user' }), $val); #delete it ok (delfattr($_, "$key", { namespace => 'user' })); #check that it's gone is (getfattr($_, "$key", { namespace => 'user' }), undef); #check user namespace doesn't exist now SKIP: { skip "Unremoveable user attributes prevent testing namespace removal", 1 if t::Support::has_system_attrs($_); @ns = listfattrns($_); is (grep(/^user$/, @ns), 0); } #} } ########################## # IO::Handle-based tests # ########################## $fh = new IO::File("<$filename") or die "Unable to open $filename"; print "# using file descriptor ".$fh->fileno()."\n"; #for (1..30000) { #checking memory leaks #will die if xattr stuff doesn't work at all setfattr($fh, "$key", $val, { namespace => 'user' }) or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; #set it is (setfattr($fh, "$key", $val, { namespace => 'user' }), 1); #check user namespace exists now @ns = listfattrns($fh); is (grep(/^user$/, @ns), 1); print '# '.join(' ', @ns)."\n"; #read it back is (getfattr($fh, "$key", { namespace => 'user' }), $val); #delete it ok (delfattr($fh, "$key", { namespace => 'user' })); #check that it's gone is (getfattr($fh, "$key", { namespace => 'user' }), undef); #check user namespace doesn't exist now SKIP: { skip "Unremoveable user attributes prevent testing namespace removal", 1 if t::Support::has_system_attrs($fh); @ns = listfattrns($fh); is (grep(/^user$/, @ns), 0); } #} #print STDERR "done\n"; #; END { unlink $filename if $filename; rmdir $dirname if $dirname; };