Monitoring the logs in real-time on the command line, can also be very useful when debugging either the rules themselves or when analyzing certain issues. Rather than just looking at the logs, in some situations it might be useful to track the rate of the log messages. A self-written Perl script can be useful as it allows to be flexible when it comes to:

• parsing logs
• formatting the output (with colors or tables or …)
• calculating statistics
• …

The following Perl script uses a few modules which need to be present:

use IO::Async::Timer::Periodic;
use IO::Async::Loop;
use Time::HiRes qw/time/;
use Term::ANSIColor qw(:constants);
use Getopt::Long;

The first two modules can be installed on Debian systems with:

apt install libio-async-perl

The others are part of the normal Perl packages and do not require any extra installation.

Next the script will use a polling mechanism to read from standard output at fixed intervals, to calculate the rate of the unique log lines. The default polling rate is set to 2 seconds but it can be managed through command line parameters:

my $last_poll_time = time;

my $poll_rate = 2;
GetOptions (
    'p|pollrate=i' => \$poll_rate,
);

my $loop = IO::Async::Loop->new;
my $timer = IO::Async::Timer::Periodic->new(
   interval => $poll_rate,
   on_tick  => \&log_rate
);

$timer->start;
$loop->add( $timer );
$loop->run;

Finally, the script will define a subroutine called log_rate, which will read from standard output (or even a file) at each poll interval. Important is of course that the log lines from standard output do not contain unique data such as timestamps. The output must be as generic as possible.

Example:

tail -qf /var/log/ulog/blocked_detailed.json /var/log/ulog/blocked.json /var/log/ulog/passed.json  | jq -r --unbuffered '."oob.prefix"' 
blocked: invalid state
blocked: invalid state
blocked: invalid state
blocked: invalid state
blocked: invalid state
action=blocked
action=blocked
action=blocked
action=blocked
action=blocked
action=passed
action=passed
action=passed
action=passed

The code snippit for log_rate could contain:

sub log_rate {
    local $SIG{ALRM} = sub { die time, " time exceeded to read STDIN\n" };

    alarm($poll_rate);
    my $h;
    eval {
        local $| = 1;
        while (my $line = <>) {
            chomp($line);
            $h->{$line}++;
        }
    };
    alarm(0);

    return unless keys %$h;

    my $delta_time = time - $last_poll_time;
    print DARK WHITE . sprintf("%d: ", time) . RESET;
    print( BOLD WHITE . $_ ." [" . GREEN . sprintf("%.2f/s", $h->{$_}/$delta_time) . BOLD WHITE "] | " . RESET) foreach keys %$h; 
    print "\n";

    $last_poll_time = time;
}

Line 2 will start with declaring the “ALARM” signal. This signal is called when the alarm timeout has been reached (see further below).

Line 4 defines the alarm timeout in seconds: meaning: if everything below line 4 (until the next alarm line) takes longer than the defined timeout in seconds, the “ALRM” signal handler defined at line 2 will be called, which basically stops the code execution with a die (which in theory should stop the script with an exit 1).

Line 5 defines a hash reference which is required down below, to temporarily store unique log lines.

Line 6 until 12 define an eval block. The eval block will catch the ALRM signal die (once reached) without stopping the script with an exit 1. Inside the eval block, the standard output will be read with the diamond operator (<>) and unique lines will be counted and stored in the $h hash reference.

Line 13, right after the eval block, sets to alarm timeout to 0 again, which means it is disabled. This allows that only execution of the eval block will be evaluated for timeout.

Line 15 ensures that only when log lines were discovered and stored in the temporary hash-ref $h, that rates will be printed to the screen.

The rest of the code will take care of printing the discovered log lines with their rates to the screen. Colors from Term::ANSIColor are used to make the output more vivid.

Example output:

The full version of the script can be found at: https://github.com/insani4c/perl_tools/tree/master/log_rate

The PostgreSQL tool used for those backups is ‘pg_dump‘ and I have used Perl to script all the interesting stuff together.

The script will basically go through the following steps:

• Check the backup path for the required directories (and if not, create them)
• Rotate old backups based on thresholds
• Create a new backup

The script shown below is just an example and probably needs to be adopted for your own needs. The script works for me and the environment it was created in.

First things first.
The script uses the following Perl modules:

use DateTime;
use Pod::Usage;
use YAML qw/LoadFile/;
use File::Path qw/make_path/;
use File::Copy;
use Data::Dumper;
use POSIX qw/setuid/;

A YAML configuration file is used to provide the script with essential information. An example configuration file looks like the following:

thresholds:
    daily: 7
    weekly: 4

backup_path: /data/backup/schema_backups

database: my_db

daily_to_weekly_pattern: sunday

schemas:
    - my_cool_schema
    - my_not_so_cool_schema

Remember: YAML is sensitive about tabs!

Command line arguments are set up in the script by using Getopt::Long.

my ($help, $cfg_file, $schema, $verbose, $debug) = @_;
# Check command line arguments
GetOptions(
    "help"     => \$help,
    "verbose"  => \$verbose,
    "debug"    => \$debug,
    "cfg=s"    => \$cfg_file,
    "schema=s" => \$schema,
);
pod2usage(1) if $help;

The script needs to run as the ‘postgres’ user. Should it be executed by another user (for instance root), then script will try to switch to the ‘postgres’ user.

