#!/usr/bin/perl
# vim:set autoindent cindent smarttab shiftwidth=4:
#
# $Id: suidregister,v 1.20.2.3 2000/02/27 19:51:22 aklein Exp $
#

use strict;

my @conf;	# the suidmanager registry, in hashes
my @diversions;	# the diversions file, in hashes
my (
    $pkg,	# package name
    $file,	# file to add
    $realfile,  # the real location of the file (after diversions)
    $user,	# user of that file
    $group,	# group of that file
    $mode	# permissions of that file
);
my $rec;	# a temporary variable to create new records for the above
# temporary variables for package, file, user, group, and mode
my ($p, $f, $u, $g, $m);

# Find out what we were run as, without the leading directories
my $progname = $0;
$progname =~ s[.*/][];

# The suidmanager registry
my $suidconf = '/etc/suid.conf';
# dpkg's diversions registry
my $diversionsconf = '/var/lib/dpkg/diversions';
# Only operate with diversions if the above file exists
my $divert = 1 if -e $diversionsconf;

# Create the registry if there isn't one
if (not -e $suidconf) {
    open CONF, ">$suidconf" or die "$progname: Can't write $suidconf: $!\n";
    print CONF "# Configuration File for suid programs or special permissions\n",
	       "#\n",
	       "# The format is:\n",
	       "# package file user group permissions\n";
    close CONF;
}

# Read in the diversions file
if ($divert) {
    open DIVERSIONS, "<$diversionsconf" or die "$progname: Can't read $diversionsconf: $!\n";
    while (<DIVERSIONS>) {
	$rec = {};
	chomp($rec->{oldname} = $_);
	chomp($rec->{newname} = <DIVERSIONS>);
	chomp($rec->{pkg} = <DIVERSIONS>);
    	if ($rec->{pkg} eq ':') {
	    $rec->{pkg} = 'user';
	}
	push @diversions, $rec;
    }
    close DIVERSIONS;
}

# Read the configuration into an array of hashes
open CONF, "<$suidconf" or die "$progname: Can't read $suidconf: $!\n";

# Read the file into @conf with each line being a hash
while (<CONF>) {
    # Skip comments and empty lines
    next if /^#|^\s*$/;
    ($p, $f, $u, $g, $m) = split;
    $rec = {
	pkg => $p,
	file => $f,
	# Check if the file is diverted
	realfile => diverted($f, $p),
	# If the user is a UID, convert it to a name
	user => ($u =~ /^\d/) ? $u : scalar getpwnam($u),
	# If the group is a GID, convert it to a name
	group => ($g =~ /^\d/) ? $g : scalar getgrnam($g),
	# Convert the mode to octal
	mode => oct $m
    };
    push @conf, $rec;
}
close CONF;

# The functionality of suidunregister is now included in the main program
if ($progname eq 'suidunregister') { unregister(@ARGV) and exit 0 or exit 1 }

# When called with no argument, just check settings
if (@ARGV == 0) {
    suidrun();
    exit 0;
}

if ($ARGV[0] eq '-s') {
    $pkg = $ARGV[1];
    shift; shift;
} else {
    $pkg = 'user';
}

if (@ARGV != 4) {
    print STDERR "Usage: $progname [-s package] [file user group mode]\n";
    exit 1;
}

($file, $user, $group, $mode) = @ARGV;
$realfile = diverted($file, $pkg);

if ($realfile !~ m[^/]) {
    print STDERR "$progname: $realfile is not an absolute path\n";
    exit 1;
}

if (not -e $realfile) {
    print STDERR "$progname: $realfile not found\n";
    exit 1;
}

if ($user !~ /^\d/) {
    # Check that the user exists
    if (defined($u = getpwnam($user))) {
        $user = $u;
    } else {
        print STDERR "$progname: $user: no such user\n";
	exit 1;
    }
}

if ($group !~ /^\d/) {
    # Check that the group exists
    if (defined($g = getgrnam($group))) {
	$group = $g;
    } else {
	print STDERR "$progname: $group: no such group\n";
	exit 1;
    }
}

if ($mode =~ /^\d+$/) {
    $mode = oct $mode;
} else {
    print STDERR "$progname: mode $mode is not numerical\n";
    exit 1;
}

