Replace all tests that require knowing syscall numbers.
authorDerrik Pates <demon@now.ai>
Fri, 29 Jul 2011 16:53:27 +0000 (10:53 -0600)
committerDerrik Pates <demon@now.ai>
Fri, 29 Jul 2011 16:53:27 +0000 (10:53 -0600)
Since tests that need syscall.pm or sys/syscall.pm, et al., always
fail on the CPAN testing systems for one of several reasons (causing
"make test" to fail because loopback.pl can't even create plain
files without it), I'm adopting the *BSD arrangement for handling
mknod() in loopback.pl, and using the Lchown module to do lchown()
instead of trying to lookup a syscall number for it. Also changed
the statfs test to do the same, as I'd already written code to
use Filesys::Statvfs instead of trying to track down the
statfs/statvfs/statvfs1 syscall number, and worry about packing
the arguments the right way. Also changed Makefile.PL to provide
per-platform explanations of what to install for FUSE support, and
moved the "-g -ggdb" options into the OPTIMIZE parameter to
WriteMakefile(). Also made a note of testing against CentOS 5.6,
due to its use of Perl 5.8, as opposed to everything else I'd
tested against prior.

Makefile.PL
README
examples/loopback.pl
test/statfs.t

index e40f912..e82bf97 100644 (file)
@@ -36,10 +36,31 @@ unless ($fusever) {
 
 unless ($fusever) {
     # make CPANPLUS happy and don't report errors if fuse isn't installed
-    die("No support for os: $^O\n",
-        "You need to have fuse-dev (or similar) package installed and have sufficient permissions in order to install this module\n",
-        $^O eq 'darwin' ? ("One option on Mac is http://code.google.com/p/macfuse/\n") : (),
-    );
+    my $explanation;
+    if ($^O eq 'linux') {
+        if (-e '/etc/debian_version') {
+            $explanation = 'You need to install "libfuse-dev" to provide build support for this module';
+        }
+        elsif (-e '/etc/redhat-release') {
+            $explanation = 'You need to install "fuse-devel" to provide build support for this module';
+        }
+        else {
+            $explanation = 'I don\'t know your Linux distribution, but please install the FUSE libraries and headers to build this module';
+        }
+    }
+    elsif ($^O eq 'freebsd') {
+        $explanation = 'You need to install the "fusefs-libs" package from ports to support this module';
+    }
+    elsif ($^O eq 'netbsd') {
+        $explanation = 'Could not find librefuse? Maybe install "perfuse" from pkgsrc, or upgrade to newer NetBSD';
+    }
+    elsif ($^O = 'darwin') {
+        $explanation = 'Please install MacFuse from http://code.google.com/p/macfuse/';
+    }
+    else {
+        $explanation = 'There is no FUSE support for your platform to our knowledge, sorry';
+    }
+    die("Cannot build for platform: $^O\n", $explanation, "\n");
 }
 if ($fusever && $fusever + 0 < 2.6) {
     die "FUSE API is ", $fusever, ", must be 2.6 or later\n";
@@ -50,17 +71,24 @@ if ($fusever && $fusever + 0 < 2.6) {
 chomp(my $inc = `pkg-config --cflags-only-I fuse 2> /dev/null` || '-I ../include');
 chomp(my $libs = `pkg-config --libs-only-L fuse 2> /dev/null`);
 chomp($libs .= `pkg-config --libs-only-l fuse 2> /dev/null` || (($^O eq 'netbsd') ? '-lrefuse' : '-lfuse'));
+# Needed for Fuse on OS X 10.6, due to 10.6 and up always using the 64-bit
+# inode structs; unfortunately MacFuse doesn't just do the right thing
+# on its own.
 if ($^O eq 'darwin' && (uname())[2] =~ /^10\./) {
     $libs =~ s/-lfuse/-lfuse_ino64/;
 }
-chomp(my $def = '-Wall -g -ggdb -DFUSE_USE_VERSION=26 ' . `pkg-config --cflags-only-other fuse 2> /dev/null` || '-D_FILE_OFFSET_BITS=64');
+chomp(my $def = '-Wall -DFUSE_USE_VERSION=26 ' . `pkg-config --cflags-only-other fuse 2> /dev/null` || '-D_FILE_OFFSET_BITS=64');
 chomp($def .= `pkg-config --libs-only-other fuse 2> /dev/null`);
 $def .= ' -DPERL_HAS_64BITINT' if $Config{'use64bitint'};
 
 WriteMakefile(
     'NAME'          => 'Fuse',
     'VERSION_FROM'  => 'Fuse.pm', # finds $VERSION
-    'PREREQ_PM'     => {}, # e.g., Module::Name => 1.1
+    'PREREQ_PM'     => { # e.g., Module::Name => 1.1
+        'Lchown'            => 0,
+        'Filesys::Statvfs'  => 0,
+        'Unix::Mknod'       => 0,
+    },
     ($] >= 5.005 ?  ## Add these new keywords supported since 5.005
        (ABSTRACT_FROM   => 'Fuse.pm', # retrieve abstract from module
         AUTHOR          => 'Mark Glines <mark@glines.org>') : ()),
@@ -72,12 +100,13 @@ WriteMakefile(
             },
         })
     ),
