Included below are:
* Patch to mod_groups.c against the cvs version. This fixes a bug that
was preventing the admin JID adding people to a group. It also
implements full JIDs for admin users rather than just the username,
which I think is useful to do (ie admins can be remote) but up to you
whether its included in an update.
* Perl program to register users. This is setup for our configuration
here and is provided for reference for people who want to do similar. It
is not intended as an out-of-the-box working system that I support
(although I've tried to make it as generic as possible). It does two
things: Creates a users user.xml file directly from the information
provided, and using Net::Jabber adds that user to a relevant mod_group
(in this case defined by the office entered). Hope people find it useful
so they don't waste as much time as I did getting the basics straight.
-Mark
*** mod_groups.c.cvs Thu Jan 24 18:06:25 2002
--- mod_groups.c Thu Jan 24 18:06:25 2002
***************
*** 578,584 ****
log_debug(ZONE,"Setting");
gid = strchr(jp->to->resource,'/');
! if (gid == NULL || ++gid == NULL);
{
js_bounce(m->si,jp->x,TERROR_NOTACCEPTABLE);
return;
--- 578,584 ----
log_debug(ZONE,"Setting");
gid = strchr(jp->to->resource,'/');
! if (gid == NULL || ++gid == NULL)
{
js_bounce(m->si,jp->x,TERROR_NOTACCEPTABLE);
return;
***************
*** 596,602 ****
}
info = mod_groups_get_info(mi,p,jp->to->server,gid);
! if (info == NULL || xmlnode_get_tag(info,spools(p,"edit/user=",jp->from->user,p)) == NULL)
{
js_bounce(m->si,jp->x,TERROR_NOTALLOWED);
return;
--- 596,602 ----
}
info = mod_groups_get_info(mi,p,jp->to->server,gid);
! if (info == NULL || xmlnode_get_tag(info,spools(p,"edit/user=",jid_full(jp->from),p)) == NULL)
{
js_bounce(m->si,jp->x,TERROR_NOTALLOWED);
return;
***************
*** 941,947 ****
return M_HANDLED;
}
! if (xmlnode_get_tag(info,spools(jp->p,"write/user=",jp->from->user,jp->p)) != NULL)
mod_groups_message_online(mi,jp->x,gid);
else
js_bounce(m->si,jp->x,TERROR_NOTALLOWED);
--- 941,947 ----
return M_HANDLED;
}
! if (xmlnode_get_tag(info,spools(jp->p,"write/user=",jid_full(jp->from),jp->p)) != NULL)
mod_groups_message_online(mi,jp->x,gid);
else
js_bounce(m->si,jp->x,TERROR_NOTALLOWED);
#!/usr/bin/perl
use strict;
use Net::Jabber qw( Client );
use Digest::SHA1 qw ( sha1_hex );
use Date::Format qw ( time2str );
use Unicode::MapUTF8 qw ( to_utf8 );
use constant SPOOLDIR => '/usr/local/jabber/jabber-1.4.1/spool';
use constant ADMINUSERNAME => 'youradminname';
use constant ADMINPASSWORD => 'youradminpassword';
use constant ADMINSERVER => 'youradminserver';
use constant JABBERUID => 501;
use constant JABBERGID => 501;
my $offices = {
cologne => 'im.example.com',
dublin => 'im.example.com',
edinburgh => 'im.example.com',
hamburg => 'im.example.com',
leeds => 'im.example.com',
london => 'im.example.com',
madrid => 'im.example.com',
milan => 'im.example.com',
paris => 'im.example.com',
usa => 'im.example.com',
};
my( $name, $email, $password, $office );
if( $ARGV[0] ) {
$name = $ARGV[0];
$email = $ARGV[1];
$password = $ARGV[2];
$office = $ARGV[3];
} else {
print "Enter full name: ";
$name = <STDIN>; chomp $name;
print "Enter email: ";
$email = <STDIN>; chomp $email;
print "Enter password: ";
$password = <STDIN>; chomp $password;
print "Enter office: ";
$office = <STDIN>; chomp $office;
print "Create $name, $email, $office [Y/N]? ";
my $ans = <STDIN>;
if( ! $ans =~ /^[yY]/ ) {
print "Aborted account creation\n";
exit;
}
}
# Munge
( my $name_utf8 = $name ) =~ s/'/'/; # Escape for XML
$name_utf8 = to_utf8(-string => $name, -charset => "ISO-8859-1"); # Change from latin-1 to UTF8, Net::Jabber does this itself
$email = lc( $email );
my $server = $offices->{$office} || die "Unknown office $office";
my ( $username ) = $email =~ /(.*)@(.*)/;
print STDERR "Creating $name, $email ($username:$password)\n";
# Generate password hash
my $time = time();
my $date = time2str("%Y%m%dT%T",$time);
my $token = sprintf( "%X", $time );
my $hash = sha1_hex(sha1_hex($password) . $token);
my $sequence = 500; # This is the default seq and will need to be changed if you specify anything other in jabber.xml
my $i = 0;
while( $i < $sequence ) {
$hash = sha1_hex($hash);
$i++;
}
my $xml = <<END_XML;
<xdb><query xmlns='jabber:iq:last' last='$time' xdbns='jabber:iq:last'>Registered</query><zerok xmlns='jabber:iq:auth:0k' xdbns='jabber:iq:auth:0k'><hash>$hash</hash><token>$token</token><sequence>$sequence</sequence></zerok><password xmlns='jabber:iq:auth' xdbns='jabber:iq:auth'>$password</password><query xmlns='jabber:iq:register' xdbns='jabber:iq:register'><name>$name_utf8</name><x xmlns='jabber:x:delay' stamp='$date'>registered</x></query></xdb>
END_XML
print STDERR "Writing $server/$username.xml\n";
open( FH, ">" . SPOOLDIR . "/$server/$username.xml" ) || die "Couldn't open " . SPOOLDIR . "/$server/$username.xml for writing";
print FH $xml;
close( FH );
chown( JABBERUID, JABBERGID, SPOOLDIR . "/$server/$username.xml" );
# Need to connect to server as user to get jabberd to cache the new and to check it all works of course
my $connect = new Net::Jabber::Client();
my $conn_resp = $connect->Connect( hostname => $server );
if ($conn_resp){
print STDERR "Connected to $server\n";
} else {
die "Connection failed\n";
}
my @result = $connect->AuthSend(
username => $username,
password => $password,
resource => 'register.pl',
);
if ($result[0] ne "ok") {
die "Ident/Auth with server failed: $result[0] - $result[1]\n";
} else {
print STDERR "Authed as $username\n";
}
print STDERR "Adding $username to group '$office'\n";
my $conn_resp = $connect->Connect( hostname => ADMINSERVER );
if ($conn_resp){
print STDERR "Connected to " . ADMINSERVER . "\n";
} else {
die "Connection failed\n";
}
my @result = $connect->AuthSend(
username => ADMINUSERNAME,
password => ADMINPASSWORD,
resource => 'register.pl',
);
if ($result[0] ne "ok") {
die "Ident/Auth with server failed: $result[0] - $result[1]\n";
} else {
print STDERR "Authed as " . ADMINUSERNAME . "\n";
}
my $iq = new Net::Jabber::IQ();
$iq->SetIQ(
type => 'set',
to => "$server/groups/$office",
from => ADMINUSERNAME . "\@" . ADMINSERVER,
);
my $query = $iq->NewQuery( "jabber:iq:browse" );
$query->AddItem( "user",
jid => "$username\@$server",
name => $name,
);
$connect->Send( $iq );
print STDERR "Added $username to group $server/groups/$office\n";
print STDERR "Done\n\n";
