#! /usr/bin/perl

# Copyright (C) 2000 Ian Zimmerman <itz@speakeasy.org>
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License as
#  published by the Free Software Foundation; either version 2 of the
#  License, or (at your option) any later version.

#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  General Public License for more details.

use File::Find;
use Getopt::Std;

$exit_code = 0;

my %user_mismatches;
my %group_mismatches;
my %perm_mismatches;

sub do_check {
    my ($nodename) = @_;
    my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
        $atime, $mtime, $ctime, $blksize, $blocks) = lstat _;
    if ($owner ne "*" && $nowner != $uid) {
        $user_mismatches{"$dev|$ino"} = [ $nodename, $nowner, $uid ];
    } elsif (defined $user_mismatches{"$dev|$ino"}) {
        delete $user_mismatches{"$dev|$ino"};
    }
    if ($group ne "*" && $ngroup != $gid) {
        $group_mismatches{"$dev|$ino"} = [ $nodename, $ngroup, $gid ];
    } elsif (defined $group_mismatches{"$dev|$ino"}) {
        delete $group_mismatches{"$dev|$ino"};
    }
    $mode &= 07777;
    if ($op eq "=" && $mode != $perms) {
        $perm_mismatches{"$dev|$ino"} = [ $nodename, "=$perms", $mode ];
    } elsif ($op eq "<" && ($mode & $perms) != $mode) {
        $perm_mismatches{"$dev|$ino"} = [ $nodename, "<$perms", $mode ];
    } elsif ($op eq ">" && ($mode & $perms) != $perms) {
        $perm_mismatches{"$dev|$ino"} = [ $nodename, ">$perms", $mode ];
    } elsif (defined $perm_mismatches{"$dev|$ino"}) {
        delete $perm_mismatches{"$dev|$ino"};
    }
}

sub wanted {
    if ($File::Find::name !~ /$pat/) {
        return;
    }
    if (-l $_ ||
        ($type eq "d" && ! -d _) ||
        ($type eq "f" && ! -f _)) {
        return;
    }
    if ($opt_v) {
        print STDOUT "$File::Find::name\n";
    }
    do_check($File::Find::name);
 }

getopts("dfsv");

