Sasl oauth

Lib/Protocols/IdDICT.pas

@@ -178,7 +178,7 @@ procedure TIdDICT.Connect;
  end;
  end;
  end else begin
- FSASLMechanisms.LoginSASL('SASLAUTH',FHost, 'dict', ['230'], ['330'], Self, FCapabilities, ''); {do not localize}
+ FSASLMechanisms.LoginSASL('SASLAUTH', FHost, FPort, 'dict', ['230'], ['330'], Self, FCapabilities, ''); {do not localize}
  end;
  if FTryMIME and IsCapaSupported('MIME') then begin {do not localize}
  SendCmd('OPTION MIME'); {do not localize}

Lib/Protocols/IdIMAP4.pas

@@ -1390,7 +1390,7 @@ function PerformSASLLogin_IMAP(ASASL: TIdSASL; AEncoder: TIdEncoder;
  // TODO: use UTF-8 when base64-encoding strings...
 
  if AClient.IsCapabilityListed('SASL-IR') then begin {Do not localize}
- if ASASL.TryStartAuthenticate(AClient.Host, IdGSKSSN_imap, S) then begin
+ if ASASL.TryStartAuthenticate(AClient.Host, AClient.Port, IdGSKSSN_imap, S) then begin
  AClient.SendCmd(AClient.NewCmdCounter, 'AUTHENTICATE ' + String(ASASL.ServiceName) + ' ' + AEncoder.Encode(S), [], True); {Do not Localize}
  if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then begin
  ASASL.FinishAuthenticate;
@@ -1415,7 +1415,7 @@ function PerformSASLLogin_IMAP(ASASL: TIdSASL; AEncoder: TIdEncoder;
  // must be a continue reply...
  if not AuthStarted then begin
  S := ADecoder.DecodeString(TrimRight(TIdReplyIMAP4(AClient.LastCmdResult).Extra.Text));
- S := ASASL.StartAuthenticate(S, AClient.Host, IdGSKSSN_imap);
+ S := ASASL.StartAuthenticate(S, AClient.Host, AClient.Port, IdGSKSSN_imap);
  AClient.IOHandler.WriteLn(AEncoder.Encode(S));
  AClient.GetInternalResponse(AClient.LastCmdCounter, [], True);
  if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then
@@ -1426,7 +1426,7 @@ function PerformSASLLogin_IMAP(ASASL: TIdSASL; AEncoder: TIdEncoder;
  end;
  while PosInStrArray(AClient.LastCmdResult.Code, AContinueReplies) > -1 do begin
  S := ADecoder.DecodeString(TrimRight(TIdReplyIMAP4(AClient.LastCmdResult).Extra.Text));
- S := ASASL.ContinueAuthenticate(S, AClient.Host, IdGSKSSN_imap);
+ S := ASASL.ContinueAuthenticate(S, AClient.Host, AClient.Port, IdGSKSSN_imap);
  AClient.IOHandler.WriteLn(AEncoder.Encode(S));
  AClient.GetInternalResponse(AClient.LastCmdCounter, [], True);
  if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then
@@ -2426,7 +2426,7 @@ procedure TIdIMAP4.Login;
  if not FHasCapa then begin
  Capability;
  end;
- // FSASLMechanisms.LoginSASL('AUTHENTICATE', FHost, IdGSKSSN_imap, [IMAP_OK], [IMAP_CONT], Self, FCapabilities, 'AUTH', IsCapabilityListed('SASL-IR')); {Do not Localize}
+ // FSASLMechanisms.LoginSASL('AUTHENTICATE', FHost, FPort, IdGSKSSN_imap, [IMAP_OK], [IMAP_CONT], Self, FCapabilities, 'AUTH', IsCapabilityListed('SASL-IR')); {Do not Localize}
  TIdSASLEntriesIMAP4(FSASLMechanisms).LoginSASL_IMAP(Self);
  end;
  FConnectionState := csAuthenticated;

Lib/Protocols/IdPOP3.pas

@@ -221,6 +221,7 @@ TIdPOP3 = class(TIdMessageClient)
  FHasAPOP: Boolean;
  FHasCAPA: Boolean;
  FSASLMechanisms : TIdSASLEntries;
+ FSASLCanAttemptIR: Boolean;
  //
  function GetReplyClass:TIdReplyClass; override;
  function GetSupportsTLS: Boolean; override;
@@ -260,6 +261,7 @@ TIdPOP3 = class(TIdMessageClient)
  property Password;
  property Port default IdPORT_POP3;
  property SASLMechanisms : TIdSASLEntries read FSASLMechanisms write SetSASLMechanisms;
+ property SASLCanAttemptInitialResponse: Boolean read FSASLCanAttemptIR write FSASLCanAttemptIR default True;
  end;
 
 type
@@ -297,6 +299,22 @@ procedure TIdPOP3.Login;
 var
  S: String;
  LMD5: TIdHashMessageDigest5;
+
+ function IsSASLSupported: Boolean;
+ var
+ i : Integer;
+ LBuf : String;
+ begin
+ Result := False;
+ for i := 0 to FCapabilities.Count -1 do begin
+ LBuf := TrimLeft(FCapabilities[i]);
+ if TextIsSame(Fetch(LBuf), 'SASL') then begin {do not localize}
+ Result := True;
+ Exit;
+ end;
+ end;
+ end;
+
 begin
  if UseTLS in ExplicitTLSVals then begin
  if SupportsTLS then begin
@@ -339,10 +357,27 @@ procedure TIdPOP3.Login;
  // in RFC 2449 along with the CAPA command. If a server supports the CAPA
  // command then it *should* also support Initial-Response as well, however
  // many POP3 servers support CAPA but do not support Initial-Response
- // (which was formalized in RFC 5034). So, until we can handle that
- // descrepency better, we will simply disable Initial-Response for now.
-
- FSASLMechanisms.LoginSASL('AUTH', FHost, IdGSKSSN_pop, [ST_OK], [ST_SASLCONTINUE], Self, Capabilities, 'SASL'); {do not localize}
+ // (which was formalized in RFC 5034).
+ //
+ // RFC 5034 says:
+ //
+ // "If a server either does not support the CAPA command or does not
+ // advertise the SASL capability, clients SHOULD NOT attempt the AUTH
+ // command. If a client does attempt the AUTH command in such a
+ // situation, it MUST NOT supply the client initial response
+ // parameter (for backwards compatibility with [RFC1734])."
+ //
+ // So, as most modern POP3 servers do support Initial-Response now, we
+ // will attempt Initial-Response by default, unless told not to. For
+ // instance, Microsoft Office 365 does not support Initial-Response
+ // when using XOAuth2 authentication (why?)...
+
+ // TODO: look in the SASLMechanisms if XOAuth2 is enabled, and if so
+ // then disable Initial-Response...
+
+ FSASLMechanisms.LoginSASL('AUTH', FHost, FPort, IdGSKSSN_pop, [ST_OK], [ST_SASLCONTINUE], Self, Capabilities, 'SASL', {do not localize}
+ FSASLCanAttemptIR and HasCAPA and IsSASLSupported
+ );
  end;
  end;
 end;
@@ -352,6 +387,7 @@ procedure TIdPOP3.InitComponent;
  inherited;
  FAutoLogin := True;
  FSASLMechanisms := TIdSASLEntries.Create(Self);
+ FSASLCanAttemptIR := True;
  FRegularProtPort := IdPORT_POP3;
  FImplicitTLSProtPort := IdPORT_POP3S;
  FExplicitTLSProtPort := IdPORT_POP3;

Lib/Protocols/IdRegister.pas

@@ -273,6 +273,7 @@ implementation
  IdSASLDigest,
  IdSASLExternal,
  IdSASLLogin,
+ IdSASLOAuth,
  IdSASLOTP,
  IdSASLPlain,
  IdSASLSKey,
@@ -411,9 +412,12 @@ implementation
  {$R IconsDotNet\TIdSASLExternal.bmp}
  {$R IconsDotNet\TIdSASLList.bmp}
  {$R IconsDotNet\TIdSASLLogin.bmp}
+ {$R IconsDotNet\TIdSASLOAuth2Bearer.bmp}
+ {$R IconsDotNet\TIdSASLOAuth10A.bmp}
  {$R IconsDotNet\TIdSASLOTP.bmp}
  {$R IconsDotNet\TIdSASLPlain.bmp}
  {$R IconsDotNet\TIdSASLSKey.bmp}
+ {$R IconsDotNet\TIdSASLXOAuth2.bmp}
  {$R IconsDotNet\TIdServerCompressionIntercept.bmp}
  {$R IconsDotNet\TIdServerInterceptLogEvent.bmp}
  {$R IconsDotNet\TIdServerInterceptLogFile.bmp}
@@ -588,9 +592,12 @@ procedure Register;
  TIdSASLDigest,
  TIdSASLExternal,
  TIdSASLLogin,
+ TIdSASLOAuth10A,
+ TIdSASLOAuth2Bearer,
  TIdSASLOTP,
  TIdSASLPlain,
  TIdSASLSKey,
+ TIdSASLXOAuth2,
  TIdUserPassProvider
  ]);
 
@@ -738,9 +745,12 @@ procedure Register;
  TIdSASLDigest,
  TIdSASLExternal,
  TIdSASLLogin,
+ TIdSASLOAuth10A,
+ TIdSASLOAuth2Bearer,
  TIdSASLOTP,
  TIdSASLPlain,
  TIdSASLSKey,
+ TIdSASLXOAuth2,
  TIdUserPassProvider
  ]);
 

