This file is indexed.

/usr/share/perl5/Munin/Plugin/Pgsql.pm is in munin-node 1.4.6-3ubuntu3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
# -*- cperl -*-
#
# Copyright (C) 2009 Magnus Hagander, Redpill Linpro AB
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; version 2 dated June,
# 1991.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 USA.

# This Module is user documented inline, interspersed with code with
# perlpod.


# $Id: Pgsql.pm 4063 2010-12-16 14:46:08Z mha $

=head1 NAME

Munin::Plugin::Pgsql - Base module for PostgreSQL plugins for Munin

=head1 SYNOPSIS

The Munin::Plugin::Pgsql module provides base functionality for all
PostgreSQL Munin plugins, including common configuration parameters.

=head1 CONFIGURATION

All configuration is done through environment variables.

=head1 ENVIRONMENT VARIABLES

All plugins based on Munin::Plugin::Pgsql accepts all the environment
variables that libpq does. The most common ones used are:

 PGHOST      hostname to connect to, or path to Unix socket
 PGPORT      port number to connect to
 PGUSER      username to connect as
 PGPASSWORD  password to connect with, if a password is required

The plugins will always connect to the 'template1' database, except for
wildcard per-database plugins.

=head2 Example

 [postgres_*]
    user postgres
    env.PGUSER postgres
    env.PGPORT 5433

=head1 WILDCARD MATCHING

Wildcard plugins based on this module will match on whatever type of object
specifies for a filter, usually a database. If the object name ALL is used
(for example, a symlink to postgres_connections_ALL), the filter will not be
applied, and the plugin behaves like a non-wildcard one.

=head1 REQUIREMENTS

The module requires DBD::Pg to work.

=head1 TODO

Support for using psql instead of DBD::Pg, to remove dependency.

=head1 BUGS

No known bugs at this point.

=head1 SEE ALSO

L<DBD::Pg>

=head1 AUTHOR

Magnus Hagander <magnus@hagander.net>, Redpill Linpro AB

=head1 COPYRIGHT/License.

Copyright (c) 2009 Magnus Hagander, Redpill Linpro AB

All rights reserved. This program is free software; you can
redistribute it and/or modify it under the terms of the GNU General
Public License as published by the Free Software Foundation; version 2
dated June, 1991.

=head1 API DOCUMENTATION

The following functions are available to plugins using this module.

=cut

package Munin::Plugin::Pgsql;

use strict;
use warnings;

use Munin::Plugin;

=head2 Initialization

 use Munin::Plugin::Pgsql;
 my $pg = Munin::Plugin::Pgsql->new(
    parameter=>value,
    parameter=>value
 );

=head3 Parameters

 minversion     Minimum PostgreSQL version required, formatted like 8.2. If the
                database is an older version than this, the plugin will exit
                with an error.
 title          The title for this plugin. Copied directly to the config output.
 info           The info for this plugin. Copied directly to the config output.
 vlabel         The vertical label for the graph. Copied directly to the config
                output.
 basename       For wildcard plugins, this is the base name of the plugin,
                including the trailing underscore.
 basequery      SQL query run to get the plugin values. The query should return
                two columns, one being the name of the counter and the second
                being the current value for the counter.
 pivotquery     Set to 1 to indicate that the query in basequery returns a single
                row, with one field for each counter. The name of the counter is
                taken from the returned column name, and the value from the
                first row in the result.
 configquery    SQL query run to generate the configuration information for the
                plugin. The query should return at least two columns, which are
                the name of the counter and the label of the counter. If
                a third column is present, it will be used as the info
                parameter.
 suggestquery   SQL query to run to generate the list of suggestions for a
                wildcard plugin. Don't forget to include ALL if the plugin
                supports aggregate statistics.
 graphdraw      The draw parameter for the graph. The default is LINE1.
 graphtype      The type parameter for the graph. The default is GAUGE.
 graphperiod    The period for the graph. Copied directly to the config output.
 graphmin       The min parameter for the graph. The default is no minimum.
 graphmax       The max parameter for the graph. The default is no maximum.
 stack          If set to 1, all counters except the first one will be written
                with a draw type of STACK.
 base           Used for graph_args --base. Default is 1000, set to 1024 when
                returning sizes in Kb for example.
 wildcardfilter The SQL to substitute for when a wildcard plugin is run against
                a specific entity, for example a database. All occurrances of
                the string %%FILTER%% will be replaced with this string, and
                for each occurance a parameter with the value of the filtering
                condition will be added to the DBI statement.
 paramdatabase  Makes the plugin connect to the database in the first parameter
                (wildcard plugins only) instead of 'postgres'.
 extraconfig    This string is copied directly into the configuration output
                when the plugin is run in config mode, allowing low-level
                customization.

=head3 Specifying queries

Queries specified in one of the parameters above can take one of two forms.
The easiest one is a simple string, which will then always be executed,
regardless of server version. The other form is an array, looking like this:
 [
  "SELECT 'default',... FROM ...",
  [
    "8.3", "SELECT 'query for 8.3 or earlier',... FROM ...",
    "8.1", "SELECT 'query for 8.1 or earlier',... FROM ..."
  ]
 ]