-       'LIBS'          => '-lpthread ' . $libs, # e.g., '-lm'
-       'DEFINE'        => $def, # e.g., '-DHAVE_SOMETHING'
-       # Insert -I. if you add *.h files later:
-       'INC'           => $inc, # e.g., '-I/usr/include/other'
-       # Un-comment this if you add C files to link with later:
-       'OBJECT'        => 'Fuse$(OBJ_EXT)', # link all the C files too
+    'LIBS'          => '-lpthread ' . $libs, # e.g., '-lm'
+    'DEFINE'        => $def, # e.g., '-DHAVE_SOMETHING'
+    'OPTIMIZE'      => '-g -ggdb',
+    # Insert -I. if you add *.h files later:
+    'INC'           => $inc, # e.g., '-I/usr/include/other'
+    # Un-comment this if you add C files to link with later:
+    'OBJECT'        => 'Fuse$(OBJ_EXT)', # link all the C files too
 );
 
 sub MY::postamble {
diff --git a/README b/README
index 4a60518..8a0d77b 100644 (file)
--- a/README
+++ b/README
@@ -85,6 +85,7 @@ Currently tests have been attempted and succeeded on:
   * Ubuntu 10.10/amd64
   * Ubuntu 11.04/amd64
   * Debian 5.0/powerpc
+  * CentOS 5.6/amd64
   * NetBSD 5.1/i386
   * NetBSD 5.1/amd64
   * FreeBSD 8.2/i386
index 1df7535..ebcb7f9 100755 (executable)
@@ -28,8 +28,10 @@ use blib;
 use Fuse;
 use IO::File;
 use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
-use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET S_ISREG S_ISFIFO S_IMODE);
+use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET S_ISREG S_ISFIFO S_IMODE S_ISCHR S_ISBLK S_ISSOCK);
 use Getopt::Long;
+use Lchown;
+use Unix::Mknod;
 
 my %extraopts = ( 'threaded' => 0, 'debug' => 0 );
 my($use_real_statfs, $pidfile);
@@ -46,21 +48,6 @@ GetOptions(
     'pidfile=s'         => \$pidfile,
 ) || die('Error parsing options');
 
