On Perl 5.8, lchown() sometimes ends up with leaked errno; declare $! local.
[perl-fuse.git] / 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 my ($mountpoint) = '';
179 $mountpoint = shift(@ARGV) if @ARGV;
180
181 if (! -d $mountpoint) {
182     print STDERR "ERROR: attempted to mount to non-directory\n";
183     return -&ENOTDIR
184 }
185 my $pid = fork();
186 die("fork() failed: $!") unless defined $pid;
187
188 if ($pid > 0) {
189     # parent process
190     exit(0);
191 }
192 if ($pidfile) {
193     open(PIDFILE, '>', $pidfile);
194     print PIDFILE $$, "\n";
195     close(PIDFILE);
196 }
197 Fuse::main(
198     'mountpoint'    => $mountpoint,
199     'getattr'       => 'main::x_getattr',
200     'readlink'      => 'main::x_readlink',
201     'getdir'        => 'main::x_getdir',
202     'mknod'         => 'main::x_mknod',
203     'mkdir'         => 'main::x_mkdir',
204     'unlink'        => 'main::x_unlink',
205     'rmdir'         => 'main::x_rmdir',
206     'symlink'       => 'main::x_symlink',
207     'rename'        => 'main::x_rename',
208     'link'          => 'main::x_link',
209     'chmod'         => 'main::x_chmod',
210     'chown'         => 'main::x_chown',
211     'truncate'      => 'main::x_truncate',
212     'utime'         => 'main::x_utime',
213     'open'          => 'main::x_open',
214     'read'          => 'main::x_read',
215     'write'         => 'main::x_write',
216     'statfs'        => 'main::x_statfs',
217     %extraopts,
218 );
219
220 # vim: ts=4 ai et hls