diff -r 000000000000 -r b30cade45ad7 check
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/check	Thu Jan 09 20:58:30 2014 +0100
@@ -0,0 +1,137 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use POSIX;
+use File::Spec::Functions;
+use Data::Dumper;
+use File::Find;
+use Carp;
+
+sub su;
+sub find_tool;
+sub check_perms;
+sub config_names;
+sub get_devices;
+sub amcheck;
+sub amlist;
+
+# test needs to be run as root:* or as backup:backup
+my $USER = 'backup';
+my $CFDIR = '/etc/amanda';
+
+# change to backup if still root
+su $USER if $> == 0;
+
+# amservice needs to be suid root, but executable
+# by the backup user/group
+check_perms find_tool('amservice'), 04750, 'root', $);
+
+# find the backup sets we know about
+# here we suppose that it's possible to find strings like
+# 'conf "foo"' in files named 'amanda-client.conf' below /etc/amanda
+
+my @confs = config_names $CFDIR
+	or die "no amanda backup sets found (did: find $CFDIR -name amanda-client.conf)\n";
+
+#eval { amcheck $_ } or die $@
+#		foreach @confs;
+
+my @devs = get_devices;
+foreach (@confs) {
+	my @dles = amlist $_;
+	warn Dumper \@dles;
+	warn Dumper \@devs;
+}
+
+exit;
+#---
+
+# compare the file systems
+# get a list of file system
+sub get_devices {
+	open(my $fh, '/proc/filesystems');
+	my @types = map { /^\s+(\S+)/ ? $1 : () } <$fh>;
+	my @df = (df => '-P', map { -t => $_ } @types);
+	map { [$_, (stat)[0]] } map { (split ' ', $_)[5] } grep { /^\// } `@df`;
+}
+
+sub su {
+	my $user = shift;
+	my $group = (getgrnam $user)[0];
+	my $uid = getpwnam $user;
+	my $gid = getgrnam $group;
+
+	my @groups;
+	
+	setgrent;
+	my @rc;
+	while (my @g = getgrent) {
+		 push @groups, $g[2] if $USER ~~ [split ' ', $g[3]];
+	}
+	endgrent;
+	$) = "@groups";
+	setgid $gid;
+	setuid $uid;
+}
+
+sub find_tool {
+	my $name = shift;
+	my @rc = grep { -f -x } map { catfile $_, $name } split /:/, $ENV{PATH}
+		or croak "Can't find `$name' in $ENV{PATH}\n";
+	$rc[0];
+};
+
+sub check_perms {
+	my ($file, $mode, $owner, $group) = @_;
+
+	$owner = getpwuid $owner if $owner ~~ /^\d+$/;
+	
+	$group = getgrgid +(split ' ', $group)[0]
+		if $group ~~ /^[\d\s]+$/;
+
+	stat $file or croak "Can't stat `$file': $!\n";
+
+	eval {
+		my $f_owner = getpwuid +(stat _)[4] or die $!;
+		my $f_group = getgrgid +(stat _)[5] or die $!;
+		my $f_mode = (stat _)[2] & 07777 or die $!;
+
+		my $msg = sprintf "need: 0%04o root:$group, got: 0%04o $f_owner:$f_group\n", 
+			$mode, $f_mode;
+
+		die $msg unless $f_owner eq $owner;
+		die $msg unless $f_group eq $group;
+		die $msg unless $f_mode == $mode;
+	};
+	croak "wrong permissions for `$file', $@" if $@;
+}
+
+
+sub config_names {
+	my $dir = shift;
+	my @configs = ();
+	find(sub {
+		-f and /^amanda-client\.conf$/ or return;
+		open(my $fh, '<', $_) or die "Can't open  $File::Find::name: $!\n";
+		push @configs, map { /^conf\s+"(.+?)"/ ? $1 : () } <$fh>;
+	}, $dir);
+	return @configs;
+};
+
+sub amcheck {
+	my $conf = shift;
+	my @errors = map { "$conf: $_" } grep { /^error/i } qx(amdump_client --config '$conf' check 2>&1);
+	die @errors if @errors;
+	return 1;
+}
+
+sub amlist {
+	my $conf = shift;
+	chomp((undef, my @dles) = qx(amdump_client --config '$conf' list));
+	return map { [$_, (stat $_)[0] ] } @dles;
+}
+
+__END__
+system amdump_client => '--config', 'daily', 'list';