#!/usr/bin/perl -w use strict; use Carp (); local $SIG{'__WARN__'} = \&Carp::cluck; my $has_threads = 0; eval { require threads; require threads::shared; 1; } and do { $has_threads = 1; threads->import(); threads::shared->import(); }; my $has_Filesys__Statvfs = 0; eval { require Filesys::Statvfs; 1; } and do { $has_Filesys__Statvfs = 1; Filesys::Statvfs->import(); }; my $use_lchown = 0; eval { require Lchown; 1; } and do { $use_lchown = 1; }; my $has_mknod = 0; eval { require Unix::Mknod; 1; } and do { $has_mknod = 1; }; use blib; use Fuse; use IO::File; use POSIX qw(ENOTDIR ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT setsid); 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; my %extraopts = ( 'threaded' => 0, 'debug' => 0 ); my($use_real_statfs, $pidfile); GetOptions( 'use-threads' => sub { if ($has_threads) { $extraopts{'threaded'} = 1; } }, 'debug' => sub { $extraopts{'debug'} = 1; }, 'use-real-statfs' => \$use_real_statfs, 'pidfile=s' => \$pidfile, ) || die('Error parsing options'); sub fixup { return "/tmp/fusetest-" . $ENV{LOGNAME} . shift } sub x_getattr { my ($file) = fixup(shift); my (@list) = lstat($file); return -$! unless @list; return @list; } sub x_getdir { my ($dirname) = fixup(shift); unless(opendir(DIRHANDLE,$dirname)) { return -ENOENT(); } my (@files) = readdir(DIRHANDLE); closedir(DIRHANDLE); return (@files, 0); } sub x_open { my ($file) = fixup(shift); my ($mode) = shift; return -$! unless sysopen(FILE,$file,$mode); close(FILE); return 0; } sub x_read { my ($file,$bufsize,$off) = @_; my ($rv) = -ENOSYS(); my ($handle) = new IO::File; return -ENOENT() unless -e ($file = fixup($file)); my ($fsize) = -s $file; return -ENOSYS() unless open($handle,$file); if(seek($handle,$off,SEEK_SET)) { read($handle,$rv,$bufsize); } return $rv; } sub x_write { my ($file,$buf,$off) = @_; my ($rv); return -ENOENT() unless -e ($file = fixup($file)); my ($fsize) = -s $file; return -ENOSYS() unless open(FILE,'+<',$file); if($rv = seek(FILE,$off,SEEK_SET)) { $rv = print(FILE $buf); } $rv = -ENOSYS() unless $rv; close(FILE); return length($buf); } sub err { return (-shift || -$!) } sub x_readlink { return readlink(fixup(shift)); } sub x_unlink { return unlink(fixup(shift)) ? 0 : -$!; } sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; } sub x_rename { my ($old) = fixup(shift); my ($new) = fixup(shift); my ($err) = rename($old,$new) ? 0 : -ENOENT(); return $err; } sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! } sub x_chown { my ($fn) = fixup(shift); local $!; print "nonexistent $fn\n" unless -e $fn; my ($uid,$gid) = @_; if( $use_lchown ){ lchown($uid, $gid, $fn); }else{ chown($uid, $gid, $fn); } return -$!; } sub x_chmod { my ($fn) = fixup(shift); my ($mode) = shift; my ($err) = chmod($mode,$fn) ? 0 : -$!; return $err; } sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; } sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; } sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; } sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; } sub x_mknod { # 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 (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)) { if($has_mknod){ Unix::Mknod::mknod($file, $modes, $dev); return -$!; }else{ return -POSIX::errno(); } } # S_ISSOCK maybe should be handled; however, for our test it should # not really matter. else { return -&ENOSYS; } return -$!; } # kludge sub x_statfs { if ($has_Filesys__Statvfs && $use_real_statfs) { (my($bsize, $frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail, $flag, $namemax) = statvfs('/tmp')) || return -$!; return ($namemax, $files, $ffree, $blocks, $bavail, $bsize); } return 255,1000000,500000,1000000,500000,4096; } # Required for some edge cases where a simple fork() won't do. # from http://perldoc.perl.org/perlipc.html#Complete-Dissociation-of-Child -from-Parent sub daemonize { chdir("/") || die "can't chdir to /: $!"; open(STDIN, "< /dev/null") || die "can't read /dev/null: $!"; open(STDOUT, "> /dev/null") || die "can't write to /dev/null: $!"; defined(my $pid = fork()) || die "can't fork: $!"; exit if $pid; # non-zero now means I am the parent (setsid() != -1) || die "Can't start a new session: $!"; open(STDERR, ">&STDOUT") || die "can't dup stdout: $!"; if ($pidfile) { open(PIDFILE, '>', $pidfile); print PIDFILE $$, "\n"; close(PIDFILE); } } my ($mountpoint) = ''; if(@ARGV){ $mountpoint = shift(@ARGV) }else{ print "\n Usage: loopback.pl <mountpoint> [options] \n Options: --debug Turn on debugging (verbose) output --use-threads Use threads --use-real-statfs Use real stat command against /tmp or generic values --pidfile Set pidfile value --pidfile=<numeric-value>\n\n"; exit; } if (! -d $mountpoint) { print STDERR "ERROR: attempted to mount to non-directory\n"; return -&ENOTDIR } daemonize(); Fuse::main( 'mountpoint' => $mountpoint, 'getattr' => 'main::x_getattr', 'readlink' => 'main::x_readlink', 'getdir' => 'main::x_getdir', 'mknod' => 'main::x_mknod', 'mkdir' => 'main::x_mkdir', 'unlink' => 'main::x_unlink', 'rmdir' => 'main::x_rmdir', 'symlink' => 'main::x_symlink', 'rename' => 'main::x_rename', 'link' => 'main::x_link', 'chmod' => 'main::x_chmod', 'chown' => 'main::x_chown', 'truncate' => 'main::x_truncate', 'utime' => 'main::x_utime', 'open' => 'main::x_open', 'read' => 'main::x_read', 'write' => 'main::x_write', 'statfs' => 'main::x_statfs', %extraopts, ); # vim: ts=4 ai et hls