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 S_ISCHR S_ISBLK S_ISSOCK);
  32 use Getopt::Long;
  33 use Lchown;
  34 use Unix::Mknod qw(:all);
  35
  36 my %extraopts = ( 'threaded' => 0, 'debug' => 0 );
  37 my($use_real_statfs, $pidfile);
  38 GetOptions(
  39     'use-threads'       => sub {
  40         if ($has_threads) {
  41             $extraopts{'threaded'} = 1;
  42         }
  43     },
  44     'debug'             => sub {
  45         $extraopts{'debug'} = 1;
  46     },
  47     'use-real-statfs'   => \$use_real_statfs,
  48     'pidfile=s'         => \$pidfile,
  49 ) || die('Error parsing options');
  50
  51 sub fixup { return "/tmp/fusetest-" . $ENV{LOGNAME} . shift }
  52
  53 sub x_getattr {
  54     my ($file) = fixup(shift);
  55     my (@list) = lstat($file);
  56     return -$! unless @list;
  57     return @list;
  58 }
  59
  60 sub x_getdir {
  61     my ($dirname) = fixup(shift);
  62     unless(opendir(DIRHANDLE,$dirname)) {
  63         return -ENOENT();
  64     }
  65     my (@files) = readdir(DIRHANDLE);
  66     closedir(DIRHANDLE);
  67     return (@files, 0);
  68 }
  69
  70 sub x_open {
  71     my ($file) = fixup(shift);
  72     my ($mode) = shift;
  73     return -$! unless sysopen(FILE,$file,$mode);
  74     close(FILE);
  75     return 0;
  76 }
  77
  78 sub x_read {
  79     my ($file,$bufsize,$off) = @_;
  80     my ($rv) = -ENOSYS();
  81     my ($handle) = new IO::File;
  82     return -ENOENT() unless -e ($file = fixup($file));
  83     my ($fsize) = -s $file;
  84     return -ENOSYS() unless open($handle,$file);
  85     if(seek($handle,$off,SEEK_SET)) {
  86         read($handle,$rv,$bufsize);
  87     }
  88     return $rv;
  89 }
  90
  91 sub x_write {
  92     my ($file,$buf,$off) = @_;
  93     my ($rv);
  94     return -ENOENT() unless -e ($file = fixup($file));
  95     my ($fsize) = -s $file;
  96     return -ENOSYS() unless open(FILE,'+<',$file);
  97     if($rv = seek(FILE,$off,SEEK_SET)) {
  98         $rv = print(FILE $buf);
  99     }
 100     $rv = -ENOSYS() unless $rv;
 101     close(FILE);
 102     return length($buf);
 103 }
 104
 105 sub err { return (-shift || -$!) }
 106
 107 sub x_readlink { return readlink(fixup(shift));         }
 108 sub x_unlink   { return unlink(fixup(shift)) ? 0 : -$!; }
 109
 110 sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }
 111
 112 sub x_rename {
 113     my ($old) = fixup(shift);
 114     my ($new) = fixup(shift);
 115     my ($err) = rename($old,$new) ? 0 : -ENOENT();
 116     return $err;
 117 }
 118 sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
 119 sub x_chown {
 120     my ($fn) = fixup(shift);
 121     local $!;
 122     print "nonexistent $fn\n" unless -e $fn;
 123     my ($uid,$gid) = @_;
 124     lchown($uid, $gid, $fn);
 125     return -$!;
 126 }
 127 sub x_chmod {
 128     my ($fn) = fixup(shift);
 129     my ($mode) = shift;
 130     my ($err) = chmod($mode,$fn) ? 0 : -$!;
 131     return $err;
 132 }
 133 sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
 134 sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }
 135
 136 sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
 137 sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
 138
 139 sub x_mknod {
 140     # since this is called for ALL files, not just devices, I'll do some checks
 141     # and possibly run the real mknod command.
 142     my ($file, $modes, $dev) = @_;
 143     $file = fixup($file);
 144     undef $!;
 145     if (S_ISREG($modes)) {
 146         open(FILE, '>', $file) || return -$!;
 147         print FILE '';
 148         close(FILE);
 149         chmod S_IMODE($modes), $file;
 150         return 0;
 151     }
 152     elsif (S_ISFIFO($modes)) {
 153         my ($rv) = POSIX::mkfifo($file, S_IMODE($modes));
 154         return $rv ? 0 : -POSIX::errno();
 155     }
 156     elsif (S_ISCHR($modes) || S_ISBLK($modes)) {
 157         mknod($file, $modes, $dev);
 158         return -$!;
 159     }
 160     # S_ISSOCK maybe should be handled; however, for our test it should
 161     # not really matter.
 162     else {
 163         return -&ENOSYS;
 164     }
 165     return -$!;
 166 }
 167
 168 # kludge
 169 sub x_statfs {
 170     if ($has_Filesys__Statvfs && $use_real_statfs) {
 171         (my($bsize, $frsize, $blocks, $bfree, $bavail,
 172             $files, $ffree, $favail, $flag,
 173             $namemax) = statvfs('/tmp')) || return -$!;
 174         return ($namemax, $files, $ffree, $blocks, $bavail, $bsize);
 175     }
 176     return 255,1000000,500000,1000000,500000,4096;
 177 }
 178
 179 # Required for some edge cases where a simple fork() won't do.
 180 # from http://perldoc.perl.org/perlipc.html#Complete-Dissociation-of-Child    -from-Parent
 181 sub daemonize {
 182     chdir("/") || die "can't chdir to /: $!";
 183     open(STDIN, "< /dev/null") || die "can't read /dev/null: $!";
 184     open(STDOUT, "> /dev/null") || die "can't write to /dev/null: $!";
 185     defined(my $pid = fork()) || die "can't fork: $!";
 186     exit if $pid; # non-zero now means I am the parent
 187     (setsid() != -1) || die "Can't start a new session: $!";
 188     open(STDERR, ">&STDOUT") || die "can't dup stdout: $!";
 189
 190     if ($pidfile) {
 191         open(PIDFILE, '>', $pidfile);
 192         print PIDFILE $$, "\n";
 193         close(PIDFILE);
 194     }
 195 }
 196
 197 my ($mountpoint) = '';
 198 $mountpoint = shift(@ARGV) if @ARGV;
 199
 200 if (! -d $mountpoint) {
 201     print STDERR "ERROR: attempted to mount to non-directory\n";
 202     return -&ENOTDIR
 203 }
 204
 205 daemonize();
 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