#!/usr/bin/perl 

# $Id: oauth2_imap,v 1.44 2025/08/26 13:05:50 gilles Exp gilles $

use strict ;
use warnings ;
use Data::Dumper ;
use Digest::SHA ;
use English ;
use Fcntl ;
use File::Basename ;
use Getopt::Long ( ) ;
use HTTP::Request::Common ;


use HTTP::Daemon ;
use HTTP::Daemon::SSL ;
use HTTP::Request ;
use HTTP::Response ;
use HTTP::Status ;
use URI ;

use JSON ;
use LWP::UserAgent ;
use LWP::Protocol::https ; # needed for the binaries
use Mail::IMAPClient ;
use MIME::Base64 ;
use URI::Escape ;

use Test::More ;

use Email::Address ( ) ;
use Net::DNS ( ) ;


#print search_dyn_lib_locale_MSWin32(  ), "\n" ;

# Unix exit style, 0 means success, non-0 means failure.
# 2025_08_21 Looking at the code, this exit code is not implemented.
#
# Refactoring idea: should return an $oauth object, with failure in it in case a failure happened.

my $oauth2_imap_result = oauth2_imap( @ARGV ) ;

exit( $oauth2_imap_result || 0 ) ; 



sub oauth2_imap
{

        # extract_options sets $oauth2_options->{ failure } if it goes wrong.
        my ( $oauth2_options, @remaining_ARG ) = parse_command_line( @ARG ) ;
        
        if ( $oauth2_options->{ failure } )
        {
                return 64 ; # EX_USAGE => 64 ; /* command line usage error */
        }
        
        # perform tests is --tests or --testone 
        do_tests( $oauth2_options ) || return ;
        
        my $user = shift @remaining_ARG ;
        
        if ( ! $user )
        {
                print "\nusage: $0 foo\@example.com\n\n" ;
                #print "LWP::VERSION=" . $LWP::VERSION . " LWP::Protocol::https::VERSION=" . $LWP::Protocol::https::VERSION . "\n" ;
                return 64 ; # EX_USAGE => 64 ; /* command line usage error */
        }
        
        
        # Now I should just call a function with $oauth2 as argument and all the remaining in it.
        # Find a name! And move some lines!
        
        
        my $oauth2 = {  } ;
        
        
        $oauth2->{ user } = $user ;

        

        $oauth2->{ provider } = $oauth2_options->{ provider } ;
        oauth2_determine_provider( $oauth2 ) || return ;
        
        # Default application is thunderbird
        $oauth2->{ application } = $oauth2_options->{ application } || 'thunderbird' ;
        
        oauth2_expand_parameters( $oauth2 ) ;
        
        
        # overwrite $oauth2 with the options values, if any.
        merge_hashes(
                $oauth2,
                $oauth2_options,
        ) ;
        
        oauth2_are_all_parameters_there( $oauth2 ) || return ;
        
        oauth2_init( $oauth2 ) || return ;

        #exit ;
        
        if ( $oauth2 )
        {
                oauth2_approve( $oauth2 ) ;
        }
        return ;
}


sub tests_parse_command_line
{
        note( 'Entering tests_parse_command_line()' ) ;

        is( 0, parse_command_line(  ),  'tests_parse_command_line: no args => 0 in scalar context' ) ;
        is( 1, parse_command_line( "" ),  'tests_parse_command_line: "" => 1 in scalar context' ) ;

        my ( $oauth2_options, @remaining_ARG ) = parse_command_line(  ) ;
        is( undef, $oauth2_options->{ debug }, 'tests_parse_command_line: no args => attended option undef' ) ;
        ok( exists( $oauth2_options->{ debug } ), 'tests_parse_command_line: no args => attended option exists' ) ;
        is( undef, $oauth2_options->{ rrrrr  }, 'tests_parse_command_line: no args => not attended option undef' ) ;
        ok( ! exists( $oauth2_options->{ rrrrr } ), 'tests_parse_command_line: no args => not attended option do not exist' ) ;
        is_deeply( [  ], [ @remaining_ARG ], 'tests_parse_command_line: no args => no remaining_ARG' ) ;

        ( $oauth2_options, @remaining_ARG ) = parse_command_line( '--debug', 'titi@pppp' ) ;
        is( 1, $oauth2_options->{ debug }, 'tests_parse_command_line: --debug titi@pppp => option debug == 1' ) ;
        ok( exists( $oauth2_options->{ debug } ), 'tests_parse_command_line: --debug titi@pppp => attended option exists' ) ;
        is( undef, $oauth2_options->{ rrrrr  }, 'tests_parse_command_line: --debug titi@pppp => not attended option undef' ) ;
        ok( ! exists( $oauth2_options->{ rrrrr } ), 'tests_parse_command_line: --debug titi@pppp => not attended option do not exist' ) ;
        is_deeply( [ 'titi@pppp' ], [ @remaining_ARG ], 'tests_parse_command_line: --debug titi@pppp => titi@pppp' ) ;

        note( 'Leaving  tests_parse_command_line()' ) ;
        return ;
}


sub parse_command_line
{
        my $oauth2_options = { } ;

        # extract_options sets $oauth2_options->{ failure } if it goes wrong.
        my @remaining_ARG = extract_options( $oauth2_options, @ARG ) ;
        
        $oauth2_options->{ debug } and print "oauth2_imap, options       : " . Data::Dumper->Dump( [ \$oauth2_options ] ) . "\n" ;
        $oauth2_options->{ debug } and print "oauth2_imap, ARG           : " . Data::Dumper->Dump( [ \@ARG ] ) . "\n" ;
        $oauth2_options->{ debug } and print "oauth2_imap, remaining_ARG : " . Data::Dumper->Dump( [ \@remaining_ARG ] ) . "\n" ;
        
        return( $oauth2_options, @remaining_ARG ) ;
}

sub oauth2_are_all_parameters_there
{
        my $oauth2 = shift @ARG ;
   
        if ( ! defined $oauth2 ) { return ; }
        
        foreach my $parameter ( qw( authorize_uri token_uri scope_string  client_id client_secret redirect_uri ) )
        {
                if ( ! defined $oauth2->{ $parameter } )
                {
                        print( "Abort. I need an oauth2 parameter called $parameter\n" ) ; 
                        return 0 ;
                }
        }
        return 1 ;
}


sub do_tests
{
        
        my $oauth2_options = shift ;
        
        if (  $oauth2_options->{ testsone } )
        {
                testsone(  ) ;
                return ;
        }

        if ( ! $oauth2_options->{ tests } )
        { 
                return 1 ; 
        }
        else
        {
                note( 'Entering tests()' ) ;
                infos_modules(  ) ;
                tests_oauth2_generate_code_verifier(  ) ;
                tests_oauth2_code_challenge(  ) ;
                tests_merge_hashes(  ) ;
                tests_find_domain_from_email(  ) ;
                tests_find_provider_from_domain(  ) ;
                tests_find_provider_from_email(  ) ;
                tests_oauth2_lunch_httpd_localhost_ssl(  ) ;
                tests_oauth2_determine_provider(  ) ;
                tests_parse_command_line(  ) ;
                tests_extract_options(  ) ;
                tests_token_file(  ) ;
                done_testing( 82 ) ;
                note( 'Leaving  tests()' ) ;
        }
        return ;
}

sub testsone
{
        note( 'Entering testsone()' ) ;
        tests_token_file(  ) ;
        done_testing(  ) ;
        note( 'Leaving  testsone()' ) ;
}

sub infos_modules
{
        printf( "%-20s %s\n", "HTTP::Daemon",      $HTTP::Daemon::VERSION )  ;
        printf( "%-20s %s\n", "HTTP::Daemon::SSL", $HTTP::Daemon::SSL::VERSION )  ;
        printf( "%-20s %s\n", "IO::Socket::SSL",   $IO::Socket::SSL::VERSION )  ;
        printf( "%-20s %s\n", "Net::SSLeay",       $Net::SSLeay::VERSION )  ;
}



sub tests_extract_options
{
        note( 'Entering tests_extract_options()' ) ;

        is_deeply( [], [ extract_options(  ) ],     'tests_extract_options: {  } => empty array' ) ;
        is_deeply( [], [ extract_options( {  } ) ], 'tests_extract_options: {  } => empty array' ) ;
        
        my $oauth2_options = {  } ;
        is_deeply( [], [ extract_options( $oauth2_options ) ], 'tests_extract_options: {  } as variable => empty array' ) ;
        is_deeply( [], [ extract_options( $oauth2_options, '--kkk' ) ], 'tests_extract_options: --kkk => undef' ) ;
        is( 1, $oauth2_options->{ failure }, 'tests_extract_options: --kkk => failure == 1' ) ;
        
        is_deeply( [], [ extract_options( $oauth2_options, '--debug' ) ], 'tests_extract_options: --debug => []' ) ;
        
        # Caveat emptor, second call maintains failure.
        is( 1, $oauth2_options->{ failure }, 'tests_extract_options: second call --debug  => failure == 1' ) ;
        is_deeply( [ 'toto@casa' ], [ extract_options( $oauth2_options, '--debug', 'toto@casa' ) ], 'tests_extract_options: --debug toto@casa => toto@casa' ) ;
        
        # Reset, no failure.
        $oauth2_options = {  } ;
        is_deeply( [ 'toto@casa' ], [ extract_options( $oauth2_options, '--debug', 'toto@casa' ) ], 'tests_extract_options: --debug toto@casa => toto@casa' ) ;
        is( undef, $oauth2_options->{ failure }, 'tests_extract_options: reset + --debug  => undef' ) ;
        
        
        note( 'Leaving  tests_extract_options()' ) ;
        return ;
}


sub extract_options
{
        my $oauth2_options = shift @ARG ;
        my $ret = Getopt::Long::GetOptionsFromArray( \@ARG, 
                'tests!'          => \$oauth2_options->{ tests },
                'testsone!'       => \$oauth2_options->{ testsone },
                'debug!'          => \$oauth2_options->{ debug },
                'startover!'      => \$oauth2_options->{ startover },
                'provider=s'      => \$oauth2_options->{ provider },
                'authorize_uri=s' => \$oauth2_options->{ authorize_uri },
                'token_uri=s'     => \$oauth2_options->{ token_uri },
                'redirect_uri=s'  => \$oauth2_options->{ redirect_uri },
                'scope_string=s'  => \$oauth2_options->{ scope_string },
                'application=s'   => \$oauth2_options->{ application },
                'client_id=s'     => \$oauth2_options->{ client_id },
                'client_secret=s' => \$oauth2_options->{ client_secret },
                'thunderbird!'    => \$oauth2_options->{ thunderbird },
                'token_file=s'    => \$oauth2_options->{ token_file },
                'local!'          => \$oauth2_options->{ local },
                'localssl!'       => \$oauth2_options->{ localssl },
                'imap_server=s'   => \$oauth2_options->{ imap_server },
                'remotebrowser!'  => \$oauth2_options->{ remotebrowser },
        ) ;
        
        $oauth2_options->{ debug } and print "extract_options, ret, ARG: (" . Data::Dumper->Dump( [ $ret, \@ARG ]  ) . ")\n" ;
        
        # Something went wrong for GetOptionsFromArray
        if ( ! $ret )
        {
                $oauth2_options->{ failure } = 1 ;
                return ; 
        }
        
        # Returns remaining args 
        return( @ARG ) ;
}

# https://web.archive.org/web/20231218111748/https://hg.mozilla.org/comm-central/file/tip/mailnews/base/src/OAuth2Providers.jsm
# ( was https://hg.mozilla.org/comm-central/file/tip/mailnews/base/src/OAuth2Providers.jsm )

sub oauth2_office365
{
        my $oauth2_office365 = 
        {
                authorize_uri  => 'https://login.microsoftonline.com/common/oauth2/v2.0/authorize',
                token_uri      => 'https://login.microsoftonline.com/common/oauth2/v2.0/token',
                redirect_uri   => 'https://localhost',
                scope_string   => 'offline_access https://outlook.office.com/IMAP.AccessAsUser.All',
                imap_server    => 'outlook.office365.com',
        } ;
        
        return $oauth2_office365 ;
}


# With account gilles.lamiral@outlook.com
# https://portal.azure.com/#view/Microsoft_AAD_RegisteredApps/ApplicationMenuBlade/~/Authentication/appId/c46947ca-867f-48b7-9231-64213fdd765e

sub oauth2_office365_imapsync 
{
        my $oauth2_office365_imapsync = 
        {
                authorize_uri  => 'https://login.microsoftonline.com/common/oauth2/v2.0/authorize',
                token_uri      => 'https://login.microsoftonline.com/common/oauth2/v2.0/token',
                redirect_uri   => 'https://imapsync.lamiral.info/cgi-bin/auth',
                scope_string   => 'offline_access https://outlook.office.com/IMAP.AccessAsUser.All',
                client_id      => 'c46947ca-867f-48b7-9231-64213fdd765e',
                client_secret  => 'cdX8Q~jy-ynhroJTduZJNM4WulTngWeYcCIIgdkq',
                imap_server    => 'outlook.office365.com',
        } ;
        
        return $oauth2_office365_imapsync ;
} 


sub oauth2_office365_thunderbird
{
        my $oauth2_office365_thunderbird = 
        {
                authorize_uri  => 'https://login.microsoftonline.com/common/oauth2/v2.0/authorize',
                token_uri      => 'https://login.microsoftonline.com/common/oauth2/v2.0/token',
                scope_string   => 'offline_access https://outlook.office.com/IMAP.AccessAsUser.All',
                redirect_uri   => 'https://localhost',
                client_id      => '9e5f94bc-e8a4-4e73-b8be-63364c29d753',
                client_secret  => '',
                imap_server    => 'outlook.office365.com',
        } ;
        
        return $oauth2_office365_thunderbird ;
        
}

sub oauth2_gmail
{
        my $oauth2_gmail = 
        {
                authorize_uri  => 'https://accounts.google.com/o/oauth2/auth',
                token_uri      => 'https://accounts.google.com/o/oauth2/token',
                redirect_uri   => 'http://localhost',
                imap_server    => 'imap.gmail.com',
        } ;
        
        return $oauth2_gmail ;
}


sub oauth2_gmail_imapsync
{
        my $oauth2_gmail_imapsync = 
        {
                authorize_uri  => 'https://accounts.google.com/o/oauth2/auth',
                token_uri      => 'https://accounts.google.com/o/oauth2/token',
                redirect_uri   => 'http://localhost',
                scope_string   => 'https://mail.google.com/',
                client_id      => '108687549524-s5ijqmadnmi4qfgfgicuquftv8f8a3da.apps.googleusercontent.com',
                client_secret  => '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',
                imap_server    => 'imap.gmail.com',
        } ;
        
        return $oauth2_gmail_imapsync ;
}

sub oauth2_gmail_thunderbird
{
        my $oauth2_gmail_thunderbird = 
        {
                authorize_uri  => 'https://accounts.google.com/o/oauth2/auth',
                token_uri      => 'https://accounts.google.com/o/oauth2/token',
                scope_string   => 'https://mail.google.com/',
                redirect_uri   => 'https://localhost',
                client_id      => '406964657835-aq8lmia8j95dhl1a2bvharmfk3t1hgqj.apps.googleusercontent.com',
                client_secret  => 'kSmqreRr0qwBWJgbf5Y-PjSU',
                imap_server    => 'imap.gmail.com',
         } ;
        
        return $oauth2_gmail_thunderbird ;
}

sub oauth2_expand_parameters
{
        my $oauth2 = shift @ARG ;

        if ( ! defined $oauth2 ) { return ; }
        
        if ( ! defined $oauth2->{ application } ) { return ; }
        if ( ! defined $oauth2->{ provider } )    { return ; }

        if ( 'thunderbird'    eq $oauth2->{ application } 
              and 'office365' eq $oauth2->{ provider } )
        {
                merge_hashes(
                        $oauth2,
                        oauth2_office365_thunderbird(  ),
                ) ;
                
        }
        elsif( 'thunderbird' eq $oauth2->{ application } 
                and 'gmail'  eq $oauth2->{ provider } )
        {
                merge_hashes(
                        $oauth2,
                        oauth2_gmail_thunderbird(  ),
                ) ;
        }
        elsif ( 'imapsync'      eq $oauth2->{ application } 
                and 'office365' eq $oauth2->{ provider } )
        {
                merge_hashes(
                        $oauth2,
                        oauth2_office365_imapsync(  ),
                ) ;
        }
        elsif( 'imapsync'   eq $oauth2->{ application } 
                and 'gmail' eq $oauth2->{ provider } )
        {
                merge_hashes(
                        $oauth2,
                        oauth2_gmail_imapsync(  ),
                ) ;
        }
        elsif( 'gmail' eq $oauth2->{ provider } )
        {
                merge_hashes(
                        $oauth2,
                        oauth2_gmail(  ),
                ) ;
        }
        elsif ( 'office365' eq $oauth2->{ provider } )
        {
                merge_hashes(
                        $oauth2,
                        oauth2_office365(  ),
                ) ;
        }
        
        return ;
}
        


sub tests_oauth2_determine_provider
{
        note( 'Entering tests_oauth2_determine_provider()' ) ;

        is( undef, oauth2_determine_provider(  ),  'tests_oauth2_determine_provider: no args => undef' ) ;
        my $oauth2 = {  } ;
        is( undef, oauth2_determine_provider( $oauth2 ),  'tests_oauth2_determine_provider: {  } => undef' ) ;
        
        $oauth2->{ user } = 'gilles@lamiral.info' ;
        is( undef, oauth2_determine_provider( $oauth2 ), 'tests_oauth2_determine_provider:gilles@lamiral.info => undef' ) ;
        
        
        $oauth2->{ provider } = 'tartanpion' ;
        is( 'tartanpion', oauth2_determine_provider( $oauth2 ), 'tests_oauth2_determine_provider:gilles@lamiral.info + provider tartanpion => tartanpion' ) ;
        is( 'tartanpion', $oauth2->{ provider },   'tests_oauth2_determine_provider: provider tartanpion remains' ) ;
        
        
        $oauth2 = {  } ;
        $oauth2->{ user } = 'toto@gmail.com' ;
        is( 'gmail', oauth2_determine_provider( $oauth2 ), 'tests_oauth2_determine_provider: toto@gmail.com => gmail' ) ;
        is( 'gmail', $oauth2->{ provider },   'tests_oauth2_determine_provider: toto@gmail.com => gmail' ) ;
        
        
        $oauth2->{ provider } = 'tartanpion' ;
        is( 'tartanpion', oauth2_determine_provider( $oauth2 ), 'tests_oauth2_determine_provider: toto@gmail.com + provider tartanpion => tartanpion' ) ;
        is( 'tartanpion', $oauth2->{ provider },   'tests_oauth2_determine_provider: toto@gmail.com + provider tartanpion => tartanpion' ) ;
        

        note( 'Leaving  tests_oauth2_determine_provider()' ) ;
        return ;
}

sub oauth2_determine_provider
{
        my $oauth2 = shift @ARG ;
   
        if ( ! defined $oauth2 ) { return ; }
        if ( ! defined $oauth2->{ user } ) { return ; }
   
        if ( defined(  $oauth2->{ provider } ) )
        {
                print( "The provider used comes from --provider $oauth2->{ provider }\n" ) ;
        }
        else
        {
                my $provider = find_provider_from_email( $oauth2->{ user } ) ;

                if ( ! $provider )
                {
                        print( 
                        "Could not guess the oauth2 provider from the address $oauth2->{ user }\n"
                        . "Specify it with --provider office365 or --provider gmail\n"
                        . "or bring all the details like the following example:\n"
                        . "$0 --authorize_uri value --token_uri value --scope_string value --client_id value --client_secret value --redirect_uri value --imap_server value $oauth2->{ user }\n"
                        ) ;
                        return ;
                }
                else
                {
                        print( "Found provider $provider from address $oauth2->{ user }\n" ) ;
                        $oauth2->{ provider } = $provider ;
                }
        }
        
        return $oauth2->{ provider } ;
}



sub tests_token_file
{
        note( 'Entering tests_token_file()' ) ;

        is( undef, token_file(  ),  'tests_token_file: no args => undef' ) ;
        my $oauth2 = {  } ;
        is( undef, token_file( $oauth2 ),  'tests_token_file: {  } => undef' ) ;
        
        $oauth2->{ user } = 'toto@kaka.com' ;
        is( 'tokens/oauth2_tokens_toto@kaka.com.txt', token_file( $oauth2 ),  'tests_token_file: user toto@kaka.com => tokens/oauth2_tokens_toto@kaka.com.txt' ) ;

        $oauth2->{ application } = 'app' ;
        is( 'tokens/oauth2_tokens_app_toto@kaka.com.txt', token_file( $oauth2 ),  'tests_token_file: application appapp => tokens/oauth2_tokens_app_toto@kaka.com.txt' ) ;
        
        $oauth2->{ provider } = 'prov' ;
        is( 'tokens/oauth2_tokens_app_prov_toto@kaka.com.txt', token_file( $oauth2 ),  'tests_token_file: provider prov => tokens/oauth2_tokens_app_prov_toto@kaka.com.txt' ) ;
        
        note( 'Leaving  tests_token_file()' ) ;
        return ;
}

sub token_file
{
        my $oauth2 = shift @ARG ;
        
        if ( $oauth2->{ token_file } )
        {
                return $oauth2->{ token_file } ;
        }
        
        my $token_file = "tokens/oauth2_tokens_" ;
        
        if ( $oauth2->{ application } )
        {
                $token_file .= $oauth2->{ application } . '_' ;
        }

        if ( $oauth2->{ provider } )
        {
                $token_file .= $oauth2->{ provider } . '_' ;
        }
        
        if ( $oauth2->{ user } )
        {
                $token_file .= $oauth2->{ user } . '.txt' ;
        }
        else
        {
                $token_file = undef ;
        }
      
        
        return $token_file ;
}




sub oauth2_init
{
        my $oauth2 = shift @ARG || {  } ;
        
        my $user = $oauth2->{ user } || '' ;
        
        if ( ! $user ) 
        {
                return ;
        }
        
        my $token_file = token_file( $oauth2 ) ;

        set_local_from_redirect_uri( $oauth2 ) ;
        set_localssl_from_redirect_uri( $oauth2 ) ;
        
        my $oauth2_code_verifier  = oauth2_generate_code_verifier(  ) ;  # 128 characters. Yeah, guess that man!
        my $oauth2_code_challenge = oauth2_code_challenge( $oauth2_code_verifier ) ; # Just BASE64URL-ENCODE(SHA256(ASCII(code_verifier)))
        my $oauth2_code_challenge_method = 'S256' ;
        my $state = generate_a_random_string( 32 ) ;
        # less secure way:
        # my $oauth2_code_challenge = $oauth2_code_verifier ;
        # my $oauth2_code_challenge_method = 'plain' ; # or nothing since plain is the default 

        
        
        merge_hashes(
                $oauth2,
                {
                        user           => $user,
                        token_file     => $token_file,
                        code_verifier  => $oauth2_code_verifier,
                        code_challenge => $oauth2_code_challenge,
                        code_challenge_method => $oauth2_code_challenge_method,
                        state          => $state,
                },
        ) ;

       return( $oauth2 ) ;
}




sub tests_oauth2_generate_code_verifier
{
        note( 'Entering tests_oauth2_generate_code_verifier()' ) ;

        is( 128, length( oauth2_generate_code_verifier(  ) ),           'tests_oauth2_generate_code_verifier: 128 characters long' ) ;

        note( 'Leaving  tests_oauth2_generate_code_verifier()' ) ;
        return ;
}


sub oauth2_generate_code_verifier
{
        return( generate_a_random_string( 128 ) ) ;
}



sub set_local_from_redirect_uri
{
        my $oauth2 = shift ;
        if ( ! defined( $oauth2 ) ) { return ; }

        if ( defined( $oauth2->{ local } ) )
        {
                return ;
        }
        elsif ( 'http://localhost' eq  $oauth2->{ redirect_uri } )
        {
                $oauth2->{ local } = 1 ;
        }
        else
        {
                $oauth2->{ local } = 0 ;
        }
}
        
        
sub set_localssl_from_redirect_uri
{
        my $oauth2 = shift ;
        if ( ! defined( $oauth2 ) ) { return ; }
              
        if ( defined( $oauth2->{ localssl } ) )
        {
                return ;
        }
        elsif ( 'https://localhost' eq  $oauth2->{ redirect_uri } )
        {
                $oauth2->{ localssl } = 1 ;
        }
        else
        {
                $oauth2->{ localssl } = 0 ;
        }
}
        
        


sub oauth2_approve
{ 
        my $oauth2 = shift  ;


        if ( oauth2_load_tokens_from_file( $oauth2 ) and oauth2_is_imap_access_ok( $oauth2 ) )
        {
                print "Access token is ok but let's get a new one anyway.\n" ;
        }
        
        if ( $oauth2->{ refresh_token } )
        {
                print "Found a refresh token. Refreshing the access token with it, and maybe the refresh token.\n" ;
                if ( ! oauth2_refresh_tokens( $oauth2 ) )
                {
                        oauth2_ask_authorization_code( $oauth2 ) ;
                        oauth2_request_tokens( $oauth2 ) ;
                }
        }
        else
        {
                oauth2_ask_authorization_code( $oauth2 ) ;
                oauth2_request_tokens( $oauth2 ) ;
        }
        
        if ( oauth2_is_imap_access_ok( $oauth2 ) )
        {
                oauth2_save_tokens_to_file( $oauth2 ) ;
                return 0
        }
        else
        {
                print "Failure\n" ;
                return 1
        }
} 



sub oauth2_load_tokens_from_file
{
        my $oauth2 = shift ;
        
        # ignore the tokens file
        if ( $oauth2->{ startover } ) { return ; }
        
        my $token_file = $oauth2->{ token_file } ;
        
        print "Reading tokens from file $token_file, if any\n\n" ;
        my $access_token  = nthline( $token_file, 1 ) ;
        my $refresh_token = nthline( $token_file, 2 ) ;

        $oauth2->{ access_token }  = $access_token  ;
        $oauth2->{ refresh_token } = $refresh_token ;
        
        return $access_token ;
}


sub oauth2_build_authorization_code_uri
{
        my $oauth2 = shift ;
        
        my $authorization_code_uri = join( '',
                $oauth2->{ authorize_uri },
                '?',
                'client_id=', uri_escape( $oauth2->{ client_id } ),
                '&tenant=common',
                '&scope=', uri_escape( $oauth2->{ scope_string } ),
                '&login_hint=', uri_escape( $oauth2->{ user } ),
                '&response_type=code',
                '&redirect_uri=', uri_escape( $oauth2->{ redirect_uri } ),
                '&code_challenge=', $oauth2->{ code_challenge },
                '&code_challenge_method=', $oauth2->{ code_challenge_method },
                '&state=', $oauth2->{ state },
                ) ;

        $oauth2->{ authorization_code_uri } = $authorization_code_uri ;
        return $authorization_code_uri ;
}


sub oauth2_ask_authorization_code
{
        my $oauth2 = shift ;

        

        if ( $oauth2->{ local } )
        {
                if ( oauth2_lunch_httpd_localhost( $oauth2 ) )
                {
                        print "Launched httpd\n" ;
                }
                else
                {
                        print "Failed to launch localhost httpd\n" ;
                        return ;
                }
                return( oauth2_ask_authorization_code_localhost( $oauth2 ) ) ;
        }
        elsif ( $oauth2->{ localssl } )
        {
                if ( oauth2_lunch_httpd_localhost_ssl( $oauth2 ) )
                {
                        print "Launched httpd ssl\n" ;
                }
                else
                {
                        print "Failed to launch localhost httpd ssl\n" ;
                        return ;
                }
                return( oauth2_ask_authorization_code_localhost( $oauth2 ) ) ;
        }
        else
        {
                
                return( oauth2_ask_authorization_code_remote( $oauth2 )  ) ;
        }
}




sub oauth2_ask_authorization_code_localhost 
{
        my $oauth2 = shift ;

        oauth2_invite_with_browser( $oauth2 ) ;

        my $code_from_localhost ;
        my $code_from_stdin ;

        if ( $oauth2->{ remotebrowser } )
        {
                print "\n\nLet's collect the code from the terminal\n" ;
                $code_from_stdin = oauth2_collect_code_from_stdin( $oauth2 ) ;                
        }
        else
        { 
                print "\n\nNow I try to collect the code. Will give up in 120 seconds (maybe 4x).\n" ;
                if ( $code_from_localhost = oauth2_collect_code_localhost_insist( $oauth2 ) )
                {
                        print "\nGOOD!\n" ;
                }
                else
                {
                        print "\n\nFailed to collect the code on localhost.\n" ;
                        $code_from_stdin = oauth2_collect_code_from_stdin( $oauth2 ) ;
                }
        }
        
        return( $code_from_localhost || $code_from_stdin ) ;
} 

sub oauth2_invite_with_browser
{
        my $oauth2 = shift ;
        
        print "Go to the following link with your web browser:\n\n" ;
        my $authorization_code_uri = oauth2_build_authorization_code_uri( $oauth2 ) ;
        print "$authorization_code_uri\n\n" ;
        
        if ( ! $oauth2->{ remotebrowser } )
        {
                launch_browser_on_url( $authorization_code_uri ) ;
        }
}

sub launch_browser_on_url
{
        my $url = shift ;
        
        if ( 'MSWin32' eq $OSNAME )
        {
                print "I help you to open the link with the following, hoping it works\n" ; 
                print qq{start \"\" \"$url\"\n} ;
                `start \"\" \"$url\"` ;
        }
        elsif( 'darwin' eq $OSNAME )
        {
                print "I help you to open the link with the following, hoping it works\n" ; 
                print qq{open \'$url\'\n} ;
                `open \'$url\' \&` ;
        }
        else
        {
                print "I help you to open the link with the following, hoping it works\n" ; 
                print qq{firefox \'$url\'\n} ;
                `firefox \'$url\' \&` ;
        }
        return ;
}

sub oauth2_collect_code_localhost_insist
{
        my $oauth2 = shift ;

        my $code_from_localhost ;
        
        # Yes, sometimes four times is necessary, Gmail...
        if ( $code_from_localhost = oauth2_collect_code_localhost( $oauth2 ) )
        {
                print "\n\nSuccess collecting the code first time\n" ;
                $oauth2->{ code } = $code_from_localhost ;
        }
        elsif ( $code_from_localhost = oauth2_collect_code_localhost( $oauth2 ) )
        {
                print "\n\nSuccess collecting the code the second time\n" ;
                $oauth2->{ code } = $code_from_localhost ;
        }
        elsif ( $code_from_localhost = oauth2_collect_code_localhost( $oauth2 ) )
        {
                print "\n\nSuccess collecting the code the third time\n" ;
                $oauth2->{ code } = $code_from_localhost ;
        }
        elsif ( $code_from_localhost = oauth2_collect_code_localhost( $oauth2 ) )
        {
                print "\n\nSuccess collecting the code the fourth time\n" ;
                $oauth2->{ code } = $code_from_localhost ;
        }
        else
        {
                print "\n\nFailed to collect the code on localhost.\n" ;
        }
        
        return $code_from_localhost ;
}

sub oauth2_collect_code_from_stdin
{
        my $oauth2 = shift ;
        
        my $code_from_stdin ;
        
        print "\n\nYou can find the code in the url at the end of the authentication process in your browser.\n" ;
        print "\n\nPaste the code here and press ENTER: " ;
        $code_from_stdin = <STDIN> ;
        chomp( $code_from_stdin ) ;
        $oauth2->{ code } = $code_from_stdin ;
        
        return $code_from_stdin ;
      
}


sub oauth2_ask_authorization_code_remote 
{
        my $oauth2 = shift ;
        
        oauth2_invite_with_browser( $oauth2 ) ;
        
        print "\n\nThen, after the authentication is finished, press ENTER: " ;
        my $enter = <STDIN> ;
        print "\n\nThanks. Now I try to collect the code.\n" ;
        my $code_from_auth ;
        my $code_from_stdin ;
       
        if ( $code_from_auth = oauth2_collect_code_remote( $oauth2 ) )
        {
                print "\n\nSuccess collecting the code\n" ;
                $oauth2->{ code } = $code_from_auth ;
        }
        else
        {
                print "\n\nFailed to collect the code remotely\n" ;
                $code_from_stdin = oauth2_collect_code_from_stdin( $oauth2 ) ;
        }
        
        return( $code_from_auth || $code_from_stdin ) ;
} 



sub oauth2_collect_code_remote
{
        my $oauth2 = shift ;
        
        my $ua = LWP::UserAgent->new( timeout => 10 ) ;
        $ua->env_proxy() ;
        
        # uncomment the next line if you encounter the "500 Can't verify SSL peers..." error.
        $ua->ssl_opts( verify_hostname => 0, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE ) ;
 
        my $code_url = 'https://imapsync.lamiral.info/imapsync_auth/' . $oauth2->{ state } ;

        my $response = $ua->get( $code_url ) ;
 
        my $code ;
        if ( $response->is_success(  ) ) {
                $code = $response->decoded_content(  ) ;
                chomp( $code ) ;
                print "code from $code_url = " . $code . "\n" ;
                return( $code ) ;
        }
        else
        {
                print "No code from $code_url : " . $response->status_line(  ) . "\n" ;
                return ;
        }
}



sub oauth2_lunch_httpd_localhost
{
        my $oauth2 = shift ;
        my $httpd = HTTP::Daemon->new(
                LocalAddr => 'localhost',
                #LocalPort => 9999,
                Timeout   => 120,
        ) || return ;
        my $url = 'http://localhost:' . $httpd->sockport(  ) ;
        print "Now waiting for the code, " . 120 . " sec max, at $url\n" ;
        $oauth2->{ httpd } = $httpd ;
        $oauth2->{ redirect_uri } = $url ;
        return( $httpd ) ;
}




sub tests_oauth2_lunch_httpd_localhost_ssl
{
        note( 'Entering tests_oauth2_lunch_httpd_localhost_ssl()' ) ;

        is( undef, oauth2_lunch_httpd_localhost_ssl(  ),  'tests_oauth2_lunch_httpd_localhost_ssl: no args => undef' ) ;
        my $oauth2 = {  } ;
        
        isa_ok( oauth2_lunch_httpd_localhost_ssl( $oauth2 ), 'HTTP::Daemon::SSL', 'tests_oauth2_lunch_httpd_localhost_ssl: {  } => a HTTP::Daemon::SSL' ) ;
        isa_ok( $oauth2->{ httpd }, 'HTTP::Daemon::SSL', 'tests_oauth2_lunch_httpd_localhost_ssl: {  } => a HTTP::Daemon::SSL again' ) ;
        
        note( $oauth2->{ httpd }->get_fingerprint(  ) ) ;
        print $oauth2->{ httpd }->get_fingerprint(  ), "\n" ;
        #$oauth2->{ httpd }->accept(  ) ;
        note( $oauth2->{ httpd } ) ;
        
        #my $wait = <STDIN> ;

        note( 'Leaving  tests_oauth2_lunch_httpd_localhost_ssl()' ) ;
        return ;
}


sub oauth2_lunch_httpd_localhost_ssl
{
        my $oauth2 = shift ;
        
        if ( ! defined( $oauth2 ) ) { return ; }
        require HTTP::Daemon::SSL ;
        require IO::Socket::SSL ;
        # Good reads: 
        # https://letsencrypt.org/docs/certificates-for-localhost/
        # https://stackoverflow.com/a/60516812/491175
        
        #$IO::Socket::SSL::DEBUG = 4 ;
        my $httpd = HTTP::Daemon::SSL->new(
                LocalAddr => 'localhost',
                Timeout   => 120,
                SSL_cert_file => './localhost.crt',
                SSL_key_file =>  './localhost.key',
        ) || do
        { 
                print( "failed connect or ssl handshake: $! $IO::Socket::SSL::SSL_ERROR" ) ; 
                return ;
        } ;
        my $url = 'https://localhost:' . $httpd->sockport(  ) ;
        print "Now waiting for the code, " . 120 . " sec max, at $url\n" ;
        $oauth2->{ httpd } = $httpd ;
        $oauth2->{ redirect_uri } = $url ;
        return( $httpd ) ;
}





sub oauth2_collect_code_localhost
{
        my $oauth2 = shift ;
        my $httpd  = $oauth2->{ httpd } ;
        
        my $code = '' ;

        print( "Entering oauth2_collect_code_localhost\n" ) ;
        
        
        while ( my $connection = $httpd->accept(  ) and not $code )
        {
                print( "Connection accepted\n" ) ;
                $oauth2->{ debug } and print "Connection a: " . Data::Dumper->Dump( [ \$connection ] ) . "\n" ;
                while ( defined( $connection ) and my $request = $connection->get_request(  ) )
                {
                        $oauth2->{ debug } and print "Received: " . Data::Dumper->Dump( [ \$request ] ) . "\n" ;
                        # $request->uri() is a URI::http object. See https://metacpan.org/pod/URI
                        if ( $request->method(  ) eq 'GET' and $request->uri->path(  ) )
                        {
                                $oauth2->{ debug } and print "Received: " . Data::Dumper->Dump( [ \$request ] ) . "\n" ;
                                my %form = $request->uri->query_form(  ) ;
                                $code = $form{ 'code' } || '' ;
                                my $state = $form{ 'state' } || '' ;
                        
                                if ( $code )
                                { 
                                        $oauth2->{ code } = $code ;
                                        $oauth2->{ state_back } = $state ;
                                        my $message = oauth2_collect_code_answer( $code ) ;
                                        my $response = HTTP::Response->new(  ) ;
        
                                        $response->content( $message ) ;
                                        $connection->send_response( $response ) ;
                                        defined( $connection ) and $connection->close(  ) ;
                                        undef( $connection ) ;
                                }
                                else
                                {
                                        print "No code received.\n" ;
                                }
                        }
                        else 
                        {
                        
                                $connection->send_error( RC_FORBIDDEN ) ;
                        }
                }
                $oauth2->{ debug } and print "Connection e: " . Data::Dumper->Dump( [ \$connection ] ) . "\n" ;
        }
        print( "Leaving  oauth2_collect_code_localhost\n" ) ;
        return( $oauth2->{ code } || '' ) ;
}

sub oauth2_collect_code_answer
{
        my $code = shift ;
        
        my $message = "The authentication is ok, now you can go back where you started\n\n"
                . "If it does not work, here is the code to copy and past:\n\n"
                . $code . "\n\n"
                . "Have a nice day!\n\n\n\n\n\n" ;
        return( $message ) ;
}

sub oauth2_request_tokens
{
        my $oauth2 = shift ;
        my $ua = LWP::UserAgent->new(  ) ;
        $ua->timeout( 11 ) ;
        $ua->env_proxy(  ) ;

        # uncomment the next line if you encounter the "500 Can't verify SSL peers..." error.
        $ua->ssl_opts( verify_hostname => 0, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE ) ;

        print "Exchanging the code for an access token and a refresh token...\n";
        my $token_response = $ua->post( 
                $oauth2->{ token_uri },
                'Content_Type' => 'application/x-www-form-urlencoded',
                'Content' => [
                        'code'          => $oauth2->{ code },
                        'client_id'     => $oauth2->{ client_id },
                        'client_secret' => $oauth2->{ client_secret },
                        'redirect_uri'  => $oauth2->{ redirect_uri },
                        'grant_type'    => 'authorization_code',
                        'code_verifier' => $oauth2->{ code_verifier },
                ],
        ) ;

        #print Data::Dumper->Dump( [ $token_response ] ) ;

        print "token_response: ", $token_response->decoded_content, "\n\n" ;

        my $response = decode_json( $token_response->decoded_content ) ;

        my $access_token  = $response->{ access_token  } ;
        my $refresh_token = $response->{ refresh_token } ;

        if ( $access_token )
        {
                print "access token:\n$access_token\n\n" ;
                $oauth2->{ access_token }  = $access_token  ;
        }
        
        if ( $refresh_token )
        {
                print "refresh token:\n$refresh_token\n\n";
                $oauth2->{ refresh_token } = $refresh_token ;

        }
        else
        {
                print "No refresh token proposed\n\n";
        }
        return ;
}


sub oauth2_refresh_tokens
{ 
        my $oauth2 = shift ;
        print "Refreshing the access and refresh tokens\n";
        my $ua = LWP::UserAgent->new(  ) ;
        $ua->timeout( 11 ) ;
        $ua->env_proxy(  ) ;
        # uncomment the next line if you encounter the "500 Can't verify SSL peers..." error.
        $ua->ssl_opts( verify_hostname => 0, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE ) ;

        my $token_response = $ua->post( 
                $oauth2->{ token_uri },
                'Content_Type' => 'application/x-www-form-urlencoded',
                'Content' => [
                        'client_id'     => $oauth2->{ client_id },
                        'client_secret' => $oauth2->{ client_secret },
                        'refresh_token' => $oauth2->{ refresh_token },
                        'grant_type' => 'refresh_token',
                ],
        ) ;

        my $response = decode_json( $token_response->decoded_content ) ;
        my $access_token  = $response->{ access_token  } ;
        my $refresh_token = $response->{ refresh_token } ;

        if ( $access_token )
        {
                print "access token:\n$access_token\n\n" ;
                $oauth2->{ access_token }  = $access_token  ;
        }
        
        if ( $refresh_token )
        {
                print "refresh token:\n$refresh_token\n\n";
                $oauth2->{ refresh_token } = $refresh_token ;

        }
        else
        {
                print "No refresh token proposed\n\n";
        }
        
        return $access_token ;
} 

sub oauth2_is_imap_access_ok
{
        my $oauth2 = shift ;

        if ( ! $oauth2->{ user } ) 
        {
                print "No user given. It is useless to try an authentication, is not it?\n" ;
                return ;
        }
        
        if ( ! $oauth2->{ access_token } ) 
        {
                print "No access token given. It is useless to try an authentication, is not it?\n" ;
                return ;
        }
        
        my $oauth_sign = encode_base64( "user=". $oauth2->{ user } . "\x01auth=Bearer ". $oauth2->{ access_token } ."\x01\x01", '' ) ;

        my $imap = Mail::IMAPClient->new(
                Server => $oauth2->{ imap_server },
                Port  => 993,
                Ssl   => 1,
                Uid   => 1,
                Debug => 1,
        ) ;
        
        if ( ! $imap )
        {
                print( "Can't connect to imap server " . $oauth2->{ imap_server } . "\n\n" ) ;
                return ;
        }
        
        if ( ! $imap->authenticate( 'XOAUTH2', sub { return $oauth_sign } ) )
        {
                print( "Auth error: " . $imap->LastError . "\n\n" ) ;
                return ;
        }
        
        my @folders = $imap->folders(  ) ;
        if ( @folders )
        {
                print 'Found ' . @folders . ' folders: ' . join( ", ", @folders) . "\n\n" ;
                print "Success IMAP login to account " . $oauth2->{ user } . " with access token in " . $oauth2->{ token_file } . "\n" ;
                return 1 ;
        }
        else
        {
                print "Found no folders. Bad sign.\n" ;
                return ;
        }
}



sub oauth2_save_tokens_to_file
{
        my $oauth2 = shift ;
        my $token_file = $oauth2->{ token_file } ;
        
        my $string = join( "\n", 
                $oauth2->{ access_token }, 
                $oauth2->{ refresh_token },
                '# The first   line is the access  token',
                '# The second  line is the refresh token',
                '# Account is ' . $oauth2->{ user },
                '# File generated on ' . scalar localtime() . " by $0 @ARGV",
                '',
        ) ;
        
        print "Writing tokens to the file " . $token_file . "\n" ;
        if ( string_to_file( $string, $token_file ) )
        {
                return 1 ;
        }
        else
        {
                return 0 ;
        }  
}


sub tests_oauth2_code_challenge
{
        note( 'Entering tests_oauth2_code_challenge()' ) ;

        is( '47DEQpj8HBSa-_TImW-5JCeuQeRkm5NMpJWZG3hSuFU', oauth2_code_challenge( '' ),    'tests_oauth2_code_challenge: empty => 47DEQpj8HBSa-_TImW-5JCeuQeRkm5NMpJWZG3hSuFU' ) ;
        is( 'ungWv48Bz-pBQUDeXa4iI7ADYaOWF3qctBD_YfIAFa0', oauth2_code_challenge( 'abc' ), 'tests_oauth2_code_challenge:   abc => ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0' ) ;
        
        # Example from https://datatracker.ietf.org/doc/html/rfc7636#appendix-B
        is( 'E9Melhoa2OwvFrEMTJguCHaoeK1t8URWbuGJSstw-cM', oauth2_code_challenge( 'dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk' ), 
                'tests_oauth2_code_challenge:   dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk => E9Melhoa2OwvFrEMTJguCHaoeK1t8URWbuGJSstw-cM' ) ;
        
        my $code_challenge ;
        is( '47DEQpj8HBSa-_TImW-5JCeuQeRkm5NMpJWZG3hSuFU', oauth2_code_challenge(  ), 'tests_oauth2_code_challenge: no args => 47DEQpj8HBSa-_TImW-5JCeuQeRkm5NMpJWZG3hSuFU' ) ;
        note( 'Leaving  tests_code_challenge()' ) ;
        return ;
}


sub oauth2_code_challenge
{
        my $code_verifier = shift || '' ;
        # BASE64URL-ENCODE(SHA256(ASCII(code_verifier)))
        return( MIME::Base64::encode_base64url( Digest::SHA::sha256( $code_verifier ) ) ) ;
}




sub tests_merge_hashes
{
        note( 'Entering tests_merge_hashes()' ) ;

        is( undef, merge_hashes(  ),  'tests_merge_hashes: no args => undef' ) ;
        is_deeply( {  }, merge_hashes( {  } ),  'tests_merge_hashes: {  } => {  }' ) ;
        is_deeply( {  }, merge_hashes( {  }, {  } ),  'tests_merge_hashes: {  } + {  } => {  }' ) ;
        is_deeply( {  }, merge_hashes( {  }, {  }, {  } ),  'tests_merge_hashes: {  } + {  } + {  } => {  }' ) ;
        
        my $hash_a = {  } ;
        is_deeply( $hash_a, merge_hashes( $hash_a ),  'tests_merge_hashes: {  } => {  } 2nd' ) ;
        
        my $hash_b = {  } ;
        my $hash_m = merge_hashes( $hash_a, $hash_b ) ;
        is_deeply( $hash_m, {}, 'tests_merge_hashes: {  } + {  } => {  }' ) ;

        my $hash_u = { ku => undef } ;
        $hash_m = merge_hashes( $hash_u ) ;
        is_deeply( $hash_m, { ku => undef }, 'tests_merge_hashes: { ku undef }  => { ku undef }' ) ;
       

        $hash_a = { ka => 'va' } ;
        $hash_m = merge_hashes( $hash_a ) ;
        is_deeply( $hash_m, $hash_a, 'tests_merge_hashes: { ka va  }  => { ka va }' ) ;
        
        $hash_m = merge_hashes( $hash_a, {  } ) ;
        is_deeply( $hash_m, $hash_a, 'tests_merge_hashes: { ka va  } + {  } => { ka va }' ) ;
        
        $hash_m = merge_hashes( {  }, $hash_a ) ;
        is_deeply( $hash_m, $hash_a, 'tests_merge_hashes:  {  } + { ka va  } => { ka va }' ) ;
        
        $hash_m = merge_hashes( $hash_a, $hash_a ) ;
        is_deeply( $hash_m, $hash_a, 'tests_merge_hashes:  { ka va } + { ka va  } => { ka va }' ) ;
        
        $hash_b = { kb1 => 'vb1' } ;
        $hash_m = merge_hashes( $hash_a, $hash_b ) ;
        is_deeply( $hash_m, { kb1 => 'vb1', ka => 'va' } , 'tests_merge_hashes:  { ka va } + { kb vb  } => { ka va, kb vb }' ) ;
        
        $hash_m = merge_hashes( $hash_b, $hash_a ) ;
        is_deeply( $hash_m, { kb1 => 'vb1', ka => 'va' } , 'tests_merge_hashes:  { kb vb  } + { ka va } => { ka va, kb vb }' ) ;
        
        # same key, value from the second hash.
        $hash_a = { ka => 'va' } ;
        $hash_b = { ka => 'vb' } ;
        $hash_m = merge_hashes( $hash_a, $hash_b ) ;
        is_deeply( $hash_m, { ka => 'vb' }, 'tests_merge_hashes:  { ka va } + { ka vb  } => { ka vb }' ) ;

        $hash_a = { ka => 'va' } ;
        $hash_m = merge_hashes( $hash_b, $hash_a ) ;
        is_deeply( $hash_m, { ka => 'va' }, 'tests_merge_hashes:  { ka vb } + { ka va  } => { ka va }' ) ;

        $hash_b = { kb1 => 'vb1', kb2 => 'vb2' } ;
        $hash_m = merge_hashes( $hash_b, $hash_a ) ;
        is_deeply( $hash_m, { kb1 => 'vb1', kb2 => 'vb2', ka => 'va' } , 'tests_merge_hashes:  { kb1 vb1, kb2 vb2  } + { ka va } => { ka va, kb1 vb1, kb2 vb2 }' ) ;


        # undef value are not merged
        
        $hash_m = merge_hashes( $hash_a, $hash_u ) ;
        is_deeply( $hash_m, { ka => 'va' } , 'tests_merge_hashes:  { ka va } + { ku undef  } => { ka va }' ) ;
        
        $hash_m = merge_hashes( $hash_u, $hash_a ) ;
        is_deeply( $hash_m, { ku => undef, ka => 'va' } , 'tests_merge_hashes:  { ku undef  } + { ka va }  => { ku undef, ka va }' ) ;

        # same key, undef value fron the second
        $hash_b = { ka => undef } ;
        $hash_m = merge_hashes( $hash_a, $hash_b ) ;
        is_deeply( $hash_m, { ka => 'va' } , 'tests_merge_hashes:  { ka va } + { ka undef  } => { ka va }' ) ;

        # three hashes merge
        my $hash_c = { kc => 'vc' } ;
        $hash_m = merge_hashes( $hash_a, $hash_b, $hash_c ) ;
        is_deeply( $hash_m, { ka => 'va', kc => 'vc' } , 'tests_merge_hashes:  { ka va } + { ka undef } + { kc vc  } => { ka va, kv vc }' ) ;
        
        $hash_m = merge_hashes( $hash_b, $hash_a, $hash_c ) ;
        is_deeply( $hash_m, { ka => 'va', kc => 'vc' } , 'tests_merge_hashes:  { ka undef } + { ka va } + { kc vc  } => { ka va, kv vc }' ) ;
        
        $hash_a = { ka => 'va' } ;
        $hash_b = { ka => 'vb' } ;
        $hash_c = { ka => 'vc' } ;
        $hash_m = merge_hashes( $hash_a, $hash_b, $hash_c ) ;
        is_deeply( $hash_m, { ka => 'vc' } , 'tests_merge_hashes:  { ka va } + { ka vb } + { ka vc } => { ka vc }' ) ;
        
        $hash_c = { ka => undef } ;
        $hash_m = merge_hashes( $hash_a, $hash_b, $hash_c ) ;
        is_deeply( $hash_m, { ka => 'vb' } , 'tests_merge_hashes:  { ka va } + { ka vb } + { ka undef } => { ka vb }' ) ;
        
        $hash_a = { ka => 'va' } ;
        $hash_b = { ka => undef } ;
        $hash_m = merge_hashes( $hash_a, $hash_b, $hash_c ) ;
        is_deeply( $hash_m, { ka => 'va' } , 'tests_merge_hashes:  { ka va } + { ka undef } + { ka undef } => { ka va }' ) ;
        
        
        note( 'Leaving  tests_merge_hashes()' ) ;
        return ;
}



sub merge_hashes
{
        my $hash_d =  shift @ARG ;
        
        while( my $hash_a =  shift @ARG )
        {
                foreach my $key ( keys( %$hash_a ) )
                {
                        if ( defined( $hash_a->{ $key } ) ) 
                        {
                                $hash_d->{ $key } = $hash_a->{ $key } ;
                        }
                }
        }
        return $hash_d ;
}




sub tests_find_domain_from_email
{
        note( 'Entering tests_find_domain_from_email()' ) ;

        is( undef, find_domain_from_email(  ),  'tests_find_domain_from_email: no args => undef' ) ;
        is( undef, find_domain_from_email( '' ), 'tests_find_domain_from_email: "" => undef' ) ;
        is( 'example.com', find_domain_from_email( 'foo@example.com' ), 'tests_find_domain_from_email: foo@example.com => example.com' ) ;
        is( undef, find_domain_from_email( 'blabla' ), 'tests_find_domain_from_email: blabla => undef' ) ;

        note( 'Leaving  tests_find_domain_from_email()' ) ;
        return ;
}

sub find_domain_from_email
{
        my $email = shift @ARG ;
        
        if( ! $email ) { return ; }
        
        my ( $address ) = Email::Address->parse( $email ) ;
        
        my $domain ;
        
        if ( defined( $address ) )
        {
                $domain = $address->host(  ) ;
        }

        return $domain ;
}


sub tests_find_provider_from_email
{
        note( 'Entering tests_find_provider_from_email()' ) ;

        is( undef, find_provider_from_email(  ),  'tests_find_provider_from_email: no args => undef' ) ;
        is( undef, find_provider_from_email( '' ),  'tests_find_provider_from_email: "" => undef' ) ;   
        is( 'office365', find_provider_from_email( 'gilles.lamiral@outlook.com' ),  'tests_find_provider_from_email: gilles.lamiral@outlook.com => office365' ) ;
        is( 'gmail', find_provider_from_email( 'gilles.lamiral@gmail.com' ),  'tests_find_provider_from_email: gilles.lamiral@gmail.com => gmail' ) ;
        is( undef, find_provider_from_email( 'gilles@lamiral.info' ),  'tests_find_provider_from_email: gilles@lamiral.info => undef' ) ;

        note( 'Leaving  tests_find_provider_from_email()' ) ;
        return ;
}


sub find_provider_from_email
{
        my $email = shift ;
        
        my $provider = find_provider_from_domain( find_domain_from_email( $email ) ) ;
        return( $provider ) ;    
}


sub tests_find_provider_from_domain
{
        note( 'Entering tests_find_provider_from_domain()' ) ;

        is( undef, find_provider_from_domain(  ),  'tests_find_provider_from_domain: no args => undef' ) ;
        is( undef, find_provider_from_domain( '' ),  'tests_find_provider_from_domain: "" => undef' ) ;   
        is( 'office365', find_provider_from_domain( 'outlook.com' ),  'tests_find_provider_from_domain: outlook.com => office365' ) ;
        is( 'gmail', find_provider_from_domain( 'gmail.com' ),  'tests_find_provider_from_domain: gmail.com => gmail' ) ;
        is( undef, find_provider_from_domain( 'lamiral.info' ),  'tests_find_provider_from_domain: lamiral.info => undef' ) ;

        note( 'Leaving  tests_find_provider_from_domain()' ) ;
        return ;
}

# find  /home/vmail/gilles/cur | tail -9999 | xargs grep From: | egrep -o '<[^>]+' | tr -d '<' | egrep -o '@[^@]+' | tr -d '@' | grep -v '"' | sort | uniq | tee domains.txt
# ( cat domains.txt | while read d ; do host -t mx $d  | head -1 ; done ) | tee domains_mx.txt 


sub find_provider_from_domain
{
        my $domain = shift @ARG ;
        
        if( ! $domain ) { return ; }
        
        my $provider ;
        
        
        my $res  = Net::DNS::Resolver->new ;
        my @mx = Net::DNS::mx( $res, $domain ) ;
        
        my $mx_exchange = '' ;
        if ( @mx )
        {
                $mx_exchange = $mx[ 0 ]->exchange ; 
                #print $mx_exchange, "\n";
        } 
        else
        {
                print "Can not find MX records for $domain: ", $res->errorstring, "\n";
        }

        if ( $mx_exchange =~ 'outlook.com' )
        {
                $provider = 'office365' ;
        }
        elsif ( $mx_exchange =~ 'google.com' )
        {
                $provider = 'gmail' ;
        }
        
        return $provider ;
}





# All the reminding is taken from imapsync 

sub string_to_file
{
        my( $string, $file ) = @_ ;
	if( ! defined $string ) { return ; }
	if( ! defined $file )   { return ; }

	if ( ! -e $file && ! -w dirname( $file ) ) {
		print( "string_to_file: directory of $file is not writable\n" ) ;
		return ;
	}

        if ( ! sysopen( FILE, $file, O_WRONLY|O_TRUNC|O_CREAT, 0600) ) {
		print( "string_to_file: failure writing to $file with error: $OS_ERROR\n" ) ;
		return ;
	}
        print FILE $string ;
        close FILE ;
        return $string ;
}



sub nthline
{
        # extract the nth line of a file (without \n)
        # return empty string if error or empty string

        my $file = shift @ARG ;
        my $num  = shift @ARG ;

        my $line ;

        $line = ( file_to_array( $file ) )[$num - 1] ;
        if ( ! defined $line )
        {
                return q{} ;
        }
        else
        {
                chomp $line ;
                return $line ;
        }
}


sub file_to_array
{

        my( $file ) = shift @ARG ;
	if ( ! $file )    { return ; }
	if ( ! -e $file ) { return ; }
	if ( ! -f $file ) { return ; }
	if ( ! -r $file ) { return ; }
        
        my @string ;

        if ( open my $FILE, '<', $file )
        {
                @string = <$FILE> ;
                close $FILE ;
                return( @string ) ;
        }
        else
        {
		print( "Error reading file $file : $OS_ERROR\n" ) ;
		return ;
	}
}


sub generate_a_random_string
{
        my $num = shift || 64 ;
	my @chars = ( "a".."z" ) ;
	my $string;
	$string .= $chars[rand @chars] for 1..$num ;
	return $string ;
}


sub search_dyn_lib_locale_MSWin32
{
        my $command = qq{ Listdlls.exe $PROCESS_ID|findstr Strawberry } ;
        #my $command = qq{ Listdlls.exe $PROCESS_ID  } ;
        # $command = qq{ Listdlls.exe $PROCESS_ID|findstr Strawberry } ;
        print( "Search non embeded dynamic libs with the command: $command\n" ) ;
        return qx( $command ) ;
}




sub tests_template
{
        note( 'Entering tests_template()' ) ;

        is( undef, template(  ),  'tests_template: no args => undef' ) ;
        my $oauth2 = {  } ;
        is( undef, template( $oauth2 ),  'tests_template: {  } => undef' ) ;
        is_deeply( {}, {}, 'tests_template: a hash is a hash' ) ;
        is_deeply( [], [], 'tests_template: an array is an array' ) ;

        note( 'Leaving  tests_template()' ) ;
        return ;
}

sub template
{
        my $oauth2 = shift @ARG ;
        
        return ;
}


