file/getfacl.cgi

   1 #!/usr/local/bin/perl
   2 # getfacl.cgi
   3 # Gets the ACLs for some file
   4
   5 require './file-lib.pl';
   6 &ReadParse();
   7 &switch_acl_uid_and_chroot();
   8 print "Content-type: text/plain\n\n";
   9 if (!&can_access($in{'file'})) {
  10         print $text{'facl_eaccess'},"\n";
  11         }
  12 else {
  13         $getfacl = $config{'getfacl'};
  14         if ($getfacl =~ /^\.\//) {
  15                 $getfacl =~ s/^\./$module_root_directory/;
  16                 }
  17         chdir("/");
  18         if ($in{'file'} eq '/') {
  19                 $in{'file'} = '.';
  20                 }
  21         else {
  22                 $in{'file'} =~ s/^\///;
  23                 }
  24         $out = &backquote_command($getfacl." ".quotemeta($in{'file'})." 2>&1");
  25         if ($?) {
  26                 print $out,"\n";
  27                 }
  28         else {
  29                 foreach $l (split(/\n/, $out)) {
  30                         $l =~ s/#.*$//;
  31                         $l =~ s/\s+$//;
  32                         push(@rv, $l) if ($l =~ /\S/);
  33                         }
  34                 if (!@rv) {
  35                         print "Filesystem does not support ACLs\n";
  36                         }
  37                 else {
  38                         print "\n";
  39                         foreach $l (@rv) {
  40                                 print $l,"\n";
  41                                 }
  42                         }
  43                 }
  44         }
  45