Subversion Repositories general

#!/usr/bin/perl -w

#

# Sample backend for HostAdmiral

# (copyleft) Anatoli Klassen

#

# FIXME use transactions

use strict;

use vars;

use subs;

use Socket;

use DBI;

use Time::HiRes qw( gettimeofday tv_interval );

# == configuration =============================

my $host        = '127.0.0.1';

my $port        = 9097;

my $password    = '0123456789ABCDEF';

my $db_url      = 'DBI:mysql:database=mail;host=localhost;port=3306';

my $db_user     = 'root';

my $db_password = '';

my $log_level   = 9;                              # 0 - none, 9 - all

# == constants =================================

my $protocol_ver_maj   = "1";

my $protocol_ver_min   = "0";

my $protocol_header    = "HostAdmiral_TcpListener";

my $password_header    = "password=";

my $domain_header      = "inetDomain";

my $user_header        = "user";

my $system_user_header = "systemUser";

my $mailbox_header     = "mailbox";

my $mail_alias_header  = "mailAlias";

my $create_action      = "create";

my $modify_action      = "modify";

my $delete_action      = "delete";

# response codes

my $code_ok               = 200;

my $code_ok_but           = 201;

my $code_ignored          = 202;

my $code_no_body          = 400;

my $code_protocol_header  = 401;

my $code_no_end_lines     = 402;

my $code_no_password      = 403;

my $code_wrong_password   = 404;

my $code_no_command       = 405;

my $code_wrong_command    = 406;

my $code_unknown_command  = 407;

my $code_wrong_params     = 408;

my $code_db_connect_error = 501;

my $code_db_error         = 502;

my $code_db_close_error   = 503;

# == internal global variables =================

my %handlers;

sub connection_loop

{

	# listen for connections

	socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or die "$!\n";

	setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1)             or die "$!\n";

	bind(SERVER, sockaddr_in($port, inet_aton($host)))          or die "$!\n";

	listen(SERVER, 1);

	while(1) {

		# get connection

		my $rem_addr = accept(CLIENT, SERVER);

		my $buf;

		my $body = "";

		my %request = ();

		#log_debug("Remote: $rem_addr");

		$request{'start_timestamp'} = [gettimeofday];

		# receive request body

		while((my $size = sysread CLIENT, $buf, 65536) > 0) {

			$body .= $buf;

		}

		$request{'body'} = $body;

		$request{'body_timestamp'} = [gettimeofday];

		# call handler

		handle_request(\%request);

		$request{'done_timestamp'} = [gettimeofday];

		# print out response

		print CLIENT "$protocol_header $protocol_ver_maj.$protocol_ver_min"

			. "\n$request{'code'} $request{'response'}\n\n";

		close CLIENT;

		$request{'stop_timestamp'} = [gettimeofday];

		log_debug("Duration: " . tv_interval($request{'start_timestamp'},

			$request{'stop_timestamp'}) . " sec");

	}

	# close the port

	close SERVER;

}

sub handle_request

{

	my $request = shift @_;

	log_debug("Handle request [\n$request->{'body'}]");

	my @lines = split /\n/, $request->{'body'}, -1;

	my $cur   = 0;

	# check header

	if($#lines < $cur) {

		set_request_code($request, $code_no_body, "Request without body");

		return;

	}

	unless($lines[$cur] =~ /^$protocol_header $protocol_ver_maj\.\d+$/) {

		set_request_code($request, $code_protocol_header, "Request must start"

			. "with [$protocol_header $protocol_ver_maj.minor],"

			. " but [$lines[$cur]] found");

		return;

	}

	$cur++;

	# check end lines

	if($#lines < $cur+1 || $lines[$#lines-1] ne "" || $lines[$#lines] ne "") {

		set_request_code($request, $code_no_end_lines,

			"Request doesn't end with \\n\\n");

		return;

	}

	# check password

	if($password) {

		if($#lines < $cur || !($lines[$cur] =~ /^$password_header/)) {

			set_request_code($request, $code_no_password,

				"Password not specified");

			return;

		}

		unless($lines[$cur] =~ /^$password_header$password$/) {

			set_request_code($request, $code_wrong_password,

				"Wrong password");

			return;

		}

		$cur++;

	}

	# get command handler

	if($#lines < $cur) {

		set_request_code($request, $code_no_command, "Empty command");

		return;

	}

	unless($lines[$cur] =~ /^(\S+)\t(\S+)/) {

		set_request_code($request, $code_wrong_command, "Can not get command");

		return;

	}

	$request->{'command'}    = $1;

	$request->{'subcommand'} = $2;

	$request->{'handler'}    = $handlers{"$1_$2"};

	unless($request->{'handler'}) {

		set_request_code($request, $code_unknown_command,

			"Unknown command [$request->{'command'} $request->{'subcommand'}]");

		return;

	}

	# call

	log_debug("call $request->{'command'}_$request->{'subcommand'}");

	my @params = @lines[$cur..$#lines-2];

	&{$request->{'handler'}}($request, @params);

}

sub handle_user_create

{

	my $request = shift @_;

	set_request_code($request, $code_ignored, "Not interesting in users");

}

sub handle_user_modify

{

	my $request = shift @_;

	set_request_code($request, $code_ignored, "Not interesting in users");

}

sub handle_user_delete

{

	my $request = shift @_;

	set_request_code($request, $code_ignored, "Not interesting in users");

}

sub handle_domain_create

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_, ("name"));

	return unless(%params);

	my $res_action = save_to_db($request, "transport",

		{ domain => $params{"name"} },

		{ domain => $params{"name"}, comment => $params{"comment"},

		  transport => 'virtual:' } );

	if($res_action eq 'update') {

		return unless(restart_mail_system());

		set_request_code($request, $code_ok_but, "Domain exists, modified");

	}

	elsif($res_action eq 'insert') {

		return unless(restart_mail_system());

		set_request_code($request, $code_ok, "Domain created");

	}

}

sub handle_domain_modify

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_, ("oldName", "name"));

	return unless(%params);

	my $res_action = save_to_db($request, "transport",

		{ domain => $params{"oldName"} },

		{ domain => $params{"name"}, comment => $params{"comment"},

		  transport => 'virtual:' } );

	if($res_action eq 'update') {

		return unless(restart_mail_system());

		set_request_code($request, $code_ok, "Domain modified");

	}

	elsif($res_action eq 'insert') {

		return unless(restart_mail_system());

		set_request_code($request, $code_ok_but, "Domain not found, created");

	}

}

sub handle_domain_delete

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_, ("name"));

	return unless(%params);

	my $res_action = delete_from_db($request, "transport",

		{ domain => $params{"name"} } );

	if($res_action eq 'delete') {

		return unless(restart_mail_system());

		set_request_code($request, $code_ok, "Domain deleted");

	}

	elsif($res_action eq 'not found') {

		set_request_code($request, $code_ok_but, "Domain not found");

	}

}

sub handle_system_user_create

{

}

sub handle_system_user_modify

{

}

sub handle_system_user_delete

{

}

sub handle_mailbox_create

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_,

		("login", "password", "domain"));

	return unless(%params);

	my $res_action = save_to_db($request, "users",

		{ login => "$params{'login'}\@$params{'domain'}" },

		{ login => "$params{'login'}\@$params{'domain'}",

		  password => $params{"password"},

		  maildir => "$params{'domain'}/$params{'login'}/",

		  expired => ($params{"enabled"} eq "true" ? 0 : 1),

		  comment => $params{"comment"},

		  uid => ($params{"systemUser"} ? $params{"systemUser"} : undef) } );

	if($res_action eq 'update') {

		set_request_code($request, $code_ok_but, "Mailbox exists, modified");

	}

	elsif($res_action eq 'insert') {

		set_request_code($request, $code_ok, "Mailbox created");

	}

}

sub handle_mailbox_modify

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_,

		("oldLogin", "oldDomain", "login", "domain"));

	return unless(%params);

	# FIXME move the old maildir

	my $res_action = save_to_db($request, "users",

		{ login => "$params{'oldLogin'}\@$params{'oldDomain'}" },

		{ login => "$params{'login'}\@$params{'domain'}",

		  password => $params{"password"},

		  maildir => "$params{'domain'}/$params{'login'}/",

		  expired => ($params{"enabled"} eq "true" ? "0" : "1"),

		  comment => $params{"comment"},

		  uid => ($params{"systemUser"} ? $params{"systemUser"} : undef) } );

	if($res_action eq 'update') {

		set_request_code($request, $code_ok, "Mailbox modified");

	}

	elsif($res_action eq 'insert') {

		set_request_code($request, $code_ok_but, "Mailbox not found, created");

	}

}

sub handle_mailbox_delete

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_, ("login", "domain"));

	return unless(%params);

	# FIXME remove the maildir

	my $res_action = delete_from_db($request, "users",

		{ login => "$params{'login'}\@$params{'domain'}" } );

	if($res_action eq 'delete') {

		set_request_code($request, $code_ok, "Mailbox deleted");

	}

	elsif($res_action eq 'not found') {

		set_request_code($request, $code_ok_but, "Mailbox not found");

	}

}

sub handle_mail_alias_create

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_, ("address", "domain"));

	return unless(%params);

	my @rcpts = parse_command_array($request, @_);

	my $del_action = delete_from_db($request, "aliases",

		{ alias => "$params{'address'}\@$params{'domain'}" } );

	return if($del_action eq "error");

	foreach my $rcpt (@rcpts) {

		log_debug("save $rcpt");

		my $res_action = save_to_db($request, "aliases",

			undef,

			{ alias => "$params{'address'}\@$params{'domain'}",

			  rcpt => $rcpt, comment => $params{"comment"} } );

		return if($res_action eq "error");

	}

	if($del_action eq 'delete') {

		set_request_code($request, $code_ok_but, "Mail alias exists, modified");

	}

	elsif($del_action eq 'not found') {

		set_request_code($request, $code_ok, "Mail alias created");

	}

}

sub handle_mail_alias_modify

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_, ("address", "domain"));

	return unless(%params);

	my @rcpts = parse_command_array($request, @_);

	my $del_action = delete_from_db($request, "aliases",

		{ alias => "$params{'address'}\@$params{'domain'}" } );

	return if($del_action eq "error");

	foreach my $rcpt (@rcpts) {

		log_debug("save $rcpt");

		my $res_action = save_to_db($request, "aliases",

			undef,

			{ alias => "$params{'address'}\@$params{'domain'}",

			  rcpt => $rcpt, comment => $params{"comment"} } );

		return if($res_action eq "error");

	}

	# FIXME add the loopback destination? handle "a@domain.com => a@domain.com"

	# as "a@domain.com => _something_@domain.com + _something_@domain.com => _something_@domain.com" ?

	if($del_action eq 'delete') {

		set_request_code($request, $code_ok, "Mail alias modified");

	}

	elsif($del_action eq 'not found') {

		set_request_code($request, $code_ok_but, "Mail alias not found, created");

	}

}

sub handle_mail_alias_delete

{

	my $request = shift @_;

	my %params  = parse_command_params($request, shift @_, ("address", "domain"));

	return unless(%params);

	my $res_action = delete_from_db($request, "aliases",

		{ alias => "$params{'address'}\@$params{'domain'}" } );

	if($res_action eq 'delete') {

		set_request_code($request, $code_ok, "Mail alias deleted");

	}

	elsif($res_action eq 'not found') {

		set_request_code($request, $code_ok_but, "Mail alias not found");

	}

}

sub decode_param

{

	my $value = shift @_;

	$value =~ s/\\r/\r/g;

	$value =~ s/\\n/\n/g;

	$value =~ s/\\t/\t/g;

	$value =~ s/\\0/\000/g;

	$value =~ s/\\\\/\\/g;

	return $value;

}

sub parse_command_array

{

	my $request = shift @_;

	my @params  = ();

	map {

		if(/^\t(.*)$/) {

			push @params, decode_param($1);

		}

	} @_;

	return @params;

}

sub parse_command_params($$@)

{

	my $request  = shift @_;

	my @params   = split /\t/, shift @_, -1;

	my %required = map { $_ => 1 } @_; # convert array to hash

	my %values   = ();

	@params = @params[2..$#params]; # remove handler and action

	map {

		my ($key, $value) = split /=/, $_;

		$values{$key} = decode_param($value);

		delete($required{$key});

	} @params;

	if(%required) {

		set_request_code($request, $code_wrong_params,

			"Params " . join(', ', keys %required) . " expected but not found");

		return ();

	}

	return %values;

}

sub restart_mail_system

{

	my $request = shift @_;

	log_debug("Mail system restarted");

	return 1;

}

sub db_connect

{

	my $request = shift @_;

	my $dbh     = undef;

	eval { $dbh = DBI->connect($db_url, $db_user, $db_password); };

	if($@) {

		set_request_code($request, $code_db_connect_error, $@);

		$dbh = undef;

	}

	return $dbh;

}

sub db_close

{

	my $request  = shift @_;

	my $dbh      = shift @_;

	my $error    = shift @_;

	my $no_error = 1;

	if($error) {

		set_request_code($request, $code_db_error, $error);

		$no_error = 0;

	}

	eval {

		$dbh->disconnect() if($dbh);

	};

	if($@ && $no_error) {

		set_request_code($request, $code_db_close_error, $@);

		$no_error = 0;

	}

	return $no_error;

}

sub delete_from_db

{

	my $request     = shift @_;

	my $table       = shift @_;

	my $key_columns = shift @_;

	my $res_action  = 'none';

	my $dbh         = db_connect($request);

	return 'error' unless($dbh);

	eval {

		my $sql = "";

		while(my ($key, $value) = each(%$key_columns)) {

			next unless(defined $value);

			$sql .= " and " if($sql);

			$sql .= "$key = ?";

		}

		$sql = "delete from $table where $sql";

		my $sth   = $dbh->prepare($sql);

		my $count = 0;

		while(my ($key, $value) = each(%$key_columns)) {

			next unless(defined $value);

			$sth->bind_param(++$count, $value);

		}

		my $res = $sth->execute;

		if($res < 1) {

			$res_action = 'not found';

		}

		else {

			$res_action = 'delete';

		}

	};

	if(db_close($request, $dbh, $@)) {

		return $res_action;

	}

	else {

		return 'error';

	}

}

sub save_to_db

{

	my $request       = shift @_;

	my $table         = shift @_;

	my $key_columns   = shift @_;

	my $value_columns = shift @_;

	my $error_set  = 0;

	my $res_action = 'none';

	my $dbh        = db_connect($request);

	return 'error' unless($dbh);

	eval {

		my $res = 0;

		if($key_columns) {

			my $update_sql = "";

			my $where      = "";

			while(my ($key, $value) = each(%$value_columns)) {

				next unless(defined $value);

				$update_sql .= ", " if($update_sql);

				$update_sql .= "$key = ?";

			}

			while(my ($key, $value) = each(%$key_columns)) {

				next unless(defined $value);

				$where .= " and " if($where);

				$where .= "$key = ?";

			}

			$update_sql = "update $table set $update_sql where $where";

			my $update_sth = $dbh->prepare($update_sql);

			my $count      = 0;

			while(my ($key, $value) = each(%$value_columns)) {

				next unless(defined $value);

				$update_sth->bind_param(++$count, $value);

			}

			while(my ($key, $value) = each(%$key_columns)) {

				next unless(defined $value);

				$update_sth->bind_param(++$count, $value);

			}

			$res        = $update_sth->execute;

			$res_action = 'update';

		}

		if($res < 1) {

			my $insert_sql = "";

			my $sql_params = "";

			while(my ($key, $value) = each(%$key_columns)) {

				next unless(defined $value);

				next if($value_columns->{$key});

				if($insert_sql) {

					$insert_sql .= ", ";

					$sql_params .= ", ";

				}

				$insert_sql .= "$key";

				$sql_params .= "?";

			}

			while(my ($key, $value) = each(%$value_columns)) {

				next unless(defined $value);

				if($insert_sql) {

					$insert_sql .= ", ";

					$sql_params .= ", ";

				}

				$insert_sql .= "$key";

				$sql_params .= "?";

			}

			$insert_sql = "insert into $table ($insert_sql)"

				. " values ($sql_params)";

			my $insert_sth = $dbh->prepare($insert_sql);

			my $count      = 0;

			while(my ($key, $value) = each(%$key_columns)) {

				next unless(defined $value);

				next if($value_columns->{$key});

				$insert_sth->bind_param(++$count, $value);

			}

			while(my ($key, $value) = each(%$value_columns)) {

				next unless(defined $value);

				$insert_sth->bind_param(++$count, $value);

			}

			$res        = $insert_sth->execute;

			$res_action = 'insert';

		}

	};

    # FIXME handle exceptions?

	if(db_close($request, $dbh, $@)) {

		return $res_action;

	}

	else {

		return 'error';

	}

}

sub set_request_code

{

	my $request = shift @_;

	my $code    = shift @_;

	my $message = shift @_;

	$request->{'code'}     = $code;

	$request->{'response'} = $message;

	my $error = "Error $code '$message' in request [\n$request->{'body'}]";

	if($code >= 500 && $code < 600) {

		log_error($error);

	}

	elsif($code >= 400 && $code < 500) {

		log_warning($error);

	}

	elsif($code >= 200 && $code < 300) {

		log_info("$code $message");

	}

	else {

		log_error("unknown code $code");

	}

}

sub log_debug

{

	log_message("DEBUG", shift @_) if ($log_level >= 9);

}

sub log_info

{

	log_message("INFO", shift @_) if ($log_level >= 5);

}

sub log_warning

{

	log_message("WARN", shift @_) if ($log_level >= 3);

}

sub log_error

{

	log_message("ERROR", shift @_) if ($log_level >= 1);

}

sub log_message

{

	print shift @_, ":\t", shift @_, "\n";

}

sub init

{

	$handlers{"${user_header}_${create_action}"}        = \&handle_user_create;

	$handlers{"${user_header}_${modify_action}"}        = \&handle_user_modify;

	$handlers{"${user_header}_${delete_action}"}        = \&handle_user_delete;

	$handlers{"${domain_header}_${create_action}"}      = \&handle_domain_create;

	$handlers{"${domain_header}_${modify_action}"}      = \&handle_domain_modify;

	$handlers{"${domain_header}_${delete_action}"}      = \&handle_domain_delete;

	$handlers{"${system_user_header}_${create_action}"} = \&handle_system_user_create;

	$handlers{"${system_user_header}_${modify_action}"} = \&handle_system_user_modify;

	$handlers{"${system_user_header}_${delete_action}"} = \&handle_system_user_delete;

	$handlers{"${mailbox_header}_${create_action}"}     = \&handle_mailbox_create;

	$handlers{"${mailbox_header}_${modify_action}"}     = \&handle_mailbox_modify;

	$handlers{"${mailbox_header}_${delete_action}"}     = \&handle_mailbox_delete;

	$handlers{"${mail_alias_header}_${create_action}"}  = \&handle_mail_alias_create;

	$handlers{"${mail_alias_header}_${modify_action}"}  = \&handle_mail_alias_modify;

	$handlers{"${mail_alias_header}_${delete_action}"}  = \&handle_mail_alias_delete;

}

sub main

{

	#my $sth = $dbh->prepare("SELECT * FROM transport");

	#$sth->execute();

	#while(my $ref = $sth->fetchrow_hashref()) {

	#	print "id = $ref->{'id'}\n";

	#}

	#$sth->finish();

	init();

	connection_loop();

}

main();