퓨즈가있는 Perl의 가상 파일 시스템

Question

누구나 펄에서 가상 파일 시스템을 만들 수있게 도와주세요. 아주 간단한 , 2 심도 수준,

/subdir 
    subdir-l2 
    file2.txt 
/file1.txt 

으로 나는 Fuse.pm를 사용하려고 노력하지만, 서브 디렉토리 레벨을 작성하는 방법을 이해하지. % 파일 해시를 만들고 하위 디렉토리로 이동하는 경우 새 레코드로 다시 만드십시오. 테스트 용입니다. 난 정말 퓨즈 모듈, 퓨즈 시스템의도의 일반 사용자 아니에요

#!/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, 
     mode => 0755, 
     ctime => 1490603721 
    }, 
    "file1.txt" => { 
      type => 0100, 
      mode => 0755, 
      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, 
        mode => 0755, 
        ctime => 1490603721  
       }, 

       # /subdir/subdir-l2 
       "subdir-l2" => { 
        type => 0040, 
        mode => 0755, 
        ctime => 1490603721  
       } , 

       # /subdir/a-l2.file 
       "file2.txt" => { 
        cont => "File 'al2'.\n", 
        type => 0100, 
        mode => 0755, 
        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,0,0,1,0,0,1,1024); 
    my ($atime, $ctime, $mtime); 
    $atime = $ctime = $mtime = $files{$file}{ctime}; 
    return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks); 
} 

Fuse::main(
    mountpoint => "/tmp/123", 
    getdir  => \&getdir, 
    getattr  => \&getattr, 
); 

한 단계 잘 마운트, 그러나 깊이에 가면 내가

?????????? ? ? ? ?   ? file2.txt 
?????????? ? ? ? ?   ? subdir-l2 

Answer 1

를 얻을. 순수한 호기심에서이 문제로 고생했습니다. 따라서, 비록 내가 당신의 목표를 달성하기 위해 평범한 퓨즈 모듈을 사용하는 방법을 자세히 설명 할 수는 없지만 필자는 적어도 필자의 시스템에서는 원하는 파일 시스템을 만드는 작업 코드를 가지고있다. 임의의 파일 시스템 트리),이 코드가 어떻게 작동하는지 설명 할 수 있습니다.

먼저 CPAN에서 Fuse::Simple 모듈을 발견했습니다. SYNOPSIS는 해시 구조에서 임의의 파일 시스템을 생성하기위한 Fuse 모듈에 매우 간단한 API를 제공한다는 것을 보여줍니다. 이것의 source code은 그렇게 크지 않아서 'listing.pl'스크립트 파일을 만들었고 대부분의 기능 (fserr을 제외하고는 Modification of a read-only value 예외가 발생 함)을 복사하여 메인 하위 컨텐츠를 꺼내 주 스크립트가되도록했습니다. 흐름, 파일 시스템 구조 ($fs var)를 하드 코드하고 예외를 방지하기 위해 my과 같이 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_ACCMODE(), 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, 0,  # $dev, $ino, 
    $mode, 
    1,   # $nlink, see fuse.sourceforge.net/wiki/index.php/FAQ 
    $uid, $gid, # $uid, $gid, 
    0,   # $rdev, 
    $size,  # $size, 
    $ctime, $ctime, $ctime, # actually $atime, $mtime, $ctime, 
    1024, 1, # $blksize, $blocks, 
    ); 
} 

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 ",ref($obj)," $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, 
     1,1, # $files, $files_free, 
     1,1, # $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, $buf, $off); # this runs the coderefs! 
    return -$$obj if ref($obj) eq "ERROR"; 
    return length($buf); 
} 

최종 단어 : 나는 그것이 내 배포판의 패키지 저장소에없는 것 (모듈 자체를 사용하려고하지 않았고, 내가 설치가) 너무 (게으른 미안 cpanm 또는 다른 방법으로). 하지만 펄을 사용하여 FUSE를 사용해야한다면 Fuse 대신 Fuse :: Simple을 사용할 것입니다. 나는 평범한 퓨즈를 나의 학문적 인 연구만을 위해서 쓰고 싶다. 나는 생각한다 ...

희망이있다.