-my $can_syscall = eval {
-    require 'sys/syscall.ph'; # for SYS_mknod and SYS_lchown
-};
-if (!$can_syscall && open my $fh, '<', '/usr/include/sys/syscall.h') {
-    my %sys = do { local $/ = undef;
-            <$fh> =~ m/\#define \s+ (\w+) \s+ (\d+)/gxms;
-        };
-    close $fh;
-    if ($sys{SYS_mknod} && $sys{SYS_lchown}) {
-        *SYS_mknod  = sub { $sys{SYS_mknod}  };
-        *SYS_lchown = sub { $sys{SYS_lchown} };
-        $can_syscall = 1;
-    }
-}
-
 sub fixup { return "/tmp/fusetest-" . $ENV{LOGNAME} . shift }
 
 sub x_getattr {
@@ -130,16 +117,11 @@ sub x_rename {
 }
 sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
 sub x_chown {
-    return -ENOSYS() if ! $can_syscall;
     my ($fn) = fixup(shift);
     print "nonexistent $fn\n" unless -e $fn;
     my ($uid,$gid) = @_;
-    # perl's chown() does not chown symlinks, it chowns the symlink's
-    # target.  it fails when the link's target doesn't exist, because
-    # the stat64() syscall fails.
-    # this causes error messages when unpacking symlinks in tarballs.
-    my ($err) = syscall(&SYS_lchown,$fn,$uid,$gid,$fn) ? -$! : 0;
-    return $err;
+    lchown($uid, $gid, $fn);
+    return -$!;
 }
 sub x_chmod {
     my ($fn) = fixup(shift);
@@ -154,24 +136,31 @@ sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); ret
 sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
 
 sub x_mknod {
-    return -ENOSYS() if ! $can_syscall;
     # since this is called for ALL files, not just devices, I'll do some checks
     # and possibly run the real mknod command.
     my ($file, $modes, $dev) = @_;
     $file = fixup($file);
     undef $!;
-    if ($^O eq 'freebsd' || $^O eq 'darwin' || $^O eq 'netbsd') {
-        if (S_ISREG($modes)) {
-            open(FILE, '>', $file) || return -$!;
-            print FILE '';
-            close(FILE);
-            return 0;
-        } elsif (S_ISFIFO($modes)) {
-            my ($rv) = POSIX::mkfifo($file, S_IMODE($modes));
-            return $rv ? 0 : -POSIX::errno();
-        }
+    if (S_ISREG($modes)) {
+        open(FILE, '>', $file) || return -$!;
+        print FILE '';
+        close(FILE);
+        chmod S_IMODE($modes), $file;
+        return 0;
+    }
+    elsif (S_ISFIFO($modes)) {
+        my ($rv) = POSIX::mkfifo($file, S_IMODE($modes));
+        return $rv ? 0 : -POSIX::errno();
+    }
+    elsif (S_ISCHR($modes) || S_ISBLK($modes)) {
+        mknod($file, $modes, $dev);
+        return -$!;
+    }
+    # S_ISSOCK maybe should be handled; however, for our test it should
+    # not really matter.
+    else {
+        return -&ENOSYS;
     }
-    syscall(&SYS_mknod,$file,$modes,$dev);
     return -$!;
 }
 
index 1a5b973..bf24bbb 100644 (file)
 use test::helper qw($_real $_point);
 use Test::More;
 use Config;
-
-my $has_Filesys__Statvfs = 0;
-eval {
-    require Filesys::Statvfs;
-    1;
-} and do {
-    $has_Filesys__Statvfs = 1;
-    Filesys::Statvfs->import();
-};
-
-my $has_syscall = 0;
-eval {
-   require 'sys/syscall.ph'; # for SYS_statfs
-   1;
-} and do {
-    $has_syscall = 1;
-};
-
-if (!($has_syscall || $has_Filesys__Statvfs)) {
-    plan skip_all => 'No Filesys::Statvfs and no sys/syscall.ph';
-}
-
-# Maybe not the best way to do this... but it works. Only extract the values
-# we care about, so we don't have to worry about changing field ordering
-# around and other such nastiness.
-my $packmask;
-# Don't even bother setting up a packmask if we have Filesys::Statvfs.
-# In that case, we can just make one call, and save ourselves a ton of
-# messing around.
-if (!$has_Filesys__Statvfs) {
-    if ($^O eq 'linux') {
-        $packmask = 'x[L!]L![6]x[L]x[L]L';
-    }
-    elsif ($^O eq 'freebsd') {
-        $packmask = 'x[16]Qx[8]Q[2]qQqx[112]Lx[4]';
-    }
-    elsif ($^O eq 'netbsd') {
-        if ($Config{'use64bitint'}) {
-            # This should work for any 64-bit NetBSD...
-            $packmask = 'x[8]Lx![q]x[16]Q[3]x[8]Q[2]x[64]L';
-        }
-        else {
-            # NetBSD's perl on 32-bit doesn't handle quadword types, and
-            # this is my workaround. Ugly, but it does the job. And yes,
-            # won't work for big values. Good thing we're not testing
-            # with any, huh?
-            if ($Config{'byteorder'} eq '1234') { # little endian
-                $packmask = 'x[4]Lx[8]Lx[4]Lx[4]Lx[4]x[8]Lx[4]Lx[4]x[64]L';
-            }
-            elsif ($Config{'byteorder'} eq '4321') { # big endian
-                $packmask = 'x[4]Lx[8]x[4]Lx[4]Lx[4]Lx[8]x[4]Lx[4]Lx[64]L';
-            }
-            else {
-                plan skip_all => "Word ordering not known, don't know how to handle statvfs1()";
-                exit(1);
-            }
-        }
-    }
-    elsif ($^O eq 'darwin') {
-        # Accurate for OS X 10.6; 10.5 and earlier may not actually correspond
-        # to this, if my understanding of statfs(2) on OS X is fair.
-        $packmask = 'x[L!]L!x[L!]L![5]';
-    }
-    else {
-        plan skip_all => 'Platform not known, need to know how to statfs';
-        exit(1);
-    }
-}
+use Filesys::Statvfs;
 
 if ($^O eq 'netbsd' || $^O eq 'darwin') {
     # Ignoring the f_namelen field; no such animal on OS X statfs(), and
-       # NetBSD's statvfs1(2) syscall doesn't seem to handle f_namelen right
-       # for PUFFS-based filesystems. Not our failure, and mostly irrelevant.
+    # NetBSD's statvfs1(2) syscall doesn't seem to handle f_namelen right
+    # for PUFFS-based filesystems. Not our failure, and mostly irrelevant.
     plan tests => 6;
 }
 else {
     plan tests => 7;
 }
-my @list;
-if ($has_Filesys__Statvfs) {
-    # This is a neater way to do this - if it's available...
-    ok(@list = (statvfs($_point))[1,2,3,4,5,6,9]);
-}
-elsif ($has_syscall) {
-    # Just make the buffer large enough that we don't have to care...
-    my ($statfs_data) = "\0" x 4096;
-    my ($tmp) = $_point;
-    if ($^O eq 'netbsd') {
-        # NetBSD doesn't have statfs(2); statvfs1(2) is its closest analogue.
-       ok(!syscall(&SYS_statvfs1,$tmp,$statfs_data,1),'statvfs1');
-    }
-    else {
-       ok(!syscall(&SYS_statfs,$tmp,$statfs_data),'statfs');
-    }
-    @list = unpack($packmask,$statfs_data);
-}
+ok(my @list = (statvfs($_point))[1,2,3,5,6,9]);
 diag "statfs: ",join(', ', @list);
 is(shift(@list),4096,'block size');
 is(shift(@list),1000000,'blocks');
 is(shift(@list),500000,'blocks free');
-shift(@list);
 is(shift(@list),1000000,'files');
 is(shift(@list),500000,'files free');
 unless ($^O eq 'netbsd' || $^O eq 'darwin') {