#!/usr/bin/perl
# Copyright (c) 2018 Veltro. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# This package is provided "as is" and without any express or implied
# warranties, including, without limitation, the implied warranties of
# merchantability and fitness for a particular purpose
#
# Description:
# Part of SASL authentication mechanism for OAuth 2.0 (RFC 6749)
# This package contains the method to create the initial client
# response according to the format specified in:
# https://developers.google.com/gmail/imap/xoauth2-protocol

package Authen::SASL::Perl::XOAUTH2 ;

use strict ;
use warnings ;

our $VERSION = "0.01c" ;
our @ISA = qw( Authen::SASL::Perl ) ;

my %secflags = ( ) ;

sub _order { 1 }

sub _secflags {
  shift ;
  scalar grep { $secflags{$_} } @_ ;
}

sub mechanism {
	# SMTP->auth may call mechanism again with arg $mechanisms
	#            but that means something is not right
	if ( defined $_[1] ) { die "XOAUTH2 not supported by host\n" } ;
	return 'XOAUTH2' ;
} ;

my @tokens = qw( user auth access_token ) ;

sub client_start {
	# Create authorization string:
	# "user=" {User} "^Aauth=Bearer " {Access Token} "^A^A"
	my $self = shift ;
	$self->{ error } = undef ;
	$self->{ need_step } = 0 ;
	return
		'user=' .
		$self->_call( $tokens[0] ) .
		"\001auth=" .
		$self->_call( $tokens[1] ) .
		" " .
		$self->_call( $tokens[2] ) .
		"\001\001" ;
}

1 ;