File Coverage

lib/Illumos/SMF.pm

Criterion	Covered	Total	%
statement	14	251	5.5
branch	3	106	2.8
condition	0	33	0.0
subroutine	3	24	12.5
pod	21	22	95.4
total	41	436	9.4

package Illumos::SMF;

use strict;
use warnings;

# version
our $VERSION = '0.1.7';

# commands
my $SVCS   = '/usr/bin/svcs';
my $SVCCFG = '/usr/sbin/svccfg';
my $SVCADM = '/usr/sbin/svcadm';
my $ZLOGIN = '/usr/sbin/zlogin';

# constructor
sub new {
    my $class = shift;
    my $self = { @_ };

    # add Illumos::Zone instance if zone support is required
    $self->{zonesupport} && do {
        eval {
            require Illumos::Zones;
        };
        if ($@) {
            die "ERROR: Unable to load package Illumos::Zones.";
        }

        $self->{zone} = Illumos::Zones->new(debug => $self->{debug});
    };

    return bless $self, $class
}
# private methods
my $svcAdm = sub {
    my $self = shift;
    my $cmd  = shift;
    my $fmri = shift;

    my @cmd = ($SVCADM, $cmd, $fmri);

    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot $cmd '$fmri'\n";
};

my $zoneCmd = sub {
    my $self     = shift;
    my $zoneName = shift;

    print STDERR "WARNING: zonename specified but 'zonesupport' not enabled for Illumos::SMF\n"
        . "use 'Illumos::SMF(zonesupport => 1)' to enable zone support\n" if $zoneName && !$self->{zone};

    return { cmd => [], shellquote => q{"} } if !$zoneName || !$self->{zone};

    my $zone = $self->{zone}->listZone($zoneName, { requireSMF => 1 })
        or die "ERROR: zone '$zoneName' does not exist or not support SMF (is the zone root dataset mounted?).\n";

    if ($zone->{state} eq 'running') {
        return { cmd => [ $ZLOGIN, $zoneName ], shellquote => q{'"'} };
    }
    else {
        return { cmd => [], zpath => $zone->{zonepath}, shellquote => q{"} };
    }

    # just in case, should never reach here...
    return { cmd => [], shellquote => q{"} };
};

# public methods
sub refreshFMRI {
    my $self = shift;
    my $fmri = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    push @cmd, ($SVCCFG, '-s', $fmri, 'refresh');

    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot refresh FMRI '$fmri'\n";

    return 1;
}

sub listFMRI {
    my $self = shift;
    my $fmri = shift;
    my $opts = $_[0] // {};
    my @fmris;

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    $fmri ||= '*';

    # remove leading 'svc:/'
    $fmri =~ s/^svc:\///;

    my @cmd1 = (@cmd, $SVCCFG, 'list', $fmri);

    print STDERR '# ' . join(' ', @cmd1) . "\n" if $self->{debug};
    open my $fmris, '-|', @cmd1
        or die "ERROR: cannot get list of FMRI\n";

    while (my $elem = <$fmris>) {
        chomp $elem;
        push @fmris, "svc:/$elem" if !$opts->{instancesonly};

        my @cmd2 = (@cmd, $SVCCFG, '-s', $elem, 'list');

        open my $instances, '-|', @cmd2
            or die "ERROR: cannot get instances of '$elem'\n";

        while (<$instances>) {
            chomp;
            next if /:properties/;
            push @fmris, "svc:/$elem:$_";
        }
        close $instances;
    }

    return [ @fmris ];
}

sub fmriExists {
    my $self = shift;
    my $fmri = shift;
    my $opts = shift;

    # remove instance name
    my ($baseFmri) = $fmri =~ /^((?:svc:)?[^:]+)/;

    return grep { $fmri eq $_ } @{$self->listFMRI($baseFmri, $opts)};
}

sub fmriState {
    my $self = shift;
    my $fmri = shift;
    my $opts = shift;

    my @cmd = ($SVCS, $opts->{zonename} ? ('-z', $opts->{zonename}) : (), qw(-H -o state), $fmri);

    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    open my $fmris, '-|', @cmd
        or die "ERROR: cannot get list of FMRI\n";

    chomp(my $state = <$fmris>);
    return $state;
}

sub fmriOnline {
    my $self = shift;

    return $self->fmriState(shift, shift) eq 'online';
}

sub enable {
    my $self = shift;
    my $fmri = shift;

    $self->$svcAdm('enable', $fmri);
}

sub disable {
    my $self = shift;
    my $fmri = shift;

    $self->$svcAdm('disable', $fmri);
}

sub restart {
    my $self = shift;
    my $fmri = shift;

    $self->$svcAdm('restart', $fmri);
}

sub addFMRI {
    my $self = shift;
    my $fmri = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    # remove leading 'svc:/'
    $fmri =~ s/^svc:\///;

    push @cmd, ($SVCCFG, 'add', $fmri);

    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot add '$fmri'\n";
}

sub deleteFMRI {
    my $self = shift;
    my $fmri = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    push @cmd, ($SVCCFG, 'delete', $fmri);
    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot delete $fmri\n";
}

sub addInstance {
    my $self = shift;
    my $fmri = shift;
    my $instance = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    push @cmd, ($SVCCFG, '-s', $fmri, 'add', $instance);
    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot add instance '$instance' to $fmri\n";

    $self->addPropertyGroup("$fmri:$instance", 'general', 'framework', $opts);
    $self->setProperty("$fmri:$instance", 'general/complete', $instance, undef, $opts);
    $self->setProperty("$fmri:$instance", 'general/enabled',
        $opts->{enabled} ? 'true' : 'false', undef, $opts);
}

sub getPropertyGroups {
    my $self = shift;
    my $fmri = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    my $pg = [];
    push @cmd, ($SVCCFG, '-s', $fmri, 'listpg');

    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    open my $props, '-|', @cmd
        or die "ERROR: cannot get property group of FMRI '$fmri'\n";

    while (my $prop = <$props>){
        chomp $prop;
        my ($name, $type) = split /\s+/, $prop, 2;
        push @$pg, $name;
    }

    return $pg;
}

sub propertyExists {
    my $self = shift;
    my $fmri = shift;
    my $property = shift;
    my $opts = shift;

    # extract property group
    my ($pg) = $property =~ /^([^\/]+)/;

    return grep { $property eq $_ } keys %{$self->getProperties($fmri, $pg, $opts)};
}

sub propertyGroupExists {
    my $self = shift;
    my $fmri = shift;
    my $pg   = shift;
    my $opts = shift;

    return grep { $pg eq $_ } @{$self->getPropertyGroups($fmri, $opts)};
}

sub addPropertyGroup {
    my $self = shift;
    my $fmri = shift;
    my $pg   = shift;
    my $type = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    # set type to application if not specified
    $type //= 'application';

    return if $self->propertyGroupExists($fmri, $pg, $opts);

    push @cmd, ($SVCCFG, '-s', $fmri, 'addpg', $pg, $type);
    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot add property group to $fmri\n";
}

sub deletePropertyGroup {
    my $self = shift;
    my $fmri = shift;
    my $pg   = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    push @cmd, ($SVCCFG, '-s', $fmri, 'delpg', $pg);
    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot delete property group from $fmri\n";
}

sub setProperty {
    my $self = shift;
    my $fmri = shift;
    my $property = shift;
    my $value = shift;
    my $type  = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    # guess property type if not provided
    $type || do {
        $type = 'astring';

        for ($value){
            /^\d+$/ && do {
                $type = 'count';
                last;
            };

            /^(?:true|false)$/i && do {
                $type = 'boolean';
                last;
            };
        }
    };

    push @cmd, $self->propertyExists($fmri, $property, $opts) ?
        ($SVCCFG, '-s', $fmri, 'setprop', $property, '=',
            $zcmd->{shellquote} . $value . $zcmd->{shellquote})
        : ($SVCCFG, '-s', $fmri, 'addpropvalue', $property, "$type:",
            $zcmd->{shellquote} . $value . $zcmd->{shellquote});
    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    system(@cmd) and die "ERROR: cannot set property $property of $fmri\n";
}

sub setProperties {
    my $self = shift;
    my $fmri = shift;
    my $properties = shift;
    my $opts = shift;

    for my $key (keys %$properties){
        $self->setProperty($fmri, $key, $properties->{$key}, undef, $opts)
    }
}

sub getProperties {
    my $self = shift;
    my $fmri = shift;
    my $pg   = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    my $properties = {};

    push @cmd, ($SVCCFG, '-s', $fmri, 'listprop', $pg);

    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    open my $props, '-|', @cmd
        or die "ERROR: cannot get properties of FMRI '$fmri'\n";

    while (<$props>){
        chomp;
        my ($name, $type, $value) = split /\s+/, $_, 3;
        next if $name eq $pg;
        #remove quotes
        $value =~ s/^"|"$//g;
        $properties->{$name} = $value;

    }

    return $properties;
}

sub setFMRIProperties {
    my $self       = shift;
    my $fmri       = shift;
    my $properties = shift;
    my $opts = $_[0] // {};

    $self->addFMRI($fmri, $opts) if !$self->fmriExists($fmri, $opts);
    # extract property groups
    my @pg = map { $properties->{$_}->{members} ? $_ : () } keys %$properties;

    for my $pg (@pg) {
        $self->addPropertyGroup($fmri, $pg, $properties->{$pg}->{type}, $opts);
        for my $prop (keys %{$properties->{$pg}->{members}}) {
            $self->setProperty($fmri, "$pg/$prop",
                $properties->{$pg}->{members}->{$prop}->{value},
                $properties->{$pg}->{members}->{$prop}->{type},
                $opts);
        }
        delete $properties->{$pg};
    }

    for my $prop (keys %$properties) {
        $self->setProperty($fmri, $prop,
            $properties->{$prop}->{value},
            $properties->{$prop}->{type},
            $opts);
    }
}

sub getFMRIProperties {
    my $self = shift;
    my $fmri = shift;
    my $opts = $_[0] // {};

    my $zcmd = $self->$zoneCmd($opts->{zonename});
    my @cmd  = @{$zcmd->{cmd}};
    local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
        . '/root/etc/svc/repository.db' if $zcmd->{zpath};

    my $properties = {};

    push @cmd, ($SVCCFG, '-s', $fmri, 'listprop');

    print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
    open my $props, '-|', @cmd
        or die "ERROR: cannot get properties of FMRI\n";

    while (<$props>) {
        chomp;
        my ($pg, $prop, $type, $value) = /^(?:([-\w]+)\/)?([-\w]+)\s+([-\w]+)(?:\s+(.+))?$/;
        next if !$prop || !$type;
        # remove quotes from $value
        $value =~ s/^"|"$//g if $value;
        if ($pg) {
            $properties->{$pg}->{members}->{$prop}->{type} = $type;
            $properties->{$pg}->{members}->{$prop}->{value} = $value;
        }
        else {
            $properties->{$prop}->{type} = $type;
            $properties->{$prop}->{value} = $value // '';
        }
    }

    return $properties;
}

1;

__END__