Add the DragonFly cvs id and perform general cleanups on cvs/rcs/sccs ids. Most
[dragonfly.git] / usr.sbin / adduser / rmuser.perl
1 #!/usr/bin/perl
2 # -*- perl -*-
3 # Copyright 1995, 1996, 1997 Guy Helmer, Ames, Iowa 50014.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 # 1. Redistributions of source code must retain the above copyright
10 #    notice, this list of conditions and the following disclaimer as
11 #    the first lines of this file unmodified.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 #    notice, this list of conditions and the following disclaimer in the
14 #    documentation and/or other materials provided with the distribution.
15 # 3. The name of the author may not be used to endorse or promote products
16 #    derived from this software without specific prior written permission.
17 #
18 # THIS SOFTWARE IS PROVIDED BY GUY HELMER ``AS IS'' AND ANY EXPRESS OR
19 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
20 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
21 # IN NO EVENT SHALL GUY HELMER BE LIABLE FOR ANY DIRECT, INDIRECT,
22 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
23 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
24 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
25 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 #
29 # rmuser - Perl script to remove users
30 #
31 # Guy Helmer <ghelmer@cs.iastate.edu>, 02/23/97
32 #
33 # $FreeBSD: src/usr.sbin/adduser/rmuser.perl,v 1.8.2.9 2002/02/14 10:32:53 yar Exp $
34 # $DragonFly: src/usr.sbin/adduser/Attic/rmuser.perl,v 1.2 2003/06/17 04:29:52 dillon Exp $
35
36 use Fcntl;
37
38 sub LOCK_SH {0x01;}
39 sub LOCK_EX {0x02;}
40 sub LOCK_NB {0x04;}
41 sub LOCK_UN {0x08;}
42 sub F_SETFD {2;}
43
44 $ENV{"PATH"} = "/bin:/sbin:/usr/bin:/usr/sbin";
45 umask(022);
46 $whoami = $0;
47 $passwd_file = "/etc/master.passwd";
48 $passwd_tmp = "/etc/ptmp";
49 $group_file = "/etc/group";
50 $new_group_file = "${group_file}.new.$$";
51 $mail_dir = "/var/mail";
52 $crontab_dir = "/var/cron/tabs";
53 $affirm = 0;
54
55 #$debug = 1;
56
57 sub cleanup {
58     local($sig) = @_;
59
60     print STDERR "Caught signal SIG$sig -- cleaning up.\n";
61     &unlockpw;
62     if (-e $new_passwd_file) {
63         unlink $new_passwd_file;
64     }
65     exit(0);
66 }
67
68 sub lockpw {
69     # Open the password file for reading
70     if (!open(MASTER_PW, "$passwd_file")) {
71         print STDERR "${whoami}: Error: Couldn't open ${passwd_file}: $!\n";
72         exit(1);
73     }
74     # Set the close-on-exec flag just in case
75     fcntl(MASTER_PW, &F_SETFD, 1);
76     # Apply an advisory lock the password file
77     if (!flock(MASTER_PW, &LOCK_EX|&LOCK_NB)) {
78         print STDERR "${whoami}: Error: Couldn't lock ${passwd_file}: $!\n";
79         exit(1);
80     }
81 }
82
83 sub unlockpw {
84     flock(MASTER_PW, &LOCK_UN);
85 }
86
87 $SIG{'INT'} = 'cleanup';
88 $SIG{'QUIT'} = 'cleanup';
89 $SIG{'HUP'} = 'cleanup';
90 $SIG{'TERM'} = 'cleanup';
91
92 if ($#ARGV == 1 && $ARGV[0] eq '-y') {
93     shift @ARGV;
94     $affirm = 1;
95 }
96
97 if ($#ARGV > 0) {
98     print STDERR "usage: ${whoami} [-y] [username]\n";
99     exit(1);
100 }
101
102 if ($< != 0) {
103     print STDERR "${whoami}: Error: you must be root to use ${whoami}\n";
104     exit(1);
105 }
106
107 &lockpw;
108
109 if ($#ARGV == 0) {
110     # Username was given as a parameter
111     $login_name = pop(@ARGV);
112 } else {
113     if ($affirm) {
114         print STDERR "${whoami}: Error: -y option given without username!\n";
115         &unlockpw;
116         exit 1;
117     }
118     # Get the user name from the user
119     $login_name = &get_login_name;
120 }
121
122 ($name, $password, $uid, $gid, $change, $class, $gecos, $home_dir, $shell) =
123     (getpwnam("$login_name"));
124
125 if (!defined $uid) {
126     print STDERR "${whoami}: Error: User ${login_name} not in password database\n";
127     &unlockpw;
128     exit 1;
129 }
130
131 if ($uid == 0) {
132     print "${whoami}: Error: I'd rather not remove a user with a uid of 0.\n";
133     &unlockpw;
134     exit 1;
135 }
136
137 if (! $affirm) {
138     print "Matching password entry:\n\n$name\:$password\:$uid\:$gid\:$class\:$change\:0\:$gecos\:$home_dir\:$shell\n\n";
139
140     $ans = &get_yn("Is this the entry you wish to remove? ");
141
142     if ($ans eq 'N') {
143         print "${whoami}: Informational: User ${login_name} not removed.\n";
144         &unlockpw;
145         exit 0;
146     }
147 }
148
149 #
150 # Get owner of user's home directory; don't remove home dir if not
151 # owned by $login_name
152
153 $remove_directory = 1;
154
155 if (-l $home_dir) {
156     $real_home_dir = &resolvelink($home_dir);
157 } else {
158     $real_home_dir = $home_dir;
159 }
160
161 #
162 # If home_dir is a symlink and points to something that isn't a directory,
163 # or if home_dir is not a symlink and is not a directory, don't remove
164 # home_dir -- seems like a good thing to do, but probably isn't necessary...
165
166 if (((-l $home_dir) && ((-e $real_home_dir) && !(-d $real_home_dir))) ||
167     (!(-l $home_dir) && !(-d $home_dir))) {
168     print STDERR "${whoami}: Informational: Home ${home_dir} is not a directory, so it won't be removed\n";
169     $remove_directory = 0;
170 }
171
172 if (length($real_home_dir) && -d $real_home_dir) {
173     $dir_owner = (stat($real_home_dir))[4]; # UID
174     if ($dir_owner != $uid) {
175         print STDERR "${whoami}: Informational: Home dir ${real_home_dir} is" .
176             " not owned by ${login_name} (uid ${dir_owner})\n," .
177                 "\tso it won't be removed\n";
178         $remove_directory = 0;
179     }
180 }
181
182 if ($remove_directory && ! $affirm) {
183     $ans = &get_yn("Remove user's home directory ($home_dir)? ");
184     if ($ans eq 'N') {
185         $remove_directory = 0;
186     }
187 }
188
189 #exit 0 if $debug;
190
191 #
192 # Remove the user's crontab, if there is one
193 # (probably needs to be done before password databases are updated)
194
195 if (-e "$crontab_dir/$login_name") {
196     print STDERR "Removing user's crontab:";
197     system('/usr/bin/crontab', '-u', $login_name, '-r');
198     print STDERR " done.\n";
199 }
200
201 #
202 # Remove the user's at jobs, if any
203 # (probably also needs to be done before password databases are updated)
204
205 &remove_at_jobs($login_name);
206
207 #
208 # Kill all the user's processes
209
210 &kill_users_processes($login_name, $uid);
211
212 #
213 # Copy master password file to new file less removed user's entry
214
215 &update_passwd_file;
216
217 #
218 # Remove the user from all groups in /etc/group
219
220 &update_group_file($login_name);
221
222 #
223 # Remove the user's home directory
224
225 if ($remove_directory) {
226     print STDERR "Removing user's home directory ($home_dir):";
227     &remove_dir($home_dir);
228     print STDERR " done.\n";
229 }
230
231 #
232 # Remove files related to the user from the mail directory
233
234 #&remove_files_from_dir($mail_dir, $login_name, $uid);
235 $file = "$mail_dir/$login_name";
236 if (-e $file || -l $file) {
237     print STDERR "Removing user's incoming mail file ${file}:";
238     unlink $file ||
239         print STDERR "\n${whoami}: Warning: unlink on $file failed ($!) - continuing\n";
240     print STDERR " done.\n";
241 }
242
243 #
244 # Remove some pop daemon's leftover file
245
246 $file = "$mail_dir/.${login_name}.pop";
247 if (-e $file || -l $file) {
248     print STDERR "Removing pop daemon's temporary mail file ${file}:";
249     unlink $file ||
250         print STDERR "\n${whoami}: Warning: unlink on $file failed ($!) - continuing\n";
251     print STDERR " done.\n";
252 }
253
254 #
255 # Remove files belonging to the user from the directories /tmp, /var/tmp,
256 # and /var/tmp/vi.recover.  Note that this doesn't take care of the
257 # problem where a user may have directories or symbolic links in those
258 # directories -- only regular files are removed.
259
260 &remove_files_from_dir('/tmp', $login_name, $uid);
261 &remove_files_from_dir('/var/tmp', $login_name, $uid);
262 &remove_files_from_dir('/var/tmp/vi.recover', $login_name, $uid)
263     if (-e '/var/tmp/vi.recover');
264
265 #
266 # All done!
267
268 exit 0;
269
270 sub get_login_name {
271     #
272     # Get new user's name
273     local($done, $login_name);
274
275     for ($done = 0; ! $done; ) {
276         print "Enter login name for user to remove: ";
277         $login_name = <>;
278         chomp $login_name;
279         if (not getpwnam("$login_name")) {
280             print STDERR "Sorry, login name not in password database.\n";
281         } else {
282             $done = 1;
283         }
284     }
285
286     print "User name is ${login_name}\n" if $debug;
287     return($login_name);
288 }
289
290 sub get_yn {
291     #
292     # Get a yes or no answer; return 'Y' or 'N'
293     local($prompt) = @_;
294     local($done, $ans);
295
296     for ($done = 0; ! $done; ) {
297         print $prompt;
298         $ans = <>;
299         chop $ans;
300         $ans =~ tr/a-z/A-Z/;
301         if (!($ans =~ /^[YN]/)) {
302             print STDERR "Please answer (y)es or (n)o.\n";
303         } else {
304             $done = 1;
305         }
306     }
307
308     return(substr($ans, 0, 1));
309 }
310
311 sub update_passwd_file {
312     local($skipped);
313
314     print STDERR "Updating password file,";
315     seek(MASTER_PW, 0, 0);
316
317     sysopen(NEW_PW, $passwd_tmp, O_RDWR|O_CREAT|O_EXCL, 0600) ||
318         die "\n${whoami}: Error: Couldn't open file ${passwd_tmp}:\n $!\n";
319
320     $skipped = 0;
321     while (<MASTER_PW>) {
322         if (/^\Q$login_name:/o) {
323             print STDERR "Dropped entry for $login_name\n" if $debug;
324             $skipped = 1;
325         } else {
326             print NEW_PW;
327             # The other perl password tools assume all lowercase entries.
328             # Add a warning to help unsuspecting admins who might be
329             # using the wrong tool for the job, or might otherwise
330             # be unwittingly holding a loaded foot-shooting device.
331             if (/^\Q$login_name:/io) {
332                 my $name = $_;
333                 $name =~ s#\:.*\n##;
334                 print STDERR "\n\n\tThere is also an entry for $name in your",
335                     "password file.\n\tThis can cause problems in some ",
336                     "situations.\n\n";
337             }
338         }
339     }
340     close(NEW_PW);
341     seek(MASTER_PW, 0, 0);
342
343     if ($skipped == 0) {
344         print STDERR "\n${whoami}: Whoops! Didn't find ${login_name}'s entry second time around!\n";
345         unlink($passwd_tmp) ||
346             print STDERR "\n${whoami}: Warning: couldn't unlink $passwd_tmp ($!)\n\tPlease investigate, as this file should not be left in the filesystem\n";
347         &unlockpw;
348         exit 1;
349     }
350
351     #
352     # Run pwd_mkdb to install the updated password files and databases
353
354     print STDERR " updating databases,";
355     system('/usr/sbin/pwd_mkdb', '-p', ${passwd_tmp});
356     print STDERR " done.\n";
357
358     close(MASTER_PW);           # Not useful anymore
359 }
360
361 sub update_group_file {
362     local($login_name) = @_;
363
364     local($i, $j, $grmember_list, $new_grent, $changes);
365     local($grname, $grpass, $grgid, $grmember_list, @grmembers);
366
367     $changes = 0;
368     print STDERR "Updating group file:";
369     open(GROUP, $group_file) ||
370         die "\n${whoami}: Error: couldn't open ${group_file}: $!\n";
371     if (!flock(GROUP, &LOCK_EX|&LOCK_NB)) {
372         print STDERR "\n${whoami}: Error: couldn't lock ${group_file}: $!\n";
373         exit 1;
374     }
375     local($group_perms, $group_uid, $group_gid) =
376         (stat(GROUP))[2, 4, 5]; # File Mode, uid, gid
377     open(NEW_GROUP, ">$new_group_file") ||
378         die "\n${whoami}: Error: couldn't open ${new_group_file}: $!\n";
379     chmod($group_perms, $new_group_file) ||
380         printf STDERR "\n${whoami}: Warning: could not set permissions of new group file to %o ($!)\n\tContinuing, but please check permissions of $group_file!\n", $group_perms;
381     chown($group_uid, $group_gid, $new_group_file) ||
382         print STDERR "\n${whoami}: Warning: could not set owner/group of new group file to ${group_uid}/${group_gid} ($!)\n\rContinuing, but please check ownership of $group_file!\n";
383     while ($i = <GROUP>) {
384         if (!($i =~ /\Q$login_name\E/)) {
385             # Line doesn't contain any references to the user, so just add it
386             # to the new file
387             print NEW_GROUP $i;
388         } else {
389             #
390             # Remove the user from the group
391             if ($i =~ /\n$/) {
392                 chop $i;
393             }
394             ($grname, $grpass, $grgid, $grmember_list) = split(/:/, $i);
395             @grmembers = split(/,/, $grmember_list);
396             undef @new_grmembers;
397             local(@new_grmembers);
398             foreach $j (@grmembers) {
399                 if ($j ne $login_name) {
400                     push(@new_grmembers, $j);
401                 } else {
402                     print STDERR " $grname";
403                     $changes = 1;
404                 }
405             }
406             if ($grname eq $login_name && $#new_grmembers == -1) {
407                 # Remove a user's personal group if empty
408                 print STDERR " (removing group $grname -- personal group is empty)";
409                 $changes = 1;
410             } else {
411                 $grmember_list = join(',', @new_grmembers);
412                 $new_grent = join(':', $grname, $grpass, $grgid, $grmember_list);
413                 print NEW_GROUP "$new_grent\n";
414             }
415         }
416     }
417     close(NEW_GROUP);
418     rename($new_group_file, $group_file) || # Replace old group file with new
419         die "\n${whoami}: Error: couldn't rename $new_group_file to $group_file ($!)\n";
420     close(GROUP);                       # File handle is worthless now
421     print STDERR " (no changes)" if (! $changes);
422     print STDERR " done.\n";
423 }
424
425 sub remove_dir {
426     # Remove the user's home directory
427     local($dir) = @_;
428     local($linkdir);
429
430     if (-l $dir) {
431         $linkdir = &resolvelink($dir);
432         # Remove the symbolic link
433         unlink($dir) ||
434             warn "${whoami}: Warning: could not unlink symlink $dir: $!\n";
435         if (!(-e $linkdir)) {
436             #
437             # Dangling symlink - just return now
438             return;
439         }
440         # Set dir to be the resolved pathname
441         $dir = $linkdir;
442     }
443     if (!(-d $dir)) {
444         print STDERR "${whoami}: Warning: $dir is not a directory\n";
445         unlink($dir) || warn "${whoami}: Warning: could not unlink $dir: $!\n";
446         return;
447     }
448     system('/bin/rm', '-rf', $dir);
449 }
450
451 sub remove_files_from_dir {
452     local($dir, $login_name, $uid) = @_;
453     local($path, $i, $owner);
454
455     print STDERR "Removing files belonging to ${login_name} from ${dir}:";
456
457     if (!opendir(DELDIR, $dir)) {
458         print STDERR "\n${whoami}: Warning: couldn't open directory ${dir} ($!)\n";
459         return;
460     }
461     while ($i = readdir(DELDIR)) {
462         next if $i eq '.';
463         next if $i eq '..';
464
465         $owner = (stat("$dir/$i"))[4]; # UID
466         if ($uid == $owner) {
467             if (-f "$dir/$i") {
468                 print STDERR " $i";
469                 unlink "$dir/$i" ||
470                     print STDERR "\n${whoami}: Warning: unlink on ${dir}/${i} failed ($!) - continuing\n";
471             } else {
472                 print STDERR " ($i not a regular file - skipped)";
473             }
474         }
475     }
476     closedir(DELDIR);
477
478     printf STDERR " done.\n";
479 }
480
481
482 sub invoke_atq {
483     local *ATQ;
484     my($user) = (shift || "");
485     my($path_atq) = "/usr/bin/atq";
486     my(@at) = ();
487     my($pid, $line);
488     
489     return @at if ($user eq "");
490     
491     if (!defined($pid = open(ATQ, "-|"))) {
492         die("creating pipe to atq: $!\n");
493     } elsif ($pid == 0) {
494         exec($path_atq, $user);
495         die("executing $path_atq: $!\n");
496     }
497     
498     while(defined($_ = <ATQ>)) {
499         chomp;
500         if (/^\d\d.\d\d.\d\d\s+\d\d.\d\d.\d\d\s+(\S+)\s+\S+\s+(\d+)$/) {
501             push(@at, $2) if ($1 eq $user);
502         }
503     }
504     close ATQ;
505     return @at;
506 }
507
508 sub invoke_atrm {
509     local *ATRM;
510     my($user) = (shift || "");
511     my($path_atrm) = "/usr/bin/atrm";
512     my(@jobs) = @_;
513     my($pid);
514     my($txt) = "";
515     
516     return "Invalid arguments" if (($user eq "") || ($#jobs == -1));
517     
518     if (!defined($pid = open(ATRM, "-|"))) {
519         die("creating pipe to atrm: $!\n");
520     } elsif ($pid == 0) {
521         exec($path_atrm, $user, @jobs);
522     }
523     
524     while(defined($_ = <ATRM>)) {
525         $txt .= $_;
526     }
527     close ATRM;
528     return $txt;
529 }
530
531 sub remove_at_jobs {
532     my($user) = (shift || "");
533     my(@at, $atrm);
534     
535     return 1 if ($user eq "");
536     
537     @at = invoke_atq($user);
538     return 0 if ($#at == -1);
539     
540     print STDERR "Removing user's at jobs:";
541     print STDERR " @at:";
542     $atrm = invoke_atrm($user, @at);
543     if ($atrm ne "") {
544         print STDERR " -- $atrm\n";
545         return 1;
546     }
547     
548     print STDERR " done.\n";
549     return 0;
550 }
551
552 sub resolvelink {
553     local($path) = @_;
554     local($l);
555
556     while (-l $path && -e $path) {
557         if (!defined($l = readlink($path))) {
558             die "${whoami}: readlink on $path failed (but it should have worked!): $!\n";
559         }
560         if ($l =~ /^\//) {
561             # Absolute link
562             $path = $l;
563         } else {
564             # Relative link
565             $path =~ s/\/[^\/]+\/?$/\/$l/; # Replace last component of path
566         }
567     }
568     return $path;
569 }
570
571 sub kill_users_processes {
572     local($login_name, $uid) = @_;
573     local($pid, $result);
574
575     #
576     # Do something a little complex: fork a child that changes its
577     # real and effective UID to that of the removed user, then issues
578     # a "kill(9, -1)" to kill all processes of the same uid as the sender
579     # (see kill(2) for details).
580     # The parent waits for the exit of the child and then returns.
581
582     if ($pid = fork) {
583         # Parent process
584         waitpid($pid, 0);
585     } elsif (defined $pid) {
586         # Child process
587         $< = $uid;
588         $> = $uid;
589         if ($< != $uid || $> != $uid) {
590             print STDERR "${whoami}: Error (kill_users_processes):\n" .
591                 "\tCouldn't reset uid/euid to ${uid}: current uid/euid's are $< and $>\n";
592             exit 1;
593         }
594         $result = kill(9, -1);
595         print STDERR "Killed process(es) belonging to $login_name.\n"
596             if $result;
597         exit 0;
598     } else {
599         # Couldn't fork!
600         print STDERR "${whoami}: Error: couldn't fork to kill ${login_name}'s processes - continuing\n";
601     }
602 }