| package Bastille::API::AccountPermission; |
| use strict; |
| |
| use Bastille::API; |
| |
| use Bastille::API::HPSpecific; |
| |
| require Exporter; |
| our @ISA = qw(Exporter); |
| our @EXPORT_OK = qw( |
| B_chmod |
| B_chmod_if_exists |
| B_chown |
| B_chown_link |
| B_chgrp |
| B_chgrp_link |
| B_userdel |
| B_groupdel |
| B:remove_user_from_group |
| B_check_owner_group |
| B_is_unowned_file |
| B_is_ungrouped_file |
| B_check_permissions |
| B_permission_test |
| B_find_homes |
| B_is_executable |
| B_is_suid |
| B_is_sgid |
| B_get_user_list |
| B_get_group_list |
| B:remove_suid |
| ); |
| our @EXPORT = @EXPORT_OK; |
| |
| ########################################################################### |
| # &B_chmod ($mode, $file) sets the mode of $file to $mode. $mode must |
| # be stored in octal, so if you want to give mode 700 to /etc/aliases, |
| # you need to use: |
| # |
| # &B_chmod ( 0700 , "/etc/aliases"); |
| # |
| # where the 0700 denotes "octal 7-0-0". |
| # |
| # &B_chmod ($mode_changes,$file) also respects the symbolic methods of |
| # changing file permissions, which are often what question authors are |
| # really seeking. |
| # |
| # &B_chmod ("u-s" , "/bin/mount") |
| # or |
| # &B_chmod ("go-rwx", "/bin/mount") |
| # |
| # |
| # &B_chmod respects GLOBAL_LOGONLY and uses |
| # &B_revert_log used to insert a shell command that will return |
| # the permissions to the pre-Bastille state. |
| # |
| # B_chmod allow for globbing now, as of 1.2.0. JJB |
| # |
| ########################################################################## |
| |
| |
| sub B_chmod($$) { |
| my ($new_perm,$file_expr)=@_; |
| my $old_perm; |
| my $old_perm_raw; |
| my $new_perm_formatted; |
| my $old_perm_formatted; |
| |
| my $retval=1; |
| |
| my $symbolic = 0; |
| my ($chmod_noun,$add_remove,$capability) = (); |
| # Handle symbolic possibilities too |
| if ($new_perm =~ /([ugo]+)([+-]{1})([rwxst]+)/) { |
| $symbolic = 1; |
| $chmod_noun = $1; |
| $add:remove = $2; |
| $capability = $3; |
| } |
| |
| my $file; |
| my @files = glob ($file_expr); |
| |
| foreach $file (@files) { |
| |
| # Prepend global prefix, but save the original filename for B_backup_file |
| my $original_file=$file; |
| |
| # Store the old permissions so that we can log them. |
| unless (stat $file) { |
| &B_log("ERROR","Couldn't stat $original_file from $old_perm to change permissions\n"); |
| next; |
| } |
| |
| $old_perm_raw=(stat(_))[2]; |
| $old_perm= (($old_perm_raw/512) % 8) . |
| (($old_perm_raw/64) % 8) . |
| (($old_perm_raw/8) % 8) . |
| ($old_perm_raw % 8); |
| |
| # If we've gone symbolic, calculate the new permissions in octal. |
| if ($symbolic) { |
| # |
| # We calculate the new permissions by applying a bitmask to |
| # the current permissions, by OR-ing (for +) or XOR-ing (for -). |
| # |
| # We create this mask by first calculating a perm_mask that forms |
| # the right side of this, then multiplying it by 8 raised to the |
| # appropriate power to affect the correct digit of the octal mask. |
| # This means that we raise 8 to the power of 0,1,2, or 3, based on |
| # the noun of "other","group","user", or "suid/sgid/sticky". |
| # |
| # Actually, we handle multiple nouns by summing powers of 8. |
| # |
| # The only tough part is that we have to handle suid/sgid/sticky |
| # differently. |
| # |
| |
| # We're going to calculate a mask to OR or XOR with the current |
| # file mode. This mask is $mask. We calculate this by calculating |
| # a sum of powers of 8, corresponding to user/group/other, |
| # multiplied with a $premask. The $premask is simply the |
| # corresponding bitwise expression of the rwx bits. |
| # |
| # To handle SUID, SGID or sticky in the simplest way possible, we |
| # simply add their values to the $mask first. |
| |
| my $perm_mask = 00; |
| my $mask = 00; |
| |
| # Check for SUID, SGID or sticky as these are exceptional. |
| if ($capability =~ /s/) { |
| if ($chmod_noun =~ /u/) { |
| $mask += 04000; |
| } |
| if ($chmod_noun =~ /g/) { |
| $mask += 02000; |
| } |
| } |
| if ($capability =~ /t/) { |
| $mask += 01000; |
| } |
| |
| # Now handle the normal attributes |
| if ($capability =~ /[rwx]/) { |
| if ($capability =~ /r/) { |
| $perm_mask |= 04; |
| } |
| if ($capability =~ /w/) { |
| $perm_mask |= 02; |
| } |
| if ($capability =~ /x/) { |
| $perm_mask |= 01; |
| } |
| |
| # Now figure out which 3 bit octal digit we're affecting. |
| my $power = 0; |
| if ($chmod_noun =~ /u/) { |
| $mask += $perm_mask * 64; |
| } |
| if ($chmod_noun =~ /g/) { |
| $mask += $perm_mask * 8; |
| } |
| if ($chmod_noun =~ /o/) { |
| $mask += $perm_mask * 1; |
| } |
| } |
| # Now apply the mask to get the new permissions |
| if ($add_remove eq '+') { |
| $new_perm = $old_perm_raw | $mask; |
| } |
| elsif ($add_remove eq '-') { |
| $new_perm = $old_perm_raw & ( ~($mask) ); |
| } |
| } |
| |
| # formating for simple long octal output of the permissions in string form |
| $new_perm_formatted=sprintf "%5lo",$new_perm; |
| $old_perm_formatted=sprintf "%5lo",$old_perm_raw; |
| |
| &B_log("ACTION","change permissions on $original_file from $old_perm_formatted to $new_perm_formatted\n"); |
| |
| &B_log("ACTION", "chmod $new_perm_formatted,\"$original_file\";\n"); |
| |
| # Change the permissions on the file |
| |
| if ( -e $file ) { |
| unless ($GLOBAL_LOGONLY) { |
| $retval=chmod $new_perm,$file; |
| if($retval){ |
| # if the distribution is HP-UX then the modifications should |
| # also be made to the IPD (installed product database) |
| if(&GetDistro =~ "^HP-UX"){ |
| &B_swmodify($file); |
| } |
| # making changes revert-able |
| &B_revert_log(&getGlobal('BIN', "chmod") . " $old_perm $file\n"); |
| } |
| } |
| unless ($retval) { |
| &B_log("ERROR","Couldn't change permissions on $original_file from $old_perm_formatted to $new_perm_formatted\n"); |
| $retval=0; |
| } |
| } |
| else { |
| &B_log("ERROR", "chmod: File $original_file doesn't exist!\n"); |
| $retval=0; |
| } |
| } |
| |
| $retval; |
| |
| } |
| |
| ########################################################################### |
| # &B_chmod_if_exists ($mode, $file) sets the mode of $file to $mode *if* |
| # $file exists. $mode must be stored in octal, so if you want to give |
| # mode 700 to /etc/aliases, you need to use: |
| # |
| # &B_chmod_if_exists ( 0700 , "/etc/aliases"); |
| # |
| # where the 0700 denotes "octal 7-0-0". |
| # |
| # &B_chmod_if_exists respects GLOBAL_LOGONLY and uses |
| # &B_revert_log to reset the permissions of the file. |
| # |
| # B_chmod_if_exists allow for globbing now, as of 1.2.0. JJB |
| # |
| ########################################################################## |
| |
| |
| sub B_chmod_if_exists($$) { |
| my ($new_perm,$file_expr)=@_; |
| # If $file_expr has a glob character, pass it on (B_chmod won't complain |
| # about nonexistent files if given a glob pattern) |
| if ( $file_expr =~ /[\*\[\{]/ ) { # } just to match open brace for vi |
| &B_log("ACTION","Running chmod $new_perm $file_expr"); |
| return(&B_chmod($new_perm,$file_expr)); |
| } |
| # otherwise, test for file existence |
| if ( -e $file_expr ) { |
| &B_log("ACTION","File exists, running chmod $new_perm $file_expr"); |
| return(&B_chmod($new_perm,$file_expr)); |
| } |
| } |
| |
| ########################################################################### |
| # &B_chown ($uid, $file) sets the owner of $file to $uid, like this: |
| # |
| # &B_chown ( 0 , "/etc/aliases"); |
| # |
| # &B_chown respects $GLOBAL_LOGONLY and uses |
| # &B_revert_log to insert a shell command that will return |
| # the file/directory owner to the pre-Bastille state. |
| # |
| # Unlike Perl, we've broken the chown function into B_chown/B_chgrp to |
| # make error checking simpler. |
| # |
| # As of 1.2.0, this now supports file globbing. JJB |
| # |
| ########################################################################## |
| |
| |
| sub B_chown($$) { |
| my ($newown,$file_expr)=@_; |
| my $oldown; |
| my $oldgown; |
| |
| my $retval=1; |
| |
| my $file; |
| my @files = glob($file_expr); |
| |
| foreach $file (@files) { |
| |
| # Prepend prefix, but save original filename |
| my $original_file=$file; |
| |
| $oldown=(stat $file)[4]; |
| $oldgown=(stat $file)[5]; |
| |
| &B_log("ACTION","change ownership on $original_file from $oldown to $newown\n"); |
| &B_log("ACTION","chown $newown,$oldgown,\"$original_file\";\n"); |
| if ( -e $file ) { |
| unless ($GLOBAL_LOGONLY) { |
| # changing the files owner using perl chown function |
| $retval = chown $newown,$oldgown,$file; |
| if($retval){ |
| # if the distribution is HP-UX then the modifications should |
| # also be made to the IPD (installed product database) |
| if(&GetDistro =~ "^HP-UX"){ |
| &B_swmodify($file); |
| } |
| # making ownership change revert-able |
| &B_revert_log(&getGlobal('BIN', "chown") . " $oldown $file\n"); |
| } |
| } |
| unless ($retval) { |
| &B_log("ERROR","Couldn't change ownership to $newown on file $original_file\n"); |
| } |
| } |
| else { |
| &B_log("ERROR","chown: File $original_file doesn't exist!\n"); |
| $retval=0; |
| } |
| } |
| |
| $retval; |
| } |
| |
| ########################################################################### |
| # &B_chown_link just like &B_chown but one exception: |
| # if the input file is a link it will not change the target's ownship, it only change the link itself's ownship |
| ########################################################################### |
| sub B_chown_link($$){ |
| my ($newown,$file_expr)=@_; |
| my $chown = &getGlobal("BIN","chown"); |
| my @files = glob($file_expr); |
| my $retval = 1; |
| |
| foreach my $file (@files) { |
| # Prepend prefix, but save original filename |
| my $original_file=$file; |
| my $oldown=(stat $file)[4]; |
| my $oldgown=(stat $file)[5]; |
| |
| &B_log("ACTION","change ownership on $original_file from $oldown to $newown\n"); |
| &B_log("ACTION","chown -h $newown,\"$original_file\";\n"); |
| if ( -e $file ) { |
| unless ($GLOBAL_LOGONLY) { |
| `$chown -h $newown $file`; |
| $retval = ($? >> 8); |
| if($retval == 0 ){ |
| # if the distribution is HP-UX then the modifications should |
| # also be made to the IPD (installed product database) |
| if(&GetDistro =~ "^HP-UX"){ |
| &B_swmodify($file); |
| } |
| # making ownership change revert-able |
| &B_revert_log("$chown -h $oldown $file\n"); |
| } |
| } |
| unless ( ! $retval) { |
| &B_log("ERROR","Couldn't change ownership to $newown on file $original_file\n"); |
| } |
| } |
| else { |
| &B_log("ERROR","chown: File $original_file doesn't exist!\n"); |
| $retval=0; |
| } |
| } |
| } |
| |
| |
| ########################################################################### |
| # &B_chgrp ($gid, $file) sets the group owner of $file to $gid, like this: |
| # |
| # &B_chgrp ( 0 , "/etc/aliases"); |
| # |
| # &B_chgrp respects $GLOBAL_LOGONLY and uses |
| # &B_revert_log to insert a shell command that will return |
| # the file/directory group to the pre-Bastille state. |
| # |
| # Unlike Perl, we've broken the chown function into B_chown/B_chgrp to |
| # make error checking simpler. |
| # |
| # As of 1.2.0, this now supports file globbing. JJB |
| # |
| ########################################################################## |
| |
| |
| sub B_chgrp($$) { |
| my ($newgown,$file_expr)=@_; |
| my $oldown; |
| my $oldgown; |
| |
| my $retval=1; |
| |
| my $file; |
| my @files = glob($file_expr); |
| |
| foreach $file (@files) { |
| |
| # Prepend global prefix, but save original filename for &B_backup_file |
| my $original_file=$file; |
| |
| $oldown=(stat $file)[4]; |
| $oldgown=(stat $file)[5]; |
| |
| &B_log("ACTION", "Change group ownership on $original_file from $oldgown to $newgown\n"); |
| &B_log("ACTION", "chown $oldown,$newgown,\"$original_file\";\n"); |
| if ( -e $file ) { |
| unless ($GLOBAL_LOGONLY) { |
| # changing the group for the file/directory |
| $retval = chown $oldown,$newgown,$file; |
| if($retval){ |
| # if the distribution is HP-UX then the modifications should |
| # also be made to the IPD (installed product database) |
| if(&GetDistro =~ "^HP-UX"){ |
| &B_swmodify($file); |
| } |
| &B_revert_log(&getGlobal('BIN', "chgrp") . " $oldgown $file\n"); |
| } |
| } |
| unless ($retval) { |
| &B_log("ERROR","Couldn't change ownership to $newgown on file $original_file\n"); |
| } |
| } |
| else { |
| &B_log("ERROR","chgrp: File $original_file doesn't exist!\n"); |
| $retval=0; |
| } |
| } |
| |
| $retval; |
| } |
| |
| ########################################################################### |
| # &B_chgrp_link just like &B_chgrp but one exception: |
| # if the input file is a link |
| # it will not change the target's ownship, it only change the link itself's ownship |
| ########################################################################### |
| sub B_chgrp_link($$) { |
| my ($newgown,$file_expr)=@_; |
| my $chgrp = &getGlobal("BIN","chgrp"); |
| my @files = glob($file_expr); |
| my $retval=1; |
| |
| foreach my $file (@files) { |
| # Prepend prefix, but save original filename |
| my $original_file=$file; |
| my $oldgown=(stat $file)[5]; |
| |
| &B_log("ACTION","change group ownership on $original_file from $oldgown to $newgown\n"); |
| &B_log("ACTION","chgrp -h $newgown \"$original_file\";\n"); |
| if ( -e $file ) { |
| unless ($GLOBAL_LOGONLY) { |
| # do not follow link with option -h |
| `$chgrp -h $newgown $file`; |
| $retval = ($? >> 8); |
| if($retval == 0 ){ |
| # if the distribution is HP-UX then the modifications should |
| # also be made to the IPD (installed product database) |
| if(&GetDistro =~ "^HP-UX"){ |
| &B_swmodify($file); |
| } |
| # making ownership change revert-able |
| &B_revert_log("$chgrp" . " -h $oldgown $file\n"); |
| } |
| } |
| unless (! $retval) { |
| &B_log("ERROR","Couldn't change group ownership to $newgown on file $original_file\n"); |
| } |
| } |
| else { |
| &B_log("ERROR","chgrp: File $original_file doesn't exist!\n"); |
| $retval=0; |
| } |
| } |
| } |
| |
| ########################################################################### |
| # B_userdel($user) removes $user from the system, chmoding her home |
| # directory to 000, root:root owned, and removes the user from all |
| # /etc/passwd, /etc/shadow and /etc/group lines. |
| # |
| # In the future, we may also choose to make a B_lock_account routine. |
| # |
| # This routine depends on B:remove_user_from_group. |
| ########################################################################### |
| |
| sub B_userdel($) { |
| |
| my $user_to_remove = $_[0]; |
| |
| if (&GetDistro =~ /^HP-UX/) { |
| return 0; |
| |
| # Not yet suported on HP-UX, where we'd need to support |
| # the TCB files and such. |
| } |
| |
| # |
| # First, let's chmod/chown/chgrp the user's home directory. |
| # |
| |
| # Get the user's home directory from /etc/passwd |
| if (open PASSWD,&getGlobal('FILE','passwd')) { |
| my @lines=<PASSWD>; |
| close PASSWD; |
| |
| # Get the home directory |
| my $user_line = grep '^\s*$user_to_remove\s*:',@lines; |
| my $home_directory = (split /\s*:\s*/,$user_line)[5]; |
| |
| # Chmod that home dir to 0000,owned by uid 0, gid 0. |
| if (&B_chmod_if_exists(0000,$home_directory)) { |
| &B_chown(0,$home_directory); |
| &B_chgrp(0,$home_directory); |
| } |
| } |
| else { |
| &B_log('ERROR',"B_userdel couldn't open the passwd file to remove a user."); |
| return 0; |
| } |
| |
| # |
| # Next find out what groups the user is in, so we can call |
| # B:remove_user_from_group($user,$group) |
| # |
| # TODO: add this to the helper functions for the test suite. |
| # |
| |
| my @groups = (); |
| |
| # Parse /etc/group, looking for our user. |
| if (open GROUP,&getGlobal('FILE','group')) { |
| my @lines = <GROUP>; |
| close GROUP; |
| |
| foreach my $line (@lines) { |
| |
| # Parse the line -- first field is group, last is users in group. |
| if ($line =~ /([^\#^:]+):[^:]+:[^:]+:(.*)/) { |
| my $group = $1; |
| my $users_section = $2; |
| |
| # Get the user list and check if our user is in it. |
| my @users = split /\s*,\s*/,$users_section; |
| foreach my $user (@users) { |
| if ($user_to_remove eq $user) { |
| push @groups,$group; |
| last; |
| } |
| } |
| } |
| } |
| } |
| |
| # Now remove the user from each of those groups. |
| foreach my $group (@groups) { |
| &B_remove_user_from_group($user_to_remove,$group); |
| } |
| |
| # Remove the user's /etc/passwd and /etc/shadow lines |
| &B_delete_line(&getGlobal('FILE','passwd'),"^$user_to_remove\\s*:"); |
| &B_delete_line(&getGlobal('FILE','shadow'),"^$user_to_remove\\s*:"); |
| |
| |
| # |
| # We should delete the user's group as well, if it's a single-user group. |
| # |
| if (open ETCGROUP,&getGlobal('FILE','group')) { |
| my @group_lines = <ETCGROUP>; |
| close ETCGROUP; |
| chomp @group_lines; |
| |
| if (grep /^$user_to_remove\s*:[^:]*:[^:]*:\s*$/,@group_lines > 0) { |
| &B_groupdel($user_to_remove); |
| } |
| } |
| |
| } |
| |
| ########################################################################### |
| # B_groupdel($group) removes $group from /etc/group. |
| ########################################################################### |
| |
| sub B_groupdel($) { |
| |
| my $group = $_[0]; |
| |
| # First read /etc/group to make sure the group is in there. |
| if (open GROUP,&getGlobal('FILE','group')) { |
| my @lines=<GROUP>; |
| close GROUP; |
| |
| # Delete the line in /etc/group if present |
| if (grep /^$group:/,@lines > 0) { |
| # The group is named in /etc/group |
| &B_delete_line(&getGlobal('FILE','group'),"^$group:/"); |
| } |
| } |
| |
| } |
| |
| |
| ########################################################################### |
| # B:remove_user_from_group($user,$group) removes $user from $group, |
| # by modifying $group's /etc/group line, pulling the user out. This |
| # uses B_chunk_replace thrice to replace these patterns: |
| # |
| # ":\s*$user\s*," --> ":" |
| # ",\s*$user" -> "" |
| # |
| ########################################################################### |
| |
| sub B:remove_user_from_group($$) { |
| |
| my ($user_to_remove,$group) = @_; |
| |
| # |
| # We need to find the line from /etc/group that defines the group, parse |
| # it, and put it back together without this user. |
| # |
| |
| # Open the group file |
| unless (open GROUP,&getGlobal('FILE','group')) { |
| &B_log('ERROR',"&B_remove_user_from_group couldn't read /etc/group to remove $user_to_remove from $group.\n"); |
| return 0; |
| } |
| my @lines = <GROUP>; |
| close GROUP; |
| chomp @lines; |
| |
| # |
| # Read through the lines to find the one we care about. We'll construct a |
| # replacement and then use B_replace_line to make the switch. |
| # |
| |
| foreach my $line (@lines) { |
| |
| if ($line =~ /^\s*$group\s*:/) { |
| |
| # Parse this line. |
| my @group_entries = split ':',$line; |
| my @users = split ',',($group_entries[3]); |
| |
| # Now, recreate it. |
| my $first_user = 1; |
| my $group_line = $group_entries[0] . ':' . $group_entries[1] . ':' . $group_entries[2] . ':'; |
| |
| # Add every user except the one we're removing. |
| foreach my $user (@users) { |
| |
| # Remove whitespace. |
| $user =~ s/\s+//g; |
| |
| if ($user ne $user_to_remove) { |
| # Add the user to the end of the line, prefacing |
| # it with a comma if it's not the first user. |
| |
| if ($first_user) { |
| $group_line .= "$user"; |
| $first_user = 0; |
| } |
| else { |
| $group_line .= ",$user"; |
| } |
| } |
| } |
| |
| # The line is now finished. Replace the original line. |
| $group_line .= "\n"; |
| &B_replace_line(&getGlobal('FILE','group'),"^\\s*$group\\s*:",$group_line); |
| } |
| |
| } |
| return 1; |
| } |
| |
| ########################################################################### |
| # &B_check_owner_group($$$) |
| # |
| # Checks if the given file has the given owner and/or group. |
| # If the given owner is "", checks group only. |
| # If the given group is "", checks owner only. |
| # |
| # return values: |
| # 1: file has the given owner and/or group |
| # or file exists, and both the given owner and group are "" |
| # 0: file does not has the given owner or group |
| # or file does not exists |
| ############################################################################ |
| |
| sub B_check_owner_group ($$$){ |
| my ($fileName, $owner, $group) = @_; |
| |
| if (-e $fileName) { |
| my @junk=stat ($fileName); |
| my $uid=$junk[4]; |
| my $gid=$junk[5]; |
| |
| # Check file owner |
| if ($owner ne "") { |
| if (getpwnam($owner) != $uid) { |
| return 0; |
| } |
| } |
| |
| # Check file group |
| if ($group ne "") { |
| if (getgrnam($group) != $gid) { |
| return 0; |
| } |
| } |
| |
| return 1; |
| } |
| else { |
| # Something is wrong if the file not exist |
| return 0; |
| } |
| } |
| |
| ########################################################################## |
| # this subroutine will test whether the given file is unowned |
| ########################################################################## |
| sub B_is_unowned_file($) { |
| my $file =$_; |
| my $uid = (stat($file))[4]; |
| my $uname = (getpwuid($uid))[0]; |
| if ( $uname =~ /.+/ ) { |
| return 1; |
| } |
| return 0; |
| } |
| |
| ########################################################################## |
| # this subroutine will test whether the given file is ungrouped |
| ########################################################################## |
| sub B_is_ungrouped_file($){ |
| my $file =$_; |
| my $gid = (stat($file))[5]; |
| my $gname = (getgrgid($gid))[0]; |
| if ( $gname =~ /.+/ ) { |
| return 1; |
| } |
| return 0; |
| } |
| |
| |
| |
| |
| ########################################################################### |
| # &B_check_permissions($$) |
| # |
| # Checks if the given file has the given permissions or stronger, where we |
| # define stronger as "less accessible." The file argument must be fully |
| # qualified, i.e. contain the absolute path. |
| # |
| # return values: |
| # 1: file has the given permissions or better |
| # 0: file does not have the given permsssions |
| # undef: file permissions cannot be determined |
| ########################################################################### |
| |
| sub B_check_permissions ($$){ |
| my ($fileName, $reqdPerms) = @_; |
| my $filePerms; # actual permissions |
| |
| |
| if (-e $fileName) { |
| if (stat($fileName)) { |
| $filePerms = (stat($fileName))[2] & 07777; |
| } |
| else { |
| &B_log ("ERROR", "Can't stat $fileName.\n"); |
| return undef; |
| } |
| } |
| else { |
| # If the file does not exist, permissions are as good as they can get. |
| return 1; |
| } |
| |
| # |
| # We can check whether the $filePerms are as strong by |
| # bitwise ANDing them with $reqdPerms and checking if the |
| # result is still equal to $filePerms. If it is, the |
| # $filePerms are strong enough. |
| # |
| if ( ($filePerms & $reqdPerms) == $filePerms ) { |
| return 1; |
| } |
| else { |
| return 0; |
| } |
| |
| } |
| |
| ########################################################################## |
| # B_permission_test($user, $previlege,$file) |
| # $user can be |
| # "owner" |
| # "group" |
| # "other" |
| # $previlege can be: |
| # "r" |
| # "w" |
| # "x" |
| # "suid" |
| # "sgid" |
| # "sticky" |
| # if previlege is set to suid or sgid or sticky, then $user can be empty |
| # this sub routine test whether the $user has the specified previlige to $file |
| ########################################################################## |
| |
| sub B_permission_test($$$){ |
| my ($user, $previlege, $file) = @_; |
| |
| if (-e $file ) { |
| my $mode = (stat($file))[2]; |
| my $bitpos; |
| # bitmap is | suid sgid sticky | rwx | rwx | rwx |
| if ($previlege =~ /suid/ ) { |
| $bitpos = 11; |
| } |
| elsif ($previlege =~ /sgid/ ) { |
| $bitpos = 10; |
| } |
| elsif ($previlege =~ /sticky/ ) { |
| $bitpos = 9; |
| } |
| else { |
| if ( $user =~ /owner/) { |
| if ($previlege =~ /r/) { |
| $bitpos = 8; |
| } |
| elsif ($previlege =~ /w/) { |
| $bitpos =7; |
| } |
| elsif ($previlege =~ /x/) { |
| $bitpos =6; |
| } |
| else { |
| return 0; |
| } |
| } |
| elsif ( $user =~ /group/) { |
| if ($previlege =~ /r/) { |
| $bitpos =5; |
| } |
| elsif ($previlege =~ /w/) { |
| $bitpos =4; |
| } |
| elsif ($previlege =~ /x/) { |
| $bitpos =3; |
| } |
| else { |
| return 0; |
| } |
| } |
| elsif ( $user =~ /other/) { |
| if ($previlege =~ /r/) { |
| $bitpos =2; |
| } |
| elsif ($previlege =~ /w/) { |
| $bitpos =1; |
| } |
| elsif ($previlege =~ /x/) { |
| $bitpos =0; |
| } |
| else { |
| return 0; |
| } |
| } |
| else { |
| return 0; |
| } |
| } |
| $mode /= 2**$bitpos; |
| if ($mode % 2) { |
| return 1; |
| } |
| return 0; |
| } |
| } |
| |
| ########################################################################## |
| # this subroutine will return a list of home directory |
| ########################################################################## |
| sub B_find_homes(){ |
| # find loginable homes |
| my $logins = &getGlobal("BIN","logins"); |
| my @lines = `$logins -ox`; |
| my @homes; |
| foreach my $line (@lines) { |
| chomp $line; |
| my @data = split /:/, $line; |
| if ($data[7] =~ /PS/ && $data[5] =~ /home/) { |
| push @homes, $data[5]; |
| } |
| } |
| return @homes; |
| } |
| |
| |
| ########################################################################### |
| # B_is_executable($) |
| # |
| # This routine reports on whether a file is executable by the current |
| # process' effective UID. |
| # |
| # scalar return values: |
| # 0: file is not executable |
| # 1: file is executable |
| # |
| ########################################################################### |
| |
| sub B_is_executable($) |
| { |
| my $name = shift; |
| my $executable = 0; |
| |
| if (-x $name) { |
| $executable = 1; |
| } |
| return $executable; |
| } |
| |
| ########################################################################### |
| # B_is_suid($) |
| # |
| # This routine reports on whether a file is Set-UID and owned by root. |
| # |
| # scalar return values: |
| # 0: file is not SUID root |
| # 1: file is SUID root |
| # |
| ########################################################################### |
| |
| sub B_is_suid($) |
| { |
| my $name = shift; |
| |
| my @FileStatus = stat($name); |
| my $IsSuid = 0; |
| |
| if (-u $name) #Checks existence and suid |
| { |
| if($FileStatus[4] == 0) { |
| $IsSuid = 1; |
| } |
| } |
| |
| return $IsSuid; |
| } |
| |
| ########################################################################### |
| # B_is_sgid($) |
| # |
| # This routine reports on whether a file is SGID and group owned by |
| # group root (gid 0). |
| # |
| # scalar return values: |
| # 0: file is not SGID root |
| # 1: file is SGID root |
| # |
| ########################################################################### |
| |
| sub B_is_sgid($) |
| { |
| my $name = shift; |
| |
| my @FileStatus = stat($name); |
| my $IsSgid = 0; |
| |
| if (-g $name) #checks existence and sgid |
| { |
| if($FileStatus[5] == 0) { |
| $IsSgid = 1; |
| } |
| } |
| |
| return $IsSgid; |
| } |
| |
| ########################################################################### |
| # B_get_user_list() |
| # |
| # This routine outputs a list of users on the system. |
| # |
| ########################################################################### |
| |
| sub B_get_user_list() |
| { |
| my @users; |
| open(PASSWD,&getGlobal('FILE','passwd')); |
| while(<PASSWD>) { |
| #Get the users |
| if (/^([^:]+):/) |
| { |
| push (@users,$1); |
| } |
| } |
| return @users; |
| } |
| |
| ########################################################################### |
| # B_get_group_list() |
| # |
| # This routine outputs a list of groups on the system. |
| # |
| ########################################################################### |
| |
| sub B_get_group_list() |
| { |
| my @groups; |
| open(GROUP,&getGlobal('FILE','group')); |
| while(my $group_line = <GROUP>) { |
| #Get the groups |
| if ($group_line =~ /^([^:]+):/) |
| { |
| push (@groups,$1); |
| } |
| } |
| return @groups; |
| } |
| |
| |
| ########################################################################### |
| # &B_remove_suid ($file) removes the suid bit from $file if it |
| # is set and the file exist. If you would like to remove the suid bit |
| # from /bin/ping then you need to use: |
| # |
| # &B_remove_suid("/bin/ping"); |
| # |
| # &B_remove_suid respects GLOBAL_LOGONLY. |
| # &B_remove_suid uses &B_chmod to make the permission changes |
| # &B_remove_suid allows for globbing. tyler_e |
| # |
| ########################################################################### |
| |
| sub B:remove_suid($) { |
| my $file_expr = $_[0]; |
| |
| &B_log("ACTION","Removing SUID bit from \"$file_expr\"."); |
| unless ($GLOBAL_LOGONLY) { |
| my @files = glob($file_expr); |
| |
| foreach my $file (@files) { |
| # check file existence |
| if(-e $file){ |
| # stat current file to get raw permissions |
| my $old_perm_raw = (stat $file)[2]; |
| # test to see if suidbit is set |
| my $suid_bit = (($old_perm_raw/2048) % 2); |
| if($suid_bit == 1){ |
| # new permission without the suid bit |
| my $new_perm = ((($old_perm_raw/512) % 8 ) - 4) . |
| (($old_perm_raw/64) % 8 ) . |
| (($old_perm_raw/8) % 8 ) . |
| (($old_perm_raw) % 8 ); |
| if(&B_chmod(oct($new_perm), $file)){ |
| &B_log("ACTION","Removed SUID bit from \"$file\"."); |
| } |
| else { |
| &B_log("ERROR","Could not remove SUID bit from \"$file\"."); |
| } |
| } # No action if SUID bit is not set |
| }# No action if file does not exist |
| }# Repeat for each file in the file glob |
| } # unless Global_log |
| } |
| |
| |
| |
| 1; |
| |