File Coverage

blib/lib/Sman/Config.pm

Criterion	Covered	Total	%
statement	31	139	22.3
branch	1	58	1.7
condition	1	21	4.7
subroutine	9	22	40.9
pod	0	11	0.0
total	42	251	16.7

package Sman::Config;

#$Id$

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__