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