added example filesystem which uses Filesys::Statvfs to implement statfs
[perl-fuse.git] / examples / loopback-statvfs.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use blib;
5 use Fuse;
6 use IO::File;
7 use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
8 use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);
9 require 'syscall.ph'; # for SYS_mknod and SYS_lchown
10 use Filesys::Statvfs;
11
12 my $tmp_path = "/tmp/fusetest-" . $ENV{LOGNAME};
13 if (! -e $tmp_path) {
14         mkdir($tmp_path) || die "can't create $tmp_path: $!";
15 }
16
17 sub fixup { return $tmp_path . shift }
18
19 sub x_getattr {
20         my ($file) = fixup(shift);
21         my (@list) = lstat($file);
22         return -$! unless @list;
23         return @list;
24 }
25
26 sub x_getdir {
27         my ($dirname) = fixup(shift);
28         unless(opendir(DIRHANDLE,$dirname)) {
29                 return -ENOENT();
30         }
31         my (@files) = readdir(DIRHANDLE);
32         closedir(DIRHANDLE);
33         return (@files, 0);
34 }
35
36 sub x_open {
37         my ($file) = fixup(shift);
38         my ($mode) = shift;
39         return -$! unless sysopen(FILE,$file,$mode);
40         close(FILE);
41         return 0;
42 }
43
44 sub x_read {
45         my ($file,$bufsize,$off) = @_;
46         my ($rv) = -ENOSYS();
47         my ($handle) = new IO::File;
48         return -ENOENT() unless -e ($file = fixup($file));
49         my ($fsize) = -s $file;
50         return -ENOSYS() unless open($handle,$file);
51         if(seek($handle,$off,SEEK_SET)) {
52                 read($handle,$rv,$bufsize);
53         }
54         return $rv;
55 }
56
57 sub x_write {
58         my ($file,$buf,$off) = @_;
59         my ($rv);
60         return -ENOENT() unless -e ($file = fixup($file));
61         my ($fsize) = -s $file;
62         return -ENOSYS() unless open(FILE,'+<',$file);
63         if($rv = seek(FILE,$off,SEEK_SET)) {
64                 $rv = print(FILE $buf);
65         }
66         $rv = -ENOSYS() unless $rv;
67         close(FILE);
68         return length($buf);
69 }
70
71 sub err { return (-shift || -$!) }
72
73 sub x_readlink { return readlink(fixup(shift)                 ); }
74 sub x_unlink { return unlink(fixup(shift)) ? 0 : -$!;          }
75 sub x_rmdir { return err(rmdir(fixup(shift))               ); }
76
77 sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }
78
79 sub x_rename {
80         my ($old) = fixup(shift);
81         my ($new) = fixup(shift);
82         my ($err) = rename($old,$new) ? 0 : -ENOENT();
83         return $err;
84 }
85 sub x_link {
86         my ($from) = shift;
87         my ($to) = shift;
88         print "link $from -> $to\n";
89         my ($err) = link(fixup($from),fixup($to)) ? 0 : -$!;
90         return $err;
91 }
92 sub x_chown {
93         my ($fn) = fixup(shift);
94         print "nonexistent $fn\n" unless -e $fn;
95         my ($uid,$gid) = @_;
96         # perl's chown() does not chown symlinks, it chowns the symlink's
97         # target.  it fails when the link's target doesn't exist, because
98         # the stat64() syscall fails.
99         # this causes error messages when unpacking symlinks in tarballs.
100         my ($err) = syscall(&SYS_lchown,$fn,$uid,$gid,$fn) ? -$! : 0;
101         return $err;
102 }
103 sub x_chmod {
104         my ($fn) = fixup(shift);
105         my ($mode) = shift;
106         my ($err) = chmod($mode,$fn) ? 0 : -$!;
107         return $err;
108 }
109 sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
110 sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }
111
112 sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
113 sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
114
115 sub x_mknod {
116         # since this is called for ALL files, not just devices, I'll do some checks
117         # and possibly run the real mknod command.
118         my ($file, $modes, $dev) = @_;
119         $file = fixup($file);
120         $! = 0;
121         syscall(&SYS_mknod,$file,$modes,$dev);
122         return -$!;
123 }
124
125 # kludge
126 sub x_statfs {
127         my $name = fixup(shift);
128         my($bsize, $frsize, $blocks, $bfree, $bavail,
129                 $files, $ffree, $favail, $fsid, $basetype, $flag,
130                 $namemax, $fstr) = statvfs("/tmp") || return -$!;
131         return ($namemax, $files, $ffree, $blocks, $bavail, $bsize);
132 }
133         
134 my ($mountpoint) = "";
135 $mountpoint = shift(@ARGV) if @ARGV;
136 Fuse::main(
137         mountpoint=>$mountpoint,
138         getattr =>"main::x_getattr",
139         readlink=>"main::x_readlink",
140         getdir  =>"main::x_getdir",
141         mknod   =>"main::x_mknod",
142         mkdir   =>"main::x_mkdir",
143         unlink  =>"main::x_unlink",
144         rmdir   =>"main::x_rmdir",
145         symlink =>"main::x_symlink",
146         rename  =>"main::x_rename",
147         link    =>"main::x_link",
148         chmod   =>"main::x_chmod",
149         chown   =>"main::x_chown",
150         truncate=>"main::x_truncate",
151         utime   =>"main::x_utime",
152         open    =>"main::x_open",
153         read    =>"main::x_read",
154         write   =>"main::x_write",
155         statfs  =>"main::x_statfs",
156         threaded=>0,
157         debug => 1,
158 );