Mail::Barracuda::API - Manage Barracuda Antispam Appliance

  use Mail::Barracuda::API;
  my $api = Mail::Barracuda::API->new(
  	server => 'mybarracuda.mydomain.com',
	port => 8000,
	api_key => 'my API key',
  );
  $api->domainAdd(domain => 'example.com', mailhost=> 'mail.example.com');
  $api->domainRemove(domain => 'example.com');

	my $api = Mail::Barracuda::API->new(
		server => 'http://mybarracuda.mydomain.com',
		port => 8000,
		api_key => 'my API key',
	);

	my $response = $api->userChange(
		email => 'jane@example.com',
		var => 'user_password', 
		val=> '4321',
	);

	my $response = $api->domainAdd(
		domain => 'example.com', 
		mailhost => 'mail.example.com',
	);

	my $response = $api->domainRemove(domain => 'example.com');

	my $response = $api->userAdd(
		email => 'jane@example.com', 
		paassword => '12345',
	};

	my $response = $api->userRemove(email => 'jane@example.com');

package Mail::Barracuda::API;

use 5.008008;
use strict;
use warnings;
use Data::Dumper;
use XML::Simple;
use LWP::UserAgent;

our $VERSION = '0.01';

sub new {
	my $invocant = shift;
	my $class = ref($invocant) || $invocant;
	
	my $self = {
		port => 8000,
		@_
	};
	
	return bless $self, $class;	
}

sub userChange {
	my ($class, %args) = @_;
	my $result = 0;
	
	my $email = $args{email};
	my $var = $args{var};
	my $val = $args{val};
	
	my $cmd = "config_set.cgi?account=$email&variable=$var&value=$val";
	my ($respcode, $status) = $class->_doRequest(command => $cmd);
	if ($respcode != 200) {
		print STDERR "$respcode: Could not change user $email var $var to $val\n";
		$result = 1;	
	}
	
	return $result;
}

sub domainAdd {
	my ($class, %args) = @_;
	my $result = 0;
	
	my $domain = $args{domain};
	my $mailhost = $args{mailhost};
	
	my $cmd = "add_domain.cgi?domain=$domain";
	my ($respcode, $status) = $class->_doRequest(command => $cmd);
	
	if ($respcode != 200) {
		print STDERR "Could not add domain $domain: $status\n";
		$result = 1;
	} else {
		$cmd = "config_set.cgi?variable=mta_relay_advanced_host";
		$cmd .= "&domain=$domain&value=$mailhost";
		$class->_doRequest(command => $cmd);
		if ($respcode != 200) {
			print STDERR "$respcode: Could not set mailhost for $domain: $status\n";
			$result = 1;	
		} 
	}
	
	return $result;
}

sub domainRemove {
	my ($class, %args) = @_;
	my $result = 0;
	
	my $domain = $args{domain};
		
	my $cmd = "delete_domain.cgi?domain=$domain";
	my ($respcode, $status) = $class->_doRequest(command => $cmd);
	if ($respcode != 200) {
		print STDERR "$respcode: Could not remove domain $domain: $status\n";
		$result = 1;
	}
	return $result;
}

sub userAdd {
	my ($class, %args) = @_;
	my $result = 0;	

	my $email = $args{email};
	my $pass = $args{password};
	
	my $cmd = "config_add.cgi?account=$email&create=1";	
	my ($respcode, $status) = $class->_doRequest(command => $cmd);
	
	if ($respcode != 708) {
		print STDERR "$respcode: Could not add user $email: $status\n";
		$result = 1;
	} else {
		my $resp = $class->userChange(
			email => $email,
			var => 'user_password',
			val => $pass,
		);
		if ($resp != 0) {
			print STDERR "$respcode: Could not set password for user $email: $status\n";
			$result = 1;
		}
	}
		
	return $result;
}

sub userRemove {
	my ($class, %args) = @_;
	my $result = 0;
	
	my $email = $args{email};
	
	my $cmd = "config_delete.cgi?account=$email&remove=1";
	my ($respcode, $status) = $class->_doRequest(command => $cmd);

	if ($respcode != 607) {
		print STDERR "$respcode: Could not remove user $email: $status\n";
		$result = 1;
	}
	
	return $result;
}

# Extract response code from XML response, returns status number and 
# a brief explanation
sub _parseResponse{
	my $res = pop(@_);
		
	my $xs = XML::Simple->new();
	my $ref = $xs->XMLin($res);
		
	my ($code, $result);
		
	if (exists($ref->{Result})) {
		if (ref($ref->{Result}) eq "HASH") {
			$code = $ref->{Result}->{Code};
			$result = $ref->{Result}->{String};
		} else {
			($code, $result) = split(/:/, $ref->{Result});
		}
	
	} elsif (exists($ref->{Error})) {		
		if (exists($ref->{Error}->{Code})) {
			$code = $ref->{Error}->{Code};
			$result = $ref->{Error}->{String};
		}
		
	} else {
		print Dumper($ref);
		die "Unmatched response from Appliance. Cannot continue.\n";
	}
		
	return ($code, $result);
}

sub _doRequest {
	my ($class, %args) = @_;
	my $cmd = $args{command};
	
	my @response;
	
	my $precmd = $class->{server} . ":" . $class->{port} . "/cgi-bin/";
	my $postcmd = "&password=" . $class->{api_key};
	$cmd = $precmd . $cmd . $postcmd;
		
	my $ua = LWP::UserAgent->new;
	$ua->agent("Mail::Barracuda::API/$VERSION ");
	
	my $req = HTTP::Request->new(GET => $cmd);
	my $res = $ua->request($req);
	
	if ($res->is_success) {
		@response = $class->_parseResponse($res->content);	
	} else {
		die "Error contacting Appliance: " . $res->status_line, "\n";
	}
		
	$class->_doApply();
	return @response;
}

sub _doApply {
	my ($class, %args) = @_;
	my $result = 0;
	my @response;
	
	my $cmd = "config_reload.cgi?";
	my $precmd = $class->{server} . ":" . $class->{port} . "/cgi-bin/";
	my $postcmd = "password=" . $class->{api_key};
	$cmd = $precmd . $cmd . $postcmd;
		
	my $ua = LWP::UserAgent->new;
	$ua->agent("Mail::Barracuda::API/$VERSION ");
	
	my $req = HTTP::Request->new(GET => $cmd);
	my $res = $ua->request($req);
		
	if ($res->is_success) {
		@response = $class->_parseResponse($res->content);	
	} else {
		$result = 1;
		die "Error contacting Appliance: " . $res->status_line, "\n";
	}
		
	return $result;
}