1package Bastille::API::AccountPermission; 2use strict; 3 4use Bastille::API; 5 6use Bastille::API::HPSpecific; 7 8require Exporter; 9our @ISA = qw(Exporter); 10our @EXPORT_OK = qw( 11B_chmod 12B_chmod_if_exists 13B_chown 14B_chown_link 15B_chgrp 16B_chgrp_link 17B_userdel 18B_groupdel 19B:remove_user_from_group 20B_check_owner_group 21B_is_unowned_file 22B_is_ungrouped_file 23B_check_permissions 24B_permission_test 25B_find_homes 26B_is_executable 27B_is_suid 28B_is_sgid 29B_get_user_list 30B_get_group_list 31B:remove_suid 32); 33our @EXPORT = @EXPORT_OK; 34 35########################################################################### 36# &B_chmod ($mode, $file) sets the mode of $file to $mode. $mode must 37# be stored in octal, so if you want to give mode 700 to /etc/aliases, 38# you need to use: 39# 40# &B_chmod ( 0700 , "/etc/aliases"); 41# 42# where the 0700 denotes "octal 7-0-0". 43# 44# &B_chmod ($mode_changes,$file) also respects the symbolic methods of 45# changing file permissions, which are often what question authors are 46# really seeking. 47# 48# &B_chmod ("u-s" , "/bin/mount") 49# or 50# &B_chmod ("go-rwx", "/bin/mount") 51# 52# 53# &B_chmod respects GLOBAL_LOGONLY and uses 54# &B_revert_log used to insert a shell command that will return 55# the permissions to the pre-Bastille state. 56# 57# B_chmod allow for globbing now, as of 1.2.0. JJB 58# 59########################################################################## 60 61 62sub B_chmod($$) { 63 my ($new_perm,$file_expr)=@_; 64 my $old_perm; 65 my $old_perm_raw; 66 my $new_perm_formatted; 67 my $old_perm_formatted; 68 69 my $retval=1; 70 71 my $symbolic = 0; 72 my ($chmod_noun,$add_remove,$capability) = (); 73 # Handle symbolic possibilities too 74 if ($new_perm =~ /([ugo]+)([+-]{1})([rwxst]+)/) { 75 $symbolic = 1; 76 $chmod_noun = $1; 77 $add:remove = $2; 78 $capability = $3; 79 } 80 81 my $file; 82 my @files = glob ($file_expr); 83 84 foreach $file (@files) { 85 86 # Prepend global prefix, but save the original filename for B_backup_file 87 my $original_file=$file; 88 89 # Store the old permissions so that we can log them. 90 unless (stat $file) { 91 &B_log("ERROR","Couldn't stat $original_file from $old_perm to change permissions\n"); 92 next; 93 } 94 95 $old_perm_raw=(stat(_))[2]; 96 $old_perm= (($old_perm_raw/512) % 8) . 97 (($old_perm_raw/64) % 8) . 98 (($old_perm_raw/8) % 8) . 99 ($old_perm_raw % 8); 100 101 # If we've gone symbolic, calculate the new permissions in octal. 102 if ($symbolic) { 103 # 104 # We calculate the new permissions by applying a bitmask to 105 # the current permissions, by OR-ing (for +) or XOR-ing (for -). 106 # 107 # We create this mask by first calculating a perm_mask that forms 108 # the right side of this, then multiplying it by 8 raised to the 109 # appropriate power to affect the correct digit of the octal mask. 110 # This means that we raise 8 to the power of 0,1,2, or 3, based on 111 # the noun of "other","group","user", or "suid/sgid/sticky". 112 # 113 # Actually, we handle multiple nouns by summing powers of 8. 114 # 115 # The only tough part is that we have to handle suid/sgid/sticky 116 # differently. 117 # 118 119 # We're going to calculate a mask to OR or XOR with the current 120 # file mode. This mask is $mask. We calculate this by calculating 121 # a sum of powers of 8, corresponding to user/group/other, 122 # multiplied with a $premask. The $premask is simply the 123 # corresponding bitwise expression of the rwx bits. 124 # 125 # To handle SUID, SGID or sticky in the simplest way possible, we 126 # simply add their values to the $mask first. 127 128 my $perm_mask = 00; 129 my $mask = 00; 130 131 # Check for SUID, SGID or sticky as these are exceptional. 132 if ($capability =~ /s/) { 133 if ($chmod_noun =~ /u/) { 134 $mask += 04000; 135 } 136 if ($chmod_noun =~ /g/) { 137 $mask += 02000; 138 } 139 } 140 if ($capability =~ /t/) { 141 $mask += 01000; 142 } 143 144 # Now handle the normal attributes 145 if ($capability =~ /[rwx]/) { 146 if ($capability =~ /r/) { 147 $perm_mask |= 04; 148 } 149 if ($capability =~ /w/) { 150 $perm_mask |= 02; 151 } 152 if ($capability =~ /x/) { 153 $perm_mask |= 01; 154 } 155 156 # Now figure out which 3 bit octal digit we're affecting. 157 my $power = 0; 158 if ($chmod_noun =~ /u/) { 159 $mask += $perm_mask * 64; 160 } 161 if ($chmod_noun =~ /g/) { 162 $mask += $perm_mask * 8; 163 } 164 if ($chmod_noun =~ /o/) { 165 $mask += $perm_mask * 1; 166 } 167 } 168 # Now apply the mask to get the new permissions 169 if ($add_remove eq '+') { 170 $new_perm = $old_perm_raw | $mask; 171 } 172 elsif ($add_remove eq '-') { 173 $new_perm = $old_perm_raw & ( ~($mask) ); 174 } 175 } 176 177 # formating for simple long octal output of the permissions in string form 178 $new_perm_formatted=sprintf "%5lo",$new_perm; 179 $old_perm_formatted=sprintf "%5lo",$old_perm_raw; 180 181 &B_log("ACTION","change permissions on $original_file from $old_perm_formatted to $new_perm_formatted\n"); 182 183 &B_log("ACTION", "chmod $new_perm_formatted,\"$original_file\";\n"); 184 185 # Change the permissions on the file 186 187 if ( -e $file ) { 188 unless ($GLOBAL_LOGONLY) { 189 $retval=chmod $new_perm,$file; 190 if($retval){ 191 # if the distribution is HP-UX then the modifications should 192 # also be made to the IPD (installed product database) 193 if(&GetDistro =~ "^HP-UX"){ 194 &B_swmodify($file); 195 } 196 # making changes revert-able 197 &B_revert_log(&getGlobal('BIN', "chmod") . " $old_perm $file\n"); 198 } 199 } 200 unless ($retval) { 201 &B_log("ERROR","Couldn't change permissions on $original_file from $old_perm_formatted to $new_perm_formatted\n"); 202 $retval=0; 203 } 204 } 205 else { 206 &B_log("ERROR", "chmod: File $original_file doesn't exist!\n"); 207 $retval=0; 208 } 209 } 210 211 $retval; 212 213} 214 215########################################################################### 216# &B_chmod_if_exists ($mode, $file) sets the mode of $file to $mode *if* 217# $file exists. $mode must be stored in octal, so if you want to give 218# mode 700 to /etc/aliases, you need to use: 219# 220# &B_chmod_if_exists ( 0700 , "/etc/aliases"); 221# 222# where the 0700 denotes "octal 7-0-0". 223# 224# &B_chmod_if_exists respects GLOBAL_LOGONLY and uses 225# &B_revert_log to reset the permissions of the file. 226# 227# B_chmod_if_exists allow for globbing now, as of 1.2.0. JJB 228# 229########################################################################## 230 231 232sub B_chmod_if_exists($$) { 233 my ($new_perm,$file_expr)=@_; 234 # If $file_expr has a glob character, pass it on (B_chmod won't complain 235 # about nonexistent files if given a glob pattern) 236 if ( $file_expr =~ /[\*\[\{]/ ) { # } just to match open brace for vi 237 &B_log("ACTION","Running chmod $new_perm $file_expr"); 238 return(&B_chmod($new_perm,$file_expr)); 239 } 240 # otherwise, test for file existence 241 if ( -e $file_expr ) { 242 &B_log("ACTION","File exists, running chmod $new_perm $file_expr"); 243 return(&B_chmod($new_perm,$file_expr)); 244 } 245} 246 247########################################################################### 248# &B_chown ($uid, $file) sets the owner of $file to $uid, like this: 249# 250# &B_chown ( 0 , "/etc/aliases"); 251# 252# &B_chown respects $GLOBAL_LOGONLY and uses 253# &B_revert_log to insert a shell command that will return 254# the file/directory owner to the pre-Bastille state. 255# 256# Unlike Perl, we've broken the chown function into B_chown/B_chgrp to 257# make error checking simpler. 258# 259# As of 1.2.0, this now supports file globbing. JJB 260# 261########################################################################## 262 263 264sub B_chown($$) { 265 my ($newown,$file_expr)=@_; 266 my $oldown; 267 my $oldgown; 268 269 my $retval=1; 270 271 my $file; 272 my @files = glob($file_expr); 273 274 foreach $file (@files) { 275 276 # Prepend prefix, but save original filename 277 my $original_file=$file; 278 279 $oldown=(stat $file)[4]; 280 $oldgown=(stat $file)[5]; 281 282 &B_log("ACTION","change ownership on $original_file from $oldown to $newown\n"); 283 &B_log("ACTION","chown $newown,$oldgown,\"$original_file\";\n"); 284 if ( -e $file ) { 285 unless ($GLOBAL_LOGONLY) { 286 # changing the files owner using perl chown function 287 $retval = chown $newown,$oldgown,$file; 288 if($retval){ 289 # if the distribution is HP-UX then the modifications should 290 # also be made to the IPD (installed product database) 291 if(&GetDistro =~ "^HP-UX"){ 292 &B_swmodify($file); 293 } 294 # making ownership change revert-able 295 &B_revert_log(&getGlobal('BIN', "chown") . " $oldown $file\n"); 296 } 297 } 298 unless ($retval) { 299 &B_log("ERROR","Couldn't change ownership to $newown on file $original_file\n"); 300 } 301 } 302 else { 303 &B_log("ERROR","chown: File $original_file doesn't exist!\n"); 304 $retval=0; 305 } 306 } 307 308 $retval; 309} 310 311########################################################################### 312# &B_chown_link just like &B_chown but one exception: 313# if the input file is a link it will not change the target's ownship, it only change the link itself's ownship 314########################################################################### 315sub B_chown_link($$){ 316 my ($newown,$file_expr)=@_; 317 my $chown = &getGlobal("BIN","chown"); 318 my @files = glob($file_expr); 319 my $retval = 1; 320 321 foreach my $file (@files) { 322 # Prepend prefix, but save original filename 323 my $original_file=$file; 324 my $oldown=(stat $file)[4]; 325 my $oldgown=(stat $file)[5]; 326 327 &B_log("ACTION","change ownership on $original_file from $oldown to $newown\n"); 328 &B_log("ACTION","chown -h $newown,\"$original_file\";\n"); 329 if ( -e $file ) { 330 unless ($GLOBAL_LOGONLY) { 331 `$chown -h $newown $file`; 332 $retval = ($? >> 8); 333 if($retval == 0 ){ 334 # if the distribution is HP-UX then the modifications should 335 # also be made to the IPD (installed product database) 336 if(&GetDistro =~ "^HP-UX"){ 337 &B_swmodify($file); 338 } 339 # making ownership change revert-able 340 &B_revert_log("$chown -h $oldown $file\n"); 341 } 342 } 343 unless ( ! $retval) { 344 &B_log("ERROR","Couldn't change ownership to $newown on file $original_file\n"); 345 } 346 } 347 else { 348 &B_log("ERROR","chown: File $original_file doesn't exist!\n"); 349 $retval=0; 350 } 351 } 352} 353 354 355########################################################################### 356# &B_chgrp ($gid, $file) sets the group owner of $file to $gid, like this: 357# 358# &B_chgrp ( 0 , "/etc/aliases"); 359# 360# &B_chgrp respects $GLOBAL_LOGONLY and uses 361# &B_revert_log to insert a shell command that will return 362# the file/directory group to the pre-Bastille state. 363# 364# Unlike Perl, we've broken the chown function into B_chown/B_chgrp to 365# make error checking simpler. 366# 367# As of 1.2.0, this now supports file globbing. JJB 368# 369########################################################################## 370 371 372sub B_chgrp($$) { 373 my ($newgown,$file_expr)=@_; 374 my $oldown; 375 my $oldgown; 376 377 my $retval=1; 378 379 my $file; 380 my @files = glob($file_expr); 381 382 foreach $file (@files) { 383 384 # Prepend global prefix, but save original filename for &B_backup_file 385 my $original_file=$file; 386 387 $oldown=(stat $file)[4]; 388 $oldgown=(stat $file)[5]; 389 390 &B_log("ACTION", "Change group ownership on $original_file from $oldgown to $newgown\n"); 391 &B_log("ACTION", "chown $oldown,$newgown,\"$original_file\";\n"); 392 if ( -e $file ) { 393 unless ($GLOBAL_LOGONLY) { 394 # changing the group for the file/directory 395 $retval = chown $oldown,$newgown,$file; 396 if($retval){ 397 # if the distribution is HP-UX then the modifications should 398 # also be made to the IPD (installed product database) 399 if(&GetDistro =~ "^HP-UX"){ 400 &B_swmodify($file); 401 } 402 &B_revert_log(&getGlobal('BIN', "chgrp") . " $oldgown $file\n"); 403 } 404 } 405 unless ($retval) { 406 &B_log("ERROR","Couldn't change ownership to $newgown on file $original_file\n"); 407 } 408 } 409 else { 410 &B_log("ERROR","chgrp: File $original_file doesn't exist!\n"); 411 $retval=0; 412 } 413 } 414 415 $retval; 416} 417 418########################################################################### 419# &B_chgrp_link just like &B_chgrp but one exception: 420# if the input file is a link 421# it will not change the target's ownship, it only change the link itself's ownship 422########################################################################### 423sub B_chgrp_link($$) { 424 my ($newgown,$file_expr)=@_; 425 my $chgrp = &getGlobal("BIN","chgrp"); 426 my @files = glob($file_expr); 427 my $retval=1; 428 429 foreach my $file (@files) { 430 # Prepend prefix, but save original filename 431 my $original_file=$file; 432 my $oldgown=(stat $file)[5]; 433 434 &B_log("ACTION","change group ownership on $original_file from $oldgown to $newgown\n"); 435 &B_log("ACTION","chgrp -h $newgown \"$original_file\";\n"); 436 if ( -e $file ) { 437 unless ($GLOBAL_LOGONLY) { 438 # do not follow link with option -h 439 `$chgrp -h $newgown $file`; 440 $retval = ($? >> 8); 441 if($retval == 0 ){ 442 # if the distribution is HP-UX then the modifications should 443 # also be made to the IPD (installed product database) 444 if(&GetDistro =~ "^HP-UX"){ 445 &B_swmodify($file); 446 } 447 # making ownership change revert-able 448 &B_revert_log("$chgrp" . " -h $oldgown $file\n"); 449 } 450 } 451 unless (! $retval) { 452 &B_log("ERROR","Couldn't change group ownership to $newgown on file $original_file\n"); 453 } 454 } 455 else { 456 &B_log("ERROR","chgrp: File $original_file doesn't exist!\n"); 457 $retval=0; 458 } 459 } 460} 461 462########################################################################### 463# B_userdel($user) removes $user from the system, chmoding her home 464# directory to 000, root:root owned, and removes the user from all 465# /etc/passwd, /etc/shadow and /etc/group lines. 466# 467# In the future, we may also choose to make a B_lock_account routine. 468# 469# This routine depends on B:remove_user_from_group. 470########################################################################### 471 472sub B_userdel($) { 473 474 my $user_to_remove = $_[0]; 475 476 if (&GetDistro =~ /^HP-UX/) { 477 return 0; 478 479 # Not yet suported on HP-UX, where we'd need to support 480 # the TCB files and such. 481 } 482 483 # 484 # First, let's chmod/chown/chgrp the user's home directory. 485 # 486 487 # Get the user's home directory from /etc/passwd 488 if (open PASSWD,&getGlobal('FILE','passwd')) { 489 my @lines=<PASSWD>; 490 close PASSWD; 491 492 # Get the home directory 493 my $user_line = grep '^\s*$user_to_remove\s*:',@lines; 494 my $home_directory = (split /\s*:\s*/,$user_line)[5]; 495 496 # Chmod that home dir to 0000,owned by uid 0, gid 0. 497 if (&B_chmod_if_exists(0000,$home_directory)) { 498 &B_chown(0,$home_directory); 499 &B_chgrp(0,$home_directory); 500 } 501 } 502 else { 503 &B_log('ERROR',"B_userdel couldn't open the passwd file to remove a user."); 504 return 0; 505 } 506 507 # 508 # Next find out what groups the user is in, so we can call 509 # B:remove_user_from_group($user,$group) 510 # 511 # TODO: add this to the helper functions for the test suite. 512 # 513 514 my @groups = (); 515 516 # Parse /etc/group, looking for our user. 517 if (open GROUP,&getGlobal('FILE','group')) { 518 my @lines = <GROUP>; 519 close GROUP; 520 521 foreach my $line (@lines) { 522 523 # Parse the line -- first field is group, last is users in group. 524 if ($line =~ /([^\#^:]+):[^:]+:[^:]+:(.*)/) { 525 my $group = $1; 526 my $users_section = $2; 527 528 # Get the user list and check if our user is in it. 529 my @users = split /\s*,\s*/,$users_section; 530 foreach my $user (@users) { 531 if ($user_to_remove eq $user) { 532 push @groups,$group; 533 last; 534 } 535 } 536 } 537 } 538 } 539 540 # Now remove the user from each of those groups. 541 foreach my $group (@groups) { 542 &B_remove_user_from_group($user_to_remove,$group); 543 } 544 545 # Remove the user's /etc/passwd and /etc/shadow lines 546 &B_delete_line(&getGlobal('FILE','passwd'),"^$user_to_remove\\s*:"); 547 &B_delete_line(&getGlobal('FILE','shadow'),"^$user_to_remove\\s*:"); 548 549 550 # 551 # We should delete the user's group as well, if it's a single-user group. 552 # 553 if (open ETCGROUP,&getGlobal('FILE','group')) { 554 my @group_lines = <ETCGROUP>; 555 close ETCGROUP; 556 chomp @group_lines; 557 558 if (grep /^$user_to_remove\s*:[^:]*:[^:]*:\s*$/,@group_lines > 0) { 559 &B_groupdel($user_to_remove); 560 } 561 } 562 563} 564 565########################################################################### 566# B_groupdel($group) removes $group from /etc/group. 567########################################################################### 568 569sub B_groupdel($) { 570 571 my $group = $_[0]; 572 573 # First read /etc/group to make sure the group is in there. 574 if (open GROUP,&getGlobal('FILE','group')) { 575 my @lines=<GROUP>; 576 close GROUP; 577 578 # Delete the line in /etc/group if present 579 if (grep /^$group:/,@lines > 0) { 580 # The group is named in /etc/group 581 &B_delete_line(&getGlobal('FILE','group'),"^$group:/"); 582 } 583 } 584 585} 586 587 588########################################################################### 589# B:remove_user_from_group($user,$group) removes $user from $group, 590# by modifying $group's /etc/group line, pulling the user out. This 591# uses B_chunk_replace thrice to replace these patterns: 592# 593# ":\s*$user\s*," --> ":" 594# ",\s*$user" -> "" 595# 596########################################################################### 597 598sub B:remove_user_from_group($$) { 599 600 my ($user_to_remove,$group) = @_; 601 602 # 603 # We need to find the line from /etc/group that defines the group, parse 604 # it, and put it back together without this user. 605 # 606 607 # Open the group file 608 unless (open GROUP,&getGlobal('FILE','group')) { 609 &B_log('ERROR',"&B_remove_user_from_group couldn't read /etc/group to remove $user_to_remove from $group.\n"); 610 return 0; 611 } 612 my @lines = <GROUP>; 613 close GROUP; 614 chomp @lines; 615 616 # 617 # Read through the lines to find the one we care about. We'll construct a 618 # replacement and then use B_replace_line to make the switch. 619 # 620 621 foreach my $line (@lines) { 622 623 if ($line =~ /^\s*$group\s*:/) { 624 625 # Parse this line. 626 my @group_entries = split ':',$line; 627 my @users = split ',',($group_entries[3]); 628 629 # Now, recreate it. 630 my $first_user = 1; 631 my $group_line = $group_entries[0] . ':' . $group_entries[1] . ':' . $group_entries[2] . ':'; 632 633 # Add every user except the one we're removing. 634 foreach my $user (@users) { 635 636 # Remove whitespace. 637 $user =~ s/\s+//g; 638 639 if ($user ne $user_to_remove) { 640 # Add the user to the end of the line, prefacing 641 # it with a comma if it's not the first user. 642 643 if ($first_user) { 644 $group_line .= "$user"; 645 $first_user = 0; 646 } 647 else { 648 $group_line .= ",$user"; 649 } 650 } 651 } 652 653 # The line is now finished. Replace the original line. 654 $group_line .= "\n"; 655 &B_replace_line(&getGlobal('FILE','group'),"^\\s*$group\\s*:",$group_line); 656 } 657 658 } 659 return 1; 660} 661 662########################################################################### 663# &B_check_owner_group($$$) 664# 665# Checks if the given file has the given owner and/or group. 666# If the given owner is "", checks group only. 667# If the given group is "", checks owner only. 668# 669# return values: 670# 1: file has the given owner and/or group 671# or file exists, and both the given owner and group are "" 672# 0: file does not has the given owner or group 673# or file does not exists 674############################################################################ 675 676sub B_check_owner_group ($$$){ 677 my ($fileName, $owner, $group) = @_; 678 679 if (-e $fileName) { 680 my @junk=stat ($fileName); 681 my $uid=$junk[4]; 682 my $gid=$junk[5]; 683 684 # Check file owner 685 if ($owner ne "") { 686 if (getpwnam($owner) != $uid) { 687 return 0; 688 } 689 } 690 691 # Check file group 692 if ($group ne "") { 693 if (getgrnam($group) != $gid) { 694 return 0; 695 } 696 } 697 698 return 1; 699 } 700 else { 701 # Something is wrong if the file not exist 702 return 0; 703 } 704} 705 706########################################################################## 707# this subroutine will test whether the given file is unowned 708########################################################################## 709sub B_is_unowned_file($) { 710 my $file =$_; 711 my $uid = (stat($file))[4]; 712 my $uname = (getpwuid($uid))[0]; 713 if ( $uname =~ /.+/ ) { 714 return 1; 715 } 716 return 0; 717} 718 719########################################################################## 720# this subroutine will test whether the given file is ungrouped 721########################################################################## 722sub B_is_ungrouped_file($){ 723 my $file =$_; 724 my $gid = (stat($file))[5]; 725 my $gname = (getgrgid($gid))[0]; 726 if ( $gname =~ /.+/ ) { 727 return 1; 728 } 729 return 0; 730} 731 732 733 734 735########################################################################### 736# &B_check_permissions($$) 737# 738# Checks if the given file has the given permissions or stronger, where we 739# define stronger as "less accessible." The file argument must be fully 740# qualified, i.e. contain the absolute path. 741# 742# return values: 743# 1: file has the given permissions or better 744# 0: file does not have the given permsssions 745# undef: file permissions cannot be determined 746########################################################################### 747 748sub B_check_permissions ($$){ 749 my ($fileName, $reqdPerms) = @_; 750 my $filePerms; # actual permissions 751 752 753 if (-e $fileName) { 754 if (stat($fileName)) { 755 $filePerms = (stat($fileName))[2] & 07777; 756 } 757 else { 758 &B_log ("ERROR", "Can't stat $fileName.\n"); 759 return undef; 760 } 761 } 762 else { 763 # If the file does not exist, permissions are as good as they can get. 764 return 1; 765 } 766 767 # 768 # We can check whether the $filePerms are as strong by 769 # bitwise ANDing them with $reqdPerms and checking if the 770 # result is still equal to $filePerms. If it is, the 771 # $filePerms are strong enough. 772 # 773 if ( ($filePerms & $reqdPerms) == $filePerms ) { 774 return 1; 775 } 776 else { 777 return 0; 778 } 779 780} 781 782########################################################################## 783# B_permission_test($user, $previlege,$file) 784# $user can be 785# "owner" 786# "group" 787# "other" 788# $previlege can be: 789# "r" 790# "w" 791# "x" 792# "suid" 793# "sgid" 794# "sticky" 795# if previlege is set to suid or sgid or sticky, then $user can be empty 796# this sub routine test whether the $user has the specified previlige to $file 797########################################################################## 798 799sub B_permission_test($$$){ 800 my ($user, $previlege, $file) = @_; 801 802 if (-e $file ) { 803 my $mode = (stat($file))[2]; 804 my $bitpos; 805 # bitmap is | suid sgid sticky | rwx | rwx | rwx 806 if ($previlege =~ /suid/ ) { 807 $bitpos = 11; 808 } 809 elsif ($previlege =~ /sgid/ ) { 810 $bitpos = 10; 811 } 812 elsif ($previlege =~ /sticky/ ) { 813 $bitpos = 9; 814 } 815 else { 816 if ( $user =~ /owner/) { 817 if ($previlege =~ /r/) { 818 $bitpos = 8; 819 } 820 elsif ($previlege =~ /w/) { 821 $bitpos =7; 822 } 823 elsif ($previlege =~ /x/) { 824 $bitpos =6; 825 } 826 else { 827 return 0; 828 } 829 } 830 elsif ( $user =~ /group/) { 831 if ($previlege =~ /r/) { 832 $bitpos =5; 833 } 834 elsif ($previlege =~ /w/) { 835 $bitpos =4; 836 } 837 elsif ($previlege =~ /x/) { 838 $bitpos =3; 839 } 840 else { 841 return 0; 842 } 843 } 844 elsif ( $user =~ /other/) { 845 if ($previlege =~ /r/) { 846 $bitpos =2; 847 } 848 elsif ($previlege =~ /w/) { 849 $bitpos =1; 850 } 851 elsif ($previlege =~ /x/) { 852 $bitpos =0; 853 } 854 else { 855 return 0; 856 } 857 } 858 else { 859 return 0; 860 } 861 } 862 $mode /= 2**$bitpos; 863 if ($mode % 2) { 864 return 1; 865 } 866 return 0; 867 } 868} 869 870########################################################################## 871# this subroutine will return a list of home directory 872########################################################################## 873sub B_find_homes(){ 874 # find loginable homes 875 my $logins = &getGlobal("BIN","logins"); 876 my @lines = `$logins -ox`; 877 my @homes; 878 foreach my $line (@lines) { 879 chomp $line; 880 my @data = split /:/, $line; 881 if ($data[7] =~ /PS/ && $data[5] =~ /home/) { 882 push @homes, $data[5]; 883 } 884 } 885 return @homes; 886} 887 888 889########################################################################### 890# B_is_executable($) 891# 892# This routine reports on whether a file is executable by the current 893# process' effective UID. 894# 895# scalar return values: 896# 0: file is not executable 897# 1: file is executable 898# 899########################################################################### 900 901sub B_is_executable($) 902{ 903 my $name = shift; 904 my $executable = 0; 905 906 if (-x $name) { 907 $executable = 1; 908 } 909 return $executable; 910} 911 912########################################################################### 913# B_is_suid($) 914# 915# This routine reports on whether a file is Set-UID and owned by root. 916# 917# scalar return values: 918# 0: file is not SUID root 919# 1: file is SUID root 920# 921########################################################################### 922 923sub B_is_suid($) 924{ 925 my $name = shift; 926 927 my @FileStatus = stat($name); 928 my $IsSuid = 0; 929 930 if (-u $name) #Checks existence and suid 931 { 932 if($FileStatus[4] == 0) { 933 $IsSuid = 1; 934 } 935 } 936 937 return $IsSuid; 938} 939 940########################################################################### 941# B_is_sgid($) 942# 943# This routine reports on whether a file is SGID and group owned by 944# group root (gid 0). 945# 946# scalar return values: 947# 0: file is not SGID root 948# 1: file is SGID root 949# 950########################################################################### 951 952sub B_is_sgid($) 953{ 954 my $name = shift; 955 956 my @FileStatus = stat($name); 957 my $IsSgid = 0; 958 959 if (-g $name) #checks existence and sgid 960 { 961 if($FileStatus[5] == 0) { 962 $IsSgid = 1; 963 } 964 } 965 966 return $IsSgid; 967} 968 969########################################################################### 970# B_get_user_list() 971# 972# This routine outputs a list of users on the system. 973# 974########################################################################### 975 976sub B_get_user_list() 977{ 978 my @users; 979 open(PASSWD,&getGlobal('FILE','passwd')); 980 while(<PASSWD>) { 981 #Get the users 982 if (/^([^:]+):/) 983 { 984 push (@users,$1); 985 } 986 } 987 return @users; 988} 989 990########################################################################### 991# B_get_group_list() 992# 993# This routine outputs a list of groups on the system. 994# 995########################################################################### 996 997sub B_get_group_list() 998{ 999 my @groups; 1000 open(GROUP,&getGlobal('FILE','group')); 1001 while(my $group_line = <GROUP>) { 1002 #Get the groups 1003 if ($group_line =~ /^([^:]+):/) 1004 { 1005 push (@groups,$1); 1006 } 1007 } 1008 return @groups; 1009} 1010 1011 1012########################################################################### 1013# &B_remove_suid ($file) removes the suid bit from $file if it 1014# is set and the file exist. If you would like to remove the suid bit 1015# from /bin/ping then you need to use: 1016# 1017# &B_remove_suid("/bin/ping"); 1018# 1019# &B_remove_suid respects GLOBAL_LOGONLY. 1020# &B_remove_suid uses &B_chmod to make the permission changes 1021# &B_remove_suid allows for globbing. tyler_e 1022# 1023########################################################################### 1024 1025sub B:remove_suid($) { 1026 my $file_expr = $_[0]; 1027 1028 &B_log("ACTION","Removing SUID bit from \"$file_expr\"."); 1029 unless ($GLOBAL_LOGONLY) { 1030 my @files = glob($file_expr); 1031 1032 foreach my $file (@files) { 1033 # check file existence 1034 if(-e $file){ 1035 # stat current file to get raw permissions 1036 my $old_perm_raw = (stat $file)[2]; 1037 # test to see if suidbit is set 1038 my $suid_bit = (($old_perm_raw/2048) % 2); 1039 if($suid_bit == 1){ 1040 # new permission without the suid bit 1041 my $new_perm = ((($old_perm_raw/512) % 8 ) - 4) . 1042 (($old_perm_raw/64) % 8 ) . 1043 (($old_perm_raw/8) % 8 ) . 1044 (($old_perm_raw) % 8 ); 1045 if(&B_chmod(oct($new_perm), $file)){ 1046 &B_log("ACTION","Removed SUID bit from \"$file\"."); 1047 } 1048 else { 1049 &B_log("ERROR","Could not remove SUID bit from \"$file\"."); 1050 } 1051 } # No action if SUID bit is not set 1052 }# No action if file does not exist 1053 }# Repeat for each file in the file glob 1054 } # unless Global_log 1055} 1056 1057 1058 10591; 1060 1061