File Coverage

blib/lib/Sman/Config.pm

Criterion	Covered	Total	%
statement	32	140	22.8
branch	1	58	1.7
condition	1	21	4.7
subroutine	9	22	40.9
pod	0	11	0.0
total	43	252	17.0

package Sman::Config;

#$Id: Config.pm,v 1.19 2005/09/15 02:44:55 joshr Exp $

use 5.006;
use strict;
use warnings;
use FindBin qw($Bin);
use POSIX qw(sysconf _PC_CHOWN_RESTRICTED); 	# for _isverysafe
use Cwd;	 									# for _isverysafe
use File::stat;	# used in _issafe()
use fields qw( conf );

# call like my $smanconfig = new Sman::Config();
sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {};
	bless ($self, $class);
	$self->{conf} = [];	# empty list
	my $configfile = shift;
	if (defined($configfile)) {
		$self->ReadSingleConfigFile($configfile);
	}
	return $self;
}

# Gets a config var. Because we're case INsensitive.
# returns "" if no data found.
sub GetConfigData {
	my ($self, $directive) = @_;
	#print "Looking for $directive...\n";
	for(@ {$self->{conf}} ) {
		return $_->[1] if (uc($_->[0]) eq uc($directive) && defined($_->[1]));
	}
	return "";
}

# Sets a config var. Because we're case INsensitive.
# if an existing value is set for a name, it's replaced, WHERE IT WAS.
# returns the data.
sub SetConfigData {
	my ($self, $directive, $data) = @_;
	#print "Setting '$directive' to '$data'\n";
	for (my $i=0; $i < scalar(@ {$self->{conf}}); $i++ ) {
		if (uc($self->{conf}->[$i]->[0]) eq uc($directive)) {
			warn "Clobbering previous setting for '$directive'\n"
				if defined($self->{verbose});	# there is no self->{verbose}. Why no error?
			$self->{conf}->[$i]->[1] = $data;
			return $data;
		}
	}
	my @line = ($directive, $data);	# stored as originally input
	push(@ {$self->{conf}}, \@line);	# push the listref on the list
	return $data;
}

# this returns only the first one found in the path
#  $Bin/sman.conf, ~/.sman.conf, /usr/local/etc/sman.conf, /etc/sman.conf
sub FindDefaultConfigFile {
	my $self = shift;
	my (@dirs) = $self->_getconfigdirs();
	for(@dirs) {
		if (-e "$_/sman-defaults.conf") {
			 if($self->_isverysafe("$_/sman-defaults.conf") ) {
				return "$_/sman-defaults.conf";
			} else {
				warn "$0: Can't use $_/sman-defaults.conf: ownership not safe.\n";
			}
		}
	}
	return "";
}

# finds and returns the config file(s). Looks for sman.conf(s) in:
#  $Bin/sman.conf, ~/.sman.conf, /usr/local/etc/sman.conf, /etc/sman.conf
#  (in that order)
sub FindConfigFiles {
	my $self = shift;
	my (@dirs, @configs) = $self->_getconfigdirs();
	for(@dirs) {
		my $f = "$_/sman.conf";
		if (-e $f && $self->_isverysafe($f) ) {
			push(@configs, $f);
		}
	}
	my $defaultconfig = $self->FindDefaultConfigFile();
	push(@configs, $defaultconfig) if ($defaultconfig);
	return @configs;
}

# we pass verbose here because it could be that the user's verbose setting is overridden from above
# returns the name of the file read, or "" if none found.
sub ReadDefaultConfigFile {
	my ($self, $verbose) = @_;
	my @configfiles = $self->FindConfigFiles(); 	# this includes the default one.

	# read the first config file.
	for (@configfiles) {
		print "Reading config file $_\n" if $verbose;
		$self->ReadSingleConfigFile($_);
		last;
	}
	#print "Used config file '$configfiles[0]', found '" . join(", ", @configfiles) . "'.\n"
	#	if ($verbose || $self->GetConfigData("VERBOSE"));
	if (scalar(@configfiles)) {
		return $configfiles[0];
	} else {
		return "";
	}
}

# adds data from the file into our configuration data
# returns the filename read, or "" on error
sub ReadSingleConfigFile {
	my ($self, $file) = @_;
	my $prevline;
	if (!open(FILE, "< $file")) {
		die "Couldn't open $file: $!";
	} else {
		while(defined(my $line = )) {
			chomp($line);
			if (defined($prevline)) {
				$line = "$prevline $line";
				undef $prevline;
			}
			if ($line =~ s/\\$//) {	# if the last char is \, remove it, and
				$prevline = $line;	# record it
			} else {						# else parse it
				next if $line =~ /^\s*$/;	# empty line
				next if $line =~ /^\s*#/;	# a comment
				$line =~ s/^\s+//;			# strip leading ws
				my ($directive, $value) = split(/\s+/, $line, 2);
				if (defined($directive) && $directive && defined($value)) {
					$self->SetConfigData($directive, $value); # will clobber old setting
				}
			}
		}
		close(FILE) || die "Couldn't close $file: $!";
	}
	return $file;
}

sub Reset {
	my $self = shift;
	$self->{conf} = {};	# reset the puppy
}

# returns a list of params from the config
sub GetConfigNames {
	my $self = shift;
	my @names = ();
	for( @ {$self->{conf}} ) {
		if (defined($_->[0]) && defined($_->[1])) {
			push(@names, $_->[0]);
		}
	}
	return @names;
}

sub Dump {
	my $self = shift;
	my $str = "# Sman::Config settings:\n";
	for (@ { $self->{conf} } ) {
		$str .= " $_->[0] $_->[1]\n";
	}
	return $str;
}

sub SetEnvironmentVariablesFromConfig
{
	my $self = shift;
	my $verbose = $self->GetConfigData("VERBOSE");
	my @envs = grep { /^ENV_/ } $self->GetConfigNames();
	for my $e (@envs) {
		(my $copy = $e ) =~ s/^ENV_//;
		$ENV{uc($copy)} = $self->GetConfigData($e);
		print "Set ENV{$copy} to " . $self->GetConfigData($e) . "\n"
			if ($verbose);
	}
	return @envs;
}

sub _getconfigdirs {
	my (@dirs, @configs) = ( $Bin );	# From FindBin
	if (defined($ENV{HOME})) { push(@dirs, $ENV{HOME}); }
	push(@dirs, qw(/etc/ /usr/local/etc/));
	return @dirs;
}

#from perl cookbook "8.17. Testing a File for Trustworthiness"
sub _issafe {
    my ($self, $path) = @_;
    my $info = stat($path);
    return 0 unless $info;

    # owner neither superuser nor me
    # the real uid is in stored in the $< variable
    if (($info->uid != 0) && ($info->uid != $<)) {
        return 0;
    }

    # check whether group or other can write file.
    # use 066 to detect either reading or writing
    if ($info->mode & 022) {   # someone else can write this
        return 0 unless -d _;  # non-directories aren't safe
            # but directories with the sticky bit (01000) are
        return 0 unless $info->mode & 01000;
    }
    return 1;
}

#from perl cookbook "8.17. Testing a File for Trustworthiness"
sub _isverysafe {
    my ($self, $path) = @_;
    return $self->_issafe($path) if sysconf(_PC_CHOWN_RESTRICTED);
    $path = getcwd() . '/' . $path if $path !~ m{^/};
    do {
        return unless $self->_issafe($path);
        $path =~ s#([^/]+|/)$##;               # dirname
        $path =~ s#/$## if length($path) > 1;  # last slash
    } while length $path;

    return 1;
}







1;
__END__