#! /usr/bin/perl -T
# $Id: dnsmon_account,v 1.4.4.2 2008/05/29 10:32:43 ruben Exp $
############################################################################
###    (C)opyright 2003 - 2008 RIPE NCC
###    This file is part of DNSMon
###
###    DNSMon 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 3 of the License, or
###    (at your option) any later version.
###
###    DNSMon 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 DNSMon.  If not, see <http://www.gnu.org/licenses/>.
############################################################################

use strict;
use warnings;
use SOAP::Lite;
use Data::Dumper;
use Getopt::Std;
use Error qw(:try);

$Getopt::Std::STANDARD_HELP_VERSION = 1 if $Getopt::Std::VERSION >= 1.05;

our $VERSION = sprintf "%d.%03d", q$Revision: 1.4.4.2 $ =~ /(\d+)/g;

sub list;
sub moduser;
sub modgroups;
sub adduser;
sub addgroups;
sub deluser;
sub delgroups;

# Build in operations and help for them
my %operations = (
	list		=> '- list accounts with password and groups',
	adduser		=> '<user> <password> - Adds a new account (or replaces password)',
	deluser		=> '<user> - Removes an account',
	addgroups	=> '<user> <groups> - Adds user to specified group. Ignores already used groups',
	delgroups	=> '<user> <groups> - Removes user from specified group',
	moduser		=> '- Alias for adduser',
	modgroups	=> ' -Alias for addgroups',
);

my %operation_func = (
	list		=> \&list,
	adduser		=> \&adduser,
	deluser		=> \&deluser,
	addgroups	=> \&addgroups,
	delgroups	=> \&delgroups,
	moduser		=> \&moduser,
	modgroups	=> \&modgroups,
);

my %options;

# Use this for our checksoap later on. We recast Error::Simple obtained from
# SOAP::Lite into Error::SOAP

@Error::SOAP::ISA = qw(Error::Simple);

my $soap = SOAP::Lite
		->uri('https://server.example.net/RIPE/DNSMon/SubscriberManagement')
		->proxy('https://server.example.net/soap/', keep_alive => 1);

getopts("hvd",\%options);

if (exists($options{'h'}))
{
	&usage;
	exit 1;
}

SOAP::Lite->import(+trace => ['method' , 'transport' ]) if exists($options{'v'});
SOAP::Lite->import(+trace => 'all' ) if exists($options{'d'});

# Untaint remaining arguments. Same requirements as RIPE::DNSMon::SubscriberManagement
@ARGV = map {/^([\w\-_\.]+)$/} @ARGV;

# Get operation
my $operation = shift @ARGV;

# Check for valid operations
if ($operation && (grep {$operation eq $_} keys %operations)) {
	if ($ARGV[0] && $ARGV[0] eq "help" ) {
		# "help" mode
		print "$0: usage $operation $operations{$operation}\n";
	} else {

		# Try to run selected operation, print usage when it fails.
		# SOAP::Lite might also have printed some diagnostics at this time too.

		try {
			$operation_func{$operation}(@ARGV) || print "failed: $operation @ARGV: usage $operation $operations{$operation}\n";
		} catch Error::SOAP with {
			my $E = shift;
			print "Remote SOAP call failed: $E->{-text}\n";
		} catch Error::Simple with {
			my $E = shift;
			print $E->{-text}, "\n";
		} otherwise {
			warn "Unhandled exception: @{[ map { ref $_ ?  $_ : $_} @_ ]}";
		}
	}
} else {
	&usage;
}

# XXX I thought SOAP::Lite would handle "fault" events through it's default
# on_fault handler ?  Maybe because we are throw'ing Error::Simple on the other
# side This sub will sit around SOAP calls doing the intermediate check before
# returning the SOAP::SOM object back
#

sub checksoap {
	my ($som) = @_;
	if ($som && $som->fault) {
		my $fault = new SOAP::Fault(%{$som->fault});
		if ( ref $fault->detail eq 'HASH' && exists $fault->detail->{Error__Simple} ) {
			# Looks like SOAP::Fault got a serialized Error::Simple object back.
			# Lets rethrow this as an 'Error::SOAP'
			my $err = bless $fault->detail->{Error__Simple}, 'Error::SOAP';
			throw $err;
		} elsif (!$soap->transport->is_success) {
			throw Error::Simple("SOAP transport failed: " . $soap->transport->status . ", fault: " . $fault);
		} else {
			throw Error::Simple("Unknown SOAP error. rerun command with -d for diagnostics");
		}

	} 	return $som;
}

# Stub functions calling their counterparts over SOAP

sub list {
	my (@users) = @_;

	printf("%-24s%-32sgroups\n",qw(user password) );

	foreach my $user (sort ($#users >= 0 ? @users : (checksoap($soap->users)->paramsall) )) {
		my ($password) = checksoap($soap->user($user))->result;
		my (@groups) = checksoap($soap->groups($user))->paramsall;
		printf("%-24s%-32s@groups\n", $user, $password);
		
	}
	return 1;
}

sub moduser {
	return adduser(@ARGV);
}

sub modgroups {
	return addgroups(@ARGV);
}

sub adduser {
	my ($user,$pass) = @_;
	return checksoap($soap->adduser($user,$pass))->result;
}

sub deluser {
	my ($user,$pass) = @_;
	return checksoap($soap->delusers($user))->result;
}

sub addgroups {
	my ($user,@groups) = @_;
	return checksoap($soap->addgroups($user,@groups))->result;
}

sub delgroups {
	my ($user,@groups) = @_;
	return checksoap($soap->delgroups($user,@groups))->result;
}

sub HELP_MESSAGE() {
	&usage;
}

sub usage {
	print STDERR <<"EOT";
dnsmon_account -h -v -d [ @{[join(" | ", sort keys %operations) ]} ] help
EOT
	foreach my $operation (sort keys %operations) {
		print "\t$operation $operations{$operation}\n";
	}
}

__END__

=pod

=head1 NAME

B<dnsmon_account> -- Manage DNSMon subscribers

=head1 SYNOPSIS:

dnsmon_account -h -v -d [ addgroups | adduser | delgroups | deluser | list | modgroups | moduser ] help

=head1 OPTIONS

=over

=item B<-h> Short help message

=item B<-v> Be verbose. this turns on SOAP::Lite method and fault tracing (see SOAP::Trace)

=item B<-d> Enable copoious debugging output. this turns on all SOAP::Lite tracing (see SOAP::Trace)

=item B<addgroups I<user> I<groups> > Adds user to specified group. Ignores already used groups

=item B<adduser I<user> I<password> > Adds a new account (or replaces password)

=item B<delgroups I<user> I<groups> > Removes user from specified group

=item B<deluser I<user> > Removes an account

=item B<list> list accounts with password and groups

=item B<modgroups  >Alias for addgroups

=item B<moduser> Alias for adduser

=back

=head1 NOTES

Some background info:

This script actually is a SOAP client for RIPE::DNSMon::SubscriberManagement

=head1 DEBUGGING

Either B<-d> or B<-v> turns on SOAP tracing.

=head1 BUGS

Needs actually to use https

=cut