my ($user) = ( split /\c/, getpwuid($<) )[0]; 
unless ($user eq 'postgres') { 
    p_info("Script $0 needs to run as 'postgres', switching user..."); 
    setuid(scalar getpwnam 'postgres'); 
}

Next we will load the configuration file and check if a schema name was supplied on the command line. If one was defined, then we will override the schema names which were set in the configuration, and only create a backup of that one schema name.

if(defined $cfg_file){
    if( -f $cfg_file ){
        p_info("Loading configuration file '$cfg_file'");
        $cfg = LoadFile($cfg_file);
    }
    else {
        die "No such configuration file '$cfg_file'\n";
    }
}

$cfg->{schemas} = [$schema] if defined $schema;

And now we are ready for the mainloop of the script:

foreach my $s (@{ $cfg->{schemas} }){
    check_current_backups($s);
    create_backup($s);
}

For each schema, we will first check if the required directories are in place and otherwise create them. Afterwards we will check those directories for older backups.

sub check_current_backups {
    my($schema) = @_;

    check_directory_structure($schema);
    check_backups('daily', $schema);
    check_backups('weekly', $schema);
}

sub check_directory_structure {
    my($schema) = @_;

    foreach my $period (qw/daily weekly/){
        my $_path = return_backup_path($period, $schema);;
        p_info("Checking path '$_path'");
        unless(-d $_path){
            make_path($_path);
            p_info("Created path '$_path'");
        }
    }
}

# check if older backups need rotation / deletion
sub check_backups {
    my($period, $schema) = @_;

    my $path = return_backup_path($period, $schema);

    my @files = glob("$path/*");
    my @sorted = sort { get_date($b) <=> get_date($a) } @files;

    if(scalar @sorted >= $cfg->{thresholds}{$period}){
        p_info("Rotating backups for period '$period'");
        rotate_backups($period, \@sorted);
    }
}

The rotation of the backups works like follows:
– If the day threshold has been reached (for instance 7 daily backups), then those files will be nominated for rotation or deletion

The rotation itself is custom designed for my current job. Each backup filename is appended the day name (Monday, Tuesday, …). Backup files matching a certain pattern (in my situation ‘sunday’) will be moved into the ‘weekly’ backup path, other old files will be deleted.

Since rotation is done before a backup is created, we will delete one more as required file (since a new backup file is going to be created in a few lines further).