This array is parsed from top to bottom, so the entires must be in order of
version number. The *last* value found where the version specified is higher
than or equal to the version of the server will be used (yes, it counts
backwards).

=cut

sub new {
    my ($class) = shift;
    my (%args)  = @_;

    my %defaults = (
        base      => 1000,
        graphdraw => 'LINE1',
        graphtype => 'GAUGE'
    );

    my $self = {
        minversion     => $args{minversion},
        basename       => $args{basename},
        basequery      => $args{basequery},
        title          => $args{title},
        info           => $args{info},
        vlabel         => $args{vlabel},
        graphdraw      => $args{graphdraw},
        graphtype      => $args{graphtype},
        graphperiod    => $args{graphperiod},
        graphmin       => $args{graphmin},
        graphmax       => $args{graphmax},
        stack          => $args{stack},
        configquery    => $args{configquery},
        base           => $args{base},
        wildcardfilter => $args{wildcardfilter},
        suggestquery   => $args{suggestquery},
        pivotquery     => $args{pivotquery},
        paramdatabase  => $args{paramdatabase},
        extraconfig    => $args{extraconfig},
    };

    foreach my $k (keys %defaults) {
        unless (defined $self->{$k}) {
            $self->{$k} = $defaults{$k};
        }
    }
    return bless $self, $class;
}

sub Config {
    my ($self) = @_;

    $self->ensure_version();

    my $w = $self->wildcard_parameter();
    if ($w) {
      print "graph_title $self->{title} ($w)\n";
    }
    else {
      print "graph_title $self->{title}\n";
    }
    print "graph_vlabel $self->{vlabel}\n";
    print "graph_category PostgreSQL\n";
    print "graph_info $self->{info}\n";
    print "graph_args --base $self->{base}";
    print " -l $self->{graphmin}" if (defined $self->{graphmin});
    print "\n";
    print "graph_period $self->{graphperiod}\n" if ($self->{graphperiod});
    print "$self->{extraconfig}\n"              if ($self->{extraconfig});

    my $firstrow = 1;
    my ($q, @p)
        = $self->replace_wildcard_parameters(
        $self->get_versioned_query($self->{configquery}));
    foreach my $row (@{$self->runquery($q, \@p)}) {
        my $l = Munin::Plugin::clean_fieldname($row->[0]);
        print "$l.label $row->[1]\n";
        print "$l.info $row->[2]\n" if (defined $row->[2]);
        print "$l.type $self->{graphtype}\n";
        if ($self->{stack} && !$firstrow) {
            print "$l.draw STACK\n";
        }
        else {
            print "$l.draw $self->{graphdraw}\n";
        }
        print "$l.min $self->{graphmin}\n" if (defined $self->{graphmin});
        print "$l.max $self->{graphmax}\n" if (defined $self->{graphmax});
        $firstrow = 0;
    }
}

sub Autoconf {
    my ($self) = @_;

    if (!$self->connect(1, 1)) {
        print "no ($self->{connecterror})\n";
        return 1;
    }

    # Check minimum version, if it applies
    if ($self->{minversion}) {
        $self->get_version();
        if ($self->{detected_version} < $self->{minversion}) {
            print
                "no (version $self->{detected_version} is less than the required $self->{minversion})\n";
            return 1;
        }
    }

    # More magic needed?
    print "yes\n";
    return 0;
}

sub Suggest {
    my ($self) = @_;

    if (!$self->connect(1, 1)) {
        return 0;
    }

    $self->ensure_version();
    if ($self->{suggestquery}) {
        my $r = $self->runquery($self->{suggestquery});
        foreach my $row (@$r) {
            print $row->[0] . "\n";
        }
        return 0;
    }
    die "Plugin can't do suggest, why did you try?\n";
}

sub GetData {
    my ($self) = @_;
    $self->ensure_version();
    if ($self->{basequery}) {
        my ($q, @p)
            = $self->replace_wildcard_parameters(
            $self->get_versioned_query($self->{basequery}));
        my $r = $self->runquery($q, \@p, $self->{pivotquery});
        foreach my $row (@$r) {
            my $l = Munin::Plugin::clean_fieldname($row->[0]);
            print $l . ".value " . $row->[1] . "\n";
        }
        return;
    }
    die "No query configured!";
}

=head2 Processing

 $pg->Process();

 This command executes the plugin. It will automatically parse the ARGV array
 for commands given by Munin.

=cut

sub Process {
    my ($self) = @_;

    if (defined $ARGV[0] && $ARGV[0] ne '') {
        if ($ARGV[0] eq 'autoconf') {
            return $self->Autoconf();
        }
        elsif ($ARGV[0] eq 'config') {
            return $self->Config();
        }
        elsif ($ARGV[0] eq 'suggest') {
            return $self->Suggest();
        }
        else {
            print "Unknown command: '$ARGV[0]'\n";
            return 1;
        }
    }

    return $self->GetData();
}

