Let's continue what we have started with the previous feed on Gigaset:

(see previous feed for more details)

requirement: the phone must be plugged in your local network (because of redirection of default phonebook address).

1. First you have to redirect the A lookup pbs.gigaset.net to an IP of a server in your local network
For this point just add the IP in your configuration of your main bind (named) server.

2. On this server you set up HTTP server with the a CGI called /snipweb/phonebookservlet.do that will ensure the gateway with the .tel
See bolow for a sample code

Technically, nothing complicated, it's only NAPTR lookups:

$ dig +short edouard.tel NAPTR 
100 101 "u" "E2U+voice:tel" "!^.*$!tel:+33987654321!" .
100 102 "u" "E2U+voice:tel" "!^.*$!tel:+33987654322!" .
100 100 "u" "E2U+voice:tel" "!^.*$!tel:+33123456789!" .

I made few changes on the previous code.

Sample of a lookup: here I am querying ovh.tel (feel free to compare with the web gateway: http://ovh.tel/ )


dottel lookup
dottel details

Now if you are interested in buying .tel, don't hesitate to visit: http://ovh.com/welcome

Code of phonebookservlet.do

#!/usr/bin/perl

use strict;
use CGI;
use Data::Dumper;
use Net::DNS;

my $cgi = new CGI;
my $resolver = Net::DNS::Resolver->new;

my $DEBUG = 0;

print "Content-Type: text/xml;charset=UTF-8\n\n";


my $lookup = lc( $cgi->param('nn'));
my $first = $cgi->param('first');
my $last  = $first + ($cgi->param('count') || 32) -1;


$lookup =~ s/\*//g; # cleanup '*' 
$lookup .= '.tel' unless $lookup =~ /\.tel$/; 

warn("Lookup [$lookup] from: $first to: $last\n");

my @answer = telQuery( $lookup); # TODO: should save query in order to avoid changes while navigating on differents pages

my $total = scalar(@answer );
my $last  = ( $total > $last ) ? $last : $total;
my $data=
        "<?xml version='1.0' encoding='UTF-8'?>".
        "<list reqid='".$$."' response='get_list' type='shcpb' total='".scalar(@answer )."' first='".$first."' last='".$last."'>";

my $id=0;
foreach my $entry (@answer)
{
        $id++;
        if ( $id >= $first and $id <= $last )
        {
                # change format for a better display
                my $domain = lc( $entry->{'domain'});
                $domain =~ s/\.tel$//;
                my $name = join( '/', reverse( split( /\./, $domain)));
                $name .= "#".$entry->{'label'} if $entry->{'label'};

                # escaping for security
                $name =~ s/&/&amp;/g;
                $name =~ s/</&lt;/g;
                $name =~ s/>/&gt;/;

                $data .= "<entry id='".$id."'><usr>".$entry->{'tel'}."</usr><nn>".$name."</nn></entry>";
        }
}
$data .= '</list>';


if ($cgi->user_agent() =~ /C470IP/ )
{
        printf '%x'."\n", length( $data); # print header only for phone (not with firefox: allow debug)
}
warn "sending $data\n";
print $data."\n";

# -- 
sub telQuery
{
    my $domain = shift;
    my $depth  = shift || 1;

    $DEBUG && warn "calling $domain (depth: $depth)\n";

    return if $depth < 0;

    my $query = $resolver->query( $domain, "NAPTR");

    my @numbers;

    if ($query)
    {
        my @answers = sort { $a->preference cmp $b->preference } $query->answer;
        foreach my $rr ( @answers )
        {
            #$DEBUG && warn Dumper( $rr);

            next if $rr->type ne "NAPTR"; # don't support CNAME currently
            next if $rr->name ne $domain; # security

            if (not $rr->service and not $rr->flags and not $rr->regexp)
            {
                # treat sub levels
                my $subDomain = $rr->replacement;
                my @subNumbers = telQuery( $subDomain, $depth -1);
                push @numbers, @subNumbers if @subNumbers;
                next;
            }

            next if $rr->service !~ /^E2U/;
            my @services = split( /\+/, $rr->service);
            shift @services; # remove E2U

            # keep only voice tel number
            next unless grep { $_ eq 'voice:tel' } @services;

            # check if this number has a label
            my @labels = grep s/^x-lbl://, @services;
            my $label = shift @labels;

            # check if this is the main telephone number
            my $isMainNumber = grep { $_ eq 'x-main' } @services;

            # retreive tel number from regex 
            my $tel = $rr->regexp;
            $tel =~ s/^\!\^\.\*\$\!\E(.*)\!$/$1/;
            $tel =~ s/^tel://;

            if ($isMainNumber)
            {
                unshift @numbers, { domain => $domain, label => $label, tel => $tel };
            }
            else
            {
                push @numbers, { domain => $domain, label => $label, tel => $tel };
            }
        }
    }
    else
    {
        $DEBUG && warn $resolver->errorstring();
    }
    return @numbers;
}