#!/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.6 2003/10/16 13:43:55 adulau Exp adulau $

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

$| = 1;

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

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

logMessage("Minimalist Queue Services $version - Starting");
my %queueavailable = BuildingQueue();
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 $dbh = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{dbuser},
        $allconfig{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;
}

sub CreateQueue {
    my $queuename = shift;
    my $priority  = shift;
    my $dbh       = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{dbuser},
        $allconfig{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 ( !( $queueavailable{$queuename}{'id'} ) ) {
        return errorRPCHandler(1);
    }
    my $dbh = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{dbuser},
        $allconfig{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;
}

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{dbuser},
        $allconfig{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{dbuser},
        $allconfig{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;

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

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

    my $dbh = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{dbuser},
        $allconfig{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'};
    my $body;

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

sub GetMessageBulk {
    my $auth       = shift;
    my $queuename  = shift;
    my $maxmessage = shift;



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

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

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

    my $dbh = DBI->connect(
        $allconfig{general}{dbiurl}, $allconfig{dbuser},
        $allconfig{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 @arrayBody;
    my $i = 0;

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

    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} ) );
}