LINE:
while ($line = <STDIN>) {
    if ($line =~ /^[ 	]*(\#.*)?$/) {
        next LINE;
    }
    chomp $line;
    local ($origin, $pat, $type, $owner, $group, $perms) = split /\s+/, $line;
    unless ($perms) {
        print STDERR "malformed input line: $line\n";
        exit 101;
    }
    unless (length($type) == 1 && index("*df",$type) >= 0) {
        print STDERR "$line: type must be in [*df]\n";
        exit 102;
    }
    local $nowner;
    if ($owner ne "*") {
        $nowner = ($owner =~ /^[0-9]+$/ ? $owner : getpwnam($owner));
        if (!defined $nowner) {
            print STDERR "no such user: $owner\n";
            exit 103;
        }
        $owner = getpwuid($nowner);
    }
    local $ngroup;
    if ($group ne "*") {
        $ngroup = ($group =~ /^[0-9]+$/ ? $group : getgrnam($group));
        if (!defined $ngroup) {
            print STDERR "no such group: $group\n";
            exit 104;
        }
        $group = getgrgid($ngroup);
    }
    local $op = substr($perms, 0, 1);
    $perms = substr($perms, 1);
    unless (($op eq "*" && $perms eq "") ||
            (index("<>=", $op) >= 0 && $perms =~ /^[0-7]+$/)) {
        print STDERR "perms field $op$perms: must be * or [<>=][0-7]+\n";
        exit 105;
    }
    $perms = oct($perms);
    finddepth(\&wanted, $origin);
}

if ($opt_d) {
    open SUID, "/etc/suid.conf" or die "cannot open /etc/suid.conf: $!\n";
SUIDLINE:
    while ($line = <SUID>) {
        if ($line =~ /^[ 	]*(\#.*)?$/) {
            next SUIDLINE;
        }
        chomp $line;
        local ($pkg, $path, $owner, $group, $perms) = split(/\s+/, $line);
        unless ($perms) {
            print STDERR "malformed line in /etc/suid.conf: $line\n";
            exit 106;
        }
        local $nowner = ($owner =~ /^[0-9]+$/ ? $owner : getpwnam($owner));
        if (!defined $nowner) {
            print STDERR "no such user: $owner\n";
            exit 103;
        }
        $owner = getpwuid($nowner);
        local $ngroup = ($group =~ /^[0-9]+$/ ? $group : getgrnam($group));
        if (!defined $ngroup) {
            print STDERR "no such group: $group\n";
            exit 104;
        }
        $group = getgrgid($ngroup);
        local $op = '=';
        unless ($perms =~ /^[0-7]+$/) {
            print STDERR "perms field $perms: must be [0-7]+\n";
            exit 105;
        }
        $perms = oct($perms);
        @dummy = lstat($path);
        do_check($path);
    }
    close SUID;
}

foreach $mismatch (keys %user_mismatches) {
    my ($pathname, $nowner, $uid) = @{ $user_mismatches{$mismatch} };
    my $nuid = getpwuid($uid);
    my $owner = getpwuid($nowner);
    unless ($opt_s) {
        print STDOUT "$pathname: " .
            "expected owner $owner($nowner), found $nuid($uid)\n";
    }
    if ($opt_f) {
        chown($nowner, -1, $pathname);
    }
    $exit_code = 200;
}

foreach $mismatch (keys %group_mismatches) {
    my ($pathname, $ngroup, $gid) = @{ $group_mismatches{$mismatch} };
    my $ngid = getgrgid($gid);
    my $group = getgrgid($ngroup);
    unless ($opt_s) {
        print STDOUT "$pathname: " .
            "expected group $group($ngroup), found $ngid($gid)\n";
    }
    if ($opt_f) {
        chown(-1, $ngroup, $pathname);
    }
    $exit_code = 200;
}

foreach $mismatch (keys %perm_mismatches) {
    my ($pathname, $expected, $found) = @{ $perm_mismatches{$mismatch} };
    my $op = substr($expected, 0, 1);
    $expected = substr($expected, 1);
    if ($op eq "=") {
        unless ($opt_s) {
            printf("%s: expected mode =%lo, found %lo\n",
                   $pathname, $expected, $found);
        }
        if ($opt_f) {
            chmod($expected, $pathname);
        }
    } elsif ($op eq "<") {
        unless ($opt_s) {
            printf("%s: expected mode <%lo, found %lo\n",
                   $pathname, $expected, $found);
        }
        if ($opt_f) {
            chmod($expected & $found, $pathname);
        }
    } elsif ($op eq ">") {
        unless ($opt_s) {
            printf("%s: expected mode >%lo, found %lo\n",
                   $pathname, $expected, $found);
        }
        if ($opt_f) {
            chmod($expected | $found, $pathname);
        }
    }
    $exit_code = 200;
}

exit $exit_code;

__END__

=head1 NAME

permafrost - maintain file permissions and ownership en masse noninteractively

=head1 SYNOPSIS

B<permafrost> [ C<-f> | C<-s> | C<-v> | C<-d> ] ... < I<configuration_file>

=head1 DESCRIPTION

B<permafrost> traverses directory trees and compares the permissions
and ownership (both user and group) of files it finds with
specifications from a configuration file.  If the actual state doesn't
match the specification, B<permafrost> issues a warning message, and
optionally fixes the actual state so as to match the specification.

=head1 OPTIONS

=over 4

=item C<-d>

In addition to reading the normal configuration file from standard
input, read the Debian format F</etc/suid.conf> as well.  This makes
it possible to cover binary directories like /usr/bin with a single
configuration line, usually something like

 /usr/bin	.*	f	root	root	<755

because the exceptions are handled in F<suid.conf>.

=item C<-f>

In case of discrepancies, I<fix> the permissions and ownerships to
match the specification.

=item C<-s>

Stay I<silent>; don't issue any warning messages in case of
discrepancies.  Only useful in combination with C<-f>, and not
recommended. 

=item C<-v>

Be I<verbose>; I<in addition> to the normal warning messages, print
pathnames of I<all> files or directories processed, even those that do
match the specification.

=back

=head1 CONFIGURATION FILE

B<permafrost> reads its configuration file from standard input.
Here's an example:

 /usr/src	.*	f	*	staff	>664 
 /usr/src	.*,v	f	*	staff	<555
 /usr/src	.*	d	*	staff	=2775
 /usr/share/man	.*	f	root	root	=644

The format is line oriented: one record per line, fields separated by
whitespace.  Each record causes a separate scan of a directory tree.
The first field names the tree to traverse, and the next 2 fields
select nodes within the tree to which B<permafrost> will pay
attention.  All other nodes are ignored, and won't even be printed
with the C<-v> option.  Counting from 0, field 1 is a pattern which 
the complete pathname of a node must match to be processed.  N.B. this
is a real Perl style regular expression, I<not> a shell glob!  ^ at
the beginning and $ at the end of the pattern is implicitly assumed,
so .* has to be used to force a non-anchored pattern to match, as with
B<locate(1)>.  Field 2 selects nodes according to type: C<f> selects
regular files, C<d> selects subdirectories, C<*> selects both regular
files and subdirectories.  B<permafrost> doesn't currently handle any
other types.

The last 3 fields are the permissions and ownerships specifications.
Field 3 is the expected user owner, which may be numeric (interpreted
as user id), alphabetic (interpreted as user name) or * (interpreted
as "anything goes").  Field 4 is the expected group owner, which may
be numeric (interpreted as group id), alphabetic (interpreted as group
name) or * (interpreted as "anything goes").  Field 5 specifies the
expected permissions.  It consists of a relation character 
S<(one of E<lt>, E<gt>, or =)> 
followed by an octal mode.  If the relation is <, processed
nodes are expected to have permissions which are a B<subset> of (or
possibly equal to) the mode given.  For example, with the above
configuration file, a regular file named F<foo,v> with mode 0644 will
cause a warning, because S<0644 & 0555 = 0544 != 0644.>  But a file
F<bar,v> with mode 0544 will pass without a warning, because 
S<0544 & 0555 == 0544.>  
Similarly, if the relation is >, processed nodes are
expected to have permissions which are a B<superset> of (or possibly
equal to) the mode given.  For example, with the above configuration
file, a regular file named F<foo> with mode 0755 will cause a warning,
because S<0755 & 0664 = 0654 != 0664.>  But a file F<bar> with mode 0775
will pass without a warning, because S<0775 & 0664 == 0664.>  Lastly, if
the relation is =, processed nodes are expected to have permissions
which are B<exactly equal> to the mode given.

=head1 EXIT CODE

B<permafrost> exits with status 0 if and only if neither any syntax
errors in the configuration file nor mismatches with the
specifications were found.  In the case of mismatches it exits with
status 200.

=head1 BUGS

Each line of the configuration file causes a separate scan of the
corresponding directory tree; if the directory trees overlap or
coincide, many nodes may be inspected multiple times.  Although as of
version 1.5 B<permafrost> is smart enough to avoid issuing multiple
warnings for such nodes, and indeed won't issue a warning at all if
the last test of each "kind" (for user owner, group owner, and
permissions) is successful, this algorithm still feels grossly
inefficient.  Do we really want to cache all processed nodes, though?
That might eat both RAM and swap space fast.

=head1 SEE ALSO

=over 1

=item L<perl(1)>

=item L<locate(1)>

=item L<chown(1)>

=item L<chgrp(1)>

=item L<chmod(1)>

=back

=head1 SCRIPT CATEGORIES

UNIX/System_administration

=head1 AUTHOR

Ian Zimmerman <itz@speakeasy.org>