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


line stmt bran cond sub pod time code
1             package Illumos::SMF;
2              
3 1     1   1155 use strict;
  1         2  
  1         24  
4 1     1   5 use warnings;
  1         2  
  1         5302  
5              
6             # version
7             our $VERSION = '0.1.5';
8              
9             # commands
10             my $SVCS = '/usr/bin/svcs';
11             my $SVCCFG = '/usr/sbin/svccfg';
12             my $SVCADM = '/usr/sbin/svcadm';
13             my $ZLOGIN = '/usr/sbin/zlogin';
14              
15             # constructor
16             sub new {
17 2     2 0 1229 my $class = shift;
18 2         4 my $self = { @_ };
19              
20             # add Illumos::Zone instance if zone support is required
21 2 100       8 $self->{zonesupport} && do {
22 1         2 eval {
23 1         515 require Illumos::Zones;
24             };
25 1 50       6 if ($@) {
26 1         129 die "ERROR: Unable to load package Illumos::Zones.";
27             }
28              
29 0         0 $self->{zone} = Illumos::Zones->new(debug => $self->{debug});
30             };
31            
32 1         4 return bless $self, $class
33             }
34             # private methods
35             my $svcAdm = sub {
36             my $self = shift;
37             my $cmd = shift;
38             my $fmri = shift;
39              
40             my @cmd = ($SVCADM, $cmd, $fmri);
41              
42             print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
43             system(@cmd) and die "ERROR: cannot $cmd '$fmri'\n";
44             };
45              
46             my $zoneCmd = sub {
47             my $self = shift;
48             my $zoneName = shift;
49              
50             print STDERR "WARNING: zonename specified but 'zonesupport' not enabled for Illumos::SMF\n"
51             . "use 'Illumos::SMF(zonesupport => 1)' to enable zone support\n" if $zoneName && !$self->{zone};
52              
53             return { cmd => [], shellquote => q{"} } if !$zoneName || !$self->{zone};
54              
55             my $zone = $self->{zone}->listZone($zoneName);
56             if ($zone && $zone->{state} eq 'running') {
57             return { cmd => [ $ZLOGIN, $zoneName ], shellquote => q{'"'} };
58             }
59             else {
60             return { cmd => [], zpath => $zone->{zonepath}, shellquote => q{"} };
61             }
62              
63             # just in case, should never reach here...
64             return { cmd => [], shellquote => q{"} };
65             };
66              
67             # public methods
68             sub refreshFMRI {
69 0     0 1   my $self = shift;
70 0           my $fmri = shift;
71 0   0       my $opts = $_[0] // {};
72            
73 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
74 0           my @cmd = @{$zcmd->{cmd}};
  0            
75             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
76 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
77              
78 0           push @cmd, ($SVCCFG, '-s', $fmri, 'refresh');
79              
80 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
81 0 0         system(@cmd) and die "ERROR: cannot refresh FMRI '$fmri'\n";
82            
83 0           return 1;
84             }
85              
86             sub listFMRI {
87 0     0 1   my $self = shift;
88 0           my $fmri = shift;
89 0   0       my $opts = $_[0] // {};
90 0           my @fmris;
91            
92 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
93 0           my @cmd = @{$zcmd->{cmd}};
  0            
94             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
95 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
96            
97 0   0       $fmri ||= '*';
98            
99             # remove leading 'svc:/'
100 0           $fmri =~ s/^svc:\///;
101              
102 0           my @cmd1 = (@cmd, $SVCCFG, 'list', $fmri);
103              
104 0 0         print STDERR '# ' . join(' ', @cmd1) . "\n" if $self->{debug};
105 0 0         open my $fmris, '-|', @cmd1
106             or die "ERROR: cannot get list of FMRI\n";
107              
108 0           while (my $elem = <$fmris>) {
109 0           chomp $elem;
110 0 0         push @fmris, "svc:/$elem" if !$opts->{instancesonly};
111            
112 0           my @cmd2 = (@cmd, $SVCCFG, '-s', $elem, 'list');
113              
114 0 0         open my $instances, '-|', @cmd2
115             or die "ERROR: cannot get instances of '$elem'\n";
116              
117 0           while (<$instances>) {
118 0           chomp;
119 0 0         next if /:properties/;
120 0           push @fmris, "svc:/$elem:$_";
121             }
122 0           close $instances;
123             }
124              
125 0           return [ @fmris ];
126             }
127              
128             sub fmriExists {
129 0     0 1   my $self = shift;
130 0           my $fmri = shift;
131 0           my $opts = shift;
132              
133             # remove instance name
134 0           my ($baseFmri) = $fmri =~ /^((?:svc:)?[^:]+)/;
135              
136 0           return grep { $fmri eq $_ } @{$self->listFMRI($baseFmri, $opts)};
  0            
  0            
137             }
138              
139             sub fmriState {
140 0     0 1   my $self = shift;
141 0           my $fmri = shift;
142 0           my $opts = shift;
143              
144 0 0         my @cmd = ($SVCS, $opts->{zonename} ? ('-z', $opts->{zonename}) : (), qw(-H -o state), $fmri);
145              
146 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
147 0 0         open my $fmris, '-|', @cmd
148             or die "ERROR: cannot get list of FMRI\n";
149              
150 0           chomp(my $state = <$fmris>);
151 0           return $state;
152             }
153              
154             sub fmriOnline {
155 0     0 1   my $self = shift;
156            
157 0           return $self->fmriState(shift, shift) eq 'online';
158             }
159              
160             sub enable {
161 0     0 1   my $self = shift;
162 0           my $fmri = shift;
163              
164 0           $self->$svcAdm('enable', $fmri);
165             }
166              
167             sub disable {
168 0     0 1   my $self = shift;
169 0           my $fmri = shift;
170              
171 0           $self->$svcAdm('disable', $fmri);
172             }
173              
174             sub restart {
175 0     0 1   my $self = shift;
176 0           my $fmri = shift;
177              
178 0           $self->$svcAdm('restart', $fmri);
179             }
180              
181             sub addFMRI {
182 0     0 1   my $self = shift;
183 0           my $fmri = shift;
184 0   0       my $opts = $_[0] // {};
185              
186 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
187 0           my @cmd = @{$zcmd->{cmd}};
  0            
188             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
189 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
190              
191             # remove leading 'svc:/'
192 0           $fmri =~ s/^svc:\///;
193              
194 0           push @cmd, ($SVCCFG, 'add', $fmri);
195              
196 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
197 0 0         system(@cmd) and die "ERROR: cannot add '$fmri'\n";
198             }
199              
200             sub deleteFMRI {
201 0     0 1   my $self = shift;
202 0           my $fmri = shift;
203 0   0       my $opts = $_[0] // {};
204              
205 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
206 0           my @cmd = @{$zcmd->{cmd}};
  0            
207             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
208 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
209              
210 0           push @cmd, ($SVCCFG, 'delete', $fmri);
211 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
212 0 0         system(@cmd) and die "ERROR: cannot delete $fmri\n";
213             }
214              
215             sub addInstance {
216 0     0 1   my $self = shift;
217 0           my $fmri = shift;
218 0           my $instance = shift;
219 0   0       my $opts = $_[0] // {};
220              
221 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
222 0           my @cmd = @{$zcmd->{cmd}};
  0            
223             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
224 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
225              
226 0           push @cmd, ($SVCCFG, '-s', $fmri, 'add', $instance);
227 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
228 0 0         system(@cmd) and die "ERROR: cannot add instance '$instance' to $fmri\n";
229              
230 0           $self->addPropertyGroup("$fmri:$instance", 'general', 'framework', $opts);
231 0           $self->setProperty("$fmri:$instance", 'general/complete', $instance, undef, $opts);
232             $self->setProperty("$fmri:$instance", 'general/enabled',
233 0 0         $opts->{enabled} ? 'true' : 'false', undef, $opts);
234             }
235              
236             sub getPropertyGroups {
237 0     0 1   my $self = shift;
238 0           my $fmri = shift;
239 0   0       my $opts = $_[0] // {};
240              
241 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
242 0           my @cmd = @{$zcmd->{cmd}};
  0            
243             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
244 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
245              
246 0           my $pg = [];
247 0           push @cmd, ($SVCCFG, '-s', $fmri, 'listpg');
248              
249 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
250 0 0         open my $props, '-|', @cmd
251             or die "ERROR: cannot get property group of FMRI '$fmri'\n";
252              
253 0           while (my $prop = <$props>){
254 0           chomp $prop;
255 0           my ($name, $type) = split /\s+/, $prop, 2;
256 0           push @$pg, $name;
257             }
258            
259 0           return $pg;
260             }
261              
262             sub propertyExists {
263 0     0 1   my $self = shift;
264 0           my $fmri = shift;
265 0           my $property = shift;
266 0           my $opts = shift;
267            
268             # extract property group
269 0           my ($pg) = $property =~ /^([^\/]+)/;
270              
271 0           return grep { $property eq $_ } keys %{$self->getProperties($fmri, $pg, $opts)};
  0            
  0            
272             }
273              
274             sub propertyGroupExists {
275 0     0 1   my $self = shift;
276 0           my $fmri = shift;
277 0           my $pg = shift;
278 0           my $opts = shift;
279              
280 0           return grep { $pg eq $_ } @{$self->getPropertyGroups($fmri, $opts)};
  0            
  0            
281             }
282              
283             sub addPropertyGroup {
284 0     0 1   my $self = shift;
285 0           my $fmri = shift;
286 0           my $pg = shift;
287 0           my $type = shift;
288 0   0       my $opts = $_[0] // {};
289            
290 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
291 0           my @cmd = @{$zcmd->{cmd}};
  0            
292             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
293 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
294            
295             # set type to application if not specified
296 0   0       $type //= 'application';
297              
298 0 0         return if $self->propertyGroupExists($fmri, $pg, $opts);
299              
300 0           push @cmd, ($SVCCFG, '-s', $fmri, 'addpg', $pg, $type);
301 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
302 0 0         system(@cmd) and die "ERROR: cannot add property group to $fmri\n";
303             }
304              
305             sub deletePropertyGroup {
306 0     0 1   my $self = shift;
307 0           my $fmri = shift;
308 0           my $pg = shift;
309 0   0       my $opts = $_[0] // {};
310            
311 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
312 0           my @cmd = @{$zcmd->{cmd}};
  0            
313             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
314 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
315            
316 0           push @cmd, ($SVCCFG, '-s', $fmri, 'delpg', $pg);
317 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
318 0 0         system(@cmd) and die "ERROR: cannot delete property group from $fmri\n";
319             }
320              
321             sub setProperty {
322 0     0 1   my $self = shift;
323 0           my $fmri = shift;
324 0           my $property = shift;
325 0           my $value = shift;
326 0           my $type = shift;
327 0   0       my $opts = $_[0] // {};
328            
329 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
330 0           my @cmd = @{$zcmd->{cmd}};
  0            
331             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
332 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
333              
334             # guess property type if not provided
335 0 0         $type || do {
336 0           $type = 'astring';
337              
338 0           for ($value){
339 0 0         /^\d+$/ && do {
340 0           $type = 'count';
341 0           last;
342             };
343              
344 0 0         /^(?:true|false)$/i && do {
345 0           $type = 'boolean';
346 0           last;
347             };
348             }
349             };
350              
351             push @cmd, $self->propertyExists($fmri, $property, $opts) ?
352             ($SVCCFG, '-s', $fmri, 'setprop', $property, '=',
353             $zcmd->{shellquote} . $value . $zcmd->{shellquote})
354             : ($SVCCFG, '-s', $fmri, 'addpropvalue', $property, "$type:",
355 0 0         $zcmd->{shellquote} . $value . $zcmd->{shellquote});
356 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
357 0 0         system(@cmd) and die "ERROR: cannot set property $property of $fmri\n";
358             }
359              
360             sub setProperties {
361 0     0 1   my $self = shift;
362 0           my $fmri = shift;
363 0           my $properties = shift;
364 0           my $opts = shift;
365              
366 0           for my $key (keys %$properties){
367 0           $self->setProperty($fmri, $key, $properties->{$key}, undef, $opts)
368             }
369             }
370              
371             sub getProperties {
372 0     0 1   my $self = shift;
373 0           my $fmri = shift;
374 0           my $pg = shift;
375 0   0       my $opts = $_[0] // {};
376            
377 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
378 0           my @cmd = @{$zcmd->{cmd}};
  0            
379             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
380 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
381              
382 0           my $properties = {};
383              
384 0           push @cmd, ($SVCCFG, '-s', $fmri, 'listprop', $pg);
385              
386 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
387 0 0         open my $props, '-|', @cmd
388             or die "ERROR: cannot get properties of FMRI '$fmri'\n";
389              
390 0           while (<$props>){
391 0           chomp;
392 0           my ($name, $type, $value) = split /\s+/, $_, 3;
393 0 0         next if $name eq $pg;
394             #remove quotes
395 0           $value =~ s/^"|"$//g;
396 0           $properties->{$name} = $value;
397              
398             }
399            
400 0           return $properties;
401             }
402              
403             sub setFMRIProperties {
404 0     0 1   my $self = shift;
405 0           my $fmri = shift;
406 0           my $properties = shift;
407 0   0       my $opts = $_[0] // {};
408            
409 0 0         $self->addFMRI($fmri, $opts) if !$self->fmriExists($fmri, $opts);
410             # extract property groups
411 0 0         my @pg = map { $properties->{$_}->{members} ? $_ : () } keys %$properties;
  0            
412              
413 0           for my $pg (@pg) {
414 0           $self->addPropertyGroup($fmri, $pg, $properties->{$pg}->{type}, $opts);
415 0           for my $prop (keys %{$properties->{$pg}->{members}}) {
  0            
416             $self->setProperty($fmri, "$pg/$prop",
417             $properties->{$pg}->{members}->{$prop}->{value},
418             $properties->{$pg}->{members}->{$prop}->{type},
419 0           $opts);
420             }
421 0           delete $properties->{$pg};
422             }
423              
424 0           for my $prop (keys %$properties) {
425             $self->setProperty($fmri, $prop,
426             $properties->{$prop}->{value},
427             $properties->{$prop}->{type},
428 0           $opts);
429             }
430             }
431              
432             sub getFMRIProperties {
433 0     0 1   my $self = shift;
434 0           my $fmri = shift;
435 0   0       my $opts = $_[0] // {};
436            
437 0           my $zcmd = $self->$zoneCmd($opts->{zonename});
438 0           my @cmd = @{$zcmd->{cmd}};
  0            
439             local $ENV{SVCCFG_REPOSITORY} = $zcmd->{zpath}
440 0 0         . '/root/etc/svc/repository.db' if $zcmd->{zpath};
441              
442 0           my $properties = {};
443              
444 0           push @cmd, ($SVCCFG, '-s', $fmri, 'listprop');
445              
446 0 0         print STDERR '# ' . join(' ', @cmd) . "\n" if $self->{debug};
447 0 0         open my $props, '-|', @cmd
448             or die "ERROR: cannot get properties of FMRI\n";
449              
450 0           while (<$props>) {
451 0           chomp;
452 0           my ($pg, $prop, $type, $value) = /^(?:([-\w]+)\/)?([-\w]+)\s+([-\w]+)(?:\s+(.+))?$/;
453 0 0 0       next if !$prop || !$type;
454             # remove quotes from $value
455 0 0         $value =~ s/^"|"$//g if $value;
456 0 0         if ($pg) {
457 0           $properties->{$pg}->{members}->{$prop}->{type} = $type;
458 0           $properties->{$pg}->{members}->{$prop}->{value} = $value;
459             }
460             else {
461 0           $properties->{$prop}->{type} = $type;
462 0   0       $properties->{$prop}->{value} = $value // '';
463             }
464             }
465              
466 0           return $properties;
467             }
468              
469             1;
470              
471             __END__