User Registration Script

Currently, the Jabber technology has no concept of 'anonymous' users - users that can connect to the server with no previous registration requirement. Until such time as this is possible, we will have to make do with creating specific users for specific scenarios.

To this end, it would be useful to be able to run a quick script to register a new user, rather than grab an existing client, start it up, and go through the process of registering a new user with the Jabber server, with whatever window navigation and mouse-clicking that might entail. All the script must do is interact with the Jabber server in the context of the jabber:iq:register namespace, specifically pre-session. It must be able to make a registration enquiry by sending an IQ get and returning the fields listed in the result, and to make a registration attempt, when supplied with values for the registration fields.

We should be able to invoke our script, reguser, in one of two ways. The first, specifying merely a hostname (and optional port, which will default to 5222 if not specified), implies a registration enquiry - where we wish to make an enquiry of the Jabber server as to (a) whether registration is possible and (b) if so, what fields are 'required'. The second way, specifying not only the host and optional port, but also a list of fieldname and value pairs to send in a user registration attempt. Figure 6-3 shows both these ways in action.

$ ./reguser yak:5222
[Enquiry] Fields: username password email name 

$ ./reguser yak username=joseph password=spinach 'name=Joseph Adams' email=joseph@yak
[Attempt] (joseph) Successful registration

$ ./reguser yak username=dj password=secret 'name=DJ Adams' email=dj@yak
[Attempt] (dj) Error: 409 (Username Not Available)

As it's our first substantial script, let's take it step by step. It's written in Perl.

#!/usr/bin/perl

use strict;
use Net::Jabber 1.0022 qw(Client);

use constant NS_REGISTER => 'jabber:iq:register';

unless (@ARGV) {
  print usage();
  exit;
}

We start out with some basic start-of-script housekeeping - delaring our usage of the Net::Jabber module, setting a constant for the jabber:iq:register namespace, and handling the case of being 'wrongly' invoked by giving some help text from the usage() subroutine. The specification of "Client" in the

use Net::Jabber 1.0022 qw(Client);

means that the connection is going to be client-based; in other words, the namespace that will be used to qualify the XML stream header that Net::Jabber will produce is jabber:client.

The Net::Jabber module has changed as it has matured over the recent versions (1.0020, 1.0021 and 1.0022) and these changes do sometimes affect how the scripts that use Net::Jabber should be written. So we explicitly specify in the use statement which version of Net::Jabber we require, to avoid confusion.

my ($host, $port) = split(":", shift @ARGV);
$port ||= 5222;

my $c = Net::Jabber::Client->new();

defined($c->Connect(
            hostname => $host,
            port     => $port,
)) or die "Cannot reach Jabber server at $host:$port\n";

my ($iq, $query, $result);

We parse the hostname and port, defaulting the latter to 5222 if it wasn't specified. Then we create a new instance of the Net::Jabber::Client object. The Net::Jabber family of modules presents its collective functions in an object-oriented way. The scalar $c represents the 'client' mechanism with which we connect to the Jabber server.

With the Connect() method, we make a connection to the Jabber server; the namespace of the XML stream for this connection, sent to the Jabber server in the stream header, is jabber:client.

# Registration attempt or enquiry?

