#!/usr/local/bin/perl
#
# Copyright (C) 2003 Alexandre Dulaunoy <adulau@foo.be>
#
# This program 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 2 of the License, or (at
# your option) any later version.
#
# This program  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  this  program;  if   not,  write  to  the  Free  Software
# Foundation, Inc., 59 Temple Place  - Suite 330, Boston, MA 02111-1307,
# USA.
#
#
# $Id: mqsd,v 1.8 2003/10/29 19:59:35 adulau Exp $

use Config::General;
use RPC::XML::Server;
use POSIX;
use Data::Dumper;
use RPC::XML;
my $version = "0.0.8";

$| = 1;

if ( -e "../var/mqsd.pid" ) {
    killMyself("Another mqsd running or ./var/mqsd.pid still there...");
}

my %allconfig = ReadingConfiguration("../cfg/mqs.cfg");

if ( $allconfig{general}{storage} eq "sqldatabase" ) {

    use DBI;

}
elsif ( $allconfig{general}{storage} eq "QDBM" ) {

    use lib '../lib/';
    require MQS::Storage::QDBM;

}

logMessage("Minimalist Queue Services $version - Starting");
my %qdbmstore;
my %queueavailable = BuildingQueue();

#my $brol = Dumper( \%queueavailable );
#logMessage("$brol");

goingDaemon();

my %errorCodeMQS = (
    "1"   => "Unknown queue",
    "2"   => "Emply queue",
    "3"   => "Permission denied",
    "100" => "Undefined error"
);

$method_TestEcho = RPC::XML::Procedure->new(
    {
        name      => 'mqs.TestEcho',
        code      => \&TestEcho,
        signature => ['string string']
    }
);

$method_SubmitMessage = RPC::XML::Procedure->new(
    {
        name      => 'mqs.SubmitMessage',
        code      => \&SubmitMessage,
        signature => ['string string string string string int']
    }
);

$method_DeleteMessage = RPC::XML::Procedure->new(
    {
        name      => 'mqs.DeleteMessage',
        code      => \&DeleteMessage,
        signature => ['string string string']
    }
);

$method_GetMessage = RPC::XML::Procedure->new(
    {
        name      => 'mqs.GetMessage',
        code      => \&GetMessage,
        signature => ['string string string']
    }
);

$method_GetMessageBulk = RPC::XML::Procedure->new(
    {
        name      => 'mqs.GetMessageBulk',
        code      => \&GetMessageBulk,
        signature => ['array string string int']
    }

);

$srv = RPC::XML::Server->new( port => $allconfig{general}{portrpc} );
$srv->add_method($method_TestEcho);
$srv->add_method($method_SubmitMessage);
$srv->add_method($method_GetMessage);
$srv->add_method($method_DeleteMessage);
$srv->add_method($method_GetMessageBulk);

logMessage(
"MQS Daemon waiting for RPC::XML connection on port $allconfig{general}{portrpc}"
);
$srv->server_loop;

sub TestEcho {
    my $val = shift;
    return $val;
}

sub ReadingConfiguration {
    my $configfile = shift;
    my $conf       = new Config::General($configfile);
    my %config     = $conf->getall;
    return %config;
}

