用于查找无法找到任何内容的无主文件的Perl脚本

I've written a script which is designed to find all files not owned by either an existing user or group. However, despite having created a test user and then removing it leaving behind its /home directory, the script is not finding it. Clearly I have an error in the script's logic. I just can't find it.

我编写了一个脚本，旨在查找不属于现有用户或组的所有文件。但是，尽管创建了一个测试用户，然后将其删除，留在其/ home目录后，脚本却找不到它。显然我在脚本的逻辑中有错误。我找不到它。

#!/usr/bin/perl

# Directives which establish our execution environment
use warnings;
use strict;
use File::Find;
no warnings 'File::Find';
no warnings 'uninitialized';

# Variables used throughout the script
my $OUTDIR = "/var/log/tivoli/";
my $MTAB = "/etc/mtab";
my $PERMFILE = "orphan_files.txt";
my $TMPFILE = "orphan_files.tmp";
my $ROOT = "/";
my(@devNum, @uidNums, @gidNums);

# Create an array of the file stats for "/"
my @rootStats = stat("${ROOT}");

# Compile a list of mountpoints that need to be scanned
my @mounts;

open MT, "<${MTAB}" or die "Cannot open ${MTAB}, $!";

# We only want the local HDD mountpoints
while (<MT>) {
  if ($_ =~ /ext[34]/) {
    my @line = split;
    push(@mounts, $line[1]);

  }

}

close MT;

# Build an array of each mountpoint's device number for future comparison
foreach (@mounts) {
  my @stats = stat($_);
  push(@devNum, $stats[0]);
  print $_ . ": " . $stats[0] . "\n";

}

# Build an array of the existing UIDs on the system
while((my($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell)) = getpwent()) {
  push(@uidNums, $uid);

}

# Build an array of existing GIDs on the system
while((my($name, $passwd, $gid, $members)) = getgrent()){
  push(@gidNums, $gid);

}

# Create a regex to compare file device numbers to.
my $devRegex = do {
  chomp @devNum;
  local $" = '|';
  qr/@devNum/;

};


# Create a regex to compare file UIDs to.
my $uidRegex = do {
  chomp @uidNums;
  local $" = '|';
  qr/@uidNums/;

};

# Create a regex to compare file GIDs to.
my $gidRegex = do {
  chomp @gidNums;
  local $" = '|';
  qr/@gidNums/;

};

print $gidRegex . "\n";

# Create the output file path if it doesn't already exist.
mkdir "${OUTDIR}" or die "Cannot execute mkdir on ${OUTDIR}, $!" unless (-d "${OUTDIR}");

# Create our filehandle for writing our findings
open ORPHFILE, ">${OUTDIR}${TMPFILE}" or die "Cannot open ${OUTDIR}${TMPFILE}, $!";

foreach (@mounts) {
  # The anonymous subroutine which is executed by File::Find
  find sub {
    my @fileStats = stat($File::Find::name);

    # Is it in a basic directory, ...
    return if $File::Find::dir =~ /sys|proc|dev/;

    # ...an actual file vs. a link, directory, pipe, etc, ...
    return unless -f;

    # ...local, ...
    return unless $fileStats[0] =~ $devRegex;

    # ...and unowned? If so write it to the output file
    if (($fileStats[4] !~ $uidRegex) || ($fileStats[5] !~ $gidRegex)) {
      print $File::Find::name . " UID: " . $fileStats[4] . "\n";
      print $File::Find::name . " GID: " . $fileStats[5] . "\n";
      print ORPHFILE "$File::Find::name\n";

    }

  }, $_;

}

close ORPHFILE;

# If no world-writable files have been found ${TMPFILE} should be zero-size;
# Delete it so Tivoli won't alert
if (-z "${OUTDIR}${TMPFILE}") {
  unlink "${OUTDIR}${TMPFILE}";

} else {
  rename("${OUTDIR}${TMPFILE}","${OUTDIR}${PERMFILE}") or die "Cannot rename file ${OUTDIR}${TMPFILE}, $!";

}

The test user's home directory showing ownership (or lack thereof):

测试用户的主目录显示所有权（或缺少所有权）：

drwx------   2          20000          20000   4096 Apr  9 19:59 test

The regex for comparing a files GID to those existing on the system:

用于将文件GID与系统上存在的文件进行比较的正则表达式：

(?-xism:0|1|2|3|4|5|6|7|8|9|10|12|14|15|20|30|39|40|50|54|63|99|100|81|22|35|19|69|32|173|11|33|18|48|68|38|499|76|90|89|156|157|158|67|77|74|177|72|21|501|502|10000|10001|10002|10004|10005|10006|5001|5002|5005|5003|10007|10008|10009|10012|10514|47|51|6000|88|5998)

What am I missing with my logic?

我的逻辑错过了什么？

2 个解决方案

#1

I really recommend using find2perl for doing anything with locating files by different attributes. Although not as pretty as File::Find or File::Find::Rule it does the work for you.

我真的建议使用find2perl做任何事情，通过不同的属性定位文件。虽然不像File :: Find或File :: Find :: Rule那样漂亮，但它可以帮到您。

mori@liberty ~ $ find2perl -nouser
#! /usr/bin/perl -w
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
        if 0; #$running_under_some_shell

use strict;
use File::Find ();

# Set the variable $File::Find::dont_use_nlink if you're using AFS,
# since AFS cheats.

# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name   = *File::Find::name;
*dir    = *File::Find::dir;
*prune  = *File::Find::prune;

sub wanted;


my (%uid, %user);
while (my ($name, $pw, $uid) = getpwent) {
    $uid{$name} = $uid{$uid} = $uid;
}


# Traverse desired filesystems
File::Find::find({wanted => \&wanted}, '.');
exit;


sub wanted {
    my ($dev,$ino,$mode,$nlink,$uid,$gid);

    (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
    !exists $uid{$uid}
    && print("$name\n");
}

#2

'20000' =~ /(0|1|2|...)/

matches. You probably want to anchor the expression:

火柴。您可能想要锚定表达式：

/^(0|1|2|...)$/

(The other answer is better, just adding this for completeness.)

（另一个答案更好，只需添加此内容即可完成。）

#1