#!/usr/bin/perl 

# $Id: oauth2_office365_with_imap,v 1.25 2023/10/12 12:08:11 gilles Exp gilles $

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


use HTTP::Daemon ;
#use HTTP::Daemon::SSL ; # does not work 
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 ;


#print search_dyn_lib_locale_MSWin32(  ), "\n" ;


my $username    = shift @ARGV || '' ;
my $token_file  = shift @ARGV || '' ;
my $auth_type   = shift @ARGV || 'remote' ;

my $oauth2 = oauth2_init( $username, $token_file, $auth_type ) ;

if ( $oauth2 )
{
        oauth2_approval( $oauth2 ) ;
}


sub oauth2_init
{
        my $username = shift @ARG || '' ;
        
        if ( ! $username ) 
        {
                print "\nusage: $0 foo\@example.com\n\n" ;
                #print "LWP::VERSION=" . $LWP::VERSION . " LWP::Protocol::https::VERSION=" . $LWP::Protocol::https::VERSION . "\n" ;
                return ;
        }

        my $token_file = shift @ARG || "tokens/oauth2_tokens_$username.txt" ;

        my $auth_type   = shift @ARG || 'remote' ;
        

        my $code_verifier  = oauth2_code_verifier(  ) ; # random string 
        my $code_challenge = oauth2_code_challenge( $code_verifier ) ;
        my $code_challenge_method = 'S256' ;
        my $state = random_string( 32 ) ;
        # less secure way:
        # my $code_challenge = $code_verifier ;
        # my $code_challenge_method = 'plain' ; # or nothing since plain is the default 

        # https://hg.mozilla.org/comm-central/file/tip/mailnews/base/src/OAuth2Providers.jsm
        my $oauth2 = {
                username       => "$username",
                token_file     => "$token_file",
                auth_type      => "$auth_type",
                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',
                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  => 'LH58Q~vMFFoVTbBmUnOeIDtfcacYNolMJ2cP2cLC',
                #client_id      => '9e5f94bc-e8a4-4e73-b8be-63364c29d753', # Thunderbird
                #client_secret  => '', # Thunderbird
                imap_server    => 'outlook.office365.com',
                code_verifier  => $code_verifier,
                code_challenge => $code_challenge,
                code_challenge_method => $code_challenge_method,
                state          => $state,
        } ;

       return( $oauth2 ) ;
}

sub oauth2_approval
{
        my $oauth2 = shift  ;

        

        if ( oauth2_load_tokens_from_file( $oauth2 ) and oauth2_check_imap_access( $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.\n" ;
                if ( ! refresh_access_token( $oauth2 ) )
                {
                        oauth2_ask_authorization_code( $oauth2 ) ;
                        oauth2_request_tokens( $oauth2 ) ;
                }
        }
        else
        {
                oauth2_ask_authorization_code( $oauth2 ) ;
                oauth2_request_tokens( $oauth2 ) ;
        }
        
        if ( oauth2_check_imap_access( $oauth2 ) )
        {
                oauth2_save_tokens_to_file( $oauth2 ) ;
                return 0
        }
        else
        {
                print "Failure\n" ;
                return 1
        }
}



sub oauth2_load_tokens_from_file
{
        my $oauth2 = shift ;
        
        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_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->{ username } ),
                '&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 },
                ) ;

        return $authorization_code_uri ;
}


sub oauth2_ask_authorization_code
{
        my $oauth2 = shift ;

        if ( 'localhost' eq $oauth2->{ auth_type } )
        {
                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 ) ) ;
        }
        else
        {
                
                return( oauth2_ask_authorization_code_remote( $oauth2 )  ) ;
        }
}




sub oauth2_ask_authorization_code_localhost
{
        my $oauth2 = shift ;
        print "Go to the following link with your web browser:\n\n" ;
        my $authorization_code_uri = oauth2_authorization_code_uri( $oauth2 ) ;
        print "$authorization_code_uri\n\n" ;
        
        if ( 'MSWin32' eq $OSNAME )
        {
                print "I help you to open the link with the following, hoping it works\n" ; 
                print qq{`start \"\" \"$authorization_code_uri\"`} ;
                `start \"\" \"$authorization_code_uri\"` ;
        }
        
        #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_localhost ;
        my $code_from_stdin ;
       
        if ( $code_from_localhost = oauth2_collect_code_localhost( $oauth2 ) )
        {
                print "\n\nSuccess collecting the code\n" ;
                $oauth2->{ code } = $code_from_localhost ;
        }
        else
        {
                print "\n\nFailed to collect the code\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_localhost || $code_from_stdin ) ;
}




sub oauth2_ask_authorization_code_remote
{
        my $oauth2 = shift ;
        print "Go to the following link with your web browser:\n\n" ;
        my $authorization_code_uri = oauth2_authorization_code_uri( $oauth2 ) ;
        print "$authorization_code_uri\n\n" ;
        
        if ( 'MSWin32' eq $OSNAME )
        {
                print "I help you to open the link with the following, hoping it works\n" ; 
                print qq{`start \"\" \"$authorization_code_uri\"`} ;
                `start \"\" \"$authorization_code_uri\"` ;
        }
        
        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\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_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   => 60,
        ) || return ;
        my $url = 'http://localhost:' . $httpd->sockport(  ) ;
        print "Now waiting for the code, " . 60 . " sec max, at $url\n" ;
        $oauth2->{ httpd } = $httpd ;
        $oauth2->{ redirect_uri } = $url ;
        return( $httpd ) ;
}


sub oauth2_lunch_httpd_localhost_ssl
{
        my $oauth2 = shift ;
        
        # Good read: https://letsencrypt.org/docs/certificates-for-localhost/
        $IO::Socket::SSL::DEBUG = 3 ;
        my $httpd = HTTP::Daemon::SSL->new(
                LocalAddr => 'localhost',
                #LocalPort => 9999,
                Timeout   => 120,
                SSL_cert_file => './localhost.crt',
                SSL_key_file =>  './localhost.key',
        ) || 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 $connection = $httpd->accept(  ) or print "Failed httpd accept: $!" ;
        
        my $code ;

        while ( defined( $connection ) and my $request = $connection->get_request(  ) )
        {
                # $request->uri() is a URI::http object. See https://metacpan.org/pod/URI
                if ( $request->method(  ) eq 'GET' and $request->uri->path(  ) )
                {
                        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 ) ;
                }
        }
        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 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" ; }
        if ( $refresh_token ) { print "refresh token:\n$refresh_token\n\n"; }
        $oauth2->{ access_token }  = $access_token  ;
        $oauth2->{ refresh_token } = $refresh_token ;
        return ;
}


sub refresh_access_token
{
        my $oauth2 = shift ;
        print "Refreshing the access token...\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  } ;
        print "access token:\n$access_token\n\n" ;
        $oauth2->{ access_token }  = $access_token  ;
        return $access_token ;
}

sub oauth2_check_imap_access
{
        my $oauth2 = shift ;

        if ( ! $oauth2->{ username } ) 
        {
                print "No username 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->{ username } . "\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 ;
        }
        
        print 'Folders found: ', join( ", ",$imap->folders ), ".\n\n" ;
        print "Success IMAP login to account " . $oauth2->{ username } . " with access token in " . $oauth2->{ token_file } . "\n" ;
        return 1 ;
}



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->{ username },
                '# File generated on ' . scalar localtime() . " by $0",
                '',
        ) ;
        
        print "Writing tokens to the file " . $token_file . "\n" ;
        if ( string_to_file( $string, $token_file ) )
        {
                return 1 ;
        }
        else
        {
                return 0 ;
        }  
}


sub oauth2_code_verifier
{
        return( random_string( 128 ) ) ; # yeah, guess that man!
}


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


# 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 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 ) ;
}

