1package Munin::Node::Configure::Plugin;
2
3use strict;
4use warnings;
5
6use Munin::Node::Utils qw(set_intersection set_difference);
7use Munin::Node::Configure::Debug;
8
9
10sub new
11{
12    my ($class, %opts) = @_;
13
14    my $name = delete $opts{name} or die "Must provide name\n";
15    my $path = delete $opts{path} or die "Must provide path\n";
16
17    my %plugin = (
18        name         => $name,      # the (base)name of the plugin
19        path         => $path,      # the full path to the plugin
20        default      => 'no',       # whether this plugin thinks it should be installed
21        installed    => [],         # list of installed services (as link names)
22        suggestions  => [],         # list of suggestions (as wildcards)
23        family       => 'contrib',  # the family it belongs to
24        capabilities => {},         # what capabilities it supports
25        errors       => [],         # list of errors reported against this plugin
26
27        %opts,
28    );
29
30    return bless \%plugin, $class;
31}
32
33
34################################################################################
35
36sub is_wildcard { return ((shift)->{path} =~ /_$/); }
37
38
39sub is_snmp     { return ((shift)->{name} =~ /^snmp(?:v3)?__/); }
40
41
42sub in_family { $_[0]->{family} eq $_  && return 1 foreach @_; return 0; }
43
44
45sub is_installed { return @{(shift)->{installed}} ? 'yes' : 'no'; }
46
47
48# report which services (link or wildcard) should be added, removed,
49# or left as they are.
50#   (remove) = (installed) \ (suggested)
51#   (add)    = (suggested) \ (installed)
52#   (same)   = (installed) ⋂ (suggested)
53sub _remove { set_difference(@_); }
54sub _add    { set_difference(reverse @_); }
55sub _same   { set_intersection(@_); }
56
57
58sub suggestion_string
59{
60    my ($self) = @_;
61
62    my $msg = '';
63
64    if ($self->{default} eq 'yes') {
65        my @suggestions = _same($self->_installed_wild, $self->_suggested_wild);
66        push @suggestions,
67            map { "+$_" } _add($self->_installed_wild, $self->_suggested_wild);
68        push @suggestions,
69            map { "-$_" } _remove($self->_installed_wild, $self->_suggested_wild);
70
71        $msg = ' (' . join(' ', @suggestions) . ')' if @suggestions;
72    }
73    elsif ($self->{defaultreason}) {
74        # Report why it's not being used
75        $msg = " [$self->{defaultreason}]";
76    }
77    elsif (! $self->{capabilities}->{autoconf} && ! $self->{capabilities}->{suggest}) {
78        $msg = " [[[ plugin has neither autoconf not suggest support ]]]";
79    }
80    elsif ( scalar @{$self->{errors}} != 0 ) {
81        $msg = " [[[ plugin has errors, see below ]]]";
82    }
83    else {
84        $msg = " [[[ plugin gave no reason why ]]]";
85    }
86
87    return $self->{default} . $msg;
88}
89
90
91sub installed_services_string { return join ' ', @{(shift)->_installed_wild}; }
92
93
94### Service name <-> wildcard conversion ###############################################
95# NOTE that these functions do not round-trip!
96
97# Extracts the wildcards from a service name and formats them in a user-friendly way.
98sub _reduce_wildcard
99{
100    my ($self, $link_name) = @_;
101    my $name = $self->{name};
102    my $wild;
103
104    if ($name =~ /^snmp(?:v3)?_(_\w+)/) {
105        $link_name =~ /^snmp(?:v3)?_(.+)$1(.*)/;
106        $wild = $1 . (length($2)? "/$2" : '');  # FIXME hack :-(
107    }
108    else {
109        ($wild = $link_name) =~ s/^$name//;
110    }
111    return length($wild)? $wild : ();  # FIXME more hack
112}
113
114
115# converts a wildcard to the appropriate service name
116sub _expand_wildcard
117{
118    my ($self, $suggestion) = @_;
119
120    if ($self->{name} =~ /^snmp__(\w+)/) {
121        my ($host, $wild) = @$suggestion;
122        $wild ||= '';
123        return 'snmp_' . $host . '_' . $1 . $wild;
124    }
125    else {
126        return $self->{name} . $suggestion;
127    }
128}
129
130
131# Converts a wildcard into a human-readable form
132sub _flatten_wildcard { return ref($_[0]) ? join('/', @{$_[0]}) : $_[0]; }
133
134
135################################################################################
136
137# return an arrayref of the installed and suggested service names (eg. 'memory'
138# or 'if_eth0')
139sub _installed_links { return (shift)->{installed}; }
140
141sub _suggested_links
142{
143    my ($self) = @_;
144
145    # no suggestions if the plugin shouldn't be installed
146    return [] if $self->{default} ne 'yes';
147
148    if ($self->is_wildcard or $self->is_snmp) {
149        return [ map { $self->_expand_wildcard($_) } @{$self->{suggestions}} ];
150    }
151    else {
152        return [ $self->{name} ];
153    }
154}
155
156
157# return an arrayref of the installed or suggested wildcards (eg. 'eth0' or
158# 'switch.example.com/1').  nothing is returned if the plugin contains no wildcards.
159sub _installed_wild { return [ map { $_[0]->_reduce_wildcard($_) } @{$_[0]->{installed}} ]; }
160sub _suggested_wild { return [ map { _flatten_wildcard($_) } @{(shift)->{suggestions}}   ]; }
161
162
163sub services_to_add
164{
165    my ($self) = @_;
166    return _add($self->_installed_links, $self->_suggested_links);
167}
168
169
170sub services_to_remove
171{
172    my ($self) = @_;
173    return _remove($self->_installed_links, $self->_suggested_links);
174}
175
176
177sub add_instance { push @{(shift)->{installed}}, shift; }
178
179
180sub add_suggestions { push @{(shift)->{suggestions}}, @_; }
181
182
183sub read_magic_markers
184{
185    my ($self) = @_;
186    my $PLUGIN;
187
188    DEBUG("\tReading magic markers.");
189
190    unless (open ($PLUGIN, '<', $self->{path})) {
191        DEBUG("Could not open plugin '$self->{path}' for reading: $!");
192        return;
193    }
194
195    while (<$PLUGIN>) {
196        if (/#%#\s+family\s*=\s*(\S+)\s*/) {
197            $self->{family} = $1;
198            DEBUG("\tSet family to '$1'." );
199        }
200        elsif (/#%#\s+capabilities\s*=\s*(.+)/) {
201            my @caps = split(/\s+/, $1);
202            @{$self->{capabilities}}{@caps} = (1) x scalar @caps;
203            DEBUG("\tCapabilities are: $1");
204        }
205    }
206    close ($PLUGIN);
207
208    # Some sanity-checks
209    $self->log_error(q{In family 'auto' but doesn't have 'autoconf' capability})
210        if ($self->{family} eq 'auto' and not $self->{capabilities}{autoconf});
211
212    $self->log_error(q{In family 'auto' but doesn't have 'autoconf' capability})
213        if ($self->{family} eq 'snmpauto' and not $self->{capabilities}{snmpconf});
214
215    $self->log_error(q{Has 'suggest' capability, but isn't a wildcard plugin})
216        if ($self->{capabilities}{suggest} and not $self->is_wildcard);
217
218    return;
219}
220
221
222### Parsing plugin responses ###################################################
223
224sub parse_autoconf_response
225{
226    my ($self, @response) = @_;
227
228    unless (scalar(@response) == 1) {
229        $self->log_error('Wrong amount of autoconf: expected 1 line, got ' . scalar(@response) . ' lines:');
230        $self->log_error('[start]' . join("[newline]", @response) . '[end]');
231        return;
232    }
233
234    my $line = shift @response;
235
236    unless ($line =~ /^(yes)$/
237         or $line =~ /^(no)(?:\s+\((.*)\))?\s*$/)
238    {
239        $self->log_error("Junk printed to stdout: '$line'");
240        return;
241    }
242
243    DEBUG("\tGot yes/no: $line");
244    $self->{default} = $1;
245    $self->{defaultreason} = $2;
246
247    return;
248}
249
250
251sub parse_suggest_response
252{
253    my ($self, @suggested) = @_;
254
255    foreach my $line (@suggested) {
256        if ($line =~ /^[-\w.:]+$/) {
257            DEBUG("\tAdded suggestion: $line");
258            $self->add_suggestions($line);
259        }
260        else {
261            $self->log_error("\tBad suggestion: '$line'");
262        }
263    }
264
265    return;
266}
267
268
269my $oid_pattern      = qr/^[0-9.]+[0-9]+$/;
270my $oid_root_pattern = qr/^[0-9.]+\.$/;
271
272sub parse_snmpconf_response
273{
274    my ($self, @response) = @_;
275
276    foreach my $line (@response) {
277        my ($key, $value) = $line =~ /(\w+)\s+(.+\S)/;
278
279        next unless $key and defined $value;
280
281        DEBUG("\tAnalysing line: $line");
282
283        if ($key eq 'require') {
284            my ($oid, $regex) = split /\s+/, $value, 2;
285
286            if ($oid =~ /$oid_root_pattern/) {
287                $oid =~ s/\.$//;
288                push @{ $self->{table} }, [$oid, $regex];
289
290                DEBUG("\tRegistered 'require': $oid");
291                DEBUG("\t\tFiltering on /$regex/") if $regex;
292            }
293            elsif ($oid =~ /$oid_pattern/) {
294                push @{ $self->{require_oid} }, [$oid, $regex];
295
296                DEBUG("\tRegistered 'require': $oid");
297                DEBUG("\t\tFiltering on /$regex/") if $regex;
298            }
299            else {
300                $self->log_error("Invalid format for 'require': $value");
301            }
302        }
303        elsif ($key eq 'index') {
304            if ($self->{index}) {
305                $self->log_error(q{'index' is already defined});
306                next;
307            }
308            unless ($value =~ /$oid_root_pattern/) {
309                $self->log_error(q{'index' must be an OID root});
310                next;
311            }
312            unless ($self->is_wildcard) {
313                $self->log_error(q{'index' only applies to double-wildcard SNMP plugins (ie. with a trailing '_').  Use 'require' instead.});
314                # it's valid, just suggest the author does s/index/require/
315            }
316
317            $value =~ s/\.$//;
318
319            # two copies.  one for checking requirements, the other for
320            # retrieving the indices
321            push @{ $self->{table} }, [ $value ];
322            $self->{index} = $value;
323
324            DEBUG("\tRegistered 'index'  : $value");
325        }
326        elsif ($key eq 'number') {
327            $self->log_error(q{'number' is no longer used.});
328        }
329        else {
330            $self->log_error("Couldn't parse line: $line");
331        }
332    }
333
334    if ($self->is_wildcard and !$self->{index}) {
335        $self->log_error(q{SNMP plugins with a trailing '_' need an index});
336        # FIXME: this should be fatal!
337    }
338
339    return;
340}
341
342
343### Debugging and error reporting ##############################################
344# Logs an error due to this plugin, and prints it out if debugging is on
345sub log_error
346{
347    my ($self, $msg) = @_;
348
349    chomp $msg;
350    push @{$self->{errors}}, $msg;
351    DEBUG($msg);
352
353    return;
354}
355
356
3571;
358
359__END__
360
361
362=head1 NAME
363
364Munin::Node::Configure::Plugin - Class representing a plugin, along with its
365installed and suggested services.
366
367
368=head1 SYNOPSIS
369
370  my $plugin = Munin::Node::Configure::Plugin->new();
371
372
373=head1 METHODS
374
375=over
376
377=item B<new(%args)>
378
379Constructor.
380
381Required arguments are 'name' and 'path', which should be the
382basename and full path of the plugin, respectively.
383
384
385=item B<is_wildcard()>
386
387Returns true if the plugin is a wildcard.  In the case of SNMP plugins,
388only double-wild plugins will return true (ie. 'snmp__memory' would
389return false, but 'snmp__if_' would return true).
390
391
392=item B<is_snmp()>
393
394Returns true if the plugin is an SNMP plugin.
395
396
397=item B<in_family(@families)>
398
399Returns true if plugin's family is in @families, false otherwise.
400
401
402=item B<is_installed()>
403
404Returns 'yes' if one or more links to this plugin exist in the service
405directory, 'no' otherwise.
406
407
408=item B<suggestion_string()>
409
410Returns a string detailing whether or not autoconf considers that the plugin
411should be installed.  The string may also report the reason why the plugin
412declined to be installed, or the list of suggestions it provided, if this
413information is available.
414
415
416=item B<installed_services_string()>
417
418Returns a string detailing which wildcards are installed for this plugin.
419
420
421=item B<services_to_add()>
422
423=item B<services_to_remove()>
424
425Return a list of service names that should be added or removed for this
426plugin.
427
428
429=item B<add_instance($name)>
430
431Associates a link from the service directory with this plugin.
432
433
434=item B<add_suggestions(@suggestions)>
435
436Adds @suggestions to the list of suggested wildcards for this plugin.  They
437are not validated.
438
439
440=item B<read_magic_markers()>
441
442Sets the family and capabilities from the magic markers embedded in the plugin's
443executable, as specified by
444L<http://munin-monitoring.org/wiki/ConcisePlugins#Magicmarkers>
445
446
447=item B<parse_autoconf_response(@response)>
448
449Parses and validates the autoconf response from the plugin, in the format
450specified by L<http://munin-monitoring.org/wiki/ConcisePlugins#autoconf>
451
452Invalid input will cause an error to be logged against the plugin.
453
454
455=item B<parse_suggest_response(@response)>
456
457Validates the suggestions from the plugin.
458
459Invalid suggestions will cause an error to be logged against the plugin.
460
461
462=item B<parse_snmpconf_response(@response)>
463
464Parses and validates the snmpconf response from the plugin, in the format
465specified by L<http://munin-monitoring.org/wiki/ConcisePlugins#suggest>
466
467Invalid or inconsistent input will cause an error to be logged against the
468plugin.
469
470
471=item B<log_error($message)>
472
473Logs an error for later retrieval.  The error will also be displayed if
474debugging output is enabled.
475
476
477=back
478
479=cut
480# vim: sw=4 : ts=4 : expandtab
481