Perl'de Sigorta ile Sanal Dosya Sistemi

Question

Perl'de bir sanal dosya sistemi oluşturmama yardımcı olan var. Çok basit , 2 derinlik seviyesi,

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

gibi Fuse.pm kullanmak çalışıyorum, ama altdiz seviyesini oluşturmak nasıl anlamıyorum. % Dosya karması oluşturuyorum ve alt sınıfa geçerse yeni kayıtlarla yeniden oluşturun. Sadece test için. Gerçekten Fuse modülü, FUSE sisteminin ne düzenli bir kullanıcı değilim

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

bir düzey ince montaj, ancak daha derin giderseniz ben

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

Answer 1

olsun. Bu konuyla saf meraktan tinkered. Bu nedenle, hedefinize ulaşmak için düz Sigorta modülünü nasıl kullanacağımı çok fazla ayrıntıda açıklayamasam da, istediğim dosya sistemini (çalışma sistemimdeki) yaratan bir çalışma kodum var. herhangi bir keyfi dosya sistemi ağacı) ve bu kodu nasıl çalıştığımı açıklayabilirim.

Her şeyden önce CPAN üzerindeki Fuse::Simple modülünü keşfettim. SYNOPSIS, bir karma yapısından rasgele dosya sistemlerini oluşturmak için Sigorta modülüne gerçekten basit bir API sağladığını gösterir. Onun source code o kadar büyük değil, bu yüzden 'listing.pl' betik dosyasını yarattım ve fonksiyonların çoğunu orada kopyaladım (Modification of a read-only value istisnasına neden olan fserr hariç), ana alt içeriği dışarıya koyar, böylece ana betiğin akış, dosya sistemi yapısını ($fs var) kodladı ve burada ve orada bazı küçük ayarlamalar yaptı (istisnaları önlemek için belirtme bildirimi gibi) ve son olarak, listelenen tüm dizinler ve dosyalar okunabilir olan dosya sistemini aldım. Yani bu son aldığım kodudur:

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

Son söz: Ben dağıtımımın paket depoda listede yok (modülü kendisi kullanmayı deneyin vermedi, ben yüklemek için) fazla (tembel üzüldüm cpanm veya başka bir şekilde). Ama sanırım eğer FUSE'yi Perl ile kullanmak zorundaysam muhtemelen Muuse :: Simple yerine Fuse :: Simple kullanabilirim. Ben sadece akademik araştırmam için düz Sigorta kullanırım, sanırım ...

Bu yardımcı olur umarım.