/[fuse.before_github]/perl-llin/examples/loopback.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /perl-llin/examples/loopback.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 112 - (show annotations)
Thu Nov 15 09:32:08 2007 UTC (15 years ago) by dpavlin
File MIME type: text/plain
File size: 4329 byte(s)
patch from Chris Dolan via rt.cpan.org #30631

This patch gets Fuse.pm to half-work on MacOSX with the current release
of MacFuse (v1.1.0).  By half-work, I mean that all of the directory
actions and file read actions work, but anything that involves writing a
file fails.  This appears to be because the latest MacFUSE implements
FUSE 2.6, which prefers to call CREATE instead of MKNOD.  Nonetheless,
recommend that something like this patch be included because it makes
read-only filesystems usable on Darwin systems.  Some of my changes
(like kill() instead of system("kill")) are improvements on any system.
												    I've tested only on my PowerPC G5 iMac running 10.4.

I intend to also try MacFUSE v0.4 via Fink, but that version is                                     
reportedly less stable than the latest MacFUSE.                                                     
1 #!/usr/bin/perl -w
2 use strict;
3
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 my $can_syscall = eval {
10 require 'syscall.ph'; # for SYS_mknod and SYS_lchown
11 };
12 if (!$can_syscall && open my $fh, '<', '/usr/include/sys/syscall.h') {
13 local $/ = undef;
14 my %sys = do { local $/ = undef;
15 <$fh> =~ m/\#define \s+ (\w+) \s+ (\d+)/gxms;
16 };
17 close $fh;
18 if ($sys{SYS_mknod} && $sys{SYS_lchown}) {
19 *SYS_mknod = sub { $sys{SYS_mknod} };
20 *SYS_lchown = sub { $sys{SYS_lchown} };
21 $can_syscall = 1;
22 }
23 }
24
25 my $tmp = -d '/private' ? '/private/tmp' : '/tmp';
26 my $tmp_path = "$tmp/fusetest-" . $ENV{LOGNAME};
27 if (! -e $tmp_path) {
28 mkdir($tmp_path) || die "can't create $tmp_path: $!";
29 }
30
31 sub fixup { print STDERR "fixup $_[0] from @{[caller]}\n";
32 my ($path) = @_;
33 return $tmp_path if $path eq '/';
34 return $tmp_path . $path;
35 }
36
37 sub x_getattr {
38 my ($file) = fixup(shift);
39 my (@list) = lstat($file);
40 return -$! unless @list;
41 return @list;
42 }
43
44 sub x_getdir {
45 my ($dirname) = fixup(shift);
46 unless(opendir(DIRHANDLE,$dirname)) {
47 return -ENOENT();
48 }
49 my (@files) = readdir(DIRHANDLE);
50 closedir(DIRHANDLE);
51 return (@files, 0);
52 }
53
54 sub x_open {
55 my ($file) = fixup(shift);
56 my ($mode) = shift;
57 return -$! unless sysopen(FILE,$file,$mode);
58 close(FILE);
59 return 0;
60 }
61
62 sub x_read {
63 my ($file,$bufsize,$off) = @_;
64 my ($rv) = -ENOSYS();
65 my ($handle) = new IO::File;
66 return -ENOENT() unless -e ($file = fixup($file));
67 my ($fsize) = -s $file;
68 return -ENOSYS() unless open($handle,$file);
69 if(seek($handle,$off,SEEK_SET)) {
70 read($handle,$rv,$bufsize);
71 }
72 return $rv;
73 }
74
75 sub x_write {
76 my ($file,$buf,$off) = @_;
77 my ($rv);
78 return -ENOENT() unless -e ($file = fixup($file));
79 my ($fsize) = -s $file;
80 return -ENOSYS() unless open(FILE,'+<',$file);
81 if($rv = seek(FILE,$off,SEEK_SET)) {
82 $rv = print(FILE $buf);
83 }
84 $rv = -ENOSYS() unless $rv;
85 close(FILE);
86 return length($buf);
87 }
88
89 sub err { return (-shift || -$!) }
90
91 sub x_readlink { return readlink(fixup(shift)); }
92 sub x_unlink { return unlink(fixup(shift)) ? 0 : -$!; }
93
94 sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }
95
96 sub x_rename {
97 my ($old) = fixup(shift);
98 my ($new) = fixup(shift);
99 my ($err) = rename($old,$new) ? 0 : -ENOENT();
100 return $err;
101 }
102 sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
103 sub x_chown {
104 return -ENOSYS() if ! $can_syscall;
105 my ($fn) = fixup(shift);
106 print "nonexistent $fn\n" unless -e $fn;
107 my ($uid,$gid) = @_;
108 # perl's chown() does not chown symlinks, it chowns the symlink's
109 # target. it fails when the link's target doesn't exist, because
110 # the stat64() syscall fails.
111 # this causes error messages when unpacking symlinks in tarballs.
112 my ($err) = syscall(&SYS_lchown,$fn,$uid,$gid,$fn) ? -$! : 0;
113 return $err;
114 }
115 sub x_chmod {
116 my ($fn) = fixup(shift);
117 my ($mode) = shift;
118 my ($err) = chmod($mode,$fn) ? 0 : -$!;
119 return $err;
120 }
121 sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
122 sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }
123
124 sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
125 sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
126
127 sub x_mknod {
128 return -ENOSYS() if ! $can_syscall;
129 # since this is called for ALL files, not just devices, I'll do some checks
130 # and possibly run the real mknod command.
131 my ($file, $modes, $dev) = @_;
132 $file = fixup($file);
133 $! = 0;
134 syscall(&SYS_mknod,$file,$modes,$dev);
135 return -$!;
136 }
137
138 # kludge
139 sub x_statfs {return 255,1000000,500000,1000000,500000,4096}
140 my ($mountpoint) = "";
141 $mountpoint = shift(@ARGV) if @ARGV;
142 Fuse::main(
143 mountpoint=>$mountpoint,
144 getattr =>"main::x_getattr",
145 readlink=>"main::x_readlink",
146 getdir =>"main::x_getdir",
147 mknod =>"main::x_mknod",
148 mkdir =>"main::x_mkdir",
149 unlink =>"main::x_unlink",
150 rmdir =>"main::x_rmdir",
151 symlink =>"main::x_symlink",
152 rename =>"main::x_rename",
153 link =>"main::x_link",
154 chmod =>"main::x_chmod",
155 chown =>"main::x_chown",
156 truncate=>"main::x_truncate",
157 utime =>"main::x_utime",
158 open =>"main::x_open",
159 read =>"main::x_read",
160 write =>"main::x_write",
161 statfs =>"main::x_statfs",
162 threaded=>0,
163 debug => 1,
164 );

  ViewVC Help
Powered by ViewVC 1.1.26