/usr/share/doc/libfile-policy-perl/examples/Simple.pm is in libfile-policy-perl 1.005-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | ###############################################################################
# Purpose : Very Simple File IO policies
# Author : Murray Walker
# Created : May 2005
# CVS : $Id: Simple.pm,v 1.1 2005/05/18 15:56:45 johna Exp $
###############################################################################
package File::Policy::Default;
use strict;
use File::Spec::Functions;
use Carp;
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @ISA);
@ISA = qw(Exporter);
@EXPORT_OK = qw(get_temp_dir get_log_dir check_safe);
%EXPORT_TAGS = ('all' => \@EXPORT_OK);
$VERSION = sprintf"%d.%03d", q$Revision: 1.1 $ =~ /: (\d+)\.(\d+)/;
sub get_temp_dir {
return $ENV{TEMP} || File::Spec::Functions::tmpdir();
}
sub get_log_dir {
return $ENV{LOGDIR} || File::Spec::Functions::curdir();
}
sub check_safe {
my ($name, $mode) = @_;
croak("mode must be r, w or a")
unless($mode eq 'r' || $mode eq 'w' || $mode eq 'a');
# Don't allow writing to any file in /etc
if ( ($mode eq 'w' || $mode eq 'a') and ($name =~ /^\/etc\//) ) {
die("you are not allowed to write to files in /etc/ : '$name'");
}
# Don't allow passwd files to be read
if (
($mode eq 'r' || $mode eq 'a') and
($name =~ /^\/etc\/passwd/ || $name =~ /^\/etc\/shadow/)
) {
die("you are not allowed to read passwd files");
}
# Don't allow any access to any .configuration files in
# users home directories
if ($name =~ /^\/home\/[^\/]+\/\./) {
die("you cannot access users . files (eg, .pinerc)");
}
return 1;
}
1;
=head1 NAME
File::Policy::Simple - Simple policy for file I/O functions
=head1 SYNOPSIS
use File::Policy;
use File::Policy qw/check_safe/; # to import a specific subroutine
use File::Policy qw/:all/; # to import all subroutines
# Ensure File::Policy::Config is updated with the appropriate
# default policy. For example
# package File::Policy::Config;
# use constant IMPLEMENTATION => 'Simple';
# 1;
#Checking I/O policy
check_safe($filename, 'r'); # Check it is okay for reading
check_safe($filename, 'w'); # Check it is okay for writing to
check_safe($filename, 'a'); # Check it is okay for both reading & writing
#Portable directory locations
$logdir = get_log_dir();
$tmpdir = get_temp_dir();
=head1 DESCRIPTION
This defines a simple policy for file I/O with modules such as File::Slurp::WithinPolicy.
Use IN NO WAY implies any safety to your file I/O, it is simply provided to help
demonstrate how you might implement a File Policy at your site.
=head1 FUNCTIONS
=over 4
=item check_safe
check_safe( FILENAME , MODE );
Checks a filename is safe - dies if not. MODE is r, w, or a
Using File::Policy::Simple will prevent code that calls check_safe from:
* Writing to any file under /etc/
* Reading from /etc/passwd or /etc/shadow
* Accessing in any way a .configuration file in a users home directory
=item get_temp_dir
$temporary_directory = get_temp_dir();
Returns the path to temporary directory from the TEMP environment variable or File::Spec::Functions::tmpdir().
Note that any return value will have been cleared of a trailing slash.
=item get_log_dir
$log_directory = get_log_dir();
Returns the path to log directory from the LOGDIR environment variable or the current directory.
Note that any return value will have been cleared of a trailing slash.
=back
=head1 VERSION
$Revision: 1.1 $ on $Date: 2005/05/18 15:56:45 $ by $Author: johna $
=head1 AUTHOR
Murray Walker <cpan _at_ bbc _dot_ co _dot_ uk>
=head1 COPYRIGHT
(c) BBC 2005. This program is free software; you can redistribute it and/or modify it under the GNU GPL.
See the file COPYING in this distribution, or http://www.gnu.org/licenses/gpl.txt
=cut
|