#!/usr/bin/perl

# imvirt - I'm virtualized?
#
# Authors:
#   Thomas Liske <liske@ibh.de>
#
# Copyright Holder:
#   2012 - 2013 (C) IBH IT-Service GmbH [http://www.ibh.de/]
#
# License:
#   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.
#
#   You should have received a copy of the GNU General Public License
#   along with this package; if not, write to the Free Software
#   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
#

use strict;
use warnings;
use Getopt::Std;
use MIME::Lite;
use ImVirt;

$|++;

eval 'use File::Which;';
my $nowhich = $@;


my $hostname = `hostname -f`;
chomp($hostname);

$Getopt::Std::STANDARD_HELP_VERSION++;

sub HELP_MESSAGE {
    print <<USG;
About:
  imvirt-report collects various system information and saves them to a
  mime encoded file. It might help the upstream author to provide a better
  detection support of virtualizing technologies. It might be helpful to
  attach the output to bug reports.

Usage:
  imvirt-report [-s <filename>]

    -s <filename>	where to write the collected data

USG
}

sub VERSION_MESSAGE {
    print <<LIC;
imvirt $ImVirt::VERSION - I'm virtualized?

Authors:
  Thomas Liske <liske\@ibh.de>

Copyright Holder:
  2008 - 2013 (C) IBH IT-Service GmbH [http://www.ibh.de/]

License:
  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.

LIC
    #'
}

our $opt_s = "imvirt-report_${hostname}_$$.eml";
getopts('s:') || exit(1);

my $ivout = imv_get(IMV_PROB_DEFAULT);

my $msg = MIME::Lite->new(
    Subject	=> $hostname,
    Type	=> 'multipart/mixed',
);

$msg->attach(
    Type	=> 'TEXT',
    Data	=> "Hostname: $hostname\nImVirt Version: $ImVirt::VERSION\nImVirt Output: $ivout\n",
);

sub attach_path($$) {
    my ($msg, $glob) = @_;

    foreach my $path (glob $glob) {
	my $fn = $path;
	$fn =~ s@/@_@g;

	unless (-r $path) {
	    $msg->attach(
		Type => 'TEXT',
		Data => "File $path not readable!",
		Filename => $fn,
	    );
	}
	else {
	    print STDERR " Attaching '$path'.\n";
	    $msg->attach(
		Type => 'TEXT',
		Path => $path,
		Filename => $fn,
	    );
	}
    }
}

sub attach_cmd($$$) {
    my ($msg, $cmd, $params) = @_;
    my $run = ($nowhich ne '' ? $cmd : which($cmd));

    unless (defined($run)) {
	$msg->attach(
	    Type => 'TEXT',
	    Data => "Command $cmd not available!",
	    Filename => $cmd,
	);

	return;
    }

    print STDERR " Attaching `$cmd $params`.\n";
    $msg->attach(
	Type => 'TEXT',
	Data => scalar `$run $params 2>&1`,
	Filename => $cmd,
    );
}

print STDERR "Collecting data...\n";

attach_path($msg, '/proc/1/cgroup');
attach_path($msg, '/proc/1/environ');
attach_path($msg, '/proc/1/stat');
attach_path($msg, '/proc/cmdline');
attach_path($msg, '/proc/cpuinfo');
attach_path($msg, '/proc/kallsyms');
attach_path($msg, '/proc/mounts');
attach_path($msg, '/proc/modules');
attach_path($msg, '/proc/bus/input/devices');
attach_path($msg, '/proc/uptime');
attach_path($msg, '/proc/timer_list');
attach_path($msg, '/sys/devices/system/clocksource/clocksource*/available_clocksource');
attach_path($msg, '/sys/devices/system/cpu/cpu*/cpufreq/scaling_driver');
attach_path($msg, '/var/log/dmesg');

attach_cmd($msg, 'dmesg', '');
attach_cmd($msg, 'dmidecode', '');
attach_cmd($msg, 'find', '/dev');
attach_cmd($msg, 'find', '/proc');
attach_cmd($msg, 'find', '/sys');
attach_cmd($msg, 'imvirt', '-d');
attach_cmd($msg, 'lsb_release', '-a');
attach_cmd($msg, 'lspci', '');
attach_cmd($msg, 'uname', '-a');


open(HSAVE, '>', $opt_s) || die "Could not open $opt_s: $!\n";
$msg->print(\*HSAVE);
close(HSAVE);

print STDERR "Data saved to '$opt_s'.\n";
