Userinfo check on login - script for the Globster direct connect client

globster-usercheck.pl

#!/usr/bin/perl

use strict;
use warnings;
use Net::DBus::Reactor;
use Net::DBus;
use Switch;
use XML::Simple;

# create xml object
my $xml = new XML::Simple;

# read XML file
my $config = $xml->XMLin($ARGV[0], ForceArray => [ 'hub', 'userinfo', 'inffield', 'action' ], KeyAttr => ['actionid', 'field'], ContentKey => '-content', SearchPath => [ '/etc/globster' ]);

$ENV{DBUS_SESSION_BUS_ADDRESS} = $config->{'dbusaddr'} ? $config->{'dbusaddr'} : $ENV{DBUS_SESSION_BUS_ADDRESS};

# Hubs to link (Globster hub ids)
my @hubs = @{$config->{'hub'}};
my %actions = %{$config->{'action'}};

my $g = Net::DBus->find->get_service("net.blicky.Globster")->get_object("/net/blicky/Globster");
my %objs = map +($_->{'hubid'}, $g->get_child_object("/Hub/$_->{'hubid'}")), @hubs;

sub is_forbidden {
	my ($user, $inffields) = @_;
	my %u = %{$user};
	my %detection = %{$inffields};
	my $detection_size = scalar(keys %detection);
	my $match_count = 0;
	foreach my $key (keys %u) {
		if ($detection{$key} && $u{$key} =~ /$detection{$key}/) {
			$match_count++;
		}
	}
	return 1 if ($match_count == $detection_size);
	return 0;
}

sub send_action {
	my($hubid, $user, $username, $actionid) = @_;
	my @action_arr = split(',', $actionid);
	for my $action (@action_arr) { 
		my $msg = $actions{$action}{'content'};
		$msg =~ s/%\[userNI\]/$username/g;
		switch ($actions{$action}->{'destination'}) {
			case "user" { $objs{$hubid}->SendChat($user, $msg, $actions{$action}{'me'}) }
			case "chat" { $objs{$hubid}->SendChat(-1, $msg, $actions{$action}{'me'}) }
		}
	}
}

my @userfields = ('', qw|nick description client mail slots sharedfiles sharesize conn hubs ip4 ip6 as cid flags|);
my %userfields = map +($_, $userfields[$_]), 1..$#userfields;

for my $hub (@hubs) {
	$objs{$hub->{'hubid'}}->connect_to_signal('UserJoined', sub {
		my ($user, $fields, $list) = @_;
		my %inf;
		@inf{@{$fields}} = @{$list};
		my %u = map +($userfields{$_}, $inf{$_}), keys %inf;
		my @userinfos = @{$hub->{'userinfo'}};
		foreach my $userinfo (@userinfos) {
			if (is_forbidden(\%u, $userinfo->{'inffield'})) {
				send_action($hub->{'hubid'}, $user, $u{'nick'}, $userinfo->{'actiontosend'});
				last;
			}
		}
	});
}

Net::DBus::Reactor->main->run;