# Go through each entry
foreach $rec (@conf) {
    # Is this the same file as the one we've been asked to enter?
    if ($rec->{realfile} eq $realfile or getinode($rec->{realfile}) == getinode($realfile)) {
	if ($pkg ne 'user' and $rec->{pkg} eq 'user') {
	    # Do a user override unless the new package is also user
	    printf "$progname: OVERRIDE: user $file %s %s %o\n",
	    	    getunam($rec->{user}), getgnam($rec->{group}), $rec->{mode};
	    setperm($rec->{realfile}, $rec->{user}, $rec->{group}, $rec->{mode});
	    exit 0;
	} else {
	    # Otherwise, just remove the old entry
	    unregister($rec->{file});
	}
    }
}

open CONF, ">>$suidconf" or die "$progname: Can't write $suidconf: $!\n";
printf CONF "$pkg $file %s %s %o\n", getunam($user), getgnam($group), $mode;
close CONF;
setperm($realfile, $user, $group, $mode);
exit 0;

# Subroutines

# If a [ug]id has an associated user name, return that; otherwise, return the id
sub getunam ($) { getpwuid($_[0]) or $_[0] }
sub getgnam ($) { getgrgid($_[0]) or $_[0] }

# Return the inode of the file named by the argument
# or -1 if there's a problem opening the file
sub getinode ($)
{
    my $inode = (stat $_[0])[1];
    if (defined $inode) {
	return $inode;
    } else {
	return -1;
    }
}

sub suidrun ()
{
    foreach $rec (@conf) {
	if (not -e $rec->{realfile}) {
	    print STDERR "$progname: $rec->{file} registered but not installed\n";
	    next;
	}
	my ($mode, $user, $group) = (stat _)[2,4,5];
	$mode &= 07777;
	if ($rec->{user} != $user or $rec->{group} != $group or $rec->{mode} != $mode) {
	    printf STDERR "$progname: $rec->{file} PERMISSION MISMATCH: was %s.%s %o changed to %s.%s %o\n",
	    	    getunam($user), getgnam($group), $mode,
	    	    getunam($rec->{user}),  getgnam($rec->{group}), $rec->{mode};
	    setperm($rec->{realfile}, $rec->{user}, $rec->{group}, $rec->{mode});
	}
    }
}

sub unregister (@)
{
    my ($pkg, $file);

    if ($_[0] eq '-s') {
	# Only remove an entry if it matches the package specified
	$pkg = quotemeta $_[1];
	shift; shift;
    } else {
	# Match any package
	$pkg = '[a-z0-9+-\.]+';
    }

    if (@_ != 1) {
	print STDERR "Usage: $progname [-s package] file\n";
	return 0;	# Failure
    }
    $file = quotemeta $_[0];

    open CONF, "<$suidconf" or die "$progname: Can't read $suidconf: $!";
    open NEWCONF, ">$suidconf.new" or die "$progname: Can't write $suidconf.new: $!";
    while (<CONF>) {
	# Copy all lines except the one that has the package and file asked to remove
	print NEWCONF unless /^$pkg\s+$file\s/;
    }
    close NEWCONF;
    close CONF;
    rename "$suidconf.new", "$suidconf"
	or die "$progname: Can't move $suidconf.new to $suidconf: $!";

    return 1;	# Success
}

sub diverted ($$)
{
    my ($file, $pkg) = @_;

    # Don't do anything if we're not dealing with diversions
    # Also, if the user did the registering, we'll assume they
    # know about the diversion. This is usually the right thing to do
    if (not $divert or $pkg eq 'user') {
	return $file;
    }

    foreach $rec (@diversions) {
	if ($rec->{oldname} eq $file and $rec->{pkg} ne $pkg) {
	    return $rec->{newname};
	}
    }

    # If we're still here, just return the original name
    return $file;
}

sub setperm ($$$$)
{
    my ($file, $user, $group, $mode) = @_;
    if (not chown($user, $group, $file)) {
	print STDERR "$progname: Can't chown $file: $!\n";
    }
    if (not chmod($mode, $file)) {
	print STDERR "$progname: Can't chmod $file: $!\n";
    }
}
