summaryrefslogtreecommitdiffstats
path: root/dynamic-layers/meta-perl/recipes-security/bastille/files/AccountPermission.pm
diff options
context:
space:
mode:
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.pm1060
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 @@
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
generated by cgit v1.2.3-54-g00ecf (git 2.39.0) at 2025-10-29 05:58:08 +0000