--- /dev/null
+#!/usr/bin/perl
+use strict;
+
+use Data::Dumper;
+
+use Getopt::Long;
+use Net::LDAP;
+use Net::LDAP::Control::Paged;
+use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED );
+use LWP;
+use JSON;
+use AppConfig;
+
+my $api_key;
+
+my $help;
+my $username;
+my $configfile = undef;
+my $remove = 0;
+my $dryrun = 0;
+my ($g_ua, $session, $api_key, $auth_key, $data, $domain);
+my ($user, $sipuser, $mac);
+
+my $config = AppConfig->new({ CREATE => 1 });
+
+$config->define("api_url=s");
+$config->define("api_keyfile=s");
+
+foreach (
+ "/usr/local/etc/hermes/hermes_config",
+ "/usr/local/etc/hermes/config",
+ "/etc/hermes/config",
+ $ENV{"HOME"} . "/.hermes/config",
+ $ENV{"HOME"} . "/.hermes_config",
+) { $configfile = $_ if ( -f $_ ); }
+
+GetOptions(
+ "help" => \$help,
+ "macaddress=s" => \$mac,
+ "username=s" => \$username,
+ "configfile=s" => \$configfile,
+);
+
+if (
+ (( $configfile ) && ( not -f $configfile ))
+)
+{
+ $help = 1;
+}
+
+$config->file( $configfile );
+
+if ( ( not $config->api_url ) ||
+ ( not $config->api_keyfile ) ||
+ ( $config->api_keyfile && not -f $config->api_keyfile ) )
+{
+ $help = 1;
+}
+
+if ( $help ) {
+print <<END_HELP;
+WARNING: This tool assumes that only one domain
+is registered with Kamailio. For Multidomain-setup,
+this tool must be rewritten!
+
+Verify that the following options are set:
+ --configfile=s|--config|-c
+ --macaddress=s|--mac|-m
+
+Verify the contents of the configuration file.
+Verify that the key-file exists.
+END_HELP
+exit; }
+
+open KEY, "<" . $config->api_keyfile;
+chomp( $api_key = <KEY> );
+close KEY;
+
+if ( $mac )
+{
+ # Do stuff to the MAC adress.
+ $mac =~ s/[:-]//g if ( $mac =~ m/((?:[0-9a-f]{2}[:-]){5}[0-9a-f]{2})/i);
+ $mac = lc $mac;
+ if ( not $mac =~ m/^[a-f0-9]{12}/ )
+ {
+ printf("Malformed MAC adress.\n");
+ exit;
+ }
+}
+
+$g_ua = LWP::UserAgent->new;
+$g_ua->cookie_jar({}); # In-memory jar, look at HTTP::Cookies for persistant
+
+login_apikey();
+
+# First: fetch a supported domain from the API...
+$data = exec_apinode("domain/list", undef);
+if ( $data->{'response'} eq 'ok' )
+{
+ $domain = $data->{'list'}[0];
+}
+else
+{
+ printf("Unable to get domain name. Aborting\n");
+ logout();
+ exit;
+}
+
+$data = exec_apinode("phone/list", undef );
+if ( not $data->{'response'} eq 'ok' )
+{
+ printf("Failed to query list of phones. Aborting\n");
+ logout();
+ exit;
+}
+
+my $t = $data->{'list'};
+my @phones = @$t;
+
+foreach my $p ( @phones )
+{
+ $data = undef;
+ $data = exec_apinode("phone/get", { 'mac' => $p });
+ if ( $data->{'response'} eq 'ok' )
+ {
+ my $t = $data->{'list'};
+ my @users = @$t;
+ foreach my $u ( @users )
+ {
+ printf("%-24s%-24s\n", $p, $u);
+ }
+ }
+ else
+ {
+ printf("%-24s-24s\n", $p, "unassigned");
+ }
+}
+
+logout();
+################################################################################################
+sub exec_apinode($$)
+{
+ my $node = shift;
+ my $param = shift;
+
+ my ( $response, $data );
+
+ $session = "" if not defined $session;
+ $auth_key = "" if not defined $auth_key;
+ my $url = $config->api_url . "/" . $node;
+
+ $param->{'session'} = $session;
+ $param->{'auth_key'} = $auth_key;
+
+ $response = $g_ua->post( $url, $param );
+ if ( $response->is_success )
+ {
+ if ( $response->content =~ m/\s*{/ )
+ {
+ $data = decode_json( $response->content);
+ }
+ else
+ {
+ $data = $response->content;
+ }
+
+ }
+ return $data;
+}
+
+sub login_apikey
+{
+ my $response = $g_ua->post( $config->api_url . "/auth/login",
+ [ "api_key" => $api_key ] );
+
+ my $data = decode_json( $response->content) if $response->is_success;
+ die("HTTP error") unless $response->is_success;
+
+ if ( $data->{'response'} eq "ok" )
+ {
+ $session = $data->{'session'};
+ $auth_key = $data->{'auth_key'};
+ }
+ else
+ {
+ print "Unable to log in to Hermes API\n";
+ exit;
+ }
+ undef $data; undef $response;
+}
+
+sub logout
+{
+ my $response = $g_ua->post( $config->api_url . "/auth/logout",
+ [ "session" => $session ] );
+ die("HTTP error") unless $response->is_success;
+ undef $session; undef $auth_key;
+}