#!/usr/bin/perl -w

# Copyright (C) 2016-2020 Arne Wichmann
#
# This little thing is distributed under the GNU General Public License,
# version 2. If you need the license, ask your distributor for it.

# Tell Perl what we need to use
use strict;
use Getopt::Std;

my($expect)='V';
my($unconnected,$noprimary,$notuptodate,$strange,$localio)=(0,0,0,0,0);
my($pending,$unack,$ap,$ep,$wo,$oos)=(0,0,0,0,0,0);
my($blocking,$verifying,$syncing)=(0,0,0);
my($debugout)='';

# parse /proc/drbd - this is a state machine. states are V,SV,L,C,CV,VI,VI2
open(DRBD,"/proc/drbd");
while(<DRBD>) {
  $debugout.=$_;
  if ($expect eq 'V') { # V == version line
    if (/^version/) { $expect='SV' }
    else { chomp; finish("CRITICAL - expected version got $_!",2) }

  } elsif ($expect eq 'SV') { # SV == source version line
    if (/^srcversion/) { $expect='L'}
    else { chomp; finish("CRITICAL - expected srcversion got $_!",2) }

  # L == "Line" state - the expected line describes the drbd instance
  #   numbered $1 alternatively (strictly only after C) it describes a verify
  #   information line
  } elsif ($expect eq 'L') {
    next if /^\s*$/;
    if (/^ (\d+): cs:(\w+) ro:(\w+)\/(\w+) ds:(\w+)\/(\w+) (\w) (\w.....)$/) {
      my($num,$conn,$meprip,$otherprip,$meutdp,$otherutdp,$type,$state)=
        ($1,$2,$3,$4,$5,$6,$7,$8);
      if ($conn ne 'Connected') { 
        if ($conn=~/^Verify[TS]$/) { $verifying++; $expect='CV'; } 
	elsif ($conn=~/^Sync(Target|Source)$/) { $syncing++; $expect='CV';}
	else { $unconnected++; $expect='C'; } # ist der $expect hier richtig?
      } else {$expect='C'; }
      $noprimary++;
      $meprip eq 'Primary' and $noprimary-- or 
        $otherprip eq 'Primary' and $noprimary--;
      $meutdp eq 'UpToDate' and $otherutdp eq 'UpToDate' or $notuptodate++;
      # all except A not well-tested
      $type=~/^[ABC]$/ or $strange++;
      if ($state ne 'r-----') {
	# $state=~/^[rs][a-][p-][u-][dbna-][s-]$/ or $strange++;
	$state=~/^r---([-bdna])-$/ or $strange++;
	$1 eq 'b' and $blocking++;
	# this case appears less often - maybe mark it more clearly
	$1 eq 'd' and $blocking++;
	# this happens now and then when resyncing or verifying - typically
	# it should be transient - discussion like 'b'
	$1 eq 'n' and $blocking++;
	# this is "b" and "n" together
	$1 eq 'a' and $blocking++;
      }
    } else {
      chomp;
      $strange++;
      finish("CRITICAL - expected resource line got $_!",2) 
    }

  # "Continuation line" state - the expected line is the second line of a
  # drbd instance, alternatively "Continuation line followed by
  # verification line" state - the only difference is the following state
  } elsif ($expect eq 'C' || $expect eq 'CV' ) {
    if (/^    ns:(\d+) nr:(\d+) dw:(\d+) dr:(\d+) al:(\d+) bm:(\d+) lo:(\d+) pe:(\d+) ua:(\d+) ap:(\d+) ep:(\d+) wo:(\w) oos:(\d+)$/) {
      $7 <= 1 or $localio+=$7;
      $8 == 0 or $pending+=$8;
      $9 <= 1 or $unack+=$9;
      $10 <= 1 or $ap+=$10;
      $11 == 1 or $ep++;
      $12 eq 'f' or $wo++;
      $13 == 0 or $oos++;
      $expect=($expect eq 'CV')?'VI':'L';
    } else { chomp; finish("CRITICAL - expected continuation line got $_!",2) }

  # "Verify information line" state - the expected line is the optional
  # third line of a drbd instance in case the instance is verifying
  } elsif ( $expect eq 'VI' ) {
    if (/ # long regex to parse verify information line
      ^\t\[[=>.]{20,21}\]\ (verifi|sync\')ed:\ *\d+(\.\d+)?\%\ \(\d+\/\d+\)
        Mfinish:\ \d+:\d+:\d+\ speed:\ \d+(,\d+)?\ \(\d+(,\d+)?\)
        \ (want:\ \d+(,\d+)?\ )?.\/sec(\ \(stalled\))?$
      /x) { $verifying++; $expect='L';}
    elsif (/ # long regex to parse verify information line - variant 2
      ^\t\[[=>.]{20,21}\]\ (verifi|sync\')ed:\ *\d+(\.\d+)?\%\ \(\d+\/\d+\)[MK]$
      /x) { $expect='VI2';}
    else {
      $strange++;
      finish("CRITICAL - expected Verify information line got $_!",2);
    }

  # "Verify information line 2" state - the expected line is the optional
  # fourth line of a drbd instance in case the instance is verifying and
  # the optional second line of the verify information lines
  } elsif ( $expect eq 'VI2' ) {
    if ( / # long regex to parse verify information line
        ^\tfinish:\ \d+:\d+:\d+\ speed:\ \d+(,\d+)?\ \(\d+(,\d+)?\)
        \ (want:\ \d+(,\d+)?\ )?.\/sec(\ \(stalled\))?$
      /x ) { $verifying++; $expect='L'; }
    else {
      $strange++;
      finish("CRITICAL - expected Verify information line 2 got $_!",2);
    }

  } else { finish("CRITICAL - state of confusion??!",2); $strange++; }
}

$expect eq 'L' or
  finish("CRITICAL - /proc/drbd ended in incorrect state $expect!",2);

# syntax ok, now semantics ;)
$unconnected && finish("CRITICAL - $unconnected resources not Connected!",2);
$noprimary &&
  finish("CRITICAL - $noprimary resources do not have a Primary!",2);
$notuptodate && finish("CRITICAL - $notuptodate resources not UpToDate!",2);

$strange && finish("CRITICAL - $strange instances of ununderstood syntax!",2);
$wo && finish("CRITICAL - $wo resources do not have flush write order!",2);
$oos && finish("CRITICAL - $oos resources are out of sync!",2);

if ($syncing+$localio+$pending+$unack+$ap+$ep+$verifying) {
  my(@warnings);
  $syncing && push(@warnings,"$syncing syncing");
  $verifying && push(@warnings,"$verifying verifying");
  $localio && push(@warnings,"$localio local I/O pending");
  $pending && push(@warnings,"$pending net req pending");
  $unack && push(@warnings,"$unack net req unanswered");
  $ap && push(@warnings,"$ap app req unanswered");
  $ep && push(@warnings,"$ep epoch increased");
#  this creates warnings quite often. if it happens now and then (not more
#  than 5 minutes) it does not seem a problem - maybe keeping a local
#  counter might be interesting. but this is more or less $localio - TODO
#  $blocking && push(@warnings,"backing device i/o blocking");
  finish("WARNING - ".join(",",@warnings),1);
}

my($ok)='ok';

if ($blocking) {$ok="ok, but $blocking blocking devices";}

my $perfdata = "|DRBD=0;;;;";
finish("OK - $ok|$perfdata",0);

# Show usage
sub usage() {
  print "usage:\n";
  print " $0\n\n";
  exit -1; 
}


sub finish {
    my ($msg,$state) = @_;

    if ($strange) {
      open(D,">>/tmp/debug.drbdnagios");
      print D $debugout;
      print D "$msg\n";
      close(D);
    }
    print "$msg\n";
    exit $state;
}