DataMuseum.dk

top - metrics - download

    Length: 2835 (0xb13)
    Types: TextFile
    Names: »is_able.pl«

└─⟦4f9d7c866⟧ Bits:30007245 EUUGD6: Sikkerheds distributionen
    └─⟦3da311d67⟧ »./cops/1.04/cops_104.tar.Z« 
        └─⟦6a2577110⟧ 
└─⟦4f9d7c866⟧ Bits:30007245 EUUGD6: Sikkerheds distributionen
    └─⟦6a2577110⟧ »./cops/1.04/cops_104.tar« 
            └─⟦this⟧ »cops_104/perl/is_able.pl« 

TextFile

#
#  (This takes the place of the C program is_able.c, BTW.)
# 
#  is_able filename {w|g|s|S}       {r|w|B|b|s}
#      (world/group/SUID/SGID   read/write/{read&write}/{suid&write}/s[ug]id)
# 
#     The second arg of {r|w} determines whether a file is (group or world
#   depending on the first arg of {w|g}) writable/readable, or if it is
#   SUID/SGID (first arg, either s or S, respectively), and prints out a
#   short message to that effect.
# 
#  So:
#     is_able w w		# checks if world writable
#     is_able g r		# checks if group readable
#     is_able s s		# checks if SUID
#     is_able S b		# checks if world writable and SGID

package main;
require 'file_mode.pl';

package is_able;

# package statics
#
%wg = ( 
	'w', 00006,
	'g', 00060,
	's', 04000,
	'S', 02000,
       );

%rwb= (
	'r', 00044,
	'w', 00022,
	'B', 00066,
	'b', 04022,
	's', 06000,
      );

$silent = 0;  # for suppressing diagnostic messages


sub main'is_able {
    local($file, $wg, $rwb) = @_;

    local ( 
	   $mode, 			# file mode
           $piece,			# 1 directory component
	   @pieces, 			# all the pieces
	   @dirs, 			# all the directories
	   $p, 				# punctuation; (*) mean writable
	   				#       due to writable parent
	   $retval,			# true if vulnerable
	   $[				# paranoia
	  );

    &usage, return undef	if @_ != 3 || $file eq '';

    &usage, return undef	unless defined $wg{$wg} && defined $rwb{$rwb};

    if (&'Mode($file) eq 'BOGUS' && $noisy) {
	warn "is_able: can't stat $file: $!\n";
	return undef;
    }

    $retval = 0;

    if ($rwb{$rwb} & $rwb{'w'}) {
	@pieces = split(m#/#, $file);
	for ($i = 1; $i <= $#pieces; $i++) {
	    push(@dirs, join('/', @pieces[0..$i]));
	}
    } else {
	@dirs = ( $file );
    } 

    for $piece ( reverse @dirs ) {

	next unless $mode = &'Mode($piece);
	next if $mode eq 'BOGUS';

	next unless $mode &= 07777 & $wg{$wg} & $rwb{$rwb};

	$retval = 1;

	$p = $piece eq $file ? '!' : '! (*)';

	$parent_is_writable = $p eq '! (*)'; # for later

	next if $silent; # for &is_writable

	print "Warning!  $file is group readable$p\n"	if $mode & 00040; 
	print "Warning!  $file is _World_ readable$p\n"	if $mode & 00004; 
	print "Warning!  $file is group writable$p\n"	if $mode & 00020; 
	print "Warning!  $file is _World_ writable$p\n"	if $mode & 00002; 
	print "Warning!  $file is SUID!\n"		if $mode & 04000; 
	print "Warning!  $file is SGID!\n"		if $mode & 02000; 

	last if $piece ne $file;  # only complain on first writable parent
    }
    $retval;
}

sub main'is_writable {
    local($silent) = 1;
    &'is_able($_[0], 'w', 'w') 
	? $parent_is_writable 
	     ? "writable (*)"
	     : "writable" 
	: 0;
} 

sub main'is_readable {
    local($silent) = 1;
    &'is_able($_[0], 'w', 'r');
}

sub usage { 
    warn <<EOF;
Usage: is_able file {w|g|S|s} {r|w|B|b|s}
 (not: is_able @_)
EOF
}

1;