Subversion Repositories general

Rev

Rev 1209 | Blame | Last modification | View Log | RSS feed 

#!/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();