Lib/Protocols/IdSASL.pas

@@ -86,9 +86,13 @@ TIdSASL = class(TIdBaseComponent)
  which can remove an unnecessary round-trip if both parties support it.
  }
  //SASL AProtocolName must be a name from "http://www.iana.org/assignments/gssapi-service-names"
- function TryStartAuthenticate(const AHost, AProtocolName : string; var VInitialResponse: string): Boolean; virtual;
- function StartAuthenticate(const AChallenge, AHost, AProtocolName : string): string; virtual; abstract;
- function ContinueAuthenticate(const ALastResponse, AHost, AProtocolName : string): string; virtual;
+ function TryStartAuthenticate(const AHost, AProtocolName : string; var VInitialResponse: string): Boolean; overload; virtual;
+ function StartAuthenticate(const AChallenge, AHost, AProtocolName : string): string; overload; virtual;
+ function ContinueAuthenticate(const ALastResponse, AHost, AProtocolName : string): string; overload; virtual;
+
+ function TryStartAuthenticate(const AHost: string; const APort: TIdPort; const AProtocolName : string; var VInitialResponse: string): Boolean; overload; virtual;
+ function StartAuthenticate(const AChallenge, AHost: string; const APort: TIdPort; const AProtocolName : string): string; overload; virtual;
+ function ContinueAuthenticate(const ALastResponse, AHost: string; const APort: TIdPort; const AProtocolName : string): string; overload; virtual;
 
  { For cleaning up after Authentication }
  procedure FinishAuthenticate; virtual;
