Adding upstream version 258.upstream/258

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 184 insertions, 0 deletions

diff --git a/pg_lsclusters b/pg_lsclusters
new file mode 100755
index 0000000..fec09d7
--- /dev/null
+++ b/pg_lsclusters
@@ -0,0 +1,184 @@
+#!/usr/bin/perl -wT
+# Show all PostgreSQL clusters in a list
+#
+# (C) 2005-2009 Martin Pitt <mpitt@debian.org>
+# (C) 2013-2018 Christoph Berg <myon@debian.org>
+#
+#  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; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  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.
+
+use strict;
+use PgCommon;
+use Getopt::Long;
+
+sub help ($)
+{
+    my $exit = shift;
+    print "Usage: $0 [-hjs]
+
+Options:
+  -h --no-header   Omit column headers in output
+  -j --json        JSON output
+  -s --start-conf  Include start.conf information in status column
+     --help        Print help\n";
+
+     exit $exit;
+}
+
+# option handling
+my $no_header;
+my $json;
+my $start_conf;
+help(1) unless GetOptions (
+    'help' => sub { help(0); },
+    'h|no-header' => \$no_header,
+    'j|json' => \$json,
+    's|start-conf' => \$start_conf,
+);
+
+my (@versions, $ls_cluster);
+if (@ARGV == 1 and $ARGV[0] =~ m{^(\d+(?:\.\d+)?)[-/]([-.\w]+)$}) {
+    push @versions, $1;
+    $ls_cluster = $2;
+} elsif (@ARGV >= 1) {
+    $ARGV[0] =~ /^(\d+(?:\.\d+)?)$/ or error "Invalid version number \"$ARGV[0]\"";
+    push @versions, $1;
+} else {
+    @versions = get_versions();
+}
+if (@ARGV >= 2 and $ARGV[1] =~ /^([-.\w]+)$/) {
+    $ls_cluster = $1;
+}
+
+error "Cluster @versions $ls_cluster does not exist"
+    if ($ls_cluster and not cluster_exists(@versions, $ls_cluster));
+
+# data collection
+my @lines;
+push @lines, ['Ver', 'Cluster', 'Port', 'Status', 'Owner', 'Data directory', 'Log file']
+    unless ($no_header);
+my $jsoninfo = [];
+
+foreach my $v (@versions) {
+    my $pg_log = $v >= 10 ? 'log' : 'pg_log'; # log directory in PGDATA changed in PG 10
+    my @clusters = $ls_cluster ? $ls_cluster : get_version_clusters $v;
+    foreach my $c (@clusters) {
+        my %info = cluster_info $v, $c;
+
+        my $status = $info{'running'} ? "online" : "down";
+        $status .= ",recovery" if ($info{'recovery'});
+        $status .= ",$info{supervisor}" if ($info{'supervisor'});
+        $status .= ",$info{start}" if ($start_conf);
+        unless (-e "${PgCommon::binroot}$v/bin/postgres") {
+            $status .= ",binaries_missing";
+            $info{binaries_missing} = 1;
+        }
+
+        my $logfile = $info{logfile} // '<unknown>'; # default logfile in /var/log/postgresql
+        if (config_bool ($info{config}->{logging_collector})) {
+            my $path = $info{config}->{log_directory} || $pg_log;
+            my $file = $info{config}->{log_filename} || 'postgresql-%Y-%m-%d_%H%M%S.log';
+            $logfile = "$path/$file";
+        }
+        my $destination = $info{config}->{log_destination} || 'stderr';
+        $destination =~ s/stderr/$logfile/;
+        my $csvlog = $logfile;
+        $csvlog =~ s/(?:\.log)?$/.csv/;
+        $destination =~ s/csvlog/$csvlog/;
+
+        push @lines, [$v, $c, $info{'port'} // '<unknown>', $status,
+            defined $info{'owneruid'} ? (getpwuid $info{'owneruid'})[0] : '<unknown>',
+            $info{'pgdata'} || '<unknown>', $destination];
+        $info{version} = $v;
+        $info{cluster} = $c;
+        push @$jsoninfo, \%info;
+    }
+}
+
+# output
+if ($json) {
+    eval { require JSON; };
+    error 'Please install JSON.pm for JSON output (Debian: libjson-perl)'
+        if ($@);
+    print JSON::encode_json($jsoninfo) . "\n";
+    exit 0;
+}
+
+my @colwidth = qw(1 1 1 1 1 1 1);
+foreach my $line (@lines) {
+    for (my $i = 0; $i < @$line - 1; $i++) { # skip adjustment for last column
+        my $len = length @$line[$i];
+        $colwidth[$i] = $len if ($len > $colwidth[$i]);
+    }
+}
+
+my $color = -t 1; # color output if stdout is a terminal
+my $fmtstring = join ' ', map { "%-${_}s" } @colwidth;
+
+foreach my $line (@lines) {
+    if ($color and $line->[0] ne 'Ver') { # don't color header
+        printf "\033[%dm$fmtstring\033[0m\n",
+            ($line->[3] =~ /^online/ ? 32 : 31), # green, red
+            @$line;
+    } else {
+        printf "$fmtstring\n", @$line;
+    }
+}
+
+__END__
+
+=head1 NAME
+
+pg_lsclusters - show information about all PostgreSQL clusters
+
+=head1 SYNOPSIS
+
+B<pg_lsclusters> [I<options>] [I<version> [I<cluster>]]
+
+=head1 DESCRIPTION
+
+This command list the status and some configuration details of all clusters.
+If a version and optionally a cluster name are given, only these are shown.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-h>, B<--no-header>
+
+Do not print the column header line.
+
+=item B<-j>, B<--json>
+
+Output information in JSON format. Needs JSON.pm installed.
+(Debian package: libjson-perl)
+
+=item B<-s>, B<--start-conf>
+
+Include F<start.conf> information in status column.
+
+=item B<--help>
+
+Print usage help.
+
+=back
+
+=head1 NOTES
+
+The cluster status is shown as B<online> or B<down>. If a F<recovery.conf> file
+is found in the data directory, B<,recovery> is appended. The latter needs read
+access to the data directory, which only root and the cluster owner have.
+
+The output lines are colored green and red to indicate the cluster status
+visually.
+
+=head1 AUTHOR
+
+Martin Pitt L<E<lt>mpitt@debian.orgE<gt>>