/[fuse.before_github]/perl/trunk/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

Annotation of /perl/trunk/examples/loopback_t.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 98 - (hide annotations)
Tue Jan 3 16:45:51 2006 UTC (16 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 3606 byte(s)
subversion revision 71 commited to CVS

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

  ViewVC Help
Powered by ViewVC 1.1.26