# Copyright (C) 2017 Sergey Poznyakoff

# This Perl script locates the executable files that have setuid or
# setgid bits set and mails their names to the list of recipients
# (see @rcpt below).
#
# The report is formatted as a multi-part message, with a separate attachment
# for each mount point.
#
# For details, see http://mailutils.org/wiki/Mail:_sending_attachments
#
# Before use, rename it to repsuid.pl

# 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 3, 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.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use autodie;

my @rcpt= 'root';
my @cmd = ( 'mail', '-E set nonullbodymsg', '--content-type=text/plain');
my @fds;
$^F = 255;

open(my $in, '-|', 'mount -t nonfs,noproc,nosysfs,notmpfs');
while (<$in>) {
    chomp;
    if (/^\S+ on (?<mpoint>.+) type (?<fstype>.+) /) {
	open(my $fd, '-|',
	     "sudo find $+{mpoint} -xdev -type f"
             . " \\( -perm -u+x -o -perm -g+x -o -perm -o+x \\)"
             . " \\( -perm -u+s -o -perm -g+s \\) -print");
	push @fds, $fd;
	my $mpname = $+{mpoint};
	$mpname =~ tr{/}{%}; 
	push @cmd,
	     "--content-name=Set[ug]id files on $+{mpoint} (type $+{fstype})",
	     "--content-filename=$mpname.list",
	     '--attach-fd=' . fileno($fd);
    }
}
close $in;
push @cmd, @rcpt;
close STDIN;
system(@cmd);