#!/usr/bin/perl
# Copyright 2008 Tobias Tacke, all rights reserved.
# This program is free software; you can redistribute it and/or modify it under the GPL-terms (http://dev.perl.org/licenses/gpl1.html)

use strict;
use warnings;
use Data::Dumper();

my $DISK_TIMEOUT = {};
my $DEBUG = 0;
my $ARG_DEF = qr/^([a-z0-9]+)=(\d+),(\d+)$/;
my $STATUS_DEFINITION = {
	time			=> 1,
	uptime			=> 1,
	log_offset		=> 1,
	first_log_line	=> 1,
	disk			=> {
		disk		=> 1,
		status		=> 1,
		since		=> 1,
	},
};
my $STATUS_WEIGHT = {
	active	=> 0,
	standby	=> 1,
	sleep	=> 2,
};
my $STATUS_FILE = '/var/log/disk_lullaby.status';
my $SYSLOG_FILE = '/var/log/syslog';
my $LOG_FILE = '/var/log/disk_lullaby.log';

my $LOG = undef;
my $UPTIME = 'no time';
__PACKAGE__->_execute(@ARGV);

# VOID
sub _execute {
	my ($class, @args) = @_;
	
	$LOG = __PACKAGE__->_open_log($LOG_FILE);
	$UPTIME = $class->_get_system_uptime();
	
	$class->_read_argv(@args);
	
	$class->_set_disk_access_logging();
	my $status = $class->_read_status_file($STATUS_FILE, [keys(%$DISK_TIMEOUT)]);
	$class->_prepare_status($status, [keys(%$DISK_TIMEOUT)]);
	$class->_log("DEBUG: read status = " . $class->_dump($status)) if($DEBUG);
	my $syslog = $class->_prepare_syslog($SYSLOG_FILE, $status);
	$class->_insert_last_disk_access($syslog, $status, [keys(%$DISK_TIMEOUT)]);
	$class->_log("DEBUG: access status = " . $class->_dump($status)) if($DEBUG);
	foreach my $disk (keys(%$DISK_TIMEOUT)) {
		$class->_log("actual disk status: $disk = $status->{'disk'}->{$disk}->{'status'}, since = $status->{'disk'}->{$disk}->{'since'}");
	}
	my $status_changed = $class->_get_new_disk_status_changes($status->{'uptime'}, $status, $DISK_TIMEOUT, [keys(%$DISK_TIMEOUT)]);
	$class->_log("DEBUG: changed status = $status_changed:" . $class->_dump($status)) if($DEBUG);
	$class->_set_disk_status($SYSLOG_FILE, $status->{'disk'}, [keys(%$DISK_TIMEOUT)], $status) if($status_changed);
	$class->_write_status($status, $STATUS_FILE);
	return;
}
# VOID
sub _read_argv {
	my ($class, @args) = @_;
	
	foreach my $arg (@args) {
		my ($disk, $standby, $sleep) = $arg =~ $ARG_DEF;
		if(!defined($disk)) {
			my $msg = "incorrect usage: $0 " . join(' ', @args) . "\n" .
				"Usage: $0 DISK=STANDBY_TIMEOUT,SLEEP_TIMEOUT\nNo whitespaces in one disk-config allowed. Multiple disks possible";
			$class->_log($msg);
			warn($msg . "\n");
			exit(0);
		}
		
		$DISK_TIMEOUT->{$disk} = {
			standby	=> $standby,
			sleep	=> $sleep,
		};
	}
	$class->_log("DEBUG: disk-timeout parameter = " . $class->_dump($DISK_TIMEOUT)) if($DEBUG);
	if(!scalar(keys(%$DISK_TIMEOUT))) {
		my $msg = "no parameter given. Usage: Usage: $0 DISK=STANDBY_TIMEOUT,SLEEP_TIMEOUT";
		$class->_log($msg);
		warn($msg . "\n");
		exit(0);
	}
	return;
}
# VOID
sub _set_disk_access_logging {
	my ($class) = @_;
	
	local *FH;
	if(!open(FH, '-|', 'cat /proc/sys/vm/block_dump')) {
		$class->_log("can't read kernel-io-access-log status: $!");
		exit(0);
	}
	my $flag = <FH>;
	chop($flag);
	if(!close(FH)) {
		$class->_log("can't read kernel-io-access-log status: $!");
		exit(0);
	}
	return if($flag eq '1');
		
	$class->_log("kernel-io-access-log not enabled, set flag to enable it");
	system('echo 1 >/proc/sys/vm/block_dump');
	return;
}
# \HASH  
sub _get_new_disk_status_changes {
	my ($class, $now, $status, $disk_timeout, $disks) =  @_;
	
	my $some_changes = 0;
	foreach my $disk (@$disks) {
		my $disk_status = $status->{'disk'};
		my $last_activity = $disk_status->{$disk}->{'since'};
		my $deeper_status = {};
		foreach my $status (qw/sleep standby/) {
			next if($deeper_status->{ $disk_status->{$disk}->{'status'} });
			
			my $timeout = $DISK_TIMEOUT->{$disk}->{$status};
			if($last_activity + $timeout < $now) {
				if($status ne $disk_status->{$disk}->{'status'}) {
					$some_changes = 1;
					$class->_log("DEBUG: Change status for disk $disk from $disk_status->{$disk}->{'status'} to $status") if($DEBUG);
					$disk_status->{$disk}->{'status'} = $status;
				}
				last;
			}
			$deeper_status->{$status} = 1;
		}
	}
	if($some_changes) {
		foreach my $disk (@$disks) {
			$status->{'disk'}->{$disk}->{'since'} = $now;
		}
	}
	return $some_changes;
}
# VOID
sub _prepare_status {
	my ($class, $status_file_data, $disks) = @_;
	
	my $max_int = 999_999_999;
	$status_file_data->{'disk'} = {} if(ref($status_file_data->{'disk'}) ne 'HASH');
	foreach my $disk (@$disks) {
		$status_file_data->{'disk'}->{$disk} = {} if(ref($status_file_data->{'disk'}->{$disk}) ne 'HASH');
		
		my $disk_status = $status_file_data->{'disk'}->{$disk};
		$disk_status->{'status'} = 'active' if(!$disk_status->{'status'} || !$STATUS_WEIGHT->{$disk_status->{'status'}});
		$disk_status->{'since'} = $UPTIME if(!$disk_status->{'since'} || $disk_status->{'since'} < 1 || $disk_status->{'since'} > $max_int);
		
		if($disk_status->{'since'} > $UPTIME) {
			$class->_log("Last status-change for disk $disk is in the future, reset 'status' to 'active' and 'since' to 'now'");
			$disk_status->{'status'} = 'active';
			$disk_status->{'since'} = $UPTIME;
		}
	}
	
	$status_file_data->{'uptime'} = 0 if(!$status_file_data->{'uptime'} || $status_file_data->{'uptime'} < 1 || $status_file_data->{'uptime'} > $max_int);
	$status_file_data->{'time'} = 0 if(!$status_file_data->{'time'} || $status_file_data->{'time'} < 1 || $status_file_data->{'time'} > $max_int);
	$status_file_data->{'first_log_line'} = '' if(!$status_file_data->{'first_log_line'} || ref($status_file_data->{'first_log_line'}));
	$status_file_data->{'log_offset'} = 0 if(!$status_file_data->{'log_offset'} || $status_file_data->{'log_offset'} < 1 || $status_file_data->{'log_offset'} > $max_int);
	
	my $timestamp = time();
	if($status_file_data->{'uptime'} > $UPTIME || $status_file_data->{'time'} > $timestamp) {
		$class->_log("actual uptime/time is smaller than logged uptime, possible reboot?"
			. "(uptime:$UPTIME < $status_file_data->{'uptime'}, "
			. "time:$status_file_data->{'time'} < $timestamp)");
		foreach my $disk (keys(%{ $status_file_data->{'disk'} })) {
			$status_file_data->{'disk'}->{$disk}->{'since'} = $UPTIME;
			$status_file_data->{'disk'}->{$disk}->{'status'} = 'active';
		}
	}
	
	$status_file_data->{'time'} = $timestamp;
	$status_file_data->{'uptime'} = $UPTIME;
	return;
}
# VOID
sub _write_status {
	my ($class, $status, $file) = @_;
	
	my @lines = ();
	foreach my $key (keys(%$status)) {
		my $val = $status->{$key};
		my $line = '';
		if(ref($val) eq 'HASH') {
			my @new_val = ();
			foreach my $sub_key (keys(%$val)) {
				my $new_val = "$key:$sub_key";
				my $sub_val = $val->{$sub_key};
				foreach my $sub_sub_key (keys(%$sub_val)) {
					my $sub_sub_val = $sub_val->{$sub_sub_key};
					$new_val .= "\t$sub_sub_key:$sub_sub_val";
				}
				push(@new_val, $new_val);
			}
			$val = join("\n", @new_val);
			$line = "$val\n";
		} else {
			$line = "$key:$val\n";
		}
		push(@lines, $line);
	}
	
	local *FH;
	if(!open(FH, '>', $file)) {
		$class->_log("can't write to status-file: $!");
		exit(0);
	}
	foreach my $line (sort { $a cmp $b } @lines) {
		print FH $line;
	}
	$class->_log("new statusfile: " . $class->_dump(\@lines)) if($DEBUG);
	if(!close(FH)) {
		$class->_log("can't write to status-file: $!");
		exit(0);
	}
	return;
}
# VOID
sub _set_disk_status {
	my ($class, $syslog_file, $disk_status, $disks, $status) = @_;
	
	local *FH;
	if(!open(FH, '>>', $syslog_file)) {
		$class->_log("can't write to syslog-file: $!");
		exit(0);
	}
	foreach my $disk (@$disks) {
		my $new_status = $disk_status->{$disk}->{'status'};
		my $msg = "Change disk $disk status to $new_status";

		if($new_status eq 'sleep') {
			system("hdparm -Y /dev/$disk");
			print FH "[$status->{'uptime'}] $status->{'time'}: $msg\n";
			$class->_log($msg);
		
		} elsif($new_status eq 'standby') {
			system("hdparm -y /dev/$disk");
			print FH "[$status->{'uptime'}] $status->{'time'}: $msg\n";
			$class->_log($msg);
		}
	}
	if(!close(FH)) {
		$class->_log("can't write to syslog-file: $!");
		exit(0);
	}
	return;
}
# BOOLEAN
sub _change_disk_status {
	my ($class, $last_access, $disk_status, $timeout, $new_disk_status, $status) = @_;
	
	$last_access ||= 0;
	if($last_access > $status->{'uptime'}) {
		$class->_log("disk access is in the future (date:$last_access, uptime:$status->{'uptime'})");
		foreach my $disk (keys(%{ $status->{'disk'} })) {
			$status->{'disk'}->{$disk}->{'since'} = $status->{'uptime'};
			$status->{'disk'}->{$disk}->{'status'} = 'active';
		}
		return 0;
	}
	
	return 0 if($STATUS_WEIGHT->{$new_disk_status} <= $STATUS_WEIGHT->{$disk_status->{'status'}});
	return 0 if(($last_access + $timeout) > $status->{'uptime'});
	return 0 if(($disk_status->{'since'} + $timeout) > $status->{'uptime'});
	return 1;
}
# VOID
sub _insert_last_disk_access {
	my ($class, $syslog, $status, $disks) = @_;
	
	my $existing_disks = {};
	foreach my $disk (@$disks) {
		$existing_disks->{$disk} = 1;
	}
	my $actual_status = {};
	while(my $line = <$syslog>) {
		chomp($line);
		if($line =~ m/^[^\[]+\[\W*(\d+\.\d+)\] ([^\(]+)\(\d+\): ([^0-9]+) .*? on ([a-zA-Z]+)\d+$/) {
			my ($time, $process, $cmd, $disk) = ($1, $2, $3, $4);
			next if(!$existing_disks->{$disk});
			next if($cmd !~ /^(?:dirtied|READ|WRITE) /);
			
			$actual_status->{$disk} = $time if(!$actual_status->{$disk} || $time > $actual_status->{$disk});
		} elsif($line =~ m/kernel:\W+\[\W*0.000000\]\W+Initializing/) {
			$class->_log("Reboot found, recalculating last disk access ($line)");
			foreach my $disk (@$disks) {
				$actual_status->{$disk} = $status->{'uptime'};
			}
		}
		
	}
	foreach my $disk (keys(%$actual_status)) {
		if($actual_status->{$disk} > $status->{'uptime'}) {
			$class->_log("last $disk disk access in syslog is in the future > reset to status = active: $actual_status->{$disk} > $status->{'uptime'}");
			$actual_status->{$disk} = $status->{'uptime'};
		}
		if($status->{'disk'}->{$disk}->{'since'} < $actual_status->{$disk}) {
			$status->{'disk'}->{$disk}->{'status'} = 'active';
			$status->{'disk'}->{$disk}->{'since'} = $actual_status->{$disk};
		}
		$class->_log("DEBUG: last $disk disk access in syslog: $actual_status->{$disk}") if($DEBUG);
	}
	$status->{'log_offset'} = tell($syslog);
	if(!close($syslog)) {
		$class->_log("can't close syslog: $!");
		exit(0);
	}
	return;
}
# \FH
sub _prepare_syslog {
	my ($class, $file, $status) = @_;
	
	local *FH;
	if(!open(FH, '<', $file)) {
		$class->_log("can't open syslog: $!");
		exit(0);
	}
	
	my $first_line = <FH>;
	chop($first_line);
	if(!$status->{'first_log_line'} || $status->{'first_log_line'} ne $first_line) {
		$status->{'first_log_line'} = $first_line;
		$class->_log("first log-line is changes: reset log offset");
		$status->{'log_offset'} = 0;
	}
	
	my $size = (stat($file))[7];
	if($size < $status->{'log_offset'}) {
		$class->_log("log-file-size is smaller than offset ($size < $status->{'log_offset'}): reset log offset");
		$status->{'log_offset'} = 0;
	}
	$class->_log("DEBUG: log offset = $status->{'log_offset'}") if($DEBUG);
	seek(FH, $status->{'log_offset'}, 0);
	return *FH{'IO'};
}
# \HASH
sub _read_status_file {
	my ($class, $file, $disks) = @_;
	
	my $used_disks = {};
	foreach my $disk (@$disks) {
		$used_disks->{$disk} = 1;
	}
	
	my $data = {};
	local *FH;
	if(!open(FH, '<', $file)) {
		$class->_log("can't read status-file: $!");
		return $data;
	}
	
	while(my $line = <FH>) {
		chomp($line);
		
		my ($key, $value) = split(/:/, $line, 2);
		next if(!$key);
		
		if(!$STATUS_DEFINITION->{$key}) {
			$class->_log("key $key is not allowed in status_file: $line");
			next;
		}
		
		if(ref($STATUS_DEFINITION->{$key}) eq 'HASH') {
			my @data = split(/\t/, $line);
			(undef, $value) = split(/:/, shift(@data), 2);
			next if(!$used_disks->{$value});
			
			$data->{$key} ||= {};
			my $subdata = {};
			foreach my $pair (@data) {
				my ($subkey, $subval) = split(/:/, $pair, 2);
				if(exists($subdata->{$subkey})) {
					$class->_log("status_file key $key is defined twice: $line");
					next;
				}
				$subdata->{$subkey} = $subval;
			}
			if(exists($data->{$key}->{$value})) {
				$class->_log("status_file key $key is defined twice: $line");
				next;
			}
			$data->{$key}->{$value} = $subdata;
		} else {
			if(exists($data->{$key})) {
				$class->_log("status_file key $key is defined twice: $line");
				next;
			}
			$data->{$key} = $value;
		}
	}
	if(!close(FH)) {
		$class->_log("can't read status-file: $!");
		exit(0);
	}
	return $data;
}
# VOID
sub _get_system_uptime {
	my ($class) = @_;
	
	if(!open(FH, '<', '/proc/uptime')) {
		$class->_log("Can't get uptime: $!");
		exit(0);
	}
	my $time = <FH>;
	if(!close(FH)) {
		$class->_log("Can't get uptime: $!");
		exit(0);
	}
	
	chop($time);
	my ($uptime, $idle_time) = split(/ +/, $time);
	return $uptime;
}
# VOID
sub _log {
	my ($class, $msg, $status) = @_;
	
	my $time = localtime(time());
	print $LOG "\n$UPTIME ($time): $msg";
	return;
}
# \FH
sub _open_log {
	my ($class, $file) = @_;
	local *FH;
	open(FH, '>>', $file) or die $!;
	return *FH{'IO'};
}
# STRING
sub _dump {
	return Data::Dumper::Dumper(@_);
}