sub BuildingQueue {

    my %queueavailable;

    if ( $allconfig{general}{storage} eq "sqldatabase" ) {

        my $dbh = DBI->connect(
            $allconfig{general}{dbiurl}, $allconfig{general}{dbuser},
            $allconfig{general}{dbpassword}
          )
          or killMyself(
            "BuildingQueue: unable to connect to $allconfig{general}{dbiurl}");

        if ( !( $allconfig{general}{createqueue} == "1" ) ) {
            logMessage(
"BuildingQueue : queue not created as requested in configuration"
            );
            return 0;
        }
        my $sql = "select * from mqname";
        my $sth = $dbh->prepare($sql)
          or killMyself("BuildingQueue : preparing: $dbh->errstr");
        $sth->execute or killMyself("executing: $dbh->errstr");
        my @queueformat = qw/id name priority/;
        my %queueavailable;
        while ( $row = $sth->fetchrow_hashref ) {
            my %rec;
            foreach my $val (@queueformat) {
                $rec{$val} = $row->{$val};
            }
            $queueavailable{ $row->{'name'} } = \%rec;
        }

        #print Dumper( \%queueavailable );

        foreach my $val ( keys %{ $allconfig{queue} } ) {
            if ( $queueavailable{$val} ) {
                logMessage("Queue $val already exists in db");
            }
            else {
                logMessage("Queue $val unknown in database");
                CreateQueue( "$val", $allconfig{queue}{$val}{priority} );
                logMessage("Queue $val created in database");
            }
        }

        my %queueavailable;
        my $sql = "select * from mqname";
        my $sth = $dbh->prepare($sql)
          or killMyself("BuildingQueue : preparing: $dbh->errstr");
        $sth->execute or killMyself("executing: $dbh->errstr");

        while ( $row = $sth->fetchrow_hashref ) {
            my %rec;
            foreach my $val (@queueformat) {
                $rec{$val} = $row->{$val};
            }
            $queueavailable{ $row->{'name'} } = \%rec;
        }

        return %queueavailable;

    }
    elsif ( $allconfig{general}{storage} eq "QDBM" ) {
        foreach my $val ( keys %{ $allconfig{queue} } ) {

            $queueavailable{$val} = $val;

            #    my $brol = Dumper( \%qdbmstore);
            #    logMessage("$brol");

        }
        return %queueavailable;
    }

}

sub CreateQueue {
    my $queuename = shift;
    my $priority  = shift;
    my $dbh       = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{general}{dbuser},
        $allconfig{general}{dbpassword}
      )
      or killMyself(
        "CreateQueue: unable to connect to $allconfig{general}{dbiurl}");
    my $sql = "INSERT INTO mqname(name,priority) VALUES (?,?)";
    my $sth = $dbh->prepare($sql)
      or killMyself("CreateQueue : preparing: $dbh->errstr");
    $sth->execute( $queuename, $priority )
      or killMyself("CreateQueue: unable to execute");
    $dbh->disconnect;

}

sub SubmitMessage {
    my $auth      = shift;
    my $message   = shift;
    my $queuename = shift;
    my $cid       = shift;
    my $priority  = shift;

    if ( !( $allconfig{general}{allowanonymousaccess} eq "1" ) ) {
        if ( authRequest( $auth, whoAmI(), $queuename ) =~ "denied" ) {
            return errorRPCHandler(3);
        }
    }

    if ( $allconfig{general}{storage} eq "sqldatabase" ) {

        if ( !( $queueavailable{$queuename}{'id'} ) ) {
            return errorRPCHandler(1);
        }

        my $dbh = DBI->connect(
            $allconfig{general}{dbiurl}, $allconfig{general}{dbuser},
            $allconfig{general}{dbpassword}
          )
          or killMyself(
            "SubmitMessage: unable to connect to $allconfig{general}{dbiurl}");

        my $sql = "INSERT INTO message(body,queue,priority) VALUES (?,?,?)";
        my $sth = $dbh->prepare($sql)
          or killMyself("SubmitMessage : preparing: $dbh->errstr");

        #print $sql;
        my $idqueue = $queueavailable{$queuename}{'id'};

        #print $idqueue;
        #print $message;
        if ( $priority eq "-1" ) {
            $priority = $queueavailable{$queuename}{'priority'};
        }
        $sth->execute( $message, $idqueue, $priority );
        $dbh->disconnect;

    }
    elsif ( $allconfig{general}{storage} eq "QDBM" ) {

        if ( !( $queueavailable{$queuename} ) ) {
            return errorRPCHandler(1);
        }
        my $queue =
          MQS::Storage::QDBM->new( $queuename,
            $allconfig{general}{storageqdbm} );
        $queue->putMessage("$message");
        $queue->close();
        return 1;
    }

}

sub DeleteMessage {
    my $auth      = shift;
    my $queuename = shift;

    if ( !( $allconfig{general}{allowanonymousaccess} eq "1" ) ) {
        if ( authRequest( $auth, whoAmI(), $queuename ) =~ "denied" ) {
            return errorRPCHandler(3);
        }
    }

    if ( !( $queueavailable{$queuename}{'id'} ) ) {
        return errorRPCHandler(1);
    }
    my $idqueue = $queueavailable{$queuename}{'id'};
    my $dbh     = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{general}{dbuser},
        $allconfig{general}{dbpassword}
      )
      or killMyself(
        "DeleteMessage: unable to connect to $allconfig{general}{dbiurl}");
    my $sql = "DELETE FROM message WHERE queue=? AND flag=1";
    my $sth = $dbh->prepare($sql)
      or killMyself("DeleteMessage : preparing: $dbh->errstr");
    $sth->execute($idqueue);
    $dbh->disconnect;
    return $sth->rows;

}