if (scalar @ARGV) {

  # Attempt:
  # Send <iq type='set'>
  #        <query xmlns='jabber:iq:register'>
  #          <username>...</username>
  #          <password>...</password>
  #          ...
  #        </query>
  #      </iq>

  print "[Attempt] ";

  $iq = Net::Jabber::IQ->new();
  $iq->SetType('set');
  $query = $iq->NewQuery(NS_REGISTER);

We work out what we have to do by looking to see if any extra parameters beyond the hostname and port were specified. If there were, we need to build an IQ set in the jabber:iq:register namespace to make a registration attempt.

The Net::Jabber::IQ module represents the IQ model and provides methods to manage IQ packets. With the new() constructor we create a new, empty IQ packet in $iq, and set its type attribute to 'set'.

As we know, the <query/> part of an IQ packet is contained within the <iq/> tag. The NewQuery() method, called on an IQ packet, creates a <query/> tag as a child of that IQ packet, and delivers us a handle on that <query/> tag - which we store in $query - so that we can manipulate it independently of the IQ packet that wraps around it. The jabber:iq:register namespace value is passed as a parameter to the NewQuery() call to set the correct xmlns namespace attribute.

Figure 6-4 shows what the packet looks like at this stage, and how the scalar object references $iq and $query relate to it.

  $iq -------+                         +----- $query
             |                         |
             v                         |
            <iq type='set'>            v
              <query xmlns='jabber:iq:register'/>
            </iq>

In our foreach loop we run through the list of parameters, in the form fieldname=value, and call a Set method on the $query object (the <query/> packet) to add child tags:

  foreach my $arg (@ARGV) {
    my ($field, $value) = split('=', $arg);
    print "($value) " if $field eq 'username';
    eval '$query->Set'.ucfirst($field).'($value)';
  }

  $result = $c->SendAndReceiveWithID($iq);

Net::Jabber::Query provides a number of SetXXXX methods which are available according to namespace. These 'set' methods available for the jabber:iq:register namespace are plentiful and include SetName, SetEmail, SetPhone and so on. Each method will create a child tag named after the method (e.g. SetName will create a <name/> tag and SetPhone will create a <phone/> tag) and insert the value passed to the method into the tag.

For example,

$query->SetName('DJ Adams');

will insert (or amend) a tag in the <query/> thus:

<iq type='set'>            
  <query xmlns='jabber:iq:register'>
    <name>DJ Adams</name>
  </query>
</iq>

We use eval to allow us to make our SetXXXX method calls dynamically, according to each fieldname specified. The ucfirst() function is used to change the first character of the fieldname to upper case, to suit the SetXXXX method naming conventions.

Once we've added all the fields, we send the complete packet ($iq) to the server using the SendAndReceiveWithID() method on the connection ($c) object. This method is extremely powerful and does many things for us. It keeps the process of writing small scripts like this very simple. What is does is: adds a unique id attribute to the <iq/> packet, transmits the packet over the XML stream, and waits for a response.

"Hey, what about the event-model that we read about?" you might ask. Of course, Net::Jabber supports an event-model programming style, but for now we can get away with keeping our code 'procedural' - and short - using this high-level method which does everything we want. After all, in any one execution of the script, we only wish to send one packet to the Jabber server and receive one back. Nothing more complicated than that.

Later scripts will demonstrate the event-model.

The response is stored in $result, and is itself an IQ packet, as we expect. So $result is a handle on a Net::Jabber::IQ object that we can now manipulate.

  # Success
  if ($result->GetType() eq 'result') {
    print "Successful registration\n";
  }

  # Failure
  else {
    print "Error: ",
          $result->GetErrorCode(),
          " (",
          $result->GetError(),
          ")\n";
  }

}

We check the type of the IQ returned from the server. If it's a 'result':

RECV: <iq type='result' id='1'>
        <query xmlns='jabber:iq:register'/>
      </iq>

then great - the registration was successful. Otherwise, we can grab the error code and description from the <error/> element:

RECV: <iq type='error'>
        <query xmlns='jabber:iq:register'>
          <username>dj</username>
          <password>secret</password>
        </query>
        <error code='409'>Username Not Available</error>
      </iq>

using the GetError() and GetErrorCode() methods on the IQ object.

We go through a similar process if there are no further parameters following the host[:port] specification:

else {

  # Enquiry:
  # Send <iq type='get'><query xmlns='jabber:iq:register'/></iq>

  print "[Enquiry] ";

  $iq = Net::Jabber::IQ->new();
  $iq->SetType('get');
  $query = $iq->NewQuery(NS_REGISTER);

  $result = $c->SendAndReceiveWithID($iq);

The only difference here is that we set the IQ type to 'get', not 'set', and we don't insert any tags into the $query object, before sending the packet off and waiting for a response.

  # Success
  if ($result->GetType() eq 'result') {
    $query = $result->GetQuery();

    my %contents = $query->GetRegister();
    delete $contents{'instructions'};
    print "Fields: ", join(', ', keys %contents), "\n";
  }

If we receive a 'result' type, like this:

RECV: <iq type='result'>
        <query xmlns='jabber:iq:register'>
          <instructions>
            Choose a username and password to register with this server.
          </instructions>
          <name/>
          <email/>
          <username/>
          <password/>
        </query>
      </iq>

then we need to extract the fields listed in the <query/> tag and return them to the user. While the NewQuery() method creates a new <query/> tag inside an IQ object, the GetQuery() method retrieves an existing one, in the form of a Net::Jabber::Query object whose handle we store in $query. We can call the GetRegister() method on this query object, which returns a hash of the contents:

(
  'instructions' => 'Choose a username and password ...',
  'name'         => undef,
  'email'        => undef,
  'username'     => undef,
  'password'     => undef
)

And, after removing the 'instructions', we can display them as the result.

In the case where an error is returned in response to the IQ get (perhaps no registrations are allowed), we display the error in the same was as before:

  # Failure
  else {
    $query = $result->GetQuery();
    print "Error: ",
          $result->GetErrorCode(),
          " (",
          $result->GetError(),
          ")\n";
  }

}

When we've finished, we close the connection and exit. Here we also have the usage() subroutine defined.

$c->Disconnect;

exit;


sub usage {

<<EOF
Usage:
Enquiry: reguser host[:port]
Attempt: reguser host[:port] field1=value1 [fieldN = valueN] ...
EOF

}