#!/usr/bin/perl -CA
# check_units v1.0  (c) 10.2.2021 by Andreas Ley  (u) 11.9.2024
# 

my $from = 'apache@scc.kit.edu';
my $to = 'apache@scc.kit.edu';
my $cc = 'webmaster@kit.edu';
my @ignore = (qr/^(session-\d+.scope|user@\d+.service)$/);

use strict;
#no strict 'vars';
use warnings;
no warnings 'uninitialized';
use sigtrap;
use diagnostics;

# The script itself may use utf-8 encoded identifiers and literals
use utf8;
# Latin-1 codepoints are considered characters
use feature 'unicode_strings';
#use locale;
# Enable UTF-8 encoding for all files (but not already open handles)
use open ':encoding(utf8)';

use Getopt::Long;
use File::Basename;
#use File::Spec::Functions;
use Sys::Hostname;

use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Deepcopy = 1;
#warn Data::Dumper->Dump([\%hash],['*']) if ($debug{'file'}>0);
#warn Data::Dumper->new([\%hash],['*'])->Indent(0)->Dump if ($debug{'file'}>0);

my @scaf = ('/bin/systemctl','--all','--full','--failed','--plain','--no-legend');
my @sendmail = ('/usr/sbin/sendmail','-i');

sub usage
{
	my $image = $0;
	$image =~ s!.*/!!;
	print  STDERR  "Usage: $image [options]\n";
	print  STDERR  "-v, --verbose	Verbose mode\n";
	print  STDERR  "-q, --quiet	Quiet mode\n";
	print  STDERR  "-n, --dry-run	Dry run\n";
	exit(1);
}

my %opt;
@_ = @ARGV unless (defined($Devel::Trace::TRACE));
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v+','quiet|q','dry-run|n');
exec($^X,'-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

&usage() if (defined($opt{'help'}) || @ARGV);

if (defined($opt{'verbose'}) || defined($opt{'debug'})) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}

my (%debug,$on,$off);

sub debug
{
	my $file = shift;
	my $line = shift;
	my $prefix = defined($debug{'path'})?$file:defined($debug{'file'})?basename($file):'';
	if (defined($debug{'line'})) {
		$prefix .= ':' if (length($prefix));
		$prefix .= $line;
	}
	$prefix .= '  ' if (length($prefix));
	warn $prefix.(@_>1 ? join(', ',map("\"$_\"",@_))."\n" : "@_\n");
	if (defined($debug{'stacktrace'})) {
		use Carp 'longmess';
		{	no warnings 'once';
			$Carp::MaxArgLen = 0;
			$Carp::MaxArgNum = 0;
		}
		warn longmess('debug called');
	}
}
$debug{undef} = \&debug;

if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*debug'])) if ($debug{'debug'}>0);
	&debug(__FILE__,__LINE__,'%opt = '.Data::Dumper->Dump([\%opt],['*opt'])) if ($debug{'opt'}>0);
	use Term::Cap;
	my $term = Tgetent Term::Cap { 'OSPEED'=>9600 };
	$on = $term->Tputs('md');
	$off = $term->Tputs('me');
}

# Enable UTF-8 encoding for already open handles
# ":utf8" would enable perl native coding which happens to be UTF-8 only on ASCII platforms
binmode(STDIN,':encoding(utf8)');
binmode(STDOUT,':encoding(utf8)');
# Triggers "syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at /usr/share/perl/5.28/sigtrap.pm line 86." when a signal is received
#binmode(STDERR,':encoding(utf8)') unless (defined($Devel::Trace::TRACE));

################################################################################

my @failed;
open(SCAF,'-|',@scaf) or die "Can't run ".join(' ',@scaf).": $!\n";
LOOP: while (<SCAF>) {
	chomp;
	&debug(__FILE__,__LINE__,$.,$_) if ($debug{'read'}>0);
	my ($unit) = split;
	for my $pattern (@ignore) {
		next LOOP if ($unit =~ $pattern);
	}
	push(@failed,$_);
}
close(SCAF);
exit unless (@failed);

my @cmd = (@sendmail,'-f',$from,'-t');
open(MAIL,'|-',@cmd) or die "Can't run ".join(' ',@cmd).": $!\n";
print MAIL "Precedence: bulk\n";
print MAIL "From: $from\n";
print MAIL "To: $to\n";
print MAIL "Cc: $cc\n";
print MAIL "Subject: Failed units on ".hostname()."\n";
print MAIL "\n";
print MAIL "UNIT                       LOAD   ACTIVE SUB    DESCRIPTION\n";
print MAIL "$_\n" for (@failed);
close(MAIL) or die;