sub rotate_backups {
    my($period, $files) = @_;

    p_debug("All Files: ".Dumper($files));
    p_debug("$period threshold: ".$cfg->{thresholds}{$period});

    # make a true copy
    my (@to_move_files) = (@{ $files });
    # The @files contains all backup files, with the youngest as element 0, the oldest 
    # backup as last element.
    # @to_move_files is a slice of @files, starting from the position threshold - 1, 
    # until the end of the array. Those files will be either rotated or removed
    @to_move_files = @to_move_files[ $cfg->{thresholds}{$period} -1 .. $#to_move_files ];
    p_debug("TO MOVE FILES: ".Dumper(\@to_move_files));

    if($period eq 'daily'){
        foreach my $file (@to_move_files){
            # move backups to weekly
            if($file =~ /$cfg->{daily_to_weekly_pattern}/){
                p_info("Moving daily backup '$file' to weekly");
                move($file, return_backup_path('weekly', $schema) . '/' . $file)
            }
            else {
                p_info("Removing backup '$file'");
                unlink($file);
            }
        }
    }

    if($period eq 'weekly'){
        foreach my $file (@to_move_files){
            # remove files
            p_info("Removing backup '$file'");
            unlink($file);
        }
    }
}

At this point now, the required directory structure has been checked and is present and older backup files have been rotated or deleted.
Finally we can create the actual backup:

sub create_backup {
    my($schema) =@_;

    p_info("Creating backup for schema '$schema', database:" . $cfg->{database});
    my $now = DateTime->now;
    my $path = return_backup_path('daily', $schema) 
                . '/' . $now->ymd('') . $now->hms('')
                . '_' .lc($now->day_name) 
                . '.dump.sql';

    # Create the dump file
    my $dump_output = do{
        local $/;
        open my $c, '-|', "pg_dump -v -n $schema -f $path $cfg->{database} 2>&1" 
            or die "pg_dump for '$schema' failed: $!";
        <$c>;
    };
    p_debug('pg_dump output: ', $dump_output);

    # GZIP the dump file
    my $gzip_output = do{
        local $/;
        open my $c, '-|', "gzip $path 2>&1" 
            or die "gzip for '$path' failed: $!";
        <$c>;
    };
    p_debug('gzip output: ', $gzip_output);

    # change the permissions
    chmod 0660, "$path.gz";

    p_info("Created backup for schema '$schema' in '$path.gz'");
}

The backup is created by issuing pg_dump for that schema and it will produce a normal text SQL file. This file will be compressed with gzip and afterwards the file permissions will be changed to 0660. This means that, since the backup file is created by the postgres user, only the postgres user will have access to this file.

The full script and configuration file can be found at https://github.com/insani4c/perl_tools/tree/master/backup_schema

Maintaining a large number of servers cannot be done without proper programming skills. Each good system administrator must therefor make sure he knows how to automate his daily works.

Although many many programming languages exist, most persons will only write code in one. I happen to like Perl.

In this next blog post, I am going to show how to create a script which can be deployed on all the Linux servers you need to maintain and need to check for certain running services.

Of course, a tool as Nagios together with NRPE and a configured event-handler could also be used, but lately I was often in the situation that the ‘nrpe daemon’ crashed, Nagios was spewing a lot of errors and the event-handler… well, since nrpe was down, the event-handler of course couldn’t connect or do anything. So why rely on a remote triggered action, when a simple script could be used.

The following script will check a default list of services and can additionally load or overwrite these services. A regular expression can be used to check for running processes, and of course, a startup command needs to be defined. And that is all the script will and should do.

The script uses three CPAN modules:

• Proc::ProcessTable
• YAML
• File::Slurp

The first one will be used to get a full listing of all running processes and the second one will provide us a means for using configuration files.

So let’s start our script:

#!/usr/bin/env perl 
use strict; use warnings;
use utf8;

use Proc::ProcessTable;
use YAML qw/LoadFile/;
use File::Slurp;

# Default set of processes to watch
my %default_services = (
    'NRPE' => {
        'cmd'     => '/etc/init.d/nagios-nrpe-server restart',
        're'      => '/usr/sbin/nrpe -c /etc/nagios/nrpe.cfg -d',
	'pidfile' => '/var/tmp/nagios-nrpe-server.pid',
    },
    'Freshclam' => {
        'cmd'     => '/etc/init.d/clamav-freshclam restart',
        're'      => '/usr/bin/freshclam -d --quiet',
	'pidfile' => '/var/tmp/clamav-freshclam.pid',
    },
    'Syslog-NG' => {
        'cmd'     => '/etc/init.d/syslog-ng restart',
        're'      => '/usr/sbin/syslog-ng -p /var/run/syslog-ng.pid',
	'pidfile' => '/var/run/syslog-ng.pid',     
    },
    'VMToolsD' => {
        'cmd'     => '/etc/init.d/vmware-tools restart',
        're'      => '/usr/sbin/vmtoolsd',
	'pidfile' => '/var/tmp/vmtoolsd.pid',
    },
    'Munin-Node' => {
        'cmd'     => '/etc/init.d/munin-node restart',
        're'      => '/usr/sbin/munin-node',
	'pidfile' => '/var/tmp/munin-node.pid',
    },
);

my (%services) = (%default_services);

Until now, no rocket science. We load the required modules, we defined our default services that need to be checked.

Next part, check if there is a configuration file on disk. The script looks for a hard-coded path ”/etc/default/watchdog.yaml”:

# Check if there is a local config file and if yes, load them in the services hash
if( -f '/etc/default/watchdog.yaml' ){
    my $local_config = LoadFile '/etc/default/watchdog.yaml';

    %services = (%default_services, %{ $local_config->{services} });
}

The last Perl statement actually allows to overwrite one or more (or even all) the default defined services.

Now let’s see if these processes are actually running. The following code was hugely inspired by Colin Keith’s comment below. I have combined his examples together with my code.

Let’s first have a look at the code:

# Get current process table
my $processes = Proc::ProcessTable->new;
my %procs; 
my %matched_procs;
foreach my $p (@{ $processes }){
    $procs{ $p->{pid} } = $p->{cmndline};
    foreach my $s (keys %services){
        if($p->{cmndline} =~ m#$services{$s}->{re}#){
            $matched_procs{$s}++;
            last;
        }
    }
}

# Search the process table for not running services
foreach my $service ( keys %services ) {
    if(exists($services{$service}->{pidfile}) && -f $services{$service}->{pidfile} ) {
        my $pid = read_file( glob($services{$service}->{pidfile}) );
 
        # If we get a pid ensure that it is running, and that we can signal it
        $pid && exists($procs{$pid}) && kill(0, $pid) && next;  
        
        # Remove the stale PID file because no running process for this PID file
        unlink( $services{$service}->{pidfile} );
    }
    else {
        # check if the configured process regex matches
        if( exists($matched_procs{$service}) ){
            # process is running but has no PID file
            next;
        }
    }
	
    # Execute the service command
    system( $services{$service}->{'cmd'} );

    # Check the exit code of the service command
    if ($? == -1) {
        print "Failed to restart '$service' with '$services{$service}->{cmd}': $!\n";
    }
    elsif ($? & 127) {
        printf "Restart of '$service' died with signal %d, %s coredump\n", ($? & 127),  ($? & 128) ? 'with':'without';
    }
    else {
        printf "Process '$service' successfully restarted, exit status:  %d\n", $? >> 8;
    }
}

Lines 2 retrieves the current process list. We will save that information in two hashes with a little less information, because we actually only need the PID and the actual ‘command line’ of each process.

At line 16 we will start looping through the processes we have defined in the %services hash.
Inspired by Colins post, we will check if the process’ PID file is still there and if one is configured. If it still exists, we will then verify if the PID stored in the PID file, exists in the process list, which we have stored in %procs. This happens in lines 18-21.
At line 21, if the process is still running and the PID matches, we will check the next service to check (&& next part)
If the process is not running anymore but the PID file was still in the defined path, then it will be removed at line 24.

Otherwise, if no PID file was found or no PID file was configured, we will check the process list with the regular expression defined for that process. We have already created a hash, %matched_procs between lines 7 and 10, which we will use for this checking. If the process exists in the hash, we will skip and check the next process to be checked.

Now, if there was no PID file or the PID file was removed at line 24, the process will be started again. This happens at line 35.
I’ve executed it with the ‘system’ function since I want to have the output of this command directly in STDOUT. And of course, the last thing to do is to check if the process started up correctly or not by checking its exit code.

Now save that script to for instance ‘watchdog.pl’ and configure it in a cron job.
Example:

*/5 * * * * root /usr/local/bin/watchdog.pl

And here’s an example of the configuration file:

services:
    Exim-Mailserver:
        cmd: /etc/init.d/exim4 restart
        re: /usr/sbin/exim4 -bd -q30m
    Ossec-Agent:
        cmd: /etc/init.d/ossec restart
        re: !!perl/regexp '(?:ossec-agentd|ossec-logcollector|ossec-syscheckd)'

Link to script source code: https://github.com/insani4c/perl_tools/tree/master/watchdog

In the example script we will be using a Storable state file and we will the statistics as a JSON object in the PostgreSQL database.

First let’s take a look at the query we will be executing:

SELECT schemaname, relname, seq_tup_read 
FROM pg_stat_all_tables 
WHERE seq_tup_read > '0' 
      AND relname NOT LIKE 'pg_%'
ORDER BY seq_tup_read desc

As you can see, PostgreSQL stores all the information we need about our tables in just one table, called pg_stat_all_tables. In this table there is a column called seq_tup_read, which will contain the information we need.

Just reading out this information is not going to be enough, because it contains information since the startup of your PostgreSQL database. Since production databases aren’t restarted (that often), we will have to compare this information with some previous information (hence the Storable state file).
Our plan is to run the script in a cronjob, each 5 minutes.

The statistics are also stored in as a JSON object in a database, just so that we could build some web interface for the statistics, in a later stage. And we want to keep a history of these statistics.

Furthermore the script will setuid to postgres (same like su – postgres on the command line), so that it could connect to the PostgreSQL UNIX socket file.

use strict;
use warnings;
use utf8;

use DBI;
use DateTime;
use POSIX qw/setuid/;
use Text::ASCIITable;
use JSON;

my $db   = 'mydatabase';
if(scalar @ARGV){
    $db = shift @ARGV;
}

my $host = '/var/run/postgresql';
my $user = 'postgres';
my $pass = 'undef';

my $state_db   = 'database_statistics';
my $state_host = '192.168.1.1';
my $state_user = 'skeletor';
my $state_pass = 'he-manisawhimp';

my $state_file = '/var/tmp/sequence_read.state';

# suid to postgres
setuid(scalar getpwnam 'postgres');

# define and open up the state file
my $state = {};
$state = retrieve $state_file if -f $state_file;

my $now      = DateTime->now;

# Connect to the database which we want to monitor
my $dbh = DBI->connect("dbi:Pg:dbname=$db;host=$host", $user, $pass) 
                or die "Could not connect to database: $!\n";

# Connect to the database that will be used to store the statistics
my $state_dbh = DBI->connect("dbi:Pg:dbname=$state_db;host=$state_host", $state_user, $state_pass) 
                or die "Could not connect to the State database '$state_db': $!\n";

my $sql = <<EOF;
SELECT schemaname, relname, seq_tup_read 
FROM pg_stat_all_tables 
WHERE seq_tup_read > '0' 
      AND relname NOT LIKE 'pg_%'
ORDER BY seq_tup_read desc
EOF

# Get the statistics
my $results = $dbh->selectall_arrayref( $sql, undef);

# Store the statistics as a JSON object in the second databse
eval {
    $state_dbh->do('INSERT INTO mydbschema.seq_tup_read (data) VALUES(?)', undef, encode_json($results));
};
if($@){
    print "Insert into state-db failed: $@\n";
}

# Prepare a nice ASCII table for output
my $t = Text::ASCIITable->new({ headingText => 'Seq Tup Read ' . $now->ymd('-')     . ' ' . $now->hms(':')});
$t->setCols('Schema Name','Relation Name ', 'Seq Tup Read', 'Increase (delta)');

my $row_count = 0;
foreach my $r (@{$results}){
    last if $row_count > 25;

    my (@values) = (@{$r});
    my ($increase, $delta) = (0, 0);
    # Calculate the increase and its delta
    if(defined $state->{last}{$r->[0].':'.$r->[1]}{seq_tup_read}){
        $increase = $r->[2] - $state->{last}{$r->[0].':'.$r->[1]}{seq_tup_read};
        $delta    = $increase / $state->{last}{$r->[0].':'.$r->[1]}{seq_tup_read} * 100;
        my $str = sprintf '%.0f (%.4f %%)', $increase, $delta;
        push @values, ($str);
    }
    else {
        push @values, '0 (0%)';
    }
    # Store this information for the next run of the script
    $state->{last}{$r->[0].':'.$r->[1]}{seq_tup_read} = $r->[2];
    $state->{last}{$r->[0].':'.$r->[1]}{delta}        = $delta;
    $state->{last}{$r->[0].':'.$r->[1]}{increase}     = $increase;

    # Only add the information to ASCII output table if there was an increase
    next unless $increase > 0;
    $t->addRow(@values);
    $row_count++;
}
# Print out the ASCII table
print $t;

nstore $state, $state_file;

Statistics about indexes can be easily retrieved from the PostgreSQL database system. All required information is stored in two tables:

• pg_stat_user_indexes
• pg_index

When joining these two tables, interesting information can be read in the following columns:

• idx_scan: has the query planner used this index for an ‘Index Scan’, the number returned is the amount of times it was used
• idx_tup_read: how many tuples have been read by using the index
• idx_tup_fetch: how many tuples have been fetch by using the index

A neat function called pg_relation_size() allows to fetch the on-disk size of a relation, in this case the index.

Based on this information, the monitoring query will be built up as follows:

SELECT 
    relid::regclass AS table, 
    indexrelid::regclass AS index, 
    pg_size_pretty(pg_relation_size(indexrelid::regclass)) AS index_size, 
    idx_tup_read, 
    idx_tup_fetch, 
    idx_scan
FROM 
    pg_stat_user_indexes 
    JOIN pg_index USING (indexrelid) 
WHERE 
    idx_scan = 0 
    AND indisunique IS FALSE

Now, all we need to do is write a script which stores this information in some kind of file and periodically report about the statistics.

First of all we will need a configuration file, which contains the database credentials.
I’ve chosen YAML because it is so versatile.

It will contain two important sets of information:

• The database credentials
• path to the state file

Example:

dsn: "dbi:Pg:host=/var/run/postgresql;database=testdb"
user: postgres
pass:
state_file: /var/tmp/monitor_unused_indexes.state

As you can see, we will be connect to the PostgreSQL database by using its UNIX socket.

The script will use Text::ASCIITable to output the statistics in a nice table. Storable is used to save our statistics to disk.

In the below script, we will check if an index was unused in a timespan of 30 days. If yes, the script will report this index to STDOUT.
Therefore, we will store a score and timestamp for each unused index in the state file.

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use DBI;
use Storable qw/nstore retrieve/;
use YAML qw/LoadFile/;
use POSIX qw/setuid/;
use Getopt::Long;
use DateTime;
use Text::ASCIITable;

my $cfg_file = './monitor_unused_indexes.yaml';
my $verbose = 0;
GetOptions("cfg=s" => \$cfg_file,
           "verbose|v" => \$verbose, 
        );

my $sql = <<EOS;
SELECT 
    relid::regclass AS table, 
    indexrelid::regclass AS index, 
    pg_size_pretty(pg_relation_size(indexrelid::regclass)) AS index_size, 
    idx_tup_read, 
    idx_tup_fetch, 
    idx_scan
FROM 
    pg_stat_user_indexes 
    JOIN pg_index USING (indexrelid) 
WHERE 
    idx_scan = 0 
    AND indisunique IS FALSE
EOS

my ($cfg) = LoadFile($cfg_file);

# suid to postgres, other whatever user is configured in the config.yaml file
setuid(scalar getpwnam $cfg->{user});

# Connect to the database
my $dbh = DBI->connect($cfg->{dsn}, $cfg->{user}, $cfg->{pass}) 
            or die "Could not connect to database: $! (DBI ERROR: ".$DBI::errstr.")\n";

my $state;
if(-f $cfg->{state_file}){
    $state = retrieve $cfg->{state_file};
}

# Fetch the statistics
my $results = $dbh->selectall_arrayref( $sql, undef );

my $now_dt   = DateTime->now;

# Initialize the ASCII table
my $t = Text::ASCIITable->new({ headingText => 'INDEX STATISTICS'});
$t->setCols(qw/Table Index Index_Size idx_tup_read idx_tup_fetch idx_scan/);

# Analyze the results
foreach my $r (@$results){
    if($verbose){
        $t->addRow(@{$r});
    }
    # Only update the state file if --verbose was not specified.
    # This way the script can be check manually with --verbose many times and executed for instance
    # from a cronjob once a day without --verbose
    else {
        if(defined $state->{unused_indexes}{$r->[1]}){
            my $first_dt = DateTime->from_epoch( epoch => $state->{unused_indexes}{$r->[1]}{first_hit} );
            if($first_dt->add(days => $state->{unused_indexes}{$r->[1]}{score})->day == $now_dt->day ) {
                $state->{unused_indexes}{$r->[1]}{score}++;
            }
            else {
                $state->{unused_indexes}{$r->[1]}{score}     = 1;
                $state->{unused_indexes}{$r->[1]}{first_hit} = $now_dt->epoch;;
            }
        }
        else {
            $state->{unused_indexes}{$r->[1]}{score}     = 1;
            $state->{unused_indexes}{$r->[1]}{first_hit} = $now_dt->epoch;;
        }
    }
}

# Print out the statistics table, if --verbose was specified
print $t if $verbose; 

# Store the statistics to disk in a state file
nstore $state, $cfg->{state_file};

foreach my $idx (keys %{ $state->{unused_indexes} }){
    my $first_dt = DateTime->from_epoch( epoch => $state->{unused_indexes}{$idx}{first_hit} );
    if( $first_dt->add(days => 30) <= $now_dt ){
        my $line = "Index: $idx ready for deletion";
        $line .= " (score:" . $state->{unused_indexes}{$idx}{score};
        $line .= " (|first_hit:" . DateTime->from_epoch(epoch => $state->{unused_indexes}{$idx}{first_hit})->ymd . ")";

        print $line."\n" if $verbose;
    }
}

These new features now simply for instance saving web forms in your Postgresql database. Or actually any kind of dynamic data, such as for instance Perl hashes. Plus, thanks to the new JSON functions, this data can be easily searched and indexed.

Let’s start with creating a test table.

CREATE SEQUENCE data_seq    
    START WITH 1    
    INCREMENT BY 1    
    NO MINVALUE    
    NO MAXVALUE    
    CACHE 1;

CREATE TABLE data (    
    id bigint DEFAULT nextval('data_seq'::regclass) NOT NULL,
    form_name TEXT,
    form_data JSON
);

I’ve inserted into this table 100k rows of test data with a very simple Perl script.

#!/usr/bin/perl
use strict;
use DBI;
use AnyEvent;
use AnyEvent::Util;
$AnyEvent::Util::MAX_FORKS = 25;

print "Inserting test data...\n";
my $cv = AnyEvent->condvar;
$cv->begin;
foreach my $d (0..100000){
    $cv->begin;
    fork_call {
        my($d) = @_;
        my $name = do{local $/; open my $c, '-|', 'pwgen -B -s -c1 64'; <$c>};
        chomp($name);
        my $dbh = DBI->connect("dbi:Pg:host=/var/run/postgresql;dbname=test;port=5432",'postgres', undef);
        $dbh->do(qq{insert into data (form_name,form_data) VALUES('test_form', '{"c":{"d":"ddddd"},"name":"$name","b":"bbbbb", "count":$d}')});
        $dbh->disconnect;
        return $d;
    } $d,
    sub {
        my ($count) = @_;
        print "$d ";
        $cv->end;
    }
} 
$cv->end;
$cv->recv;
print "\n\nDone\n";

Now let’s assume that the JSON data we are going to insert (or have inserted) always contains the attribute field ‘name’. On this attribute we will create the following database index:

CREATE INDEX ON data USING btree (form_name, json_extract_path_text(form_data,'name'));

The above example creates a multi-column index.

Now let’s a make our first test.
The first test will not use the index we have created previously.

EXPLAIN ANALYZE VERBOSE SELECT * FROM data WHERE form_name = 'test_form' AND form_data->>'name' = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME';
                                                                             QUERY PLAN                                                                              
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
 Seq Scan on data  (cost=0.00..4337.28 rows=500 width=102) (actual time=28.608..129.945 rows=1 loops=1)
   Filter: ((data.form_name = 'test_form'::text) AND ((data.form_data ->> 'name'::text) = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME'::text))
   Rows Removed by Filter: 100000
 Total runtime: 129.968 ms
(5 rows)

130ms for searching through 100k rows, is actually quite ok.

Now let’s see how we can speed up this query by using the index we’ve created.

EXPLAIN ANALYZE VERBOSE SELECT * FROM data WHERE form_name = 'test_form' AND json_extract_path_text(form_data,'name') = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME';
                                                                             QUERY PLAN                                                                                                
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
 Index Scan using data_form_name_json_extract_path_text_idx on data  (cost=0.42..8.44 rows=1 width=102) (actual time=0.056..0.057 rows=1 loops=1)
   Index Cond: ((data.form_name = 'test_form'::text) AND (json_extract_path_text(data.form_data, VARIADIC '{name}'::text[]) = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME'::text))
 Total runtime: 0.084 ms
(4 rows)

0.084ms! That’s is about 1625 times faster! What makes this index extremely interesting is that the index has only been created on one attribute of the JSON data and not on the entire JSON data. This will keep the index data small and thus will be kept longer in your database’ memory.

• sorted
• searched
• paginated
• scroll infinitely
• themed
• …

And most important: it’s for free! I’ve always wanted to create an infinite scrolling table and now it’s just too easy:

$(document).ready( function() {
    oTable = $('#ip_data').dataTable( {
        "bProcessing":     true,
        "bServerSide":     true,
        "bPaginate":       true,  
        "bScrollInfinite": true,
        "bScrollCollapse": true,
        "sScrollY":        "200px",
        "sAjaxSource":     "get_ip_data.pl",
    } );
} );

And that’s it! Well, ok, you need to include the Javascript file and CSS files of the Datatables Project of course and you need to create the table in HTML.

For instance:

And then you will need a Perl script providing you the data for the table.
The below example allows to

• search the tables
• scroll infinitely
• sort on the columns

It also supplies the Datatables table with a total amount or rows in the database table.

This following script will be saved as ”get_ip_data.pl”

#!/usr/bin/perl
use strict; use warnings;
use DBI;
use JSON;
use CGI;

my @columns = qw/ip country_name city latitude longitude/;

my $q = CGI->new;
my $db = DBI->connect("dbi:mysql:host=localhost;db=testdb", 'testuser', 'xxxsecret');

my $params = $q->Vars;

# Get the total count of rows in the table
my $sql_count = "select count(id) from geo_data";
my $count = $db->selectrow_arrayref($sql_count)->[0];

# Start building up the database query
my @values;
my $sql = "select ip,country_name,city,latitude,longitude from geo_data";

# if a search parameter was supplied in the AJAX call, build the WHERE part in the SQL statement
if( $params->{sSearch} ){
    $sql .= ' WHERE ';
    $sql .= 'ip LIKE ? OR country_name LIKE ? or city LIKE ? or latitude LIKE ? or longitude LIKE ?';
    push @values, ('%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%');
}

# if a sorting parameter was supplied in the AJAX call, build up the ORDER BY part in the SQL statement
if( $params->{iSortingCols} ){
    $sql .= ' ORDER BY';
    foreach my $c (0 .. ( $params->{iSortingCols} -1 )){
        $sql .= ' ' . $columns[ $params->{"iSortCol_$c"} ] . ' ' . $params->{"sSortDir_$c"};
        $sql .= ','
    }
    $sql =~ s/,$//;
}

# Limit the output and also allow to paginate or scroll infinitely
$sql .= " LIMIT ? OFFSET ?";
push @values, (($params->{iDisplayLength} > 0 ? $params->{iDisplayLength} : 25), ( $params->{iDisplayStart} // 0));

# Fetch the data from the database
my $data = $db->selectall_arrayref($sql, { Slice => [] }, @values);

# Return the JSON object
print $q->header('application/json');
my $json = encode_json({ aaData => $data, iTotalRecords => $count, iTotalDisplayRecords => $count, sEcho => int($params->{sEcho}) });
print $json;

An example can be found overhere: http://www.moretrix.com/~insaniac/map/map.pl

Before we look at the Google API for GeoChart, let’s first set up a script which will get data out of a database and return it in a JSON formatted object.
In this example we will use Perl and three Perl modules:

• DBI
• JSON
• CGI

When converting database values to a JSON object (or text string), it is very important that all data is properly type-casted.
In the following example you will see that we do:

$_->[1] = int($_->[1]) foreach @$data;

This snippet will actually make our INTEGER value into a real integer. The DBI module had returned it as a normal string (that’s just how DBI works).

#!/usr/bin/perl
use strict; use warnings;
use DBI;
use JSON;
use CGI;

my $q = CGI->new;
my $db = DBI->connect("dbi:mysql:host=localhost;db=testdb", 'testuser', 'xxxsecret');

my $sql = "SELECT country_name, count(id) as total from geo_data group by country_name";
my $data = $db->selectall_arrayref($sql);
$_->[1] = int($_->[1]) foreach @$data;
unshift(@$data, ['Country', 'Attacks']);

print $q->header('application/json');
my $json = encode_json($data);
print $json;

The above Perl script will be saved as ”get_countries_data.pl”.

In the below Javascript example, we will use the Google API for the GeoChart Map and jQuery for making the AJAX call to our Perl script. Since the Perl script already provides the data in a JSON format, we do not need to convert or parse it.
Furthermore the Javascript code is pretty straightforward and based on the example found at https://developers.google.com/chart/interactive/docs/gallery/geochart, except for the AJAX part.

    google.load('visualization', '1', {packages: ['geochart']});
    google.setOnLoadCallback(drawVisualization);

    function drawVisualization() {
        var options = {
            height: '500',
            width: '1200',
            colorAxis: {minValue: 0,  colors: ['#FFC26B', 
                                               '#FFAF3B', 
                                               '#FF9700', 
                                               '#C1852F', 
                                               '#A86400']},
            datalessRegionColor: '#FAFAFA',
            backgroundColor: '#F4EFE7',
        };
    
        $.ajax({
            type: 'POST',
            url: "get_countries_data.pl",
            dataType: "json",
            async: false,
            success: function(json_data) {
                var data = google.visualization.arrayToDataTable(json_data);
                var chart = new google.visualization.GeoChart(
                                   document.getElementById('visualization') );

                chart.draw(data, options);
            }
        });
    }

An example of this setup can be found at http://www.moretrix.com/~insaniac/map/map.pl

The default character set is alpha-numerical based, but can be set to any kind of character list.

The complete handling and generating is implemented in a module, which exports one function: ‘generate_password‘.
This function can take (optional) as arguments:

• a length
• a character list

The entropy is generated with Bytes::Random::Secure and random numbers are generated with Math::Random::ISAAC.

package MORETRIX::Password;
#===============================================================================
#  DESCRIPTION: A password generator module
#     REVISION: $Id: Password.pm 71 2013-07-02 12:28:42Z jmorano $
#===============================================================================

use strict;
use warnings;
use Digest;
use Exporter qw/import/;
use Time::HiRes qw/time/;
use Bytes::Random::Secure;
use Math::Random::ISAAC;

our @EXPORT    = qw/generate_password/;
our @EXPORT_OK = qw/generate_password/;

my $random_state;
my $CHARLIST = q{abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!"$%&/\()=?{}[]*+#;:.,-_<>|^~'};

# Generate a cryptographic safe random password
# default length: 12
#
sub generate_password {
    my ($length, $charlist) = @_;
    $length   //= 12;
    $charlist //= $CHARLIST;

    my @temp_passwords;
    foreach my $loop ( 0 .. int(random_number(100)) ){
        my $password = '';
        while (length($password) < $length) {
            $password .= substr($charlist, (int(myrand(length($charlist)))), 1);
        }
        push @temp_passwords, $password;
    }

    return $temp_passwords[int(random_number(length(scalar @temp_passwords)))];
}

sub random_number {
    my ($seed) = @_;

    my $r = Math::Random::ISAAC->new($seed);
    return $r->rand();
}

sub mysrand{
    my $seed = shift || (time ^ $ ^ int(random_number(time)) ^ int(random_number(2048 ^ 128)));
    $random_state = {
        digest  => new Digest ("SHA-512"),
        counter => 0,
        waiting => [],
        prev    => $seed
    };
}

sub myrand{
    my $range = shift || 1.0;
    mysrand() unless defined $random_state;

    if (! @{$random_state->{waiting}}){
        $random_state->{digest}->reset();
        $random_state->{digest}->add( generate_entropy(4096) .
                                     $random_state->{counter}++ .
                                     $random_state->{prev});
        $random_state->{prev} = $random_state->{digest}->digest();
        my @ints = unpack("L*", $random_state->{prev}); # 32 bit unsigned integers
        $random_state->{waiting} = \@ints;
    }
    my $int = shift @{$random_state->{waiting}};
    return $range * $int / 2**32;
}

sub generate_entropy {
    my ($length) = @_;

    $length //= 1024;

    my $random = Bytes::Random::Secure->new( NonBlocking => 1, Bits => 4096 );
    return $random->string_from($CHARLIST, $length);
}

1;

Example script:

#!/usr/bin/env perl 

use strict;
use warnings;
use utf8;
use MORETIX::Password;

my $length = shift @ARGV;
$length //= 32;

print generate_password($length) . "\n";
print generate_password($length) . "\n";
print generate_password($length) . "\n";
print generate_password($length) . "\n";
print generate_password($length) . "\n";

References:

• http://wellington.pm.org/archive/200704/randomness/#slide0

The script must be executed as ‘postgres’ user.

#!/bin/bash

# $Id: check_slave_replication.sh 3421 2013-08-09 07:52:44Z jmorano $

STATE_OK=0
STATE_WARNING=1
STATE_CRITICAL=2
STATE_UNKNOWN=3
 
## Master (p_) and Slave (s_) DB Server Information	
export s_host=$1
export s_port=$2
export p_db=$3
export p_host=$4
export p_port=$5
 
export psql=/opt/postgresql/bin/psql
export bc=/usr/bin/bc
 
## Limits
export  critical_limit=83886080 # 5 * 16MB, size of 5 WAL files
export   warning_limit=16777216 # 16 MB, size of 1 WAL file
 
master_lag=$($psql -U postgres -h$p_host -p$p_port -A -t -c "SELECT pg_xlog_location_diff(pg_current_xlog_location(), '0/0') AS offset" $p_db)
slave_lag=$($psql -U postgres  -h$s_host -p$s_port -A -t -c "SELECT pg_xlog_location_diff(pg_last_xlog_receive_location(), '0/0') AS receive" $p_db)
replay_lag=$($psql -U postgres -h$s_host -p$s_port -A -t -c "SELECT pg_xlog_location_diff(pg_last_xlog_replay_location(), '0/0') AS replay" $p_db)
replay_timediff=$($psql -U postgres -h$s_host -p$s_port -A -t -c "SELECT NOW() - pg_last_xact_replay_timestamp() AS replication_delay" $p_db)
 
if [[ $master_lag -eq '' || $slave_lag -eq '' || $replay_lag -eq '' ]]; then
    echo "CRITICAL: Stream has no value to compare (is replication configured or connectivity problem?)"
    exit $STATE_CRITICAL
else
    if [[ $master_lag -eq $slave_lag && $master_lag -eq $replay_lag && $slave_lag -eq $replay_lag ]] ; then
        echo "OK: Stream: MASTER:$master_lag Slave:$slave_lag Replay:$replay_lag"
        exit $STATE_OK
    else
        if [[ $master_lag -eq $slave_lag ]] ; then
            if [[ $master_lag -ne $replay_lag ]] ; then
                if [ $(bc <<< $master_lag-$replay_lag) -lt $warning_limit ]; then
                    echo "OK: Stream: MASTER:$master_lag Replay:$replay_lag :: REPLAY BEHIND"
                    exit $STATE_OK
                else
                    echo "WARNING: Stream: MASTER:$master_lag Replay:$replay_lag :: REPLAY $(bc <<< $master_lag-$replay_lag)bytes BEHIND (${replay_timediff}seconds)"
                    exit $STATE_WARNING
                fi
            fi
        else
            if [ $(bc <<< $master_lag-$slave_lag) -gt $critical_limit ]; then
                echo "CRITICAL: Stream: MASTER:$master_lag Slave:$slave_lag :: STREAM BEYOND CRITICAL LIMIT ($(bc <<< $master_lag-$slave_lag)bytes)"
                exit $STATE_CRITICAL
            else
                if [ $(bc <<< $master_lag-$slave_lag) -lt $warning_limit ]; then
                    echo "OK: Stream: MASTER:$master_lag Slave:$slave_lag Replay:$replay_lag :: STREAM BEHIND"
                    exit $STATE_OK
                else
                    echo "WARNING: Stream: MASTER:$master_lag Slave:$slave_lag :: STREAM BEYOND WARNING LIMIT ($(bc <<< $master_lag-$replay_lag)bytes)"
                    exit $STATE_WARNING
                fi
            fi
        fi
        echo "UNKNOWN: Stream: MASTER: $master_lag Slave: $slave_lag Replay: $replay_lag"
        exit $STATE_UNKNOWN
    fi
fi

Possible outputs:

$ bash check_slave_replication.sh 192.168.0.1 5432 live 192.168.0.2 5432
WARNING: Stream: MASTER:1907958306184 Replay:1907878056888 :: REPLAY 80249296bytes BEHIND (00:03:14.056747seconds)
$ bash check_slave_replication.sh 192.168.0.1 5432 live 192.168.0.2 5432
OK: Stream: MASTER:2055690128376 Slave:2055690143144 Replay:2055690193744 :: STREAM BEHIND
$ bash check_slave_replication.sh 192.168.0.1 5432 live 192.168.0.2 5432
OK: Stream: MASTER:2055690497120 Replay:2055690497328 :: REPLAY BEHIND
$ bash check_slave_replication.sh 192.168.0.1 5432 live 192.168.0.2 5432
OK: Stream: MASTER:2055691704672 Slave:2055691704672 Replay:2055691704672