@@ -163,9 +167,29 @@ function TIdSASL.TryStartAuthenticate(const AHost, AProtocolName : string; var V
  Result := False;
 end;
 
+function TIdSASL.TryStartAuthenticate(const AHost: string; const APort: TIdPort; const AProtocolName : string; var VInitialResponse: string): Boolean;
+begin
+ Result := TryStartAuthenticate(AHost, AProtocolName, VInitialResponse);
+end;
+
+function TIdSASL.StartAuthenticate(const AChallenge, AHost, AProtocolName : string): string;
+begin
+ Result := '';
+end;
+
+function TIdSASL.StartAuthenticate(const AChallenge, AHost: string; const APort: TIdPort; const AProtocolName : string): string;
+begin
+ Result := StartAuthenticate(AChallenge, AHost, AProtocolName);
+end;
+
 function TIdSASL.ContinueAuthenticate(const ALastResponse, AHost, AProtocolName : string): string;
 begin
- // intentionally empty
+ Result := '';
+end;
+
+function TIdSASL.ContinueAuthenticate(const ALastResponse, AHost: string; const APort: TIdPort; const AProtocolName : string): string;
+begin
+ Result := ContinueAuthenticate(ALastResponse, AHost, AProtocolName);
 end;
 
 procedure TIdSASL.FinishAuthenticate;

Lib/Protocols/IdSASLCollection.pas

@@ -49,6 +49,7 @@ interface
  IdBaseComponent,
  IdCoder,
  IdException,
+ IdGlobal,
  IdSASL,
  IdTCPConnection;
 
@@ -80,10 +81,18 @@ TIdSASLEntries = class ( TOwnedCollection )
  constructor Create ( AOwner : TPersistent ); reintroduce;
  function Add: TIdSASLListEntry;
  procedure LoginSASL(const ACmd, AHost, AProtocolName: String;
+ const AOkReplies, AContinueReplies: array of string; AClient : TIdTCPConnection;
+ ACapaReply : TStrings; const AAuthString : String = 'AUTH'; {Do not Localize}
+ ACanAttemptIR: Boolean = True); overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use overload with APort parameter'{$ENDIF};{$ENDIF}
+ procedure LoginSASL(const ACmd, AHost: String; const APort: TIdPort; const AProtocolName: String;
  const AOkReplies, AContinueReplies: array of string; AClient : TIdTCPConnection;
  ACapaReply : TStrings; const AAuthString : String = 'AUTH'; {Do not Localize}
  ACanAttemptIR: Boolean = True); overload;
  procedure LoginSASL(const ACmd, AHost, AProtocolName, AServiceName: String;
+ const AOkReplies, AContinueReplies: array of string; AClient : TIdTCPConnection;
+ ACapaReply : TStrings; const AAuthString : String = 'AUTH'; {Do not Localize}
+ ACanAttemptIR: Boolean = True); overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use overload with APort parameter'{$ENDIF};{$ENDIF}
+ procedure LoginSASL(const ACmd, AHost: String; const APort: TIdPort; const AProtocolName, AServiceName: String;
  const AOkReplies, AContinueReplies: array of string; AClient : TIdTCPConnection;
  ACapaReply : TStrings; const AAuthString : String = 'AUTH'; {Do not Localize}
  ACanAttemptIR: Boolean = True); overload;
@@ -110,7 +119,6 @@ implementation
  {$ENDIF}
  IdAssignedNumbers,
  IdCoderMIME,
- IdGlobal,
  IdGlobalProtocols,
  IdReply,
  IdResourceStringsProtocols,
@@ -188,8 +196,8 @@ function CheckStrFail(const AStr : String; const AOk, ACont: array of string) :
  (PosInStrArray(AStr, ACont) = -1);
 end;
 
-function PerformSASLLogin(const ACmd, AHost, AProtocolName: String; ASASL: TIdSASL;
- AEncoder: TIdEncoder; ADecoder: TIdDecoder; const AOkReplies, AContinueReplies: array of string;
+function PerformSASLLogin(const ACmd, AHost: string; const APort: TIdPort; const AProtocolName: String;
+ ASASL: TIdSASL; AEncoder: TIdEncoder; ADecoder: TIdDecoder; const AOkReplies, AContinueReplies: array of string;
  AClient : TIdTCPConnection; ACanAttemptIR: Boolean): Boolean;
 var
  S: String;
@@ -220,8 +228,10 @@ function PerformSASLLogin(const ACmd, AHost, AProtocolName: String; ASASL: TIdSA
  // fails here for POP3 then re-attempt without Initial-Response before
  // exiting with a failure.
 
+ // TODO: use UTF-8 when base64-encoding strings...
+
  if ACanAttemptIR then begin
- if ASASL.TryStartAuthenticate(AHost, AProtocolName, S) then begin
+ if ASASL.TryStartAuthenticate(AHost, APort, AProtocolName, S) then begin
  AClient.SendCmd(ACmd + ' ' + String(ASASL.ServiceName) + ' ' + AEncoder.Encode(S), []);//[334, 504]);
  if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then begin
  if not TextIsSame(AProtocolName, IdGSKSSN_pop) then begin
@@ -249,7 +259,7 @@ function PerformSASLLogin(const ACmd, AHost, AProtocolName: String; ASASL: TIdSA
  // must be a continue reply...
  if not AuthStarted then begin
  S := ADecoder.DecodeString(TrimRight(AClient.LastCmdResult.Text.Text));
- S := ASASL.StartAuthenticate(S, AHost, AProtocolName);
+ S := ASASL.StartAuthenticate(S, AHost, APort, AProtocolName);
  AClient.SendCmd(AEncoder.Encode(S));
  if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then
  begin
@@ -259,7 +269,7 @@ function PerformSASLLogin(const ACmd, AHost, AProtocolName: String; ASASL: TIdSA
  end;
  while PosInStrArray(AClient.LastCmdResult.Code, AContinueReplies) > -1 do begin
  S := ADecoder.DecodeString(TrimRight(AClient.LastCmdResult.Text.Text));
- S := ASASL.ContinueAuthenticate(S, AHost, AProtocolName);
+ S := ASASL.ContinueAuthenticate(S, AHost, APort, AProtocolName);
  AClient.SendCmd(AEncoder.Encode(S));
  if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then
  begin
@@ -335,9 +345,18 @@ function TIdSASLEntries.Insert(Index: Integer): TIdSASLListEntry;
  TIdSASLList = TList;
  {$ENDIF}
 
+{$I IdDeprecatedImplBugOff.inc}
 procedure TIdSASLEntries.LoginSASL(const ACmd, AHost, AProtocolName: String; const AOkReplies,
  AContinueReplies: array of string; AClient: TIdTCPConnection;
  ACapaReply: TStrings; const AAuthString: String; ACanAttemptIR: Boolean);
+{$I IdDeprecatedImplBugOn.inc}
+begin
+ LoginSASL(ACmd, AHost, 0, AProtocolName, AOkReplies, AContinueReplies, AClient, ACapaReply, AAuthString, ACanAttemptIR);
+end;
+
+procedure TIdSASLEntries.LoginSASL(const ACmd, AHost: String; const APort: TIdPort; const AProtocolName: String;
+ const AOkReplies, AContinueReplies: array of string; AClient: TIdTCPConnection;
+ ACapaReply: TStrings; const AAuthString: String; ACanAttemptIR: Boolean);
 var
  i : Integer;
  LE : TIdEncoderMIME;
@@ -360,23 +379,23 @@ procedure TIdSASLEntries.LoginSASL(const ACmd, AHost, AProtocolName: String; con
  //create a list of mechanisms that both parties support
  LSASLList := TIdSASLList.Create;
  try
- LSupportedSASL := TStringList.Create;
- try
- ParseCapaReplyToList(ACapaReply, LSupportedSASL, AAuthString);
- for i := Count-1 downto 0 do begin
- LSASL := Items[i].SASL;
- if LSASL <> nil then begin
- if not LSASL.IsAuthProtocolAvailable(LSupportedSASL) then begin
- Continue;
- end;
- if LSASLList.IndexOf(LSASL) = -1 then begin
- LSASLList.Add(LSASL);
+ LSupportedSASL := TStringList.Create;
+ try
+ ParseCapaReplyToList(ACapaReply, LSupportedSASL, AAuthString);
+ for i := Count-1 downto 0 do begin
+ LSASL := Items[i].SASL;
+ if LSASL <> nil then begin
+ if not LSASL.IsAuthProtocolAvailable(LSupportedSASL) then begin
+ Continue;
+ end;
+ if LSASLList.IndexOf(LSASL) = -1 then begin
+ LSASLList.Add(LSASL);
+ end;
  end;
  end;
+ finally
+ FreeAndNil(LSupportedSASL);
  end;
- finally
- FreeAndNil(LSupportedSASL);
- end;
 
  if LSASLList.Count = 0 then begin
  raise EIdSASLNotSupported.Create(RSSASLNotSupported);
@@ -400,7 +419,7 @@ procedure TIdSASLEntries.LoginSASL(const ACmd, AHost, AProtocolName: String; con
  if not Assigned(LD) then begin
  LD := TIdDecoderMIME.Create(nil);
  end;
- if PerformSASLLogin(ACmd, AHost, AProtocolName, LSASL, LE, LD, AOkReplies, AContinueReplies, AClient, ACanAttemptIR) then begin
+ if PerformSASLLogin(ACmd, AHost, APort, AProtocolName, LSASL, LE, LD, AOkReplies, AContinueReplies, AClient, ACanAttemptIR) then begin
  Exit;
  end;
  if not Assigned(LError) then begin
@@ -426,9 +445,19 @@ procedure TIdSASLEntries.LoginSASL(const ACmd, AHost, AProtocolName: String; con
  end;
 end;
 
+{$I IdDeprecatedImplBugOff.inc}
 procedure TIdSASLEntries.LoginSASL(const ACmd, AHost, AProtocolName, AServiceName: String;
  const AOkReplies, AContinueReplies: array of string; AClient: TIdTCPConnection;
  ACapaReply: TStrings; const AAuthString: String; ACanAttemptIR: Boolean);
+{$I IdDeprecatedImplBugOn.inc}
+begin
+ LoginSASL(ACmd, AHost, 0, AProtocolName, AServiceName, AOkReplies, AContinueReplies, AClient, ACapaReply, AAuthString, ACanAttemptIR);
+end;
+
+procedure TIdSASLEntries.LoginSASL(const ACmd, AHost: String; const APort: TIdPort;
+ const AProtocolName, AServiceName: String;
+ const AOkReplies, AContinueReplies: array of string; AClient: TIdTCPConnection;
+ ACapaReply: TStrings; const AAuthString: String; ACanAttemptIR: Boolean);
 var
  LE : TIdEncoderMIME;
  LD : TIdDecoderMIME;
@@ -463,7 +492,7 @@ procedure TIdSASLEntries.LoginSASL(const ACmd, AHost, AProtocolName, AServiceNam
  try
  LD := TIdDecoderMIME.Create(nil);
  try
- if not PerformSASLLogin(ACmd, AHost, AProtocolName, LSASL, LE, LD, AOkReplies, AContinueReplies, AClient, ACanAttemptIR) then begin
+ if not PerformSASLLogin(ACmd, AHost, APort, AProtocolName, LSASL, LE, LD, AOkReplies, AContinueReplies, AClient, ACanAttemptIR) then begin
  AClient.RaiseExceptionForLastCmdResult;
  end;
  finally