任何人帮助我在Perl中创建一个虚拟文件系统.
非常简单,2深度级,as
非常简单,2深度级,as
/subdir subdir-l2 file2.txt /file1.txt
我尝试使用Fuse.pm,但不明白如何创建subdir级别.我创建%文件哈希,如果转到subdir,重新创建新的记录.仅供测试.
#!/usr/bin/env perl use strict; use warnings; use utf8; use Fuse; use POSIX qw(ENOENT EISDIR EINVAL); my (%files) = ( '.' => { type => 0040,mode => 0755,ctime => 1490603721 },subdir => { type => 0040,"file1.txt" => { type => 0100,ctime => 1490603721 } ); sub filename_fixup { my ($file) = shift; $file =~ s,^/,; $file = '.' unless length($file); return $file; } sub getdir { my $tmp = shift; if ($tmp eq '/') { return (keys %files),0; } else { (%files) = ( '.' => { type => 0040,ctime => 1490603721 },# /subdir/subdir-l2 "subdir-l2" => { type => 0040,# /subdir/a-l2.file "file2.txt" => { cont => "File 'al2'.\n",type => 0100,ctime => 1490603721 } ); return (keys %files),0; } } sub getattr { my ($file) = filename_fixup(shift); $file =~ s,; $file = '.' unless length($file); return -ENOENT() unless exists($files{$file}); my ($size) = exists($files{$file}{cont}) ? length($files{$file}{cont}) : 0; $size = $files{$file}{size} if exists $files{$file}{size}; my ($modes) = ($files{$file}{type}<<9) + $files{$file}{mode}; my ($dev,$ino,$rdev,$blocks,$gid,$uid,$nlink,$blksize) = (0,1,1024); my ($atime,$ctime,$mtime); $atime = $ctime = $mtime = $files{$file}{ctime}; return ($dev,$modes,$size,$atime,$mtime,$blksize,$blocks); } Fuse::main( mountpoint => "/tmp/123",getdir => \&getdir,getattr => \&getattr,);
一级安装罚款,但如果去深入我得到
?????????? ? ? ? ? ? file2.txt ?????????? ? ? ? ? ? subdir-l2
解决方法
我真的不是Fuse模块的常规用户,也不是FUSE系统.从纯粹的好奇心中解决了这个问题.因此,尽管我无法非常详细地解释如何使用简单的保险丝模块来实现您的目标,但是我有一个工作代码可以创建所需的文件系统(至少在我的系统上,似乎它能够创建任何任意的文件系统树),我可以解释我如何使这个代码工作.
所以首先我发现了CPAN上的Fuse::Simple模块.
其概要表明,它为保险丝模块提供了一个非常简单的API,用于从散列结构创建任意文件系统.它的source code不是那么大,所以我刚刚创建了’listing.pl’脚本文件,并复制了大部分功能(除了fserr导致修改只读值异常),把主要的子内容放出来,所以它们将是主脚本的流程,硬编码文件系统结构($fs var),并在此处进行了一些微小的调整(像我的声明vars以防止异常),最后得到文件系统挂载,列出所有目录和文件可读.所以这是我最后得到的代码:
#!/usr/bin/env perl use strict; use warnings; use diagnostics; use Carp; use Fuse; use Errno qw(:POSIX); # ENOENT EISDIR etc use Fcntl qw(:DEFAULT :mode); # S_IFREG S_IFDIR,O_SYNC O_LARGEFILE etc. use Switch; my $debug = 0; my %codecache = (); my $ctime = time(); my $uid = $>; my $gid = $) + 0; my $fs = { "file1.txt" => "File 1 contents","subdir" => { "subdir-l2" => {},"file2.txt" => "File 2 contents" } }; # some default args my %args = ( "mountpoint" => "listing","debug" => $debug,"fuse_debug" => 0,"threaded" => 0,"/" => $fs ); # the default subs my %fs_subs = ( "chmod" => \&fs_not_imp,"chown" => \&fs_not_imp,"flush" => \&fs_flush,"fsync" => \&fs_not_imp,"getattr" => \&fs_getattr,"getdir" => \&fs_getdir,"getxattr" => \&fs_not_imp,"link" => \&fs_not_imp,"listxattr" => \&fs_not_imp,"mkdir" => \&fs_not_imp,"mknod" => \&fs_not_imp,"open" => \&fs_open,"read" => \&fs_read,"readlink" => \&fs_readlink,"release" => \&fs_release,"removexattr" => \&fs_not_imp,"rmdir" => \&fs_not_imp,"rename" => \&fs_not_imp,"setxattr" => \&fs_not_imp,"statfs" => \&fs_statfs,"symlink" => \&fs_not_imp,"truncate" => \&fs_truncate,"unlink" => \&fs_not_imp,"utime" => sub{return 0},"write" => \&fs_write,); # except extract these ones back out. $debug = delete $args{"debug"}; $args{"debug"} = delete( $args{"fuse_debug"} ) || 0; delete $args{"/"}; # add the functions,if not already defined. # wrap in debugger if debug is set. for my $name (keys %fs_subs) { my $sub = $fs_subs{$name}; # $sub = wrap($sub,$name) if $debug; $args{$name} ||= $sub; } Fuse::main(%args); sub fetch { my ($path,@args) = @_; my $obj = $fs; for my $elem (split '/',$path) { next if $elem eq ""; # skip empty // and before first / $obj = runcode($obj); # if there's anything to run # the dir we're changing into must be a hash (dir) return ENOTDIR() unless ref($obj) eq "HASH"; # note that ENOENT and undef are NOT the same thing! return ENOENT() unless exists $obj->{$elem}; $obj = $obj->{$elem}; } return runcode($obj,@args); } sub runcode { my ($obj,@args) = @_; while (ref($obj) eq "CODE") { my $old = $obj; if (@args) { # run with these args. don't cache delete $codecache{$old}; print "running $obj(",quoted(@args),") NO CACHE\n" if $debug; $obj = saferun($obj,@args); } elsif (exists $codecache{$obj}) { # found in cache print "got cached $obj\n" if $debug; $obj = $codecache{$obj}; # could be undef,or an error,BTW } else { print "running $obj() to cache\n" if $debug; $obj = $codecache{$old} = saferun($obj); } if (ref($obj) eq "NOCACHE") { print "returned a nocache() value - flushing\n" if $debug; delete $codecache{$old}; $obj = $$obj; } print "returning ",ref($obj)," ",defined($obj) ? $obj : "undef","\n" if $debug; } return $obj; } sub saferun { my ($sub,@args) = @_; my $ret = eval { &$sub(@args) }; my $died = $@; if (ref($died)) { print "+++ Error $$died\n" if ref($died) eq "ERROR"; return $died; } elsif ($died) { print "+++ $died\n"; # stale file handle? moreorless? return ESTALE(); } return $ret; } sub nocache { return bless(\ shift,"NOCACHE"); # yup,utter abuse of bless :-) } sub dump_open_flags { my $flags = shift; printf " flags: 0%o = (",$flags; for my $bits ( [ O_ACCMODE(),O_RDONLY(),"O_RDONLY" ],[ O_ACCMODE(),O_WRONLY(),"O_WRONLY" ],O_RDWR(),"O_RDWR" ],[ O_APPEND(),O_APPEND(),"|O_APPEND" ],[ O_NONBLOCK(),O_NONBLOCK(),"|O_NONBLOCK" ],[ O_SYNC(),O_SYNC(),"|O_SYNC" ],[ O_DIRECT(),O_DIRECT(),"|O_DIRECT" ],[ O_LARGEFILE(),O_LARGEFILE(),"|O_LARGEFILE" ],[ O_nofollow(),O_nofollow(),"|O_nofollow" ],) { my ($mask,$flag,$name) = @$bits; if (($flags & $mask) == $flag) { $flags -= $flag; print $name; } } printf "| 0%o !!!",$flags if $flags; print ")\n"; } sub accessor { my $var_ref = shift; croak "accessor() requires a reference to a scalar var\n" unless defined($var_ref) && ref($var_ref) eq "SCALAR"; return sub { my $new = shift; $$var_ref = $new if defined($new); return $$var_ref; } } sub fs_not_imp { return -ENOSYS() } sub fs_flush { # we're passed a path,but finding my coderef stuff from a path # is a bit of a 'mare. flush the lot,won't hurt TOO much. print "Flushing\n" if $debug; %codecache = (); return 0; } sub easy_getattr { my ($mode,$size) = @_; return ( 0,# $dev,$mode,# $nlink,see fuse.sourceforge.net/wiki/index.PHP/FAQ $uid,# $uid,# $rdev,# $size,# actually $atime,1024,# $blksize,); } sub fs_getattr { my $path = shift; my $obj = fetch($path); # undef doesn't actually mean "file not found",it could be a coderef # file-sub which has returned undef. return easy_getattr(S_IFREG | 0200,0) unless defined($obj); switch (ref($obj)) { case "ERROR" { # this is an error to be returned. return -$$obj; } case "" { # this isn't a ref,it's a real string "file" return easy_getattr(S_IFREG | 0644,length($obj)); } # case "CODE" should never happen - already been run by fetch() case "HASH" { # this is a directory hash return easy_getattr(S_IFDIR | 0755,1); } case "SCALAR" { # this is a scalar ref. we use these for symlinks. return easy_getattr(S_IFLNK | 0777,1); } else { # what the hell is this file?!? print "+++ What on earth is "," $path ?\n"; return easy_getattr(S_IFREG | 0000,0); } } } sub fs_getdir { my $obj = fetch(shift); return -$$obj if ref($obj) eq "ERROR"; # THINK this is a good idea. return -ENOENT() unless ref($obj) eq "HASH"; return (".","..",sort(keys %$obj),0); } sub fs_open { # doesn't really need to open,just needs to check. my $obj = fetch(shift); my $flags = shift; dump_open_flags($flags) if $debug; # if it's undefined,and we're not writing to it,return an error return -EBADF() unless defined($obj) or ($flags & O_ACCMODE()); switch (ref($obj)) { case "ERROR" { return -$$obj; } case "" { return 0 } # this is a real string "file" case "HASH" { return -EISDIR(); } # this is a directory hash else { return -ENOSYS(); } # what the hell is this file?!? } } sub fs_read { my $obj = fetch(shift); my $size = shift; my $off = shift; return -ENOENT() unless defined($obj); return -$$obj if ref($obj) eq "ERROR"; # any other types of refs are probably bad return -ENOENT() if ref($obj); if ($off > length($obj)) { return -EINVAL(); } elsif ($off == length($obj)) { return 0; # EOF } return substr($obj,$off,$size); } sub fs_readlink { my $obj = fetch(shift); return -$$obj if ref($obj) eq "ERROR"; return -EINVAL() unless ref($obj) eq "SCALAR"; return $$obj; } sub fs_release { my ($path,$flags) = @_; dump_open_flags($flags) if $debug; return 0; } sub fs_statfs { return ( 255,# $namelen,# $files,$files_free,# $blocks,$blocks_avail,# 0,0 seems to hide it from df? 2,# $blocksize,); } sub fs_truncate { my $obj = fetch(shift,""); # run anything to set it to "" return -$$obj if ref($obj) eq "ERROR"; return 0; } sub fs_write { my ($path,$buf,$off) = @_; my $obj = fetch($path,$off); # this runs the coderefs! return -$$obj if ref($obj) eq "ERROR"; return length($buf); }
最后一句话:我没有尝试使用模块本身(它没有列在我的发行版软件包存储库中,而且我太懒了(抱歉)通过cpanm或其他方式安装它).但是我认为如果我必须使用FUSE与Perl,我可能只需要使用Fuse :: Simple而不是Fuse,也许分配它.我只用纯保险丝作为我的学术研究,我想…
希望这可以帮助.