1 files changed, 65 insertions, 0 deletions
diff --git a/lib/filetest.pm b/lib/filetest.pm
new file mode 100644
index 0000000000..cc14e82817
--- /dev/null
+++ b/lib/filetest.pm
@@ -0,0 +1,65 @@
+package filetest;
+
+=head1 NAME
+
+filetest - Perl pragma to control the filetest permission operators
+
+=head1 SYNOPSIS
+    
+    $can_perhaps_read = -r "file";	# use the mode bits
+    {
+        use filetest 'access';		# intuit harder
+        $can_really_read = -r "file";
+    }
+    $can_perhaps_read = -r "file";	# use the mode bits again
+
+=head1 DESCRIPTION
+
+This pragma tells the compiler to change the behaviour of the filetest
+permissions operators, the -r -w -x -R -W -X (see L<perlfunc>).
+
+The default behaviour to use the mode bits as returned by the stat()
+family of calls.  This, however, may not be the right thing to do if
+for example various ACL (access control lists) schemes are in use.
+For such environments, C<use filetest> may help the permission
+operators to return results more consistent with other tools.
+
+Each "use filetest" or "no filetest" affects statements to the end of
+the enclosing block.
+
+There may be a slight performance decrease in the filetests
+when C<use filetest> is in effect, because in some systems
+the extended functionality needs to be emulated.
+
+B<NOTE>: using the file tests is a lost case from the start: there is
+a window open for race conditions (who is to say that the permissions
+will not change between the test and the real operation?).  Therefore
+if you are serious about security, just try the real operation and
+test for its success.  Think atomicity.
+
+=head2 subpragma access
+
+Currently only one subpragma, C<access> is implemented.  It enables
+(or disables) the use of access() or similar system calls.  This
+extended filetest functionality is used only when the argument of the
+operators is a filename, not when it is a filehandle.
+
+=cut
+
+sub import {
+    if ( $_[1] eq 'access' ) {
+	$^H |= 0x00400000;
+    } else {
+	die "filetest: the only implemented subpragma is 'access'.\n";
+    }
+}
+
+sub unimport {
+    if ( $_[1] eq 'access' ) {
+	$^H &= ~0x00400000;
+    } else {
+	die "filetest: the only implemented subpragma is 'access'.\n";
+    }
+}
+
+1;