Mercurial > rm-limit
view rm-limit.pl @ 0:c1b3644bfc04
initial import
| author | Eris Caffee <discordia@eldalin.com> |
|---|---|
| date | Mon, 09 May 2011 20:15:10 -0500 |
| parents | |
| children | 1217ea1da6d7 |
line source
1 #!/usr/bin/env perl
3 ################################################################################
4 #
5 # Copyright (C) 2011 Sarah Eris Horsley Caffee
6 #
7 # This is free software: you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation, either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with this program. If not, see <http://www.gnu.org/licenses/>.
19 #
20 ################################################################################
23 use strict;
24 use warnings;
26 use Cwd 'realpath';
27 use File::Basename;
30 my $debug = 1;
32 # Any file not in either the whitelist of the blacklist will generate a warning
33 # asking the user to confirm the command before proceeding.
35 ################################################################################
36 #
37 # Note: / itself is protected by default. You are not allowed to delete the
38 # entire filesystem using this script no matter what.
39 #
40 # The whitelist consists of directories from which we may always delete.
42 my @whitelist = (
43 '/tmp',
44 );
46 # whitelist_subdirs lists directories from which it is safe to delete only if
47 # we are deleting from a subdirectory of the listed directory.
48 # The purpose of this is to let us delete with impunity from user home directories
49 # but guard against accidental deletion of multiple home directories in their
50 # entirety.
52 my @whitelist_subdirs = (
53 '/home',
54 );
56 # The blacklist consists of directories that we must never delete from
57 # under any circumstances. To delete from these directories the user must
58 # invoke the /bin/rm command directly.
60 my @blacklist = (
61 '/bin/',
62 '/etc',
63 '/lib/',
64 '/boot',
65 );
67 ################################################################################
69 my $proceed = "yes";
70 my $fail = 0;
71 my $file = 0;
72 my $opts = "";
75 setup_lists();
78 my $path = "";
79 foreach (@ARGV) {
80 $path = $_;
81 if ($path !~ /^-/) {
82 if (check_whitelist($path) ) {
83 next;
84 }
86 $proceed = "no";
88 if (check_blacklist($path)) {
89 $fail = 1;
90 }
91 }
92 }
94 if ($fail) {
95 print("File deletion aborted because blacklisted files were detected in the file list.
96 If you truly need to delete the files, please call /bin/rm directly.
98 ");
99 exit 1;
100 }
104 if ($proceed ne "yes") {
105 print("
107 ============ WARNING! ========== WARNING! ========== WARNING! =================
109 You are about to delete files or directories that are not in the whitelist of
110 safe locations from which to delete. Please review the rm command for any
111 typos before proceeding.
113 Type \"yes\" to continue.
116 ");
117 $proceed = <STDIN>;
118 }
120 if ($proceed eq "yes"){
121 exec('/usr/bin/echo', ('/bin/rm', @ARGV));
122 }
124 ################################################################################
125 # Expand to full paths, append / to ends of directories.
126 # Returns empty string if the specified file does not exist.
128 sub normalize_name {
129 my $path = $_;
130 my $normal_path = "";
132 if (-l $path) {
133 $path = readlink($_);
134 }
136 $normal_path = realpath($path);
137 if (!defined $normal_path) {
138 return "";
139 }
141 if ((-d $normal_path) and ($normal_path !~ m{/$} )) {
142 $normal_path = $normal_path."/";
143 }
145 return $normal_path;
146 }
148 ################################################################################
149 # Return true if on whitelist
151 sub check_whitelist {
152 my $regex = undef;
153 my $path = normalize_name($_);
154 for (my $i = 0; $i <= $#whitelist; $i += 1) {
155 $regex = "^".quotemeta($whitelist[$i]);
156 if ($whitelist[$i] !~ m{/$}) {
157 $regex = $regex."$$";
158 }
159 ($debug) and print("regex is $regex\n");
160 if (($path =~ $regex) and ($path ne $whitelist[$i])) {
161 $debug and print("Whitelisted for being in $whitelist[$i]: $_\n");
162 return 1;
163 }
164 }
166 return 0;
167 }
169 ################################################################################
170 # Return true if on whitelist_subdirs
172 sub check_whitelist_subdirs {
173 my $regex = undef;
174 my $path = normalize_name($_);
175 for (my $i = 0; $i <= $#whitelist_subdirs; $i += 1) {
176 $regex = "^".quotemeta($whitelist_subdirs[$i]);
177 if ($whitelist_subdirs[$i] !~ m{/$}) {
178 $regex = $regex."$$";
179 }
180 ($debug) and print("regex is $regex\n");
181 if (($path =~ $regex) and ($path ne $whitelist_subdirs[$i])) {
182 $debug and print("Whitelisted for being in $whitelist_subdirs[$i]: $_\n");
183 return 1;
184 }
185 }
187 return 0;
188 }
190 ################################################################################
191 # Return true if on blacklist
193 sub check_blacklist {
194 my $regex = undef;
195 my $path = normalize_name($_);
197 # Always blacklist /
198 if ($path eq "/\n") {
199 print("Blacklisted for being the entire system: /");
200 return 1;
201 }
203 for (my $i = 0; $i <= $#blacklist; $i += 1) {
204 $regex = "^".quotemeta($blacklist[$i]);
205 if ($blacklist[$i] !~ m{/$}) {
206 $regex = $regex."$$";
207 }
208 ($debug) and print("regex is $regex\n");
209 if ($path =~ $regex) {
210 print("Blacklisted for being in $blacklist[$i]: $_\n");
211 return 1;
212 }
213 }
215 return 0;
216 }
218 ################################################################################
219 # At the moment all this does is make sure that directories listed in the
220 # lists all have a / at the end.
222 sub setup_lists {
223 for (my $i = 0; $i <= $#whitelist; $i += 1) {
224 if (-d $whitelist[$i] and $whitelist[$i] !~ m{/$}) {
225 $whitelist[$i] = $whitelist[$i]."/";
226 }
227 }
228 for (my $i = 0; $i <= $#whitelist_subdirs; $i += 1) {
229 if (-d $whitelist_subdirs[$i] and $whitelist_subdirs[$i] !~ m{/$}) {
230 $whitelist_subdirs[$i] = $whitelist_subdirs[$i]."/";
231 }
232 }
233 for (my $i = 0; $i <= $#blacklist; $i += 1) {
234 if (-d $blacklist[$i] and $blacklist[$i] !~ m{/$}) {
235 $blacklist[$i] = $blacklist[$i]."/";
236 }
237 }
239 if ($debug) {
240 print("whitelist:\n");
241 for (my $i = 0; $i <= $#whitelist; $i += 1) {
242 print($whitelist[$i]."\n");
243 }
244 print("whitelist_subdirs:\n");
245 for (my $i = 0; $i <= $#whitelist_subdirs; $i += 1) {
246 print($whitelist_subdirs[$i]."\n");
247 }
248 print("blacklist:\n");
249 for (my $i = 0; $i <= $#blacklist; $i += 1) {
250 print($blacklist[$i]."\n");
251 }
252 }
253 }