diff options
Diffstat (limited to 'dynamic-layers/meta-perl/recipes-security/bastille/files/AccountPermission.pm')
| -rw-r--r-- | dynamic-layers/meta-perl/recipes-security/bastille/files/AccountPermission.pm | 1060 |
1 files changed, 1060 insertions, 0 deletions
diff --git a/dynamic-layers/meta-perl/recipes-security/bastille/files/AccountPermission.pm b/dynamic-layers/meta-perl/recipes-security/bastille/files/AccountPermission.pm new file mode 100644 index 0000000..132b30c --- /dev/null +++ b/dynamic-layers/meta-perl/recipes-security/bastille/files/AccountPermission.pm @@ -0,0 +1,1060 @@ +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; + |