imapsync/W/learn/dns_srv_imap

#!/usr/bin/perl 

# $Id: dns_srv_imap,v 1.5 2016/08/15 01:24:20 gilles Exp gilles $

use strict ;
use warnings ;
use English ;
use Test::More ;
use Net::DNS ;



foreach my $email ( @ARGV ) {
	my $domain = domain_name_of( $email ) ;
        print "Domain for email $email: $domain\n" ;
	my ( $host, $port ) = host_port_from_lookup_srv( '_imaps._tcp.' . $domain ) ;
	$host ||= q{} ;
	$port ||= q{} ;
        print "IMAPS server name and port for $email: $host $port\n" ;

	( $host, $port ) = host_port_from_lookup_srv( '_imap._tcp.' . $domain ) ;
	$host ||= q{} ;
	$port ||= q{} ;
        print "IMAP  server name and port for $email: $host $port\n" ;
}


tests_server_name_from_srv_string(  ) ;
tests_server_port_from_srv_string(  ) ;
tests_domain_name_of(  ) ;
tests_host_port_ssl_from_user(  ) ;
done_testing(  ) ;

my $debug = 1 ;


sub host_port_ssl_from_user {
        my $user = shift @ARG ;

        if ( ! $user ) {
                return ;
        }
         
        my $domain = domain_name_of( $user ) ;
        if ( ! $domain ) {
                return ;
        }
        
        my ( $host, $port ) = host_port_from_lookup_srv( qq{_imaps._tcp.$domain}  ) ;
        my $ssl = 1 ;
        if ( $host and $port ) {
                return ( $host, $port, $ssl ) ;
        }
	
	# fallback to imap in clear
	$ssl = 0 ;
	( $host, $port ) = host_port_from_lookup_srv( qq{_imap._tcp.$domain}  ) ;

        if ( $host and $port ) {
                return ( $host, $port, $ssl ) ;
        }
	
	return ;
	
}

sub tests_host_port_ssl_from_user {
        is( undef, host_port_ssl_from_user(  ), 'host_port_ssl_from_user: no args => undef' ) ;
        is_deeply( [qw( imap.gmail.com. 993 1 )], [host_port_ssl_from_user( 'gilles.lamiral@gmail.com' )], 
        'host_port_ssl_from_user: gilles.lamiral@gmail.com => imap.gmail.com. 993 1 (ssl)' ) ;

}

sub host_port_from_lookup_srv {
	my $request = shift @ARG ;
	
        my $lookup = lookup_srv_string( $request  ) ;
        if ( ! $lookup ) {
                return ;
        }
	
        my $host = server_name_from_srv_string( $lookup ) ;
        my $port = server_port_from_srv_string( $lookup ) ;

	if( $host and $port ) {
		return ( $host, $port ) ;
	}
	else {
		return ;
	}
}


sub domain_name_of_email {
        my $email = shift ;

        return( undef ) if ( not $email ) ;
        
        my $domain ;
        
        if ( $email =~ /^.*@([^@]+)$/ ) {
                $domain = $1 ;
                $debug and print "domain: $domain\n" ;
                return( $domain ) ;
        }
        return ;
}


sub domain_name_of {
        my $email = shift ;

        return( undef ) if ( not $email ) ;
        
        my $domain = domain_name_of_email( $email ) ;
        
        if ( ! $domain ) {
                $domain = $email ;
        }
        
        return( $domain ) ;
}

sub tests_domain_name_of {
        ok( not( domain_name_of( '' ) ),      'domain_name_of: void => undef' ) ;
        ok( not( domain_name_of(  ) ),        'domain_name_of: undef => undef' ) ;
        ok( 'foo' eq domain_name_of( 'foo' ),   'domain_name_of: foo => foo' ) ;
        #ok( 'foo' eq domain_name_of( 'foo ' ),  'domain_name_of: foo  => foo' ) ;
        #ok( 'foo' eq domain_name_of( 'foo  ' ), 'domain_name_of: foo   => foo' ) ;
        ok( 'example.com' eq domain_name_of( 'foo@example.com' ),   'domain_name_of: foo@example.com => example.com' ) ;
        ok( 'example.com' eq domain_name_of( '@foo@example.com' ),  'domain_name_of: @foo@example.com => example.com' ) ;
        ok( 'example.com' eq domain_name_of( 'bar@foo@example.com' ),  'domain_name_of: bar@foo@example.com => example.com' ) ;
}

sub lookup_srv_string {
        my $name = shift ;
        
        my $resolver = new Net::DNS::Resolver(  ) ;
        my $reply = $resolver->query( $name, 'SRV' ) ;

        my $string ;
        if ( $reply ) {
                #($reply->answer)[0]->print;
                foreach my $rr ( $reply->answer ) {
                        $debug and print 'name:   ' . $rr->name   . "\n" ;
                        $debug and print 'class:  ' . $rr->class  . "\n" ;
                        $debug and print 'type:   ' . $rr->type   . "\n" ;
                        $debug and print 'ttl:    ' . $rr->ttl    . "\n" ;
                        $debug and print 'string: ' . $rr->string . "\n" ;
                        next if ( 'SRV' ne $rr->type ) ;
                        next if ( not( $rr->string ) ) ;
                        $string = $rr->string ;
                        return( $string ) ;
                }
        } else {
                print "Query failed SRV for domain $name: ", $resolver->errorstring, "\n" ;
                return( undef ) ;
        }
        return( $string ) ;
}




sub server_name_from_srv_string {
        my $srv_string = shift ;
        
        return( undef ) if ( not $srv_string ) ;
        my $server_name = (split( /\s+/ , $srv_string ) )[7] ;
        return( undef ) if ( '.' eq $server_name ) ;
        return( $server_name ) ;
}

sub tests_server_name_from_srv_string {
        ok( not( server_name_from_srv_string( '' ) ), 'server_name_from_srv_string: void' ) ;
        ok( not( server_name_from_srv_string(  ) ), 'server_name_from_srv_string: undef' ) ;
        ok( 'imap.gmail.com.' eq 
            server_name_from_srv_string( '_imaps._tcp.gmail.com.  82466   IN      SRV     5 0 993 imap.gmail.com.' ), 
            'server_name_from_srv_string: _imaps._tcp.gmail.com. => imap.gmail.com.' ) ;
        ok( not( server_name_from_srv_string( '_imap._tcp.gmail.com.   81999   IN      SRV     0 0 0 .' ) ), 
            'server_name_from_srv_string: _imap._tcp.gmail.com. => undef' ) ;
        
        return(  ) ;
}

sub server_port_from_srv_string {
        my $srv_string = shift ;
        
        return( undef ) if ( not $srv_string ) ;
        my $server_port = (split( /\s+/ , $srv_string ) )[6] ;
        return( undef ) if ( 0 == $server_port ) ;
        return( $server_port ) ;
}

sub tests_server_port_from_srv_string {
        ok( not( server_port_from_srv_string( '' ) ), 'server_port_from_srv_string: void' ) ;
        ok( not( server_port_from_srv_string(  ) ), 'server_port_from_srv_string: undef' ) ;
        ok( '993' eq 
            server_port_from_srv_string( '_imaps._tcp.gmail.com.  82466   IN      SRV     5 0 993 imap.gmail.com.' ), 
            'server_port_from_srv_string: _imaps._tcp.gmail.com. => 993' ) ;
        ok( not( server_port_from_srv_string( '_imap._tcp.gmail.com.   81999   IN      SRV     0 0 0 .' ) ), 
            'server_port_from_srv_string: _imap._tcp.gmail.com. => undef' ) ;
        
        return(  ) ;
}