530 lines
16 KiB
Perl
Executable file
530 lines
16 KiB
Perl
Executable file
#! /usr/bin/perl
|
|
|
|
|
|
# Copyright (C) 2000 Roland Bauerschmidt <rb@debian.org>
|
|
#
|
|
# Based on the Debian "adduser" utility developed by:
|
|
# Guy Maor <maor@debian.org>
|
|
# Ted Hajek <tedhajek@boombox.micro.umn.edu>
|
|
# Ian A. Murdock <imurdock@gnu.ai.mit.edu>
|
|
#
|
|
# 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.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to:
|
|
#
|
|
# Free Software Foundation
|
|
# 51 Franklin Street, Fifth Floor
|
|
# Boston, MA 02110
|
|
# USA
|
|
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Getopt::Long;
|
|
|
|
use Debian::AdduserCommon;
|
|
|
|
my $version = "3.134";
|
|
|
|
my $install_more_packages;
|
|
|
|
BEGIN {
|
|
local $ENV{PERL_DL_NONLAZY}=1;
|
|
eval 'use File::Find';
|
|
if ($@) {
|
|
$install_more_packages = 1;
|
|
}
|
|
#no warnings "File::Find";
|
|
eval 'use File::Temp';
|
|
if ($@) {
|
|
$install_more_packages = 1;
|
|
}
|
|
}
|
|
|
|
|
|
BEGIN {
|
|
eval 'use Locale::gettext';
|
|
if ($@) {
|
|
*gettext = sub { shift };
|
|
*textdomain = sub { "" };
|
|
*LC_MESSAGES = sub { 5 };
|
|
}
|
|
eval {
|
|
require POSIX;
|
|
import POSIX qw(setlocale);
|
|
};
|
|
if ($@) {
|
|
*setlocale = sub { return 1 };
|
|
}
|
|
}
|
|
|
|
setlocale(LC_MESSAGES, "");
|
|
textdomain("adduser");
|
|
|
|
my $action = $0 =~ /delgroup$/ ? "delgroup" : "deluser";
|
|
our $verbose = 1;
|
|
my %pconfig = ();
|
|
my %config = ();
|
|
my @configfiles;
|
|
my @defaults;
|
|
my $no_preserve_root;
|
|
|
|
|
|
unless (
|
|
GetOptions (
|
|
"quiet|q" => sub {$verbose = 0; },
|
|
"debug" => sub {$verbose = 2; },
|
|
"verbose" => sub {$verbose = 2; },
|
|
"version|v" => sub { &version(); exit 0; },
|
|
"help|h" => sub { &usage(); exit 0;},
|
|
"group" => sub { $action = "delgroup";},
|
|
"conf|c=s" => \@configfiles,
|
|
"system" => \$pconfig{"system"},
|
|
"only-if-empty" => \$pconfig{"only_if_empty"},
|
|
"remove-home" => \$pconfig{"remove_home"},
|
|
"remove-all-files" => \$pconfig{"remove_all_files"},
|
|
"backup" => \$pconfig{"backup"},
|
|
"backup-to=s" => \$pconfig{"backup_to"},
|
|
"backup-suffix=s" => \$pconfig{"backup_suffix"},
|
|
"no-preserve-root" => \$no_preserve_root
|
|
)
|
|
) {
|
|
&usage;
|
|
exit 1;
|
|
}
|
|
|
|
# everyone can issue "--help" and "--version", but only root can go on
|
|
dief (gtx("Only root may remove a user or group from the system.\n")) if ($> != 0);
|
|
|
|
if (!@configfiles) {
|
|
@defaults = ("/etc/adduser.conf", "/etc/deluser.conf");
|
|
} else {
|
|
@defaults = (@configfiles);
|
|
}
|
|
|
|
# explicitly set PATH, because super (1) cleans up the path and makes deluser unusable;
|
|
# this is also a good idea for sudo (which doesn't clean up)
|
|
$ENV{"PATH"}="/bin:/usr/bin:/sbin:/usr/sbin";
|
|
|
|
my @names = ();
|
|
my ($user,$group);
|
|
|
|
######################
|
|
# handling of @names #
|
|
######################
|
|
|
|
while (defined(my $arg = shift(@ARGV))) {
|
|
if (defined($names[0]) && $arg =~ /^--/) {
|
|
dief (gtx("No options allowed after names.\n"));
|
|
} else { # it's a username
|
|
push (@names, $arg);
|
|
}
|
|
}
|
|
|
|
if(@names == 0) {
|
|
if($action eq "delgroup") {
|
|
print (gtx("Enter a group name to remove: "));
|
|
} else {
|
|
print (gtx("Enter a user name to remove: "));
|
|
}
|
|
chomp(my $answer=<STDIN>);
|
|
push(@names, $answer);
|
|
}
|
|
|
|
if (length($names[0]) == 0 || @names > 2) {
|
|
dief (gtx("Only one or two names allowed.\n"));
|
|
}
|
|
|
|
if(@names == 2) { # must be deluserfromgroup
|
|
$action = "deluserfromgroup";
|
|
$user = shift(@names);
|
|
$group = shift(@names);
|
|
} else {
|
|
if($action eq "delgroup") {
|
|
$group = shift(@names);
|
|
} else {
|
|
$user = shift(@names);
|
|
}
|
|
}
|
|
|
|
undef(@names);
|
|
|
|
$ENV{"VERBOSE"} = $verbose;
|
|
$ENV{"DEBUG"} = $verbose;
|
|
|
|
##########################################################
|
|
# (1) preseed the config
|
|
# (2) read the default /etc/adduser.conf configuration.
|
|
# (3) read the default /etc/deluser.conf configuration.
|
|
# (4) process commmand line settings
|
|
# last match wins
|
|
##########################################################
|
|
|
|
preseed_config (\@defaults,\%config);
|
|
|
|
foreach(keys(%pconfig)) {
|
|
$config{$_} = $pconfig{$_} if ($pconfig{$_});
|
|
}
|
|
|
|
if (($config{remove_home} || $config{remove_all_files} || $config{backup}) && ($install_more_packages)) {
|
|
fail (8, gtx("In order to use the --remove-home, --remove-all-files, and --backup features,
|
|
you need to install the `perl' package. To accomplish that, run
|
|
apt-get install perl.\n"));
|
|
}
|
|
|
|
|
|
my ($pw_uid, $pw_gid, $pw_homedir, $gr_gid, $maingroup);
|
|
|
|
if(defined($user)) {
|
|
my @passwd = getpwnam($user);
|
|
$pw_uid = $passwd[2];
|
|
$pw_gid = $passwd[3];
|
|
$pw_homedir = $passwd[7];
|
|
|
|
$maingroup = $pw_gid ? getgrgid($pw_gid) : "";
|
|
}
|
|
if(defined($group)) {
|
|
#($gr_name,$gr_passwd,$gr_gid,$gr_members) = getgrnam($group);
|
|
my @group = getgrnam($group);
|
|
$gr_gid = $group[2];
|
|
}
|
|
|
|
# arguments are processed:
|
|
#
|
|
# $action = "deluser"
|
|
# $user name of the user to remove
|
|
#
|
|
# $action = "delgroup"
|
|
# $group name of the group to remove
|
|
#
|
|
# $action = "deluserfromgroup"
|
|
# $user the user to be remove
|
|
# $group the group to remove him/her from
|
|
|
|
|
|
if($action eq "deluser") {
|
|
my($dummy1,$dummy2,$uid);
|
|
|
|
# Don't allow a non-system user to be deleted when --system is given
|
|
# Also, "user does not exist" is only a warning with --system, but an
|
|
# error without --system.
|
|
if( $config{"system"} ) {
|
|
if( ($dummy1,$dummy2,$uid) = getpwnam($user) ) {
|
|
if ( ($uid < $config{"first_system_uid"} ||
|
|
$uid > $config{"last_system_uid" } ) ) {
|
|
warnf (gtx("The user `%s' is not a system user. Exiting.\n"), $user) if $verbose;
|
|
exit 1;
|
|
}
|
|
} else {
|
|
warnf (gtx("The user `%s' does not exist, but --system was given. Exiting.\n"), $user) if $verbose;
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
unless(exist_user($user)) {
|
|
fail (2,gtx("The user `%s' does not exist.\n"),$user);
|
|
}
|
|
|
|
# Warn in any case if you want to remove the root account
|
|
if ((defined($pw_uid)) && ($pw_uid == 0) && (!defined($no_preserve_root))) {
|
|
printf (gtx("WARNING: You are just about to delete the root account (uid 0)\n"));
|
|
printf (gtx("Usually this is never required as it may render the whole system unusable\n"));
|
|
printf (gtx("If you really want this, call deluser with parameter --no-preserve-root\n"));
|
|
printf (gtx("Stopping now without having performed any action\n"));
|
|
exit 9;
|
|
}
|
|
|
|
# consistency check
|
|
# if --backup-to is specified, --backup should be set too
|
|
if ($pconfig{"backup_to"}) {
|
|
$config{"backup"} = 1;
|
|
}
|
|
|
|
if($config{"remove_home"} || $config{"remove_all_files"}) {
|
|
s_print (gtx("Looking for files to backup/remove ...\n"));
|
|
my @mountpoints;
|
|
my $exclude_fstypes = $config{"exclude_fstypes"};
|
|
open(MOUNT, '/proc/mounts')
|
|
|| fail (4 ,gtx("failed to open /proc/mounts: %s\n", $!));
|
|
while (<MOUNT>) {
|
|
my @temparray = split;
|
|
my ($fstype, $fname) = ($temparray[2], $temparray[1]);
|
|
|
|
next if $fname eq '/';
|
|
next if $fname eq '/home';
|
|
|
|
push @mountpoints,$fname if ($fstype =~ /$exclude_fstypes/);
|
|
}
|
|
close(MOUNT) or dief (gtx("failed to close /proc/mounts: %s\n",$!));
|
|
my(@files,@dirs);
|
|
if($config{"remove_home"}) {
|
|
# collect all files in user home
|
|
sub home_match {
|
|
push(@files, $File::Find::name)
|
|
if(-f $File::Find::name || -l $File::Find::name);
|
|
push(@dirs, $File::Find::name)
|
|
if(-d $File::Find::name);
|
|
} # sub home_match
|
|
|
|
File::Find::find({wanted => \&home_match, untaint => 1, no_chdir => 1}, $pw_homedir)
|
|
if(-d "$pw_homedir");
|
|
push(@files, "/var/mail/$user")
|
|
if(-e "/var/mail/$user");
|
|
}
|
|
|
|
if ($config{"remove_all_files"}) {
|
|
# collect all files on system belonging to that user
|
|
sub find_match {
|
|
my ($dev,$ino,$mode,$nlink,$uid,$gid) = lstat;
|
|
foreach my $mount (@mountpoints) {
|
|
if( $File::Find::name eq $mount ) {
|
|
s_printf (gtx("Not backing up/removing `%s', it is a mount point.\n"),$File::Find::name) if ($verbose > 1);
|
|
$File::Find::prune=1;
|
|
return;
|
|
}
|
|
}
|
|
foreach my $re ( split ' ', $config{"no_del_paths"} ) {
|
|
if( $File::Find::name =~ qr/$re/ ) {
|
|
s_printf (gtx("Not backing up/removing `%s', it matches %s.\n"),$File::Find::name,$re) if ($verbose > 1);
|
|
$File::Find::prune=1;
|
|
return;
|
|
}
|
|
}
|
|
(defined($uid) && ($uid == $pw_uid)) &&
|
|
(
|
|
(-f $File::Find::name && push(@files, $File::Find::name)) ||
|
|
(-l $File::Find::name && push(@files, $File::Find::name)) ||
|
|
(-d $File::Find::name && push(@dirs, $File::Find::name)) ||
|
|
(-S $File::Find::name && push(@files, $File::Find::name)) ||
|
|
(-p $File::Find::name && push(@files, $File::Find::name))
|
|
);
|
|
if ( -b $File::Find::name || -c $File::Find::name ) {
|
|
warnf (gtx("Cannot handle special file %s\n"),$File::Find::name);
|
|
}
|
|
} # sub find_match
|
|
|
|
File::Find::find({wanted => \&find_match, untaint => 1, no_chdir => 1}, '/');
|
|
}
|
|
|
|
if($config{"backup"}) {
|
|
s_printf (gtx("Backing up files to be removed to %s ...\n"),$config{"backup_to"});
|
|
my $filesfile = new File::Temp(TEMPLATE=>"deluser.XXXXX", DIR=>"/tmp");
|
|
my $filesfilename = $filesfile->filename;
|
|
my $backup_name = $config{"backup_to"} . "/$user.tar";
|
|
print $filesfile join("\n", map { s/^\///r } @files);
|
|
|
|
$filesfile->close();
|
|
my $tar = &which('tar');
|
|
&check_backup_suffix();
|
|
$backup_name .= $config{'backup_suffix'};
|
|
print "backup_name = $backup_name\n";
|
|
&systemcall($tar, "--directory", "/", "--auto-compress", "-cf", $backup_name, "--files-from", $filesfilename);
|
|
chmod 0600, $backup_name;
|
|
my $rootid = 0;
|
|
chown $rootid, $rootid, $backup_name;
|
|
unlink($filesfilename);
|
|
}
|
|
|
|
if(@files || @dirs) {
|
|
s_print (gtx("Removing files ...\n"));
|
|
unlink(@files) if(@files);
|
|
foreach(reverse(sort(@dirs))) {
|
|
rmdir unless /^$config{dhome}$/ || /^\/$/;
|
|
}
|
|
}
|
|
}
|
|
|
|
if (-x '/usr/bin/crontab') {
|
|
s_print(gtx("Removing crontab ...\n"));
|
|
|
|
if (&systemcall_silent('/usr/bin/crontab', '-u', $user, '-l') == 0) {
|
|
&systemcall_or_warn('/usr/bin/crontab', '-u', $user, '-r');
|
|
}
|
|
} else {
|
|
warnf(gtx("`%s' not executed. Skipping crontab removal. Package `cron' required.\n"),
|
|
'/usr/bin/crontab');
|
|
}
|
|
|
|
s_printf(gtx("Removing user `%s' ...\n"), $user);
|
|
acquire_lock();
|
|
&systemcall('/usr/sbin/userdel', $user);
|
|
release_lock();
|
|
|
|
&systemcall('/usr/local/sbin/deluser.local', $user, $pw_uid,
|
|
$pw_gid, $pw_homedir) if (-x "/usr/local/sbin/deluser.local");
|
|
|
|
s_print(gtx("Done.\n"));
|
|
exit 0;
|
|
}
|
|
|
|
|
|
if ($action eq 'delgroup') {
|
|
unless (exist_group($group)) {
|
|
warnf (gtx("The group `%s' does not exist.\n"), $group) if $verbose;
|
|
exit(0) if $config{'system'};
|
|
exit(3);
|
|
}
|
|
|
|
my($dummy,$gid,$members);
|
|
if( !(($dummy, $dummy, $gid, $members ) = getgrnam($group)) ) {
|
|
fail (4 ,gtx("getgrnam `%s' failed. This shouldn't happen.\n"), $group);
|
|
}
|
|
if( $config{"system"} &&
|
|
($gid < $config{"first_system_gid"} ||
|
|
$gid > $config{"last_system_gid" } )) {
|
|
warnf (gtx("The group `%s' is not a system group. Exiting.\n"), $group) if $verbose;
|
|
exit 3;
|
|
}
|
|
if( $config{"only_if_empty"} && $members ne "") {
|
|
fail (5, gtx("The group `%s' is not empty!\n"),$group);
|
|
}
|
|
|
|
# groupdel will error out if there are users left that
|
|
# have $group as primary group. We are not checking this
|
|
# ourself since this would mean enumerating all users.
|
|
s_printf (gtx("Removing group `%s' ...\n"),$group);
|
|
my $groupdel = &which('groupdel');
|
|
acquire_lock();
|
|
&systemcall($groupdel,$group);
|
|
release_lock();
|
|
s_print (gtx("Done.\n"));
|
|
exit 0;
|
|
}
|
|
|
|
|
|
if($action eq 'deluserfromgroup')
|
|
{
|
|
unless(exist_user($user)) {
|
|
fail (2, gtx("The user `%s' does not exist.\n"),$user);
|
|
}
|
|
unless(exist_group($group)) {
|
|
fail (3, gtx("The group `%s' does not exist.\n"),$group);
|
|
}
|
|
if($maingroup eq $group) {
|
|
fail (7, gtx("You may not remove the user from their primary group.\n"));
|
|
}
|
|
|
|
my $is_member;
|
|
my @members;
|
|
|
|
foreach my $member (get_group_members($group)) {
|
|
|
|
if ($member eq $user) {
|
|
$is_member = 1;
|
|
next;
|
|
}
|
|
|
|
push @members, $member;
|
|
}
|
|
|
|
unless($is_member) {
|
|
fail (6, gtx("The user `%s' is not a member of group `%s'.\n"),$user,$group);
|
|
}
|
|
|
|
s_printf (gtx("Removing user `%s' from group `%s' ...\n"),$user,$group);
|
|
|
|
acquire_lock();
|
|
&systemcall('/usr/bin/gpasswd', '-M', join(',', @members), $group);
|
|
release_lock();
|
|
|
|
s_print (gtx("Done.\n"));
|
|
}
|
|
|
|
|
|
######
|
|
|
|
sub fail {
|
|
my ($errorcode, $format, @args) = @_;
|
|
warnf "$format",@args;
|
|
exit $errorcode;
|
|
}
|
|
|
|
sub version {
|
|
printf (gtx("deluser version %s\n\n"), $version);
|
|
print gtx("Removes users and groups from the system.
|
|
|
|
For detailed copyright information, please refer to
|
|
/usr/share/doc/adduser/copyright.
|
|
\n");
|
|
|
|
print gtx("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, /usr/share/common-licenses/GPL, for more details.
|
|
");
|
|
}
|
|
|
|
sub usage {
|
|
printf gtx(
|
|
"deluser [--system] [--remove-home] [--remove-all-files] [--backup]
|
|
[--backup-to dir] [--backup-suffix str] [--conf file]
|
|
[--quiet] [--verbose] [--debug] user
|
|
|
|
remove a normal user from the system
|
|
|
|
deluser --group [--system] [--only-if-empty] [--conf file] [--quiet]
|
|
[--verbose] [--debug] group
|
|
delgroup [--system] [--only-if-empty] [--conf file] [--quiet]
|
|
[--verbose] [--debug] group
|
|
remove a group from the system
|
|
|
|
deluser [--conf file] [--quiet] [--verbose] [--debug] user group
|
|
remove the user from a group\n");
|
|
}
|
|
|
|
sub exist_user {
|
|
my $exist_user = shift;
|
|
return(defined getpwnam($exist_user));
|
|
}
|
|
|
|
sub exist_group {
|
|
my $exist_group = shift;
|
|
return(defined getgrnam($exist_group));
|
|
}
|
|
|
|
sub check_backup_suffix {
|
|
my $tar = &which('tar');
|
|
my $suffix = $config{'backup_suffix'} || 'gz';
|
|
if ($suffix !~ /^\./) {
|
|
$suffix = ".$suffix";
|
|
}
|
|
my $filename = '/tmp/deluser-check.tar';
|
|
my $testfile = 'usr/sbin/deluser';
|
|
&systemcall_silent_error($tar, '--auto-compress', '--directory', '/', '-cf', $filename.$suffix, $testfile);
|
|
|
|
if ($?) {
|
|
# compressor recognized, not available
|
|
warnf gtx("Backup suffix %s unavailable, using gzip.\n"), $suffix;
|
|
$suffix = '.gz';
|
|
} else {
|
|
# no error, check if compressed
|
|
&systemcall_silent($tar, '--directory', '/', '-cf', $filename, $testfile);
|
|
|
|
my @zstat = stat($filename.$suffix);
|
|
my @ustat = stat($filename);
|
|
unlink($filename, $filename.$suffix);
|
|
if ($zstat[7] == $ustat[7]) {
|
|
warnf gtx("Backup suffix %s unavailable, using gzip.\n"), $suffix;
|
|
$suffix = '.gz';
|
|
}
|
|
}
|
|
$config{'backup_suffix'} = $suffix;
|
|
}
|
|
|
|
# vim: tabstop=4 shiftwidth=4 expandtab
|