examples/loopback.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 use Carp ();
   5 local $SIG{'__WARN__'} = \&Carp::cluck;
   6
   7 my $has_threads = 0;
   8 eval {
   9     require threads;
  10     require threads::shared;
  11     1;
  12 } and do {
  13     $has_threads = 1;
  14     threads->import();
  15     threads::shared->import();
  16 };
  17
  18 my $has_Filesys__Statvfs = 0;
  19 eval {
  20     require Filesys::Statvfs;
  21     1;
  22 } and do {
  23     $has_Filesys__Statvfs = 1;
  24     Filesys::Statvfs->import();
  25 };
  26
  27 use blib;
  28 use Fuse;
  29 use IO::File;
  30 use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
  31 use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET S_ISREG S_ISFIFO S_IMODE);
  32 use Getopt::Long;
  33
  34 my %extraopts = ( 'threaded' => 0, 'debug' => 0 );
  35 my($use_real_statfs, $pidfile);
  36 GetOptions(
  37     'use-threads'       => sub {
  38         if ($has_threads) {
  39             $extraopts{'threaded'} = 1;
  40         }
  41     },
  42     'debug'             => sub {
  43         $extraopts{'debug'} = 1;
  44     },
  45     'use-real-statfs'   => \$use_real_statfs,
  46     'pidfile=s'         => \$pidfile,
  47 ) || die('Error parsing options');
  48
  49 my $can_syscall = eval {
  50     require 'sys/syscall.ph'; # for SYS_mknod and SYS_lchown
  51 };
  52 if (!$can_syscall && open my $fh, '<', '/usr/include/sys/syscall.h') {
  53     my %sys = do { local $/ = undef;
  54             <$fh> =~ m/\#define \s+ (\w+) \s+ (\d+)/gxms;
  55         };
  56     close $fh;
  57     if ($sys{SYS_mknod} && $sys{SYS_lchown}) {
  58         *SYS_mknod  = sub { $sys{SYS_mknod}  };
  59         *SYS_lchown = sub { $sys{SYS_lchown} };
  60         $can_syscall = 1;
  61     }
  62 }
  63
  64 sub fixup { return "/tmp/fusetest-" . $ENV{LOGNAME} . shift }
  65
  66 sub x_getattr {
  67     my ($file) = fixup(shift);
  68     my (@list) = lstat($file);
  69     return -$! unless @list;
  70     return @list;
  71 }
  72
  73 sub x_getdir {
  74     my ($dirname) = fixup(shift);
  75     unless(opendir(DIRHANDLE,$dirname)) {
  76         return -ENOENT();
  77     }
  78     my (@files) = readdir(DIRHANDLE);
  79     closedir(DIRHANDLE);
  80     return (@files, 0);
  81 }
  82
  83 sub x_open {
  84     my ($file) = fixup(shift);
  85     my ($mode) = shift;
  86     return -$! unless sysopen(FILE,$file,$mode);
  87     close(FILE);
  88     return 0;
  89 }
  90
  91 sub x_read {
  92     my ($file,$bufsize,$off) = @_;
  93     my ($rv) = -ENOSYS();
  94     my ($handle) = new IO::File;
  95     return -ENOENT() unless -e ($file = fixup($file));
  96     my ($fsize) = -s $file;
  97     return -ENOSYS() unless open($handle,$file);
  98     if(seek($handle,$off,SEEK_SET)) {
  99         read($handle,$rv,$bufsize);
 100     }
 101     return $rv;
 102 }
 103
 104 sub x_write {
 105     my ($file,$buf,$off) = @_;
 106     my ($rv);
 107     return -ENOENT() unless -e ($file = fixup($file));
 108     my ($fsize) = -s $file;
 109     return -ENOSYS() unless open(FILE,'+<',$file);
 110     if($rv = seek(FILE,$off,SEEK_SET)) {
 111         $rv = print(FILE $buf);
 112     }
 113     $rv = -ENOSYS() unless $rv;
 114     close(FILE);
 115     return length($buf);
 116 }
 117
 118 sub err { return (-shift || -$!) }
 119
 120 sub x_readlink { return readlink(fixup(shift));         }
 121 sub x_unlink   { return unlink(fixup(shift)) ? 0 : -$!; }
 122
 123 sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }
 124
 125 sub x_rename {
 126     my ($old) = fixup(shift);
 127     my ($new) = fixup(shift);
 128     my ($err) = rename($old,$new) ? 0 : -ENOENT();
 129     return $err;
 130 }
 131 sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
 132 sub x_chown {
 133     return -ENOSYS() if ! $can_syscall;
 134     my ($fn) = fixup(shift);
 135     print "nonexistent $fn\n" unless -e $fn;
 136     my ($uid,$gid) = @_;
 137     # perl's chown() does not chown symlinks, it chowns the symlink's
 138     # target.  it fails when the link's target doesn't exist, because
 139     # the stat64() syscall fails.
 140     # this causes error messages when unpacking symlinks in tarballs.
 141     my ($err) = syscall(&SYS_lchown,$fn,$uid,$gid,$fn) ? -$! : 0;
 142     return $err;
 143 }
 144 sub x_chmod {
 145     my ($fn) = fixup(shift);
 146     my ($mode) = shift;
 147     my ($err) = chmod($mode,$fn) ? 0 : -$!;
 148     return $err;
 149 }
 150 sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
 151 sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }
 152
 153 sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
 154 sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
 155
 156 sub x_mknod {
 157     return -ENOSYS() if ! $can_syscall;
 158     # since this is called for ALL files, not just devices, I'll do some checks
 159     # and possibly run the real mknod command.
 160     my ($file, $modes, $dev) = @_;
 161     $file = fixup($file);
 162     undef $!;
 163     if ($^O eq 'freebsd' || $^O eq 'darwin' || $^O eq 'netbsd') {
 164         if (S_ISREG($modes)) {
 165             open(FILE, '>', $file) || return -$!;
 166             print FILE '';
 167             close(FILE);
 168             return 0;
 169         } elsif (S_ISFIFO($modes)) {
 170             my ($rv) = POSIX::mkfifo($file, S_IMODE($modes));
 171             return $rv ? 0 : -POSIX::errno();
 172         }
 173     }
 174     syscall(&SYS_mknod,$file,$modes,$dev);
 175     return -$!;
 176 }
 177
 178 # kludge
 179 sub x_statfs {
 180     if ($has_Filesys__Statvfs && $use_real_statfs) {
 181         (my($bsize, $frsize, $blocks, $bfree, $bavail,
 182             $files, $ffree, $favail, $flag,
 183             $namemax) = statvfs('/tmp')) || return -$!;
 184         return ($namemax, $files, $ffree, $blocks, $bavail, $bsize);
 185     }
 186     return 255,1000000,500000,1000000,500000,4096;
 187 }
 188 my ($mountpoint) = '';
 189 $mountpoint = shift(@ARGV) if @ARGV;
 190
 191 if (! -d $mountpoint) {
 192     print STDERR "ERROR: attempted to mount to non-directory\n";
 193     return -&ENOTDIR
 194 }
 195 my $pid = fork();
 196 die("fork() failed: $!") unless defined $pid;
 197
 198 if ($pid > 0) {
 199     # parent process
 200     exit(0);
 201 }
 202 if ($pidfile) {
 203     open(PIDFILE, '>', $pidfile);
 204     print PIDFILE $$, "\n";
 205     close(PIDFILE);
 206 }
 207 Fuse::main(
 208     'mountpoint'    => $mountpoint,
 209     'getattr'       => 'main::x_getattr',
 210     'readlink'      => 'main::x_readlink',
 211     'getdir'        => 'main::x_getdir',
 212     'mknod'         => 'main::x_mknod',
 213     'mkdir'         => 'main::x_mkdir',
 214     'unlink'        => 'main::x_unlink',
 215     'rmdir'         => 'main::x_rmdir',
 216     'symlink'       => 'main::x_symlink',
 217     'rename'        => 'main::x_rename',
 218     'link'          => 'main::x_link',
 219     'chmod'         => 'main::x_chmod',
 220     'chown'         => 'main::x_chown',
 221     'truncate'      => 'main::x_truncate',
 222     'utime'         => 'main::x_utime',
 223     'open'          => 'main::x_open',
 224     'read'          => 'main::x_read',
 225     'write'         => 'main::x_write',
 226     'statfs'        => 'main::x_statfs',
 227     %extraopts,
 228 );
 229
 230 # vim: ts=4 ai et hls