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";
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>') : ()),
},
})
),
- '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 {
* 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
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);
'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 {
}
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);
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 -$!;
}
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') {