sub ChangeFlagMessage {
    my $id   = shift;
    my $flag = shift;
    my $dbh  = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{general}{dbuser},
        $allconfig{general}{dbpassword}
      )
      or killMyself(
        "ChangeFlagMessage: unable to connect to $allconfig{general}{dbiurl}");
    my $sql = "UPDATE message SET flag=? WHERE id=?";
    my $sth = $dbh->prepare($sql)
      or killMyself("ChangeFlagMessage : preparing: $dbh->errstr");
    $sth->execute( $flag, $id );
    $dbh->disconnect;
    return;
}

sub GetMessage {
    my $auth      = shift;
    my $queuename = shift;
    my $body;

    if ( !( $allconfig{general}{allowanonymousaccess} eq "1" ) ) {
        if ( authRequest( $auth, whoAmI(), $queuename ) =~ "denied" ) {
            return errorRPCHandler(3);
        }
    }

    if ( $allconfig{general}{storage} eq "sqldatabase" ) {

        if ( !( $queueavailable{$queuename}{'id'} ) ) {
            return errorRPCHandler(1);
        }

        my $dbh = DBI->connect(
            $allconfig{general}{dbiurl}, $allconfig{general}{dbuser},
            $allconfig{general}{dbpassword}
          )
          or killMyself(
            "GetMessage: unable to connect to $allconfig{general}{dbiurl}");
        my $sql =
"SELECT * FROM message WHERE queue=? AND flag=0 ORDER BY priority,timestamp,id LIMIT 1";
        my $sth = $dbh->prepare($sql)
          or killMyself("GetMessage : preparing: $dbh->errstr");
        my $idqueue = $queueavailable{$queuename}{'id'};

        $sth->execute($idqueue);
        if ( !( $sth->rows ) ) {
            return errorRPCHandler(2);
        }
        while ( $row = $sth->fetchrow_hashref ) {
            $body .= $row->{'body'};
            ChangeFlagMessage( $row->{'id'}, 1 );
        }
        $dbh->disconnect;
    }
    elsif ( $allconfig{general}{storage} eq "QDBM" ) {

        if ( !( $queueavailable{$queuename} ) ) {
            return errorRPCHandler(1);
        }

        my $queue =
          MQS::Storage::QDBM->new( $queuename,
            $allconfig{general}{storageqdbm} );

        if ( !( $body = $queue->getMessage ) ) {
            return errorRPCHandler(2);
        }

        $queue->close();

    }
    return $body;

}

sub GetMessageBulk {
    my $auth       = shift;
    my $queuename  = shift;
    my $maxmessage = shift;
    my @arrayBody;
    my $body;

    if ( !( $allconfig{general}{allowanonymousaccess} eq "1" ) ) {
        if ( authRequest( $auth, whoAmI(), $queuename ) =~ "denied" ) {
            return errorRPCHandler(3);
        }
    }

    if ( $allconfig{general}{storage} eq "sqldatabase" ) {

        if ( !( $queueavailable{$queuename}{'id'} ) ) {
            return errorRPCHandler(1);
        }

        if ( !( $maxmessage =~ /^-?\d+$/ ) ) { return errorRPCHandler(100); }

        my $dbh = DBI->connect(
            $allconfig{general}{dbiurl}, $allconfig{general}{dbuser},
            $allconfig{general}{dbpassword}
          )
          or killMyself(
            "GetMessage: unable to connect to $allconfig{general}{dbiurl}");

        my $sql =
"SELECT * FROM message WHERE queue=? AND flag=0 ORDER BY priority,timestamp,id LIMIT $maxmessage";

        my $sth = $dbh->prepare($sql)
          or killMyself("GetMessage : preparing: $dbh->errstr");
        my $idqueue = $queueavailable{$queuename}{'id'};
        my $body;

        $sth->execute($idqueue);
        if ( !( $sth->rows ) ) {
            return errorRPCHandler(2);
        }
        my $i = 0;

        while ( $row = $sth->fetchrow_hashref ) {
            $arrayBody[$i] = "$row->{'body'}";
            ChangeFlagMessage( $row->{'id'}, 1 );
            $i++;
        }
        $dbh->disconnect;

    }
    elsif ( $allconfig{general}{storage} eq "QDBM" ) {

        if ( !( $maxmessage =~ /^-?\d+$/ ) ) { return errorRPCHandler(100); }

        my $queue =
          MQS::Storage::QDBM->new( $queuename,
            $allconfig{general}{storageqdbm} );
        my $i = 0;
        for ( 1 .. $maxmessage ) {

            if ( !( $body = $queue->getMessage ) ) {
                if ( $i == 0 ) { return errorRPCHandler(2); }
                last;
            }
            $arrayBody[$i] = "$body";
            $i++;
        }
        $queue->close();

    }

    return new RPC::XML::response( RPC::XML::array->new(@arrayBody) );
}

