/[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

Annotation of /perl-llin/examples/loopback_t.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 20 - (hide annotations)
Tue Dec 27 14:49:31 2005 UTC (18 years, 3 months ago) by dpavlin
Original Path: perl/trunk/examples/loopback_t.pl
File MIME type: text/plain
File size: 3596 byte(s)
added missing example, 0.07_1

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

  ViewVC Help
Powered by ViewVC 1.1.26