# Internal useful functions
sub connect() {
    my ($self, $noexit, $nowildcard) = @_;

    my $r = $self->_connect($nowildcard);
    return 1 if ($r);         # connect successful
    return 0 if ($noexit);    # indicate failure but don't exit
    print "Failed to connect to database: $self->{connecterror}\n";
    exit(1);
}

sub _connect() {
    my ($self, $nowildcard) = @_;

    return 1 if ($self->{dbh});

    if (eval "require DBI; require DBD::Pg;") {

        # Always connect to database template1, because it exists on both old
        # and new versions of PostgreSQL, unless the database should be controlled
        # by the first parameter.
        # All other connection parameters are controlled by the libpq environment
        # variables.
        my $dbname = "template1";
        $dbname = $self->wildcard_parameter(0) if ($self->{paramdatabase} && !defined($nowildcard));
        $self->{dbh} = DBI->connect("DBI:Pg:dbname=$dbname");
        unless ($self->{dbh}) {
            $self->{connecterror} = "$DBI::errstr";
            return 0;
        }
    }
    else {
        $self->{connecterror} = "DBD::Pg not found, and cannot do psql yet";
        return 0;
    }
    return 1;
}

sub runquery {
    my ($self, $query, $params, $pivot) = @_;
    $self->connect();
    if ($self->{dbh}) {

        # Run query on DBI
        my $s = $self->{dbh}->prepare($query);
        my $r = $s->execute(@$params);
        unless ($r) {
            print "Query failed!\n";
            exit(1);
        }
        if ($pivot) {

            # Query returning a single row with one column for each counter
            # Turn this into a regular resultset
            my $r     = [];
            my @dbrow = $s->fetchrow_array();
            for (my $i = 0; $i < scalar(@dbrow); $i++) {
                push @$r, [$s->{NAME}->[$i], $dbrow[$i]];
            }
            return $r;
        }
        else {
            return $s->fetchall_arrayref();
        }
    }
    die "Don't know how to run without DBI yet!\n";
}

sub get_version {
    my ($self) = @_;

    return if (defined $self->{detected_version});

    my $r = $self->runquery("SELECT version()");
    my $v = $r->[0]->[0];
    die "Unable to detect PostgreSQL version\n"
        unless ($v =~ /^PostgreSQL (\d+)\.(\d+)\.(\d+) on/);
    $self->{detected_version} = "$1.$2";
}

sub get_versioned_query {
    my ($self, $query) = @_;
    $self->get_version();
    if (ref($query) eq "ARRAY") {
        my $rq = undef;
        foreach my $entry (@$query) {
            if (!defined($rq)) {

                # First row must always be a scalar
                die "First available query must be unconditional"
                    unless (ref($entry) eq "");
                $rq = $entry;
                next;
            }
            die "Non-first available queries must be version conditional!"
                unless (ref($entry) eq "ARRAY");
            if ($self->{detected_version} <= @$entry[0]) {

                # We are running against a server that's this version or older, so change
                # to using this query.
                $rq = @$entry[1];
            }
        }
        return $rq;
    }
    else {
        return $query;
    }
}

sub ensure_version {
    my ($self) = @_;

    if ($self->{minversion}) {
        $self->get_version();
        if ($self->{detected_version} < $self->{minversion}) {
            die
                "This plugin requires PostgreSQL $self->{minversion} or newer!\n";
        }
    }
}

sub replace_wildcard_parameters {
    my ($self, $q) = @_;
    my @p = ();

    my $w = $self->wildcard_parameter();
    if ($w) {
        while ($q =~ s/%%FILTER%%/$self->{wildcardfilter}/) {
            push @p, $self->wildcard_parameter();
        }
    }
    else {

        # Not called as a wildcard, or called with "all" - remove filter spec
        $q =~ s/%%FILTER%%//g;
    }

    # PARAM replacements are done without placeholders, so they can modify
    # the query itself.
    if ($self->wildcard_parameter(-1)) {
        my @pieces = split /:/, $self->wildcard_parameter(-1);
        for (my $i = 0; $i <= $#pieces; $i++) {
            while ($q =~ s/%%PARAM$i%%/$pieces[$i]/) {
            }
        }
    }
    return ($q, @p);
}

sub wildcard_parameter {
    my ($self, $paramnum) = @_;

    return undef unless (defined $self->{basename});

    $paramnum = 0 unless (defined $paramnum);
    if ($0 =~ /$self->{basename}(.*)$/) {

        # If asking for first parameter, and there's no filter on it,
        # return undef.
        return undef if ($1 eq "ALL" && $paramnum == 0);

        # If asking for unsplit, return that (internal use only, really)
        return $1 if ($paramnum == -1);

        # Otherwise, split the string again on colon, and return the
        # selected piece.
        my @pieces = split /:/, $1;
        if (scalar(@pieces) < $paramnum + 1) {
            die "Piece $paramnum not found in wildcard parameter.\n";
        }
        return $pieces[$paramnum];
    }
    die "Wildcard base not found in called filename!\n";
}

1;