sub logMessage {
    my $message = shift;
    my $time    = POSIX::strftime( "%Y-%m-%d %H:%M:%S%z", localtime );
    my $logpath = $allconfig{general}{path} . "/var/mqsd.log";
    open( LOG, ">>$logpath" );
    print LOG "$time" . " [" . $$ . "] " . "$message\n";
    close(LOG);
    return;
}

sub goingDaemon {
    my $pid;
    $pid = fork;
    exit if $pid;
    die "goingDaemon : Couldn't fork : $!" unless defined($pid);
    POSIX::setsid() or die "goingDaemon : Can't start a new session: $!";
    $SIG{HUP}  = \&restartDaemon;
    $SIG{INT}  = \&stopDaemon;
    $SIG{TERM} = \&stopDaemon;
    logMessage("Going daemon with PID $$");
    open( PIDFILE, ">../var/mqsd.pid" );
    print PIDFILE $$;
    close(PIDFILE);
    return $$;
}

sub restartDaemon {

    logMessage("Restarting Daemon...");
    logMessage("Reading configuration...");
    %allconfig = ReadingConfiguration("../cfg/mqs.cfg");
    logMessage("Reading queue...");
    %queueavailable = BuildingQueue();
}

sub stopDaemon {

    logMessage("Stopping Daemon...");

    unlink "../var/mqsd.pid";

    die;
}

sub killMyself {
    my $message = shift;
    logMessage($message);
    die "$message";
}

sub whoAmI {
    my $tmp = ( caller(1) )[3];
    $tmp =~ s/main:://;
    return $tmp;
}

sub authRequest {
    my $authline     = shift;
    my $methodsource = shift;
    my $queuename    = shift;
    my $allowis;

    ( $prefix, $type ) = split ( /:/, $authline );

    if ( $prefix eq "auth" ) {
        if ( $type eq "simple" ) {
            ( $prefix, $type, $user, $sharedkey ) = split ( /:/, $authline );
            if ( defined( $allconfig{user}{$user} ) ) {
                if ( $allconfig{user}{$user}{sharedkey} eq $sharedkey ) {
                    my @allowQueue =
                      split ( / /, $allconfig{user}{$user}{allowQueue} );
                    foreach my $tmpKey (@allowQueue) {
                        if ( $tmpKey eq $queuename ) { $allowis = "ok"; last; }
                    }
                    if ( ( $allowQueue[0] eq '*' ) || ( $allowis eq 'ok' ) ) {
                        $allowis = 0;
                        my @allowCommand =
                          split ( / /, $allconfig{user}{$user}{allowCommand} );
                        foreach my $tmpKey (@allowCommand) {
                            if ( $tmpKey eq $methodsource ) {
                                $allowis = "ok";
                                last;
                            }
                        }
                        if ( ( $allowCommand[0] eq '*' )
                            || ( $allowis eq 'ok' ) )
                        {

                            return "ok";
                        }
                    }
                }
            }
        }
    }

    return "Permission denied";
}

sub errorRPCHandler {
    my $errorCode = shift;
    return new RPC::XML::response(
        RPC::XML::fault->new( $errorCode, $errorCodeMQS{$errorCode} ) );
}
