File Coverage

File:bin/unburden-home-dir
Coverage:68.6%

linestmtbrancondsubpodtimecode
1#!/usr/bin/perl
2#
3# This file causes a list of directories to be removed or moved off
4# the users home directory into a given other directory. Usually this
5# is used to relief NFS home directories of the burden of caches and
6# other performance needing directories.
7#
8# Copyright (C) 2010-2012 by Axel Beckert <beckert@phys.ethz.ch>,
9# Department of Physics, ETH Zurich.
10#
11# This program is free software: you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation, either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful, but
17# WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19# General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program. If not, see http://www.gnu.org/licenses/.
23#
24
25
13
13
13
68284
384421
658
use Modern::Perl;
26
27# Globally define version
28
13
5178775
our $VERSION = '0.3.2';
29
30# Configuration variables to be used in configuration files
31
13
188
my $CONFIG = {
32    TARGETDIR => '/tmp',
33    FILELAYOUT => '.unburden-%u/%s',
34};
35
36# Just show what would be done
37
13
91
my $DRYRUN = undef;
38
39# Undo feature
40
13
78
my $REVERT = 0;
41
42# Defaul base name
43
13
109
my $BASENAME = 'unburden-home-dir';
44
13
168
my $LISTSUFFIX = 'list';
45
46# Load Modules
47
13
13
13
16535
32356
2003
use Config::File;
48
13
13
13
13
86
73562
2059
3097
use Getopt::Std; $Getopt::Std::STANDARD_HELP_VERSION = 1;
49
13
13
13
186
60
2745
use File::Path qw(mkpath rmtree);
50
13
13
13
196
63
2901
use File::Basename;
51
13
13
13
10738
53676
3066
use File::BaseDir qw(config_home);
52
13
13
13
12911
344124
2324
use File::Touch;
53
13
13
13
14145
785750
1643
use File::Rsync;
54
13
13
13
12384
47811
2782
use File::Which;
55
13
13
13
243
73
1625
use IO::Handle;
56
13
13
13
18346
329142
2416478
use Data::Dumper;
57
58# Declare and initialise some variables
59
13
104
my %OPTIONS = ();
60
13
87
my $FILTER = undef;
61
13
19438
my $UID = getpwuid($<);
62
13
161
my $USE_LSOF = 1;
63
13
106
my $LSOF_CMD = undef;
64
65# Some messages for Getopt::Std
66sub VERSION_MESSAGE {
67
0
0
    my ($fh, $getoptpkg, $getoptversion, $cmdlineargs) = @_;
68
69
0
0
    say $fh "Unburden Home Directory $VERSION\n";
70
71
0
0
    return;
72}
73
74sub HELP_MESSAGE {
75
0
0
    my ($fh, $getoptpkg, $getoptversion, $cmdlineargs) = @_;
76
77
0
0
    say $fh "Usage: $0 [ -F | -n | -u | -b basename | (-c|-C) conffile | -f filter | (-l|-L) listfile ]
78       $0 ( -h | --help | --version )
79
80Options with parameters:
81
82  -b use the given string as basename instead of \"$BASENAME\".
83
84  -c read an additional configuration file
85
86  -C read only the given configuration file
87
88  -f just unburden those directory matched by the given filter (a perl
89      regular expression) -- it matches the already unburdened
90      directories if used together with -u.
91
92  -l read an additional list file
93
94  -L read only the given list file
95
96Options without parameters:
97
98  -F Do not check if to-be-(re)moved files and directories are still
99      in use (aka *F*orce (re)moving).
100
101  -n dry run (show what would be done)
102
103  -u undo (reverse the functionality and put stuff back into the home
104      directory)
105
106  -h, --help show this help
107
108  --version show the program's version
109";
110
111
0
0
    return;
112}
113
114# Parse command line options
115
13
1168
getopts('hnufFb:c:C:l:L:', \%OPTIONS);
116
117
13
3969
for (keys %OPTIONS) {
118
28
391
    when('h') {
119
0
0
        my $fh = IO::Handle->new_from_fd(fileno(STDERR),'w');
120
0
0
        VERSION_MESSAGE($fh);
121
0
0
        HELP_MESSAGE($fh);
122
0
0
        exit 0;
123    }
124
28
2
656
27
    when('b') { $BASENAME = $OPTIONS{b}; }
125}
126
127# By default check for a system wide and a user configuration and list file
128
13
817
my @CONFFILES = ("/etc/$BASENAME",
129                 "$ENV{HOME}/.$BASENAME",
130                 config_home($BASENAME).'/config');
131
13
3020
my @LISTFILES = ("/etc/$BASENAME.$LISTSUFFIX",
132                 "$ENV{HOME}/.$BASENAME.$LISTSUFFIX",
133                 config_home($BASENAME)."/$LISTSUFFIX");
134
135
13
1710
for (keys %OPTIONS) {
136
28
11
207
155
    when('C') { @CONFFILES = ($OPTIONS{C}); }
137
17
0
102
0
    when('c') { push(@CONFFILES, $OPTIONS{c}); }
138
17
11
106
152
    when('L') { @LISTFILES = ($OPTIONS{L}); }
139
6
0
37
0
    when('l') { push(@LISTFILES, $OPTIONS{l}); }
140
6
2
39
18
    when('n') { $DRYRUN = 1; }
141
4
2
28
17
    when('u') { $REVERT = 1; }
142
2
0
13
0
    when('F') { $USE_LSOF = 0; }
143
2
21
    when('f') {
144
0
0
0
0
        eval { $FILTER = qr/$OPTIONS{f}/; };
145
0
0
        if ($@) {
146
0
0
            report_serious_problem("parameter to -f", "\n$@");
147
0
0
            exit 2;
148        }
149    }
150}
151
152# Check for configuration files and read them
153
13
120
foreach my $configfile (@CONFFILES) {
154
17
2361
    if ( -e $configfile ) {
155
13
674
        $CONFIG = { %$CONFIG,
156
13
140
                    %{Config::File::read_config_file($configfile)} };
157    }
158}
159
160# Fix some values
161
13
22499
$UID =~ s/\s+//gs;
162
163# Remove quotes and line-feeds from values
164
13
189
foreach my $key (keys %$CONFIG) {
165
26
201
    chomp($CONFIG->{$key});
166
26
331
    $CONFIG->{$key} =~ s/^([\'\"])(.*)\1$/$2/;
167}
168
169# Set proper umask when creating files or directories. Save current
170# umask before.
171
13
279
my $OLDUMASK = umask();
172
13
83
umask(077);
173
174# Initialize rsync object
175my $rsync = File::Rsync->new({
176    archive => 1,
177    verbose => 1,
178    outfun => sub {
179
48
488967
        my $_ = shift;
180
48
503
        chomp;
181
48
4536
        say unless m(^sent |^total size|^\s*$);
182    },
183
0
0
0
0
    errfun => sub { chomp; warn "$_[0]\n"; },
184
13
1181
});
185
186# Check for lsof in search path
187
13
14993
my $which_lsof = which('lsof');
188
13
12344
if (!$which_lsof) {
189
0
0
    warn "WARNING: lsof not found, not checking for files in use.\n";
190
0
0
    $USE_LSOF = 0;
191}
192
193# Standard Error reporting function; Warning
194sub report_problem {
195
0
0
    warn "WARNING: Can't handle $_[0]: $_[1]";
196
0
0
    return;
197}
198
199# Standard Error reporting function; Error
200sub report_serious_problem {
201
0
0
    warn "ERROR: Can't handle $_[0]: $_[1]";
202
0
0
    return;
203}
204
205# Actually move a directory or file
206sub move ($$) {
207
11
98
    my ($from, $to) = @_;
208
11
282
    say "Moving $from -> $to";
209
11
163
    unless ($DRYRUN) {
210
9
185
        if (-d $from) {
211
8
141
            $from .= '/' unless $from =~ m(/$);
212
8
94
            $to .= '/' unless $to =~ m(/$);
213
214
8
969
            my $rc = $rsync->exec({
215                src => $from,
216                dst => $to,
217            });
218
8
33191
            rmtree($from);
219        } else {
220
1
5457
            my $rc = system(qw(mv -v), $from, $to);
221
1
77
            return !($? >> 8);
222        }
223    }
224
10
375
    return 1;
225}
226
227# Create a symlink. Create its parent directories if they don't yet
228# exist.
229sub create_symlink_and_parents {
230
1
10
    my ($old, $new) = @_;
231
1
7
    create_parent_directories($new);
232
1
11
    say "Symlinking $new -> $old";
233
1
10
    unless ($DRYRUN) {
234
1
134
        symlink($old, $new)
235            or die "Couldn't symlink $new -> $old: $!";
236    }
237
1
6
    return;
238}
239
240# Create those parent directories for a given file or directory name
241# which don't yet exist.
242sub create_parent_directories {
243
10
64
    my $file = shift;
244
10
1814
    my $parent_dir = dirname($file);
245
10
382
    unless (-d $parent_dir) {
246
3
78
        say "Create parent directories for $file";
247
3
585
        mkpath($parent_dir, { verbose => 1 }) unless $DRYRUN;
248    }
249
10
76
    return;
250}
251
252# In case of uppercase type letters, create symlinks as replacement
253# for directories files which may not even exist yet. Common cases are
254# trash directories which are created when something gets put into the
255# trashcan, etc.
256sub possibly_create_non_existing_stuff {
257
1
46
    my ($type, $item, $target) = @_;
258
259    # Shall we create not yet existing directories or files as symlink?
260    # Case 1: directory
261
1
11
    if ( $type eq 'D' ) {
262        # TODO: Refactor create_symlink_and_parents so that its
263        # create_parent_directories call isn't redundant in this case.
264
1
29
        say "Create directory $target and parents";
265
1
361
        mkpath($target, { verbose => 1 }) unless $DRYRUN;
266
1
13
        create_symlink_and_parents($target, $item);
267    }
268
269    # Case 2: file
270    elsif ( $type eq 'F' ) {
271
0
0
        create_parent_directories($target);
272
0
0
        say "Touching $target";
273
0
0
        touch($target) unless $DRYRUN;
274
0
0
        create_symlink_and_parents($target, $item)
275    }
276
1
6
    return 0;
277}
278
279# Dangling links may happen if the destination directory has been
280# weeped, e.g. due to being on an tmpfs mount or by tmpreaper, etc.
281sub fix_dangling_links {
282
1
97
    my ($type, $itemexpanded, $target) = @_;
283
1
36
    my $link = readlink($itemexpanded);
284
1
13
    my $is_dir = type_is_directory($type);
285
1
13
    my $is_file = type_is_file($type);
286
287    # Accept existing symlinks or unburden-home-dir.list entries for
288    # directories with or without trailing slash
289
1
15
    if ($is_dir) {
290
1
13
        $link =~ s{/$}{};
291
1
8
        $itemexpanded =~ s{/$}{};
292
1
23
        $target =~ s{/$}{};
293    }
294
295    # Check if link target is wanted target
296
1
13
    if ( $link ne $target ) {
297
0
0
        report_problem($itemexpanded, "$link not equal $target");
298
0
0
        return 1;
299    }
300
301    # Check if target exists and is same type
302
1
28
    if ( -e $target ) {
303
0
0
        my $unexpected_type = check_for_unexpected_type($type, $target);
304
0
0
        return $unexpected_type if $unexpected_type;
305    }
306    # Symlink is there, but file or directory not
307    else {
308
1
12
        create_object_of_type($type, $target);
309    }
310
1
10
    return 0;
311}
312
313# Find pid and command in lsof output
314sub parse_lsof_output {
315
9
100
    my ($output) = @_;
316
9
56
    chomp($output);
317
9
127
    my @lines = split(/\n/, $output);
318
319
9
67
    my $result = '';
320
9
45
    my $pid;
321
9
40
    my $cmd;
322
323
9
149
    foreach my $line (@lines) {
324
0
0
        if ($line =~ /^p(.*)$/) {
325
0
0
            $pid = $1;
326
0
0
            $cmd = undef;
327        } elsif ($line =~ /^c(.*)$/) {
328
0
0
            $cmd = $1;
329
0
0
            unless ($pid) {
330
0
0
                report_problem("lsof output", "No pid before command: $line");
331
0
0
                next;
332            }
333
0
0
            $result .= sprintf(" %5i (%s)\n", $pid, $cmd);
334
0
0
            $pid = undef;
335        } else {
336
0
0
            report_problem("line in lsof output", $line);
337        }
338    }
339
340
9
114
    return $result;
341
342}
343
344# Check if files in to be moved directories are currently in use.
345sub files_in_use {
346
9
83
    my ($item) = @_;
347
9
57
    my $lsof_output = undef;
348
349
9
186
    if (-d $item) {
350
8
2122731
        $lsof_output = `find '$item' -print0 | buffer | xargs -0 lsof -F c`;
351    } elsif (-f _) {
352
1
255645
        $lsof_output = `lsof -F c '$item'`;
353    } else {
354
0
0
        report_problem("Not checking for open files in $item: neither file nor directory");
355
0
0
        return;
356    }
357
358
9
344
    my $lsof_parsed = parse_lsof_output($lsof_output);
359
360
9
200
    if ($lsof_parsed) {
361
0
0
        report_problem($item, "in use, not (re)moving. Process list:\n$lsof_parsed");
362
0
0
        return 1;
363    } else {
364
9
323
        return 0;
365    }
366}
367
368# Move a directory or file (higher level function)
369sub action_move {
370
9
85
    my ($itemexpanded, $target) = @_;
371
372
9
137
    create_parent_directories($target);
373
9
93
    move($itemexpanded, $target)
374        or die "Couldn't move $itemexpanded -> $target: $!";
375
9
154
    return;
376}
377
378# Handle directory or file which should be emptied (higher level function)
379sub action_delete_and_recreate {
380
0
0
    my ($type, $itemexpanded, $target) = @_;
381
382
0
0
    my $is_file = type_is_file($type);
383
0
0
    my $is_dir = type_is_directory($type);
384
385
0
0
    say "Delete $itemexpanded";
386
0
0
    unless ($DRYRUN) {
387
0
0
        $is_dir and rmtree($itemexpanded, { verbose => 1 }) ;
388
0
0
        $is_file and (unlink($itemexpanded)
389                      || die "Couldn't delete $itemexpanded: $!");
390    }
391
0
0
    create_object_of_type($type, $target);
392
393
0
0
    return;
394}
395
396# Generic create function for both, directories and files
397sub create_object_of_type {
398
1
13
    my ($type, $target) = @_;
399
400
1
47
    say "Create $target";
401
1
15
    unless ($DRYRUN) {
402
1
11
        if (type_is_directory($type)) {
403
1
897
            mkpath($target, { verbose => 1 });
404        }
405        elsif (type_is_file($type)) {
406
0
0
            create_parent_directories($target);
407
0
0
            say "Touching $target";
408
0
0
            touch($target) || die "Couldn't touch $target: $!";
409        }
410    }
411
412
1
19
    return;
413}
414
415# Bail out on common assertion
416sub unknown_element {
417
0
0
    my ($what, $unknown) = @_;
418
419
0
0
    warn "Unknown $what '$unknown'. This should never happen.";
420
0
0
    return 255;
421}
422
423# Create a symlink
424sub create_symlink {
425
9
145
    my ($itemexpanded, $target) = @_;
426
427
9
195
    say "Symlinking $target -> $itemexpanded";
428
9
139
    unless ($DRYRUN) {
429
8
1680
        symlink($target, $itemexpanded)
430            or die "Couldn't symlink $target -> $itemexpanded: $!";
431    }
432
9
93
    return;
433}
434
435# Check if the expected type of an object is "directory"
436sub type_is_directory {
437
34
670
    return (lc(shift) eq 'd');
438}
439
440# Check if the expected type of an object is "file"
441sub type_is_file {
442
11
181
    return (lc(shift) eq 'f');
443}
444
445# Check if an object has an unexpected type (higher level function)
446sub check_for_unexpected_type {
447
9
92
    my ($type, $itemexpanded) = @_;
448
449
9
93
    my $is_file = type_is_file($type);
450
9
85
    my $is_dir = type_is_directory($type);
451
452
9
295
    unless ($is_file or $is_dir) {
453
0
0
        return unknown_element('type', $type);
454    }
455
456
9
147
    if ($is_file and !-f $itemexpanded) {
457
0
0
        report_serious_problem($itemexpanded,
458                               'Unexpected type (not a file)');
459
0
0
        return 1;
460    }
461
462
9
458
    if ($is_dir and !-d $itemexpanded) {
463
0
0
        report_serious_problem($itemexpanded,
464                               'Unexpected type (not a directory)');
465
0
0
        return 1;
466    }
467
468
9
67
    return;
469}
470
471# Top-level function run once per to-be-changed-item
472sub do_it {
473
9
243
    my ($type, $itemexpanded, $target, $action) = @_;
474
475
9
203
    if ( $USE_LSOF and files_in_use($itemexpanded) ) {
476
0
0
        return 0;
477    }
478
479
9
138
    my $unexpected_type = check_for_unexpected_type($type, $itemexpanded);
480
9
67
    return $unexpected_type if $unexpected_type;
481
482
9
294
    if ( $action eq 'r' or $action eq 'd' ) {
483
0
0
        action_delete_and_recreate($type, $itemexpanded, $target);
484    }
485    elsif ( $action eq 'm' ) {
486
9
226
        action_move($itemexpanded, $target);
487    }
488    else {
489
0
0
        return unknown_element('action', $action);
490    }
491
492
9
216
    create_symlink($itemexpanded, $target);
493
494
9
89
    return 0;
495}
496
497# Parse and fill placeholders in target definition
498sub calculate_target {
499
13
116
    my $replacement = shift;
500
13
231
    my $target = $CONFIG->{FILELAYOUT};
501
502
13
117
    $target =~ s|%u|$UID|g;
503
13
239
    $target =~ s|%s|$replacement|g;
504
505
13
236
    return $CONFIG->{TARGETDIR}."/$target";
506}
507
508# Parse and fill wildcards
509sub fill_in_wildcard_matches {
510
13
203
    my ($itemglob, $itemexpanded, $target) = @_;
511
512    # Replace %<n> (e.g. %1) with the n-th wildcard match. Uses perl
513    # here as it would be too complicated and way less readable if
514    # written as (bourne) shell script.
515
516    # Change from globbing to regexp
517
13
136
    $itemglob =~ s/\?/(.)/g;
518
13
158
    $itemglob =~ s/\*/(.*)/g;
519
520
13
689
    my @result = $itemexpanded =~ m($itemglob)g;
521
522
13
12
215
328
    $target =~ s/\%(\d+)/$result[$1-1]/eg;
523
524
13
180
    return $target;
525}
526
527# Check if the path to something to unburden already contains a symlink
528sub symlink_in_path {
529
19
183
    my $path = shift;
530    # Remove home directory, i.e. check just from below the home directory
531
19
1004
    if ($path =~ s($ENV{HOME}/?)()) {
532        # Split up into components, but remove the last one (which we
533        # are requested to handle, so we shouldn't check that now)
534
19
593
        my @path_elements = split(m(/), $path);
535
19
153
        pop(@path_elements);
536
537
19
347
        foreach my $i (0..$#path_elements) {
538
29
594
            my $path_to_check = $ENV{HOME}.'/'.join('/', @path_elements[0..$i]);
539            #say "Check if $path_to_check is a symlink";
540
29
1111
            return $path_to_check if -l $path_to_check;
541        }
542
11
208
        return 0;
543    } else {
544
0
0
        report_serious_problem("Can't find home directory ($ENV{HOME}) in $path!");
545    }
546
547
0
0
    return;
548}
549
550# Handle replacement requests and check if they're sane
551sub replace {
552    # replace $type $i $item $replacement
553
19
269
    my ($type, $itemexpanded, $itemglob, $replacement, $action) = @_;
554
555    # Skip entries where wildcard where passed
556
19
308
    if ($itemexpanded =~ /[][*?]/) {
557
0
0
        warn "Skipping '$itemexpanded' due to unmatched wildcard.\n";
558
0
0
        return 0;
559    }
560
561
19
247
    if (my $symlink = symlink_in_path($itemexpanded)) {
562
8
1228
        warn "Skipping '$itemexpanded' due to symlink in path: $symlink\n";
563
8
485
        return 0;
564    }
565
566
11
114
    my $target = fill_in_wildcard_matches($itemglob, $itemexpanded,
567                                          calculate_target($replacement));
568
569    # Check if the source exists
570
11
774
    if ( ! -e $itemexpanded and ! -l $itemexpanded ) {
571
1
9
        possibly_create_non_existing_stuff($type, $itemexpanded, $target);
572    }
573    # Check if source is already a symlink
574    elsif ( -l $itemexpanded ) {
575
1
16
        fix_dangling_links($type, $itemexpanded, $target);
576    }
577
578    # TODO: Check available disk space
579    # Should use report_serious_problem
580
581    # No symlink yet, then actually move or remove!
582    else {
583
9
152
        do_it($type, $itemexpanded, $target, $action);
584    }
585
586
11
1035
    return;
587}
588
589# Core functionality of the undo feature
590sub revert {
591
2
26
    my ($itemexpanded, $item_in_home, $target_glob) = @_;
592
593    # Skip entries where wildcard where passed
594
2
34
    if ($itemexpanded =~ /[][*?]/) {
595
0
0
        warn "Skipping '$target_glob' due to unmatched wildcard.\n";
596
0
0
        return 0;
597    }
598
599
2
33
    $item_in_home = "$ENV{HOME}/" .
600        fill_in_wildcard_matches($target_glob, $itemexpanded, $item_in_home);
601
2
77
    say "Trying to revert $itemexpanded to $item_in_home";
602
603
2
92
    if (-l $item_in_home) {
604
2
268
        my $link_target = readlink($item_in_home);
605
2
22
        $itemexpanded =~ s{/$}{};
606
2
16
        $link_target =~ s{/$}{};
607
608
2
30
        if ($itemexpanded eq $link_target) {
609
2
28
            say "Removing symlink $item_in_home";
610
2
219
            unlink($item_in_home) unless $DRYRUN;
611
2
27
            move($itemexpanded, $item_in_home);
612        } else {
613
0
0
            warn "Ignoring symlink $item_in_home as it points to $link_target ".
614                 "and not to $itemexpanded as expected.\n";
615        }
616    }
617
618
2
162
    return;
619}
620
621# Parse wildcards backwards
622sub exchange_wildcards_and_replacements {
623
2
21
    my ($wildcard, $replacement) = @_;
624
2
13
    my $i = 1;
625
2
56
    while ($replacement =~ /\%(\d+)/) {
626
6
66
        my $number = $1;
627
6
48
        my $prev = $number-1;
628
6
6
452
112
        $wildcard =~ s/^(([^*]*[*?]){$prev}[^*]*)([?*])/"$1\%".$i++/e;
629
6
55
        my $wildcardtype = $3;
630
6
129
        $replacement =~ s/\%(\d+)/$wildcardtype/;
631    }
632
2
40
    return ($wildcard, $replacement);
633}
634
635# Main loop over all items in list files
636
13
126
for my $list (@LISTFILES) {
637
17
530
    next unless -r $list;
638
639    # Clean up this and that
640
13
803
    open(LIST, '<', $list) or die "Can't open $list: $!";
641
13
1140
    while (<LIST>) {
642
27
1264
        next if /^#|^ *$/;
643
644
24
222
        chomp;
645
24
470
        my ($action, $type, $item, $replacement) = split;
646
647
24
302
        next unless defined $action;
648
649
23
984
        if (!defined($item) or !defined($replacement)) {
650
0
0
            warn "Can't parse '$_', skipping...";
651
0
0
            next;
652        }
653
23
275
        unless ( type_is_directory($type) or type_is_file($type) ) {
654
0
0
            warn "Can't parse type '$type', must be 'd', 'D', 'f' or 'F', skipping...";
655
0
0
            next;
656        }
657
23
1014
        if ( $action ne 'd' and $action ne 'r' and $action ne 'm' ) {
658
0
0
            warn "Can't parse action '$action', must be 'd', 'r' or 'm', skipping...";
659
0
0
            next;
660        }
661
662
23
397
        if ( $item =~ m(^(\.\.)?/) ) {
663
2
309
            warn "$item would be outside of the home directory, skipping...\n";
664
2
56
            next;
665        }
666
667
21
233
        if ($REVERT) {
668
2
22
            ($item, $replacement) = exchange_wildcards_and_replacements($item, $replacement);
669
670
2
27
            my $replacement_path = calculate_target($replacement);
671
2
618
            for my $i (glob($replacement_path)) {
672
2
33
                if (defined($FILTER)) {
673
0
0
                    next unless ($i =~ $FILTER);
674                }
675
2
34
                revert($i, $item, $replacement);
676            }
677        } else {
678
19
5362
            for my $i (glob("$ENV{HOME}/$item")) {
679
19
302
                if (defined($FILTER)) {
680
0
0
                    next unless ($i =~ $FILTER);
681                }
682
19
234
                replace($type, $i, $item, $replacement, $action);
683            }
684        }
685    }
686
13
617
    close(LIST);
687}
688
689# Restore original umask
690
13
0
umask($OLDUMASK);