ヒューズ付きPerlでの仮想ファイルシステム

Question

誰でも、Perlで仮想ファイルシステムを作るのを手伝ってください。非常にシンプルな 、2深さレベル、

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

ように私はFuse.pmを使用しようとしますが、サブディレクトリレベルの作成方法を理解していません。 ％filesハッシュを作成し、サブディレクトリに移動する場合は新しいレコードで再作成します。テスト用です。私は本当にヒューズモジュール、FUSEシステムのどちらの正規の利用者ではないよ

#!/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, 
); 

1レベルが細かいマウントが、より深くに行けば、私は

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

Answer 1

を取得します。純粋な好奇心からこの問題に触れたしたがって、私はあなたの目標を達成するためにプレーンなヒューズモジュールを使用する方法を非常に詳細に説明することはできませんが、私は望むファイルシステムを作成する作業コードを持っています（少なくとも私のシステムでは、任意のファイルシステムツリー）、私はこのコードをどのように動作させるか説明することができます。

最初に、私はFuse::SimpleというCPANのモジュールを発見しました。 SYNOPSISは、ハッシュ構造から任意のファイルシステムを作成するためのヒューズモジュールに本当にシンプルな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をPerlで使う必要があれば、おそらくFuseの代わりにFuse :: Simpleを使うでしょう。私は、私の学術研究のためだけに普通のヒューズを使用すると思います。

希望があれば幸いです。