I'm creating a Delphi REST Client to interact with the DUO API. I was able to test my authorization keys and all other parameters in Postman just fine. However, I cannot replicate the same in Delphi REST. I'm not sure if I'm doing this wrong. Below is my sample code:
//aside from the parameters below
//RESTClient1 baseurl is set to: https://api-sample123.duosecurity.com/
//RESTRequest1 Resource is set to this standard resource: admin/v1/users
procedure TfrmMain.Button1Click(Sender: TObject);
var
sAuthorization, nDate, sUsername, sPassword : string;
begin
try
nDate := formatdatetime('ddd, d mmm yyyy hh:mm:ss', now()) + ' +1000';
sAuthorization := 'Basic justasamplekeyhere123:alsoatesthmacsha1hash';
Restclient1.Params.Add();
RESTClient1.Params[0].Name := 'Date';
RESTClient1.Params[0].Value := nDate;
Restclient1.Params[0].Options := [poDoNotEncode];
Restclient1.Params.Add();
RESTClient1.Params[1].Name := 'Authorization';
RESTClient1.Params[1].Value := sAuthorization;
Restclient1.Params[1].Options := [poDoNotEncode];
Restclient1.ContentType := 'ctAPPLICATION_X_WWW_FORM_URLENCODED'; //application/x-www-form-urlencoded';
RESTRequest1.Execute;
MEMO1.Lines.Add(RestRequest1.Response.Content);
Except
On E: Exception do
begin
MessageDlg(E.Message, mtError, [mbOK], 0);
end;
end;
Related
A while ago I wrote a method in Delphi 2010 to get the OAuth2 token using the Indy components (TidHttp). See code below.
I am now doing something new in Delphi 10.4 and would like to use the REST components such as RESTClient, RESTRequest, TOAuth2Authenticator, etc.
Our grant type is Client Credentials but in none of the examples on the net could I find on how to use TOAuth2Authenticator with Client Credentials. Is it even possible?
We have a client id, client secret and token URL. We do not have authorization or redirect endpoints. In Insomnia, the setup will look like this:
Does somebody know how to get the token using TOAuth2Authenticator with grant type = client_credentials?
Here is the Delphi 2010 code:
procedure TfrmToken.btnGetTokenClick(Sender: TObject);
var
IdHTTP: TidHttp;
lsHttpError: string;
loRequest: TStringStream;
loRespJson: TMemoryStream;
liSuper: iSuperObject;
ldtExpiry: TDateTime;
begin
IdHTTP := TIdHTTP.Create();
loRespJson := TMemoryStream.Create();
try
IdHTTP.HandleRedirects := False;
loRequest := TStringStream.Create('grant_type=client_credentials&client_id=' +
edtKey.Text + '&client_secret='+edtSecret.Text);
try
IdHttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHttp);
IdHttp.Request.ContentType := 'application/x-www-form-urlencoded';
try
IdHTTP.Post(edtURL.Text, loRequest, loRespJson);
except
on E: EIdHTTPProtocolException do
begin
lsHttpError := E.ErrorMessage;
end;
on E: Exception do
begin
lsHttpError := E.Message;
end;
end;
if idHTTP.ResponseCode = 200 then
begin
liSuper := SO(StreamToString(loRespJSon));
edtToken.Text := liSuper.S['access_token'];
ldtExpiry := IncSecond(Now, liSuper.i['expires_in']);
edtExpiry.Text := 'Expires in ' + liSuper.S['expires_in'] +
' seconds. Time: ' +
FormatDateTime('yyyy/dd/mm hh:nn:ss', ldtExpiry);
end
else
begin
liSuper := SO(lsHttpError);
edtToken.Text := IdHTTP.ResponseText;
edtExpiry.Text := '';
end;
finally
FreeAndNil(loRequest);
end;
finally
FreeAndNil(IdHTTP);
FreeAndNil(loRespJson);
end;
end;
I've posted various questions trying to figure out all my issues with trying to send an email using TLS with Office365.
My last question here: How do I solve [EIdSMTPReplyError] Authentication unsuccessful?
Since I couldn't solve the latter I got credentials of one of our clients and try testing the sample with their office credentials which brought me one step closer. With my own office credentials I'm just unable to authenticate (see previous link). In PowerShell there is no issue and I can send an email with the same credentials but not programmatically.
I'm now trying to figure out why the server is returning "Invalid Address" using the client's credentials. Again, I'm able to use the exact same credentials in PowerShell and generate a sample email which works. But not with this component.
Slightly adjusted code from previous link:
procedure TForm28.SendEmail(poSMTP:TIdSMTP);
var
loSMTPMessage : TIdMessage;
begin
loSMTPMessage := TIdMessage.Create(nil);
with loSMTPMessage do
begin
Recipients.Add.Address := 'to address';
ReplyTo.Add.Text := edtUsername.Text;
From.Address := edtUsername.Text;
From.Name := 'xxx';
From.Text := 'Test';
Subject := 'Test';
end;
poSMTP.Send(loSMTPMessage);
loSMTPMessage.Free;
end;
procedure TForm28.Method2Click(Sender: TObject);
var
idSMTP1: TIdSMTP;
idSASLLogin: TIdSASLLogin;
idUserPassProvider: TIdUserPassProvider;
lp:PWideChar;
liSize:Cardinal;
begin
idSMTP1 := TIdSMTP.Create(nil);
idSMTP1.OnFailedRecipient := IdSMTP1FailedRecipient;
//have tried all these variations in trying to solve authentication issue
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameNetBIOS);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameDnsHostname);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameDnsDomain);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalNetBIOS);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalDnsHostname);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalDnsDomain);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalDnsFullyQualified);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameMax);
try
idSMTP1.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(idSMTP1);
idSMTP1.UseTLS := utUseExplicitTLS;
TIdSSLIOHandlerSocketOpenSSL(idSMTP1.IOHandler).SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
idSMTP1.Host := edtSMTP.Text;
idSMTP1.Port := StrToInt(cbPort.Text);
idSASLLogin := TIdSASLLogin.Create(idSMTP1);
idUserPassProvider := TIdUserPassProvider.Create(idSASLLogin);
idSASLLogin.UserPassProvider := idUserPassProvider;
idUserPassProvider.Username := edtUsername.Text;
idUserPassProvider.Password := edtPassword.Text;
idSMTP1.AuthType := satSASL;
idSMTP1.SASLMechanisms.Add.SASL := idSASLLogin;
try
idSMTP1.Connect;
try
if idSMTP1.Authenticate then
SendEmail(idSMTP1);
finally
idSMTP1.Disconnect;
end;
ShowMessage('OK');
except
on E: Exception do
begin
ShowMessage(Format('Failed!'#13'[%s] %s', [E.ClassName, E.Message]));
raise;
end;
end;
finally
idSMTP1.Free;
end;
end;
This gives me an error: Project SMTP_SSL_Example.exe raised exception class EIdSMTPReplyError with message 'Invalid address
'.
Oh my gosh.
From.Text := 'Test';
called after
From.Address := edtUsername.Text
was changing my email address to 'test'.
Cannot believe I've wasted time with something stupid like this.
All,
I am working on a new datasnap project based on the example project located in C:\Users\Public\Documents\Embarcadero\Studio\18.0\Samples\Object Pascal\DataSnap\FireDAC_DBX.
I am trying to transfer a large stream (1,606,408 bytes) from datasnap server to client. I am running into what appears to be a common issue and that is that the entire stream does not make it to the client.
Here is my server code:
//Returns Customer Info
function TServerMethods.GetBPInfo(CardCode : String): TStringStream;
begin
Result := TStringStream.Create;
try
qBPInfo.Close;
if CardCode.Trim = '' then
qBPInfo.ParamByName('ParmCardCode').AsString := '%%'
else
qBPInfo.ParamByName('ParmCardCode').AsString := '%' + CardCode + '%';
qBPInfo.Open;
FDSchemaAdapterBPInfo.SaveToStream(Result, TFDStorageFormat.sfBinary);
Result.Position := 0;
// Result.SaveToFile('output.adb');
except
raise;
end;
end;
Here is my client code:
procedure TdmDataSnap.GetBPInfo(CardCode : String);
var
LStringStream : TStringStream;
begin
dmDataSnap.FDStoredProcBPInfo.ParamByName('CardCode').AsString := CardCode;
FDStoredProcBPInfo.ExecProc;
LStringStream := TStringStream.Create(FDStoredProcBPInfo.ParamByName('ReturnValue').asBlob);
//LStringStream.Clear;
//LStringStream.LoadFromFile('Output.adb');
try
if LStringStream <> nil then
begin
LStringStream.Position := 0;
try
DataModuleFDClient.FDSchemaAdapterBP.LoadFromStream(LStringStream, TFDStorageFormat.sfBinary);
except
on E : Exception do
showmessage(e.Message);
end;
end;
finally
LStringStream.Free;
end;
end;
You will see the stream save and load code; that is how I determined that the server was getting the entire result set into the stream, and that the client could handle the entire result set and display it properly.
So smaller streams transfer just fine, but this big one, when examined in the ide debugger, does not start with the 65,66,68,83 characters and the load fails with the error, '[FireDAC][Stan]-710. Invalid binary storage format'.
I know from extended Googling that there are work-arounds for this, but I do not understand how to apply the workarounds to my case, with the use of Tfdstoredproc and TfdSchemaAdaptor components. I'm trying to stay with this coding scheme.
How do I adapt this code to correctly receive large streams?
Update 1:
Ok, I tried strings and Base64 encoding. It didn't work.
Client Code:
procedure TdmDataSnap.GetBPInfo(CardCode : String);
var
LStringStream : TStringStream;
TempStream : TStringStream;
begin
dmDataSnap.FDStoredProcBPInfo.ParamByName('CardCode').AsString := CardCode;
FDStoredProcBPInfo.ExecProc;
try
TempStream := TStringStream.Create;
TIdDecoderMIME.DecodeStream(FDStoredProcBPInfo.ParamByName('ReturnValue').asString,TempStream);
if TempStream <> nil then
begin
TempStream.Position := 0;
try
DataModuleFDClient.FDSchemaAdapterBP.LoadFromStream(TempStream, TFDStorageFormat.sfBinary);
except
on E : Exception do
showmessage(e.Message);
end;
end;
finally
TempStream.Free;
end;
end;
Here is my server code:
//Returns Customer Info
function TServerMethods.GetBPInfo(CardCode : String): String;
var
TempStream : TMemoryStream;
OutputStr : String;
begin
Result := '';
TempStream := TMemoryStream.Create;
try
try
qBPInfo.Close;
if CardCode.Trim = '' then
qBPInfo.ParamByName('ParmCardCode').AsString := '%%'
else
qBPInfo.ParamByName('ParmCardCode').AsString := '%' + CardCode + '%';
qBPInfo.Open;
FDSchemaAdapterBPInfo.SaveToStream(TempStream, TFDStorageFormat.sfBinary);
TempStream.Position := 0;
OutputStr := IdEncoderMIMEBPInfo.EncodeStream(TempStream);
Result := OutputStr
except
raise;
end;
finally
TempStream.Free;
end;
end;
The result is the same.
is there a simple way to look up if a domain has a MX record or not using Delphi? I have a list of emails that I wish to verify work, I want to check each of the domains and see if a MX server even exists.
Thanks.
Edit: The email addresses I have are all from bounced email messages of error code: 5.4.0. But too many servers don't follow any standards and 5.4.0 error code itself can mean too much. I don't want to just remove all the email addresses found with that error code erroraneously, so I figure a better way is to first check if the domain or mx record don't exist and remove those for sure.
You can use the windows DnsQuery API to check the MX records for a given server name. Unfortunately I didn't find a proper Delphi translation for the headers, so I made a partial (but workable) translation myself. It only supports MX and IpV4 A records, nothing else. Adding support for IpV6 address should be trivial.
Here's my translation, including a simple ServerHasMxRecords(const ServerName:string):Boolean function that returns True if any MX records are found:
unit DnsMxCheck;
interface
uses Windows, Classes;
type
DNS_STATUS = Integer;
IP4_ADDRESS = DWORD;
_DNS_RECORD_FLAGS = packed record
case Boolean of
True: (DW: DWORD);
False: (DNS_RECORD_FLAGS: DWORD);
end;
DNS_A_DATA = packed record
case Boolean of
True: (IpAddress: IP4_ADDRESS);
False: (Bytes:array[0..3] of Byte);
end;
DNS_MX_DATA = packed record
pNameExchange: PWChar;
wPreference: Word;
Pad: Word;
end;
_DNS_RECORD_DATA_UNION = packed record
case Integer of
0: (A: DNS_A_DATA);
1: (MX1, MX2, AFSDB1, AFSDB2, RT1, RT2: DNS_MX_DATA);
999: (Filler: array[0..1024] of Byte); // I have no idea what the true size of the record shoud be!
end;
PDNS_RECORD = ^DNS_RECORD;
DNS_RECORD = packed record
NextRecord: PDNS_RECORD;
pName: PWChar;
wType: Word;
wDataLength: Word;
Flags: _DNS_RECORD_FLAGS;
dwTtl: DWORD;
dwReserved: DWORD;
Data: _DNS_RECORD_DATA_UNION;
end;
const DNS_TYPE_A = $0001;
DNS_TYPE_MX = $000f;
function DnsQuery_W(lpstrName: PWChar; wType: Word; Options: DWORD; pExtra: Pointer; out ppQueryResultsSet: PDNS_RECORD; pReserved: Pointer): DNS_STATUS;stdcall;external 'dnsapi.dll';
function ServerHasMxRecords(const ServerName:string):Boolean;
implementation
function ServerHasMxRecords(const ServerName:string):Boolean;
var DNS_REC: PDNS_RECORD;
begin
if DnsQuery_W(PWChar(ServerName), DNS_TYPE_MX, 0, nil, DNS_REC, nil) = 0 then
begin
while Assigned(DNS_REC) do
begin
if DNS_REC.wType = DNS_TYPE_MX then
begin
Exit(True);
end;
DNS_REC := DNS_REC.NextRecord;
end;
end;
Result := False;
end;
end.
It is actually good to have an e-mail checker. If nothing else you can clean you e-mail base and avoid sending over and over to non existing mails. Or you can use it as means of verifying user mails when they sign on to your application.
Here is a part of the code in my mail checking class.
procedure TMailValidator.ResolveEmailAddress(const Address: TEMailAddress; const DNSServer: string);
var
I: Integer;
MXEmpty: Boolean;
DomainName: string;
DNSResolver: TIdDNSResolver;
begin
DNSResolver := TIdDNSResolver.Create(nil);
try
DomainName := StrAfter('#', string(Address));
MXEmpty := True;
DNSResolver.Host := DNSServer;
{$IFNDEF IT_UseIndy9}
DNSResolver.QueryType := [qtMx];
{$ELSE}
DNSResolver.QueryRecords := [qtMx];
{$ENDIF} // IT_UseIndy9
try
{$IFNDEF IT_UseIndy9}
DNSResolver.WaitingTime := FDNSResolveTimeout;
{$ELSE}
DNSResolver.ReceiveTimeout := FDNSResolveTimeout;
{$ENDIF} // IT_UseIndy10
DNSResolver.Resolve(DomainName);
for I := 0 to DNSResolver.QueryResult.Count - 1 do
begin
if DNSResolver.QueryResult[I].RecType = qtMX then
begin
MXEmpty := False;
CheckEmailAddress(Address, TMXRecord(DNSResolver.QueryResult[I]).ExchangeServer);
// were we successfull
if CheckSMTPExitErrorCode then
Exit;
end;
end;
// check for servers flag
if FFoundMailServer then
begin
SendLogMessage(Format('Address "%s" is not valid on domain "%s"', [Address, DNSServer]));
SetLastError(cUserErrorCodeBase + 5);
end
else
begin
if MXEmpty then
begin
SendLogMessage(Format('No valid mail(MX) server could be found for domain "%s"', [DomainName]));
CheckEmailAddress(Address, DomainName);
end
else
begin
SendLogMessage(Format('Mail server did not respond on domain "%s"', [DomainName]));
SetLastError(cUserErrorCodeBase + 3);
end;
end;
except
on E: Exception do
begin
SendLogMessage(Format('Address "%s" validation failed for domain "%s": %s', [Address,
DomainName,
E.Message]));
SetLastError(cUserErrorCodeBase + 4, E.Message);
end;
end;
finally
DNSResolver.Free;
end;
end;
procedure TMailValidator.CheckEmailAddress(const Address: TEMailAddress; const MailServer: string);
var
SMTP: TIdSMTP;
begin
SendLogMessage(Format('Validating address "%s" on server "%s"', [Address, MailServer]));
if (FCheckStep = csAddress) or (FCheckStep = csDomain) then
begin
// finish if flags in [FLAG_CheckLocal, FLAG_CheckDomain]
SendLogMessage(Format('Address "%s" successfuly validated.', [Address]));
Exit;
end;
SMTP := TIdSMTP.Create(nil);
try
FCurrentStep := csMailBox;
try
SMTP.ReadTimeout := FSMTPReadTimeout;
{$IFNDEF IT_UseIndy9}
SMTP.AuthType := satNone;
{$ELSE}
SMTP.AuthenticationType := atNone;
{$ENDIF} // IT_UseIndy9
SMTP.Host := MailServer;
SMTP.Port := 25;
SMTP.Connect;
try
FFoundMailServer := True;
try
SMTP.SendCmd('Helo ' + FQueryingServer, 250 );
SMTP.SendCmd('Rset');
SMTP.SendCmd('Mail from:<' + string(Address) + '>', 250);
SMTP.SendCmd('RCPT to:<' + string(Address) + '>', [250, 251] );
SendLogMessage(Format('Address "%s" successfuly validated on server "%s".', [FEMailAddress,
MailServer]));
except
on E: Exception do
begin
SendLogMessage(Format('Address "%s" validation failed on server "%s": %s', [Address,
MailServer,
E.Message]));
SetLastError(SMTP.LastCmdResult.NumericCode, E.Message);
Exit;
end;
end
finally
SMTP.Disconnect;
end;
except
// handle all other exceptions
on E: Exception do
begin
SendLogMessage(Format('CheckMail [%s] : Failure (Server) "%s" [%s]', [Address,
MailServer,
E.Message]));
SetLastError(Max(cUserErrorCodeBase + 6, SMTP.LastCmdResult.NumericCode), E.Message);
end;
end;
finally
SMTP.Free;
end;
end;
Basically you do it in three steps:
Check the mail syntax.
Check the domain and validate MX server
Validate the user mailbox
The only way to check if you can deliver an email is to actually deliver it, and check the zillion ways you can get a bounce response.
I'm making requests to the webaddress to get XML files throught the HTTPS connection. But this connection works like 50%. In most cases it fails. Usual error is "socket error #10060". Or "Error connecting with SSL. EOF was observed that violates the protocol". What I'm doing wrong?
function SendRequest(parameters: string): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TStringStream;
xDoc: IXMLDocument;
begin
sPostData := TStringList.Create;
try
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add(parameters);
sHttpSocket := TIdHTTP.Create;
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create;
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Request.Method := 'POST';
resStream := TStringStream.Create;
sHttpSocket.Post(Self.sUrl, sPostData, resStream);
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
resStream.Free;
sHttpSocket.Free;
sshSocketHandler.Free;
sPostData.Free;
except on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end
end;
end;
Maybe I can do this in another way, that works like 100%, when internet connection is available?
Regards,
evilone
An "EOF" error suggests you are connnecting to a server that is not actually using SSL to begin with, or the SSL data may be corrupted.
Besides that, why are you including explicit '&' characters between your post data parameters? Don't do that, Indy will just encode them and send its own '&' characters. Also, consider using TMemoryStream instead of TStringStream to ensure IXMLDocumect.LoadFromStream() is loading the server's original raw XML data as-is, and not an altered version that the RTL/VCL produces due to Unicode handling (TStringStream is TEncoding-enabled).
Edit: Given the URL you provided, an example of calling verifyUser() would look like this:
const
ERPLYAccountCode = '...';
function verifyUser(const user, pass: string; const sessionLength: Integer = 3600): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TMemoryStream;
xDoc: IXMLDocument;
begin
Result := nil;
try
resStream := TMemoryStream.Create;
try
sPostData := TStringList.Create;
try
sPostData.Add('clientCode=' + ERPLYAccountCode);
sPostData.Add('request=verifyUser');
sPostData.Add('version=1.0');
sPostData.Add('responseType=XML');
sPostData.Add('responseMode=normal');
sPostData.Add('username=' + user);
sPostData.Add('password=' + pass);
sPostData.Add('sessionLength=' + IntToStr(sessionLength));
sHttpSocket := TIdHTTP.Create;
try
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create(sHttpSocket);
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Post('https://www.erply.net/api/', sPostData, resStream);
finally
sHttpSocket.Free;
end;
finally
sPostData.Free;
end;
resStream.Position := 0;
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
finally
resStream.Free;
end;
except
on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end;
end;
end;