Subversion Repositories general

Compare Revisions

No changes between revisions

Ignore whitespace Rev 1209 → Rev 1210

/hostadmiral/trunk/backend/backend.pl
File deleted
Property changes:
Deleted: svn:executable
-*
\ No newline at end of property
/hostadmiral/trunk/backend/backend.pl.sample
0,0 → 1,734
#!/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();
 
Property changes:
Added: svn:executable
+*
\ No newline at end of property