/[fuse.before_github]/perl-llin/examples/loopback_t.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_t.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.26