#!/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:
# This program contains TWO examples which can be switched by setting
# the internal $method variable to 1 or 2.
# This program was shared by me at PerlMonks:
# https://www.perlmonks.org/?node_id=1218405
#
# Example 1:
# Example program that sends an email from your Gmail account using
# the Gmail SMTP OAuth 2.0 authenticated Server over TLS 
#
# Example 2:
# Example program that sends an email from your Gmail account using
# the Gmail API with OAuth 2.0 authentication
#
# For both examples it is not needed to
# - use your Google account password
# - to enable 'less secure apps' for Gmail
# (Since they use a different authorization mechanism).
#
# This program has been tested under Windows 10 and Strawberry Perl:
# perl 5, version 26, subversion 2 (v5.26.2) built for
# MSWin32-x64-multi-thread.
#
# Preface: After reading a couple of Perl examples that make it
# possible to send emails using the Gmail SMTP server I didn't
# like the fact that these programs often require user name and
# passwords of my Google account. So I started to wonder, is there a
# better way? Most of the alternatives that I found where written in
# different programming languages such as Python, Java and more.
# After doing some research I found out about the possibility to use a
# Oauth 2.0 authenticated SMTP server, and I thought I could
# potentially turn this into a working Perl program easily. So I
# started programming but I found that it was a bit more difficult
# than I thought it would be. While programming and getting more
# familiar on the subject I also started to realize that using the
# Google Gmail API could also be a useful method because it has better
# possibilities when using scopes. (The first method can only use one
# scope with full access to Gmail: https://mail.google.com/).
# So I tried using the API as as well and this resulted in the second
# example. Both methods work, but each has it's advantages and
# disadvantages. I decided to post both examples on PerlMonks with
# this program since I think both methods have some useful elements
# that people may want to learn from. I have tried to keep the program
# simple and pretty low level on purpose so that it easier to see
# what is happening 'under the hood'. The next thing that would
# probably be nice to have is sending more complex messages (HTML
# format body and messages with attachments).
#
# Security considerations:
# Using OAuth 2.0 authentication in my opinion looks like a better 
# method than using your Google account password written out
# fully inside a program to access the Gmail SMTP server. Your
# user name and password would give full access to your Google account
# and when compromised would allow your password to be changed.
# However, on the subject of using OAuth 2.0 authentication and Google
# API's, Google has warnings in multiple occasions like:
# - Warning: Keep your client secret private. If someone obtains your
#   client secret, they could use it to consume your quota, incur
#   charges against your Google APIs Console project, and request
#   access to user data.
# - Warning: Keep your API key private. If someone obtains your key,
#   they could use it to consume your quota or incur charges against
#   your API Console project.
# - Warning: Keep refresh and access tokens private. If someone
#   obtains your tokens, they could use them to access private user
#   data.
# Simply put I think this means: If you feel that the security of your
# credentials (in this case the JSON files that contain your secrets,
# access tokens and the refresh token) may be compromised, then don't
# use these methods!
#
# When you use the method from example 1,
# https://myaccount.google.com/permissions will show:
#    <Product Name> Has access to:
#       Gmail
#       Read, send, delete, and manage your email 
# So the method used by this program results in full access to Gmail
# and not "Full account access".
# (See also: https://support.google.com/accounts/answer/3466521).
#
# For the second method scopes can be altered. See the notes in the
# subroutine: getAuthorizationUrlGmail and the difference of the 
# $scope variable in the program.
# When you use the method 2,
# https://myaccount.google.com/permissions will show:
#    <Product Name> Has access to:
#       Gmail
#       Send email on your behalf
#
# Additionally, in my opinion there is one serious flaw in Google's
# security system that needs to be considered before using the first
# method this program uses.
# The method acquires a refresh token to use SMTP that has the scope:
# https://mail.google.com/. And it is not possible to use 'incremental
# authorization' as in method 2. The scope allows full access to your
# Gmail: Read, send, delete, and manage your email. Now here is the
# problem: The same refresh token can be used to allow access to Gmail
# through other applications interacting with Google's OAuth 2.0
# endpoints. It seems there is no possibility to set boundaries that
# tells Google to use the credentials for SMTP only (except for maybe
# not enabling the Gmail API)! And as far as I'm concerned this and
# the fact that no other scopes (with lower security levels) can be
# used this just totally sucks and it is better to take the warnings
# from the Google documentation extra serious.
#
# How to get this program working:
#
# Prerequisites:
# - Packages: JSON, MIME::Lite::TT, Net::SMTP, URL::Encode,
#   LWP::UserAgent, HTTP::Request::Common
# The program comes accompanied with the following modules: 
# - package Authen::SASL::Perl::XOAUTH2
#   To make it possible using Net::SMTP auth() method
#   location: .\Authen\SASL\Perl\XOAUTH2.pm
# - package ClientSecret ;
#   A very basic JSON reader that can read the JSON client-secret
#   downloaded from Google
#   location: .\ClientSecret.pm
# - package ClientCredentials
#   A very basic JSON storage that can read and write the acquired
#   credentials from and back to disc
#   location: .\ClientCredentials.pm
#
# Steps needed for Gmail OAuth 2.0 authentication:
# -  You need a Google account for these steps
# 1. Create a project at Google (https://console.cloud.google.com)
# 2. Select your project from the Dashboard and go to 'Credentials'
# 3. Select the tab: OAuth consent screen.
#    The minimum requirement is that you define the product name
#    So give it the name 'Perl mail' or something like that
# 4. Select the credentials tab and click on the 'Create credentials'
#    button and select: 'OAuth client ID'
# 5. Under Application type select: 'other'
# 6. Specify the name for the client id. (E.g. 'GmailPerlClientID' ) 
# 7. Download the client-secret JSON file
# 8. (Method 2 only): Activate the Gmail API (and revoke the rights
#    that you gave to method 1, see security considerations for why).
#
# Steps needed for this program:
# 1. Now that you have downloaded the JSON file, Change the line
#    'new $cs ...' and fill in the path to the JSON file
#    (Note: the JSON file contains redirect uri's, it may be needed
#           to change the order in which they appear, first the urn
#           then the one to localhost)
# 2. Do the same for 'new $cred ...', and enter a full path to a JSON
#    file where the credentials are going to be stored.
# 3. Execute this program, use the link that is given to you
#    with a Internet browser and follow the steps to get the
#    authentication code.
# 4. Once you have acquired the authentication code, change the line:
#    my $authorizationCode = 'Fill in your authorization code here' 
# 5. Change the following lines with your email address
#    my $userAuth = 'your email address here' ;
#    my $to = 'your email address here' ;
# 6. Execute this program again.
#    The program will try to create a new file (step 2) to store the
#    credentials such as access tokens and refresh tokens. Make sure
#    that the program can write to this location or it may fail.
# 7. You've Got Mail!
#
# Note: The refresh token may become invalid in certain cases. It
# may expire (after 6 months) or it becomes invalid after changing
# your password.
#
# Note: In case you need to create a new authorization code
# Set $authorizationCode to '' and delete the client_credentials file
#
use lib '.' ;

use strict ;
use warnings ;
use ClientSecret ;
use ClientCredentials ;
use MIME::Lite::TT ;
use Net::SMTP ;
use URL::Encode qw(url_encode) ;
use LWP::UserAgent ;
use HTTP::Request::Common ;
use JSON ;
use MIME::Base64 ;
use Data::Dumper ;

# Activate this line to debug SSL:
# use IO::Socket::SSL qw(debug4);

# Set this to 1 to debug SMTP:
my $dbgSMTP = 0 ;

my $method = 1 ;

my $userAuth = 'Your Gmail address here' ;
my $to = 'Your Gmail address here' ;
my $from = 'me' ;

# Download Google OAuth 2.0 client secret JSON file and fill in the
# full path here;
my $cs = new ClientSecret( q{.\client_secret_xxxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com.json}) ;
die "Failed to read client secret\n" unless ( $cs ) ;

# Specify the full path to credentials storage location here (.json):
my $cred = new ClientCredentials( q{.\client_credentials_xxxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com.json}) ;

# Fill in your authorization code here
my $authorizationCode =
	'Fill in your authorization code here' ;

# Get the refresh token if needed
if ( $cred->refreshTokenNeeded ) {
	if ( $authorizationCode eq
			'Fill in your authorization code here' ||
		 $authorizationCode eq ''
	) {
		# Authorization code needed. Follow link, accept and copy the
		# authorization code to this program in $authorizationCode
		my $scope = 'https://mail.google.com/' ;
		if ( $method == 2 ) {
			$scope = 'https://www.googleapis.com/auth/gmail.send' ;
		#	$scope = 'https://www.googleapis.com/auth/gmail.insert' ;
		}
		my $aUrl = getAuthorizationUrlGmail( $cs, $scope ) ;
		print "Get your authorization code here:\n" . $aUrl . "\n\n" ;
		print "Change \$authorizationCode to the acquired code from Google\n" ;
		exit( 0 ) ;
	} else {
		# Get the refresh token (and access token)
		getRefreshToken( $cs, $cred, $authorizationCode ) ;
	}
}

# Check if a refresh is needed
if ( $cred->expired ) {
	refresh( $cs, $cred ) ;
}

sub getAuthorizationUrlGmail {
	# IN: ClientSecret object
	# IN: scope (See:
	# 	  https://developers.google.com/gmail/api/auth/scopes)
	# OUT: URL to insert into your browser to retrieve the
	#      authorization code
	my $cs = shift ;
	my $scope = shift ;
	my $url = "$cs->{ authUri }?" .
		"client_id=" . url_encode( $cs->{ clientID } ) .
		"&redirect_uri=" . url_encode( $cs->{ redirectUris }[0] ) .
		"&scope=" . url_encode( $scope ) .
		"&response_type=code" ;
	return $url ;
}

sub getRefreshToken {
	my $cs = shift ;
	my $cred = shift ;
	my $authorizationCode = shift ;
	my $url = $cs->{ tokenUri } ;
	my $ua = LWP::UserAgent->new ;
	my $response = $ua->request( POST $url, [
		client_id => $cs->{ clientID },
		client_secret => $cs->{ clientSecret },
		code => $authorizationCode,
		# Redirect to urn, (takes first urn in JSON)
		redirect_uri => $cs->{ redirectUris }[0],
		grant_type => 'authorization_code'
	] ) ;
	my $decoded_json = decode_json($response->decoded_content);
	my $accessToken = $decoded_json->{ 'access_token' } ;
	my $expiresIn = $decoded_json->{ 'expires_in' } ;
	my $refreshToken = $decoded_json->{ 'refresh_token' } ;
	my $tokenType = $decoded_json->{ 'token_type' } ;
	$cred->setRefreshToken( $refreshToken ) ;
	$cred->setAccessToken( $accessToken, $expiresIn, $tokenType ) ;
}

sub refresh {
	my $cs = shift ;
	my $cred = shift ;
	my $url = $cs->{ tokenUri } ;
	my $ua = LWP::UserAgent->new ;
	my $response = $ua->request( POST $url, [
		client_id => $cs->{ clientID },
		client_secret => $cs->{ clientSecret },
		refresh_token => $cred->{ refreshToken },
		grant_type => 'refresh_token'
	] ) ;
	my $decoded_json = decode_json($response->decoded_content);
	my $accessToken = $decoded_json->{ 'access_token' } ;
	my $tokenType = $decoded_json->{ 'token_type' } ;
	my $expiresIn = $decoded_json->{ 'expires_in' } ;
	$cred->setAccessToken( $accessToken, $expiresIn, $tokenType ) ;
}

# Create MIME::Lite::TT email message

my %params ;
$params{first_name} = 'Veltro' ;

my %options ;
$options{INCLUDE_PATH} = './templates' ;

my $msg = MIME::Lite::TT->new(
	# From/to may not be used, but then only BCC will be filled in
	# instead. Using from/to here then Gmail finds my email
	# 'important' according to the magical formulas of Google.
	From => $from,
	To => $to,
	Subject => 'Test email from Perl',
	Template => 'test.txt.tt',
	TmplOptions => \%options,
	TmplParams => \%params,
) ;

######################## METHOD 1 ####################################
if ( $method == 1 ) {

	# use NET::SMTP instead of $msg->send:
	# - Gmail = smtp.gmail.com
	# - Port 465 = SSL, is also ok, but then do not starttls and set
	#   initial connection with option 'SSL => 1'
	# - Port 587 = TLS
	my $smtp = Net::SMTP->new( 'smtp.gmail.com', Port=>587,
		SendHello => 0, Debug => $dbgSMTP
	) ;
	if ( !( defined $smtp ) ) {
		print "Failed to connect, reason=$@\n" ;
		exit( 1 ) ;
	}

	# HELLO
	# Reminder: hello is also send again after starttls
	$smtp->hello( $cs->{ clientID } )
		or die "Error: " . $smtp->message() ;

	# STARTTLS
	if ( !$smtp->starttls() ) {
		if ( ref $smtp eq 'Net::SMTP' ) {
			die "NET::SMPT failed to upgrade connection after connection message: " .
			$smtp->message() .
			"Possible reasons for this may be firewalls or antivirus protection software (such as mail shields). You can activate debugging for IO::Socket::SSL and \$dbgSMTP to search for other possible reasons\n" ;
		} else {
			die "starttls failed with Error: " . $smtp->message() .
			"You can activate debugging for IO::Socket::SSL and \$dbgSMTP to search for possible reasons\n" ;
		}
	} ;

	# AUTHENTICATE
	use Authen::SASL qw( Perl ) ;
	my $sasl = Authen::SASL->new(
		mechanism => 'XOAUTH2',
		callback => {
			user => $userAuth,
			auth => $cred->{ tokenType },
			access_token => $cred->{ accessToken },
		}
	) ;
	$smtp->auth($sasl) or die "Can't authenticate:" . $smtp->message() ;
	# ($smtp->message)[0] should contain something like: 2.7.0 Accepted

	# MAIL (= From)
	$smtp->mail( $from )
		or die "Error: " . $smtp->message() ;

	# TO
	$smtp->to( $to )
		or die "Error: " . $smtp->message() ;

	# DATA - DATASEND - DATAEND - QUIT
	$smtp->data() or die "Error: " . $smtp->message() ;
	$smtp->datasend( $msg->as_string )
		or die "Error: " . $smtp->message() ;
	$smtp->dataend() or die "Error: " . $smtp->message() ;
	$smtp->quit() or die "Error: " . $smtp->message() ;

	if($@) {
		print STDERR "Error sending mail: $@";
	}
}

######################## METHOD 2 ####################################
if ( $method == 2 ) {
	my $msg64 = encode_base64( $msg->as_string, '' ) ;

	my %jsonraw = ( raw => $msg64 ) ;

	use LWP::Protocol::http ;
	push( @LWP::Protocol::http::EXTRA_SOCK_OPTS,
		PeerHTTPVersion => 1.1
	) ;
	my $ua = LWP::UserAgent->new( keep_alive => 1, send_te => 0 ) ;
	my @ns_headers = (
		'Connection' => 'Keep-Alive',
		'Content-Type' => 'application/json',
		'Authorization' => "Bearer $cred->{ accessToken }",
	) ;

	# scope could be : https://mail.google.com
	#      or better : https://www.googleapis.com/auth/gmail.send
	my $uri = 'https://content.googleapis.com/gmail/v1/users/me/messages/send' ;

	# scope could be: 'https://www.googleapis.com/auth/gmail.insert'
	# my $uri = 'https://content.googleapis.com/gmail/v1/users/me/messages' ;
	# Not so useful, message is created but does not appear in Inbox
	
	my $json = JSON->new ;
	my $encoded_json = $json->encode( \%jsonraw ) ;

	my $req = HTTP::Request->new( 'POST', $uri ) ;
	$req->header( @ns_headers ) ;
	$req->content( $encoded_json ) ;

	my $response = $ua->request( $req ) ;
	# This also works but I prefer a cleaner header
	# my $lwp = LWP::UserAgent->new ;
	# $lwp->request( $req ) ;

	# Enable this for debugging. The API sometimes shows pretty
	# useful error messages
	# print Dumper( $response ) ;
}