Linux-ACL-0.05/0000775000175000017500000000000013074247651013325 5ustar firefishfirefishLinux-ACL-0.05/MANIFEST0000664000175000017500000000015613074246050014450 0ustar firefishfirefishChanges MANIFEST Makefile.PL README lib/Linux/ACL.pm ACL.xs t/00-load.t t/manifest.t t/pod-coverage.t t/pod.t Linux-ACL-0.05/Makefile.PL0000664000175000017500000000177713074246050015303 0ustar firefishfirefishuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Linux::ACL', AUTHOR => q{Yuriy Nazarov }, VERSION_FROM => 'lib/Linux/ACL.pm', ABSTRACT_FROM => 'lib/Linux/ACL.pm', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Linux-ACL-*' }, LIBS => ['-lacl'], DEFINE => '', INC => '', (eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/nazarov-yuriy/Linux--ACL.git', web => 'https://github.com/nazarov-yuriy/Linux--ACL', }, }}) : () ), ); Linux-ACL-0.05/README0000664000175000017500000000277313074246050014206 0ustar firefishfirefishLinux-ACL The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it to get an idea of the module's uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Linux::ACL You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Linux-ACL AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Linux-ACL CPAN Ratings http://cpanratings.perl.org/d/Linux-ACL Search CPAN http://search.cpan.org/dist/Linux-ACL/ LICENSE AND COPYRIGHT Copyright (C) 2013 Yuriy Nazarov This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Linux-ACL-0.05/ignore.txt0000664000175000017500000000016713074246050015345 0ustar firefishfirefishblib* Makefile Makefile.old Build Build.bat _build* pm_to_blib* *.tar.gz .lwpcookies cover_db pod2htm*.tmp Linux-ACL-* Linux-ACL-0.05/lib/0000775000175000017500000000000013074246050014063 5ustar firefishfirefishLinux-ACL-0.05/lib/Linux/0000775000175000017500000000000013074246160015164 5ustar firefishfirefishLinux-ACL-0.05/lib/Linux/ACL.pm0000664000175000017500000001017013074245144016121 0ustar firefishfirefishpackage Linux::ACL; use warnings; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(getfacl setfacl); our $VERSION = '0.05'; require XSLoader; XSLoader::load('Linux::ACL', $VERSION); 1; =head1 NAME Linux::ACL - Perl extension for reading and setting Access Control Lists for files by libacl linux library. =head1 VERSION Version 0.05 =cut =head1 SYNOPSIS Quick summary of what the module does. Perhaps a little code snippet. use Linux::ACL; ($acl, $default_acl) = getfacl("path/to/file"); setfacl("path/to/file", $acl [, $default_acl]); =head1 EXPORT =over =item setfacl($$;$) Set the ACL of the file or directory named by C<$path> to that specified by C<$acl>. If C<$path> names a directory, then the optional C<$default_acl> argument can also be passed to specify the default ACL for the directory. See L<"ACL structure"> for information on how the C<$acl> and C<$default_acl> hashes should be constructed. =item getfacl($) Return a reference to a hash containing information about the file's ACL. If the file is a directory with a default ACL, then a list is returned, with the first entry being a hash reference to the ACL, and the second being a hash reference to the default ACL. See L<"Accessing ACL structures"> for information on how to access these hashes, and L<"ACL structure"> for information on how these hashes are internally constructed. =back =head1 RETURN VALUES =over =item setfacl returns TRUE if successful and FALSE if unsuccessful. =item getfacl if successful, returns a list containing a reference to the hash describing an acl, and, if there is a default acl, a reference to the hash describing the default acl. If unsuccessful, C returns a null list. =back =head1 Examples getfacl example use Linux::ACL; use Data::Dumper; my @a = getfacl("/tmp"); print Dumper \@a; prints: $VAR1 = [ { 'uperm' => { 'w' => 1, 'r' => 1, 'x' => 1 }, 'gperm' => { 'w' => 1, 'r' => 1, 'x' => 1 }, 'other' => { 'w' => 1, 'r' => 1, 'x' => 1 } } ]; setfacl example use Linux::ACL; setfacl("/mnt/testacl/d", { uperm=>{r=>1,w=>1,x=>1}, gperm=>{r=>1,w=>1,x=>1}, other=>{r=>1,w=>0,x=>1}, mask=>{r=>1,w=>1,x=>1}, group=>{ 123456=>{r=>1,w=>1,x=>1} } }, { uperm=>{r=>1,w=>1,x=>1}, gperm=>{r=>1,w=>1,x=>1}, other=>{r=>1,w=>1,x=>1}, mask=>{r=>1,w=>1,x=>1} }); system("getfacl /mnt/testacl/d"); prints: $ getfacl d # file: d # owner: user # group: user user::rwx group::rwx group:123456:rwx mask::rwx other::r-x default:user::rwx default:group::rwx default:mask::rwx default:other::rwx =head1 AUTHOR Yuriy Nazarov, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Linux::ACL You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2013 Yuriy Nazarov. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cutLinux-ACL-0.05/t/0000775000175000017500000000000013074246050013560 5ustar firefishfirefishLinux-ACL-0.05/t/00-load.t0000664000175000017500000000024513074246050015102 0ustar firefishfirefish#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Linux::ACL' ) || print "Bail out! "; } diag( "Testing Linux::ACL $Linux::ACL::VERSION, Perl $], $^X" ); Linux-ACL-0.05/t/boilerplate.t0000664000175000017500000000244313074246050016252 0ustar firefishfirefish#!perl -T use strict; use warnings; use Test::More tests => 3; sub not_in_file_ok { my ($filename, %regex) = @_; open( my $fh, '<', $filename ) or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } TODO: { local $TODO = "Need to replace the boilerplate text"; not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); module_boilerplate_ok('lib/Linux/ACL.pm'); } Linux-ACL-0.05/t/manifest.t0000664000175000017500000000042013074246050015547 0ustar firefishfirefish#!perl -T use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } eval "use Test::CheckManifest 0.9"; plan skip_all => "Test::CheckManifest 0.9 required" if $@; ok_manifest(); Linux-ACL-0.05/t/pod-coverage.t0000664000175000017500000000104713074246050016322 0ustar firefishfirefishuse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); Linux-ACL-0.05/t/pod.t0000664000175000017500000000035013074246050014525 0ustar firefishfirefish#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Linux-ACL-0.05/ACL.xs0000664000175000017500000002114313074246247014301 0ustar firefishfirefish/* Copyright 2013 Yuriy Nazarov. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. */ #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #include #include #include #ifdef __cplusplus } #endif #define USER_KEY "user" #define USER_KEY_LENGTH 4 #define GROUP_KEY "group" #define GROUP_KEY_LENGTH 5 #define OTHER_KEY "other" #define OTHER_KEY_LENGTH 5 #define MASK_KEY "mask" #define MASK_KEY_LENGTH 4 #define USER_OBJ_KEY "uperm" #define USER_OBJ_KEY_LENGTH 5 #define GROUP_OBJ_KEY "gperm" #define GROUP_OBJ_KEY_LENGTH 5 #define CONSTANT_YES 0 #define CONSTANT_NO 1 HV* derefHV(SV *hashref){ HV *ret_hash; if (! SvROK(hashref)) //check that input value is really reference return NULL; ret_hash = (HV *)SvRV(hashref); if (SvTYPE((SV *)ret_hash) != SVt_PVHV) //check that it's really hash return NULL; return ret_hash; } void add_perm_to_hash(HV *hash, int r, int w, int x, char *key, U32 key_len){ HV* perm_hash = newHV(); hv_store(perm_hash, "r", 1, newSViv( r!=0 ), 0); hv_store(perm_hash, "w", 1, newSViv( w!=0 ), 0); hv_store(perm_hash, "x", 1, newSViv( x!=0 ), 0); hv_store(hash, key, key_len, newRV_noinc((SV*) perm_hash), 0); } void add_to_hash(HV *hash, acl_entry_t *ent, char *key, U32 key_len){ acl_permset_t permset; acl_get_permset(*ent, &permset); add_perm_to_hash(hash, acl_get_perm(permset, ACL_READ), acl_get_perm(permset, ACL_WRITE), acl_get_perm(permset, ACL_EXECUTE), key, key_len); } void set_perm(acl_entry_t ent, mode_t perm) { acl_permset_t set; acl_get_permset(ent, &set); if (perm & ACL_READ) acl_add_perm(set, ACL_READ); else acl_delete_perm(set, ACL_READ); if (perm & ACL_WRITE) acl_add_perm(set, ACL_WRITE); else acl_delete_perm(set, ACL_WRITE); if (perm & ACL_EXECUTE) acl_add_perm(set, ACL_EXECUTE); else acl_delete_perm(set, ACL_EXECUTE); } int get_perm_from_hash(HV *hash, const char *key, int key_len){ HV *perm; SV **perm_ref; SV **atom_ref; int perm_val = 0; if(perm_ref = hv_fetch(hash, key, key_len, 0)){ perm = derefHV(*perm_ref); if(NULL==perm){ return 0; } if(atom_ref = hv_fetch(perm, "r", 1, 0)){ if (! SvIOK(*atom_ref)) return 0; perm_val |= SvIV(*atom_ref)?ACL_READ:0; } if(atom_ref = hv_fetch(perm, "w", 1, 0)){ if (! SvIOK(*atom_ref)) return 0; perm_val |= SvIV(*atom_ref)?ACL_WRITE:0; } if(atom_ref = hv_fetch(perm, "x", 1, 0)){ if (! SvIOK(*atom_ref)) return 0; perm_val |= SvIV(*atom_ref)?ACL_EXECUTE:0; } } return perm_val; } int getfacl_internal(char *filename, HV **out_acl, HV **out_default_acl){ //returns count struct stat st; int i; HV **acl_hashes[2] = {out_acl, out_default_acl}; acl_type_t acl_types[2] = {ACL_TYPE_ACCESS, ACL_TYPE_DEFAULT}; *out_acl = NULL; *out_default_acl = NULL; if (stat(filename, &st) != 0) { return 0; } for(i=0; i<2; i++){ HV* acl_hash; HV* ret_acl_uperm; HV* ret_acl_gperm; acl_entry_t ent; acl_t acl; int ret; acl = acl_get_file(filename, acl_types[i]); if (acl == NULL) { continue; } ret = acl_get_entry(acl, ACL_FIRST_ENTRY, &ent); if (ret != 1){ continue; } acl_hash = newHV(); ret_acl_uperm = newHV(); ret_acl_gperm = newHV(); while (ret > 0) { acl_tag_t e_type; acl_get_tag_type(ent, &e_type); char id_str[30]; //Enough to print uint64_t U32 id_str_len; id_t *id_p; switch(e_type) { case ACL_USER_OBJ: add_to_hash(acl_hash, &ent, USER_OBJ_KEY, USER_OBJ_KEY_LENGTH); break; case ACL_GROUP_OBJ: add_to_hash(acl_hash, &ent, GROUP_OBJ_KEY, GROUP_OBJ_KEY_LENGTH); break; case ACL_MASK: add_to_hash(acl_hash, &ent, MASK_KEY, MASK_KEY_LENGTH); break; case ACL_OTHER: add_to_hash(acl_hash, &ent, OTHER_KEY, OTHER_KEY_LENGTH); break; case ACL_USER: id_p = acl_get_qualifier(ent); id_str_len = sprintf(id_str, "%d", *id_p); add_to_hash(ret_acl_uperm, &ent, id_str, id_str_len); break; case ACL_GROUP: id_p = acl_get_qualifier(ent); id_str_len = sprintf(id_str, "%d", *id_p); add_to_hash(ret_acl_gperm, &ent, id_str, id_str_len); break; } ret = acl_get_entry(acl, ACL_NEXT_ENTRY, &ent); } hv_store(acl_hash, USER_KEY, USER_KEY_LENGTH, newRV_noinc((SV*) ret_acl_uperm), 0); hv_store(acl_hash, GROUP_KEY, GROUP_KEY_LENGTH, newRV_noinc((SV*) ret_acl_gperm), 0); *(acl_hashes[i]) = acl_hash; } if(NULL==*out_acl && NULL==*out_default_acl){ *out_acl = newHV(); add_perm_to_hash(*out_acl, st.st_mode && S_IRUSR, st.st_mode && S_IWUSR, st.st_mode && S_IXUSR, USER_OBJ_KEY, USER_OBJ_KEY_LENGTH); add_perm_to_hash(*out_acl, st.st_mode && S_IRGRP, st.st_mode && S_IWGRP, st.st_mode && S_IXGRP, GROUP_OBJ_KEY, GROUP_OBJ_KEY_LENGTH); add_perm_to_hash(*out_acl, st.st_mode && S_IROTH, st.st_mode && S_IWOTH, st.st_mode && S_IXOTH, OTHER_KEY, OTHER_KEY_LENGTH); } return (NULL==*out_acl)?0:( (NULL==*out_default_acl)?1:2 ); } int setfacl_internal(char *filename, HV *in_acl_hash, HV *in_default_acl_hash){ HV *acl_hashes[3] = {in_acl_hash, in_default_acl_hash, NULL}; acl_type_t acl_types[3] = {ACL_TYPE_ACCESS, ACL_TYPE_DEFAULT, 0}; int i = 0; int rc = CONSTANT_YES; while(NULL != acl_hashes[i]){ acl_t acl = NULL; acl_entry_t ent; HE *hash_entry; SV **hash_ref; HV *user_hash = NULL; HV *group_hash = NULL; HV *current_acl = acl_hashes[i]; if(hash_ref = hv_fetch(current_acl, USER_KEY, USER_KEY_LENGTH, 0)){ user_hash = derefHV(*hash_ref); }else{ //missing USER_KEY } if(hash_ref = hv_fetch(current_acl, GROUP_KEY, GROUP_KEY_LENGTH, 0)){ group_hash = derefHV(*hash_ref); }else{ //missing GROUP_KEY } acl = acl_init(0); if (!acl) { rc = CONSTANT_NO; } if (acl_create_entry(&acl, &ent) == 0){ acl_set_tag_type(ent, ACL_USER_OBJ); set_perm(ent, get_perm_from_hash(current_acl, USER_OBJ_KEY, USER_OBJ_KEY_LENGTH)); } else { rc = CONSTANT_NO; } if (acl_create_entry(&acl, &ent) == 0){ acl_set_tag_type(ent, ACL_GROUP_OBJ); set_perm(ent, get_perm_from_hash(current_acl, GROUP_OBJ_KEY, GROUP_OBJ_KEY_LENGTH)); } else { rc = CONSTANT_NO; } if (acl_create_entry(&acl, &ent) == 0){ acl_set_tag_type(ent, ACL_MASK); set_perm(ent, get_perm_from_hash(current_acl, MASK_KEY, MASK_KEY_LENGTH)); } else { rc = CONSTANT_NO; } if (acl_create_entry(&acl, &ent) == 0){ acl_set_tag_type(ent, ACL_OTHER); set_perm(ent, get_perm_from_hash(current_acl, OTHER_KEY, OTHER_KEY_LENGTH)); } else { rc = CONSTANT_NO; } if(NULL != user_hash){ hv_iterinit(user_hash); while(hash_entry = hv_iternext(user_hash)){ id_t id_p; I32 key_len; char *key = hv_iterkey(hash_entry, &key_len); id_p = atoi(key); if (acl_create_entry(&acl, &ent) == 0){ acl_set_tag_type(ent, ACL_USER); acl_set_qualifier(ent, &id_p); set_perm(ent, get_perm_from_hash(user_hash, key, key_len)); } else { rc = CONSTANT_NO; } } } if(NULL != group_hash){ hv_iterinit(group_hash); while(hash_entry = hv_iternext(group_hash)){ id_t id_p; I32 key_len; char *key = hv_iterkey(hash_entry, &key_len); id_p = atoi(key); if (acl_create_entry(&acl, &ent) == 0){ acl_set_tag_type(ent, ACL_GROUP); acl_set_qualifier(ent, &id_p); set_perm(ent, get_perm_from_hash(group_hash, key, key_len)); } else { rc = CONSTANT_NO; } } } if (acl_set_file(filename, acl_types[i], acl) == -1) { rc = CONSTANT_NO; } acl_free(acl); i++; } return rc; } /* * Exported code */ #define PACKAGE_NAME "Linux::ACL" MODULE = Linux::ACL PACKAGE = Linux::ACL void getfacl(filename) SV * filename; PPCODE: HV *acl, *default_acl; STRLEN filename_string_length; char *filename_string = SvPV(filename, filename_string_length); int count = getfacl_internal(filename_string, &acl, &default_acl); if(count>=1) XPUSHs( sv_2mortal( newRV_noinc((SV*) acl) ) ); if(count>=2) XPUSHs( sv_2mortal( newRV_noinc((SV*) default_acl) ) ); XSRETURN(count); void setfacl(filename, acl_hashref, ...) SV *filename; SV *acl_hashref; PPCODE: STRLEN filename_string_length; char* filename_string = SvPV(filename, filename_string_length); HV *acl_hash = derefHV(acl_hashref); HV *default_acl_hash = NULL; if( items > 2 ) default_acl_hash = derefHV(ST(2)); if(NULL == acl_hash){ XSRETURN_NO; } if( CONSTANT_YES == setfacl_internal(filename_string, acl_hash, default_acl_hash) ){ XSRETURN_YES; }else{ XSRETURN_NO; } Linux-ACL-0.05/Changes0000664000175000017500000000051713074247466014627 0ustar firefishfirefishRevision history for Linux::ACL 0.05 15.03.2017/01:30 UTC+3 Fixed rt.cpan.org #121126 (setfacl returns true even if an error occurs) 0.03 28.08.2014/23:53 UTC+3 Fixed rt.cpan.org #98392 (Spurious output from Linux::ACL) 0.02 21.05.2013/19:40 UTC+3 First version, released on an unsuspecting world.