Portál AbcLinuxu, 8. listopadu 2025 14:03
28.7.2010 21:01
Jakub Lucký | skóre: 40
| Praha
user::rw- user:gemini:rwx group::r-- mask::rwx other::r--Já se snažím, aby z toho vzniklo vícedimenzionální hash, kde by se dalo přistupovat k datům zhruba takto: $acl{user}{gemini}{read}=1 Pokud máte svůj vlastní, jednoduchý nápad na řešení, klidně i s jiným způsobem uložení dat, nečtěte dále a navrhněte vaše řešení Mám nějaký svůj kód, který ale selhává právě na vytváření vícedimenzionální hashe... Kód není dokončený, výsledné spojení do jednoho hashe by se měl udít pomocí Hash::Merge, nicméně navazování těch hashí do té vícedimenzové nějak selhává... problémový řádek je označený komentářem, je skoro dole...
#!/usr/bin/perl -w
use strict;
use Data::Dump qw(dump);
my $string = "user::rw-
user:gemini:rwx
group::r--
mask::rwx
other::r--
";
#Stripping last end of line
$string =~ s/^$//g;
my @lines = split(/\n/,$string);
my %result = ();
my %output = ();
foreach my $line(@lines)
{
my @parts = split(/:/,$line);
#This small part of code is ugly hack for situation, when while dies, if $part is empty string (OMG why?)
if (!$parts[1] and $parts[2]) #FIXME
{
$parts[1] = 'NULL';
}
INTERN:while( my $part = pop(@parts))
{
if ($part =~ m/[r-][w-][x-]/)
{
my @perms = split(//,$part);
if($perms[0] eq 'r') { $result{'read'} = 1 }
else {$result{'read'} = 0 }
if($perms[1] eq 'w') { $result{'write'} = 1 }
else {$result{'write'} = 0 }
if($perms[2] eq 'x') { $result{'exec'} = 1 }
else {$result{'exec'} = 0 }
# print "$result{'read'},$result{'write'},$result{'exec'} \n";
}
else
{
my %meta = ();
%meta = %result;
%result = ();
#Tento radek vsechno rozbije!!
$result{$part} = %meta;
}
}
dump(%result);
}
Bohužel, výstup z toho vůbec není takový, jako by člověk čekal, označený řádek to nějak rozbije a výstupem dumpu je tohle...
jakub@gondolin:/tmp$ ./test.pl
("user", "1/8")
("user", "1/8")
("group", "1/8")
("mask", "1/8")
("other", "1/8")
Řešení dotazu:
28.7.2010 21:14
Jakub Lucký | skóre: 40
| Praha
29.7.2010 10:42
Jakub Lucký | skóre: 40
| Praha
$result{$part} = \%meta ... referencia na hash.
to "parts =~" skús takto:
if ($parts =~ m/([-r])([-w])([-x])/) {
$result{read} = $1 eq 'r';
$result{write} = $1 eq 'w';
$result{exec} = $1 eq 'x';
)
29.7.2010 10:42
Jakub Lucký | skóre: 40
| Praha
Pokud máte svůj vlastní, jednoduchý nápad na řešení, klidně i s jiným způsobem uložení dat, nečtěte dále a navrhněte vaše řešeníAsi by se dalo vymyslet 100 způsobů, jde o to, na co to chcete použít... Každopádně ale doporučuju u takovéto datové struktury použít rovnou referenci na hash (
$acl->{user}{gemini}) místo hashe.
Jinak se mi moc nezdá že by ten kód byl v Perlu :) zkusil jsem to napsat takto:
use Modern::Perl;
use Test::More tests => 1;
my @input = qw/user::rw- user:gemini:rwx group::r-- mask::rwx other::r--/;
my $expected_output = {
user => {
NULL => { read => 1, write => 1, execute => 0 },
gemini => { read => 1, write => 1, execute => 1 },
},
group => {
NULL => { read => 1, write => 0, execute => 0 },
},
mask => {
NULL => { read => 1, write => 1, execute => 1 },
},
other => {
NULL => { read => 1, write => 0, execute => 0 },
},
};
is_deeply(acl_as_hash(@input), $expected_output);
sub acl_as_hash {
my $output;
for my $line (@_) {
my ($type, $name, $priv) = split(/:/, $line, 3);
$name ||= 'NULL';
$output->{$type}->{$name} = _privs_for($priv);
}
return $output;
}
sub _privs_for {
my $priv = shift;
return {
read => $priv =~ /r/ ? 1 : 0,
write => $priv =~ /w/ ? 1 : 0,
execute => $priv =~ /x/ ? 1 : 0,
};
}
29.7.2010 15:36
Jakub Lucký | skóre: 40
| Praha
29.7.2010 16:06
Jakub Lucký | skóre: 40
| Praha
user:gemini:r-x tak můžeme mít ještě default:user:someone:rwx (můj blik: čtvrtý sloupec může být pouze(!!!) default)
A teď, když se na to dívám, tak to vážně šlo všechno udělat jednodušeji a já si jen trval na obecném řešení pro nekonečný počet sloupců
Důvod pro implementaci je zhruba takový, že potřebuju nějaké programovací rozhraní pro ACL, v Perl není vůbec (jen výše zmíněné nepřenositelné Solaris::ACL) a v Pythonu je jen python-libacl, které je celé nějaké divné...
tak jako máme user:gemini:r-x tak můžeme mít ještě default:user:someone:rwx (můj blik: čtvrtý sloupec může být pouze(!!!) default)Jo tohle. No, ale to bych asi držel oboje na stejné úrovni jinak v tom bude pěknej bordel.
Důvod pro implementaci je zhruba takový, že potřebuju nějaké programovací rozhraní pro ACLOK, v tom případě to berete za špatný konec. Začněte s tím, že to rozhraní použijete (i když ho nemáte), tím zjistíte, jaký potřebujete interface, a pak dodělejte tu implementaci. Datová struktura je implementační detail až úplně na konci. Třeba zjistíte že to chcete úplně jinak. Např.
my $acl = Moje::ACL->new('/home/franta');
if ($acl->readable_by('franta')) { ... }
nebo
my $acl = Moje::ACL->new( { franta => 'rw-' } );
$acl->apply_to('/home/franta');
atd.
29.7.2010 17:22
Jakub Lucký | skóre: 40
| Praha
No, do něčeho podobného to směřuju, akorát tu hash chci použít jako podklad pro ty funkce... Každopádně dobrá rada s tou implementací... (A taky jsem díky vám objevil Modern::Perl)Důvod pro implementaci je zhruba takový, že potřebuju nějaké programovací rozhraní pro ACLOK, v tom případě to berete za špatný konec. Začněte s tím, že to rozhraní použijete (i když ho nemáte), tím zjistíte, jaký potřebujete interface, a pak dodělejte tu implementaci. Datová struktura je implementační detail až úplně na konci. Třeba zjistíte že to chcete úplně jinak. Např.my $acl = Moje::ACL->new('/home/franta'); if ($acl->readable_by('franta')) { ... }
No, do něčeho podobného to směřuju, akorát tu hash chci použít jako podklad pro ty funkce... Každopádně dobrá rada s tou implementací...Pokud se Vám líbí ta objektová notace, tak zkuste třeba Moose. Jak říkám, jestli tam nakonec bude ten hash nebo něco jiného vyplyne z kontextu až budete psát
sub readable_by.
Tiskni
Sdílej:
ISSN 1214-1267, (c) 1999-2007 Stickfish s.r.o.