345 lines
13 KiB
ObjectPascal
345 lines
13 KiB
ObjectPascal
/// Low-level access to GSSAPI Authentication for Linux 32/64-bit platform
|
|
// - this unit is a part of the freeware Synopse mORMot framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit SynGSSAPIAuth;
|
|
{
|
|
This file is part of Synopse mORMot framework.
|
|
|
|
Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - https://synopse.info
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
for the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is Synopse mORMot framework.
|
|
|
|
The Initial Developer of the Original Code is Chaa.
|
|
|
|
Portions created by the Initial Developer are Copyright (C) 2022
|
|
the Initial Developer. All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
Arnaud Bouchez
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
}
|
|
|
|
{$I Synopse.inc} // define HASINLINE and other compatibility switches
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
SynCommons,
|
|
SynGSSAPI;
|
|
|
|
/// Client-side authentication procedure
|
|
// - aSecContext holds information between function calls
|
|
// - aInData contains data received from server
|
|
// - aSecKerberosSPN is the Service Principal Name,
|
|
// registered in domain, e.g.
|
|
// 'mymormotservice/myserver.mydomain.tld@MYDOMAIN.TLD'
|
|
// - aOutData contains data that must be sent to server
|
|
// - if function returns True, client must send aOutData to server
|
|
// and call function again with data, returned from server
|
|
function ClientSSPIAuth(var aSecContext: TSecContext;
|
|
const aInData: RawByteString; const aSecKerberosSPN: RawUTF8;
|
|
out aOutData: RawByteString): Boolean;
|
|
|
|
/// Client-side authentication procedure with clear text password.
|
|
// This function must be used when application need to use different
|
|
// user credentials (not credentials of logged in user)
|
|
// - aSecContext holds information between function calls
|
|
// - aInData contains data received from server
|
|
// - aUserName is the domain and user name, in form of
|
|
// 'username@MYDOMAIN.TLD'. Note that domain name requires to be in upper case.
|
|
// - aPassword is the user clear text password
|
|
// - aOutData contains data that must be sent to server
|
|
// - if function returns True, client must send aOutData to server
|
|
// and call function again with data, returned from server
|
|
// - you must use ClientForceSPN to specify server SPN before call
|
|
function ClientSSPIAuthWithPassword(var aSecContext: TSecContext;
|
|
const aInData: RawByteString; const aUserName: RawUTF8;
|
|
const aPassword: RawUTF8; out aOutData: RawByteString): Boolean;
|
|
|
|
/// Server-side authentication procedure
|
|
// - aSecContext holds information between function calls
|
|
// - aInData contains data received from client
|
|
// - aOutData contains data that must be sent to client
|
|
// - if function returns True, server must send aOutData to client
|
|
// and call function again with data, returned from client
|
|
function ServerSSPIAuth(var aSecContext: TSecContext;
|
|
const aInData: RawByteString; out aOutData: RawByteString): Boolean;
|
|
|
|
/// Server-side function that returns authenticated user name
|
|
// - aSecContext must be received from previous successful call to ServerSSPIAuth
|
|
// - aUserName contains authenticated user name
|
|
procedure ServerSSPIAuthUser(var aSecContext: TSecContext; out aUserName: RawUTF8);
|
|
|
|
/// Returns name of the security package that has been used with the negotiation process
|
|
// - aSecContext must be received from previous success call to ServerSSPIAuth
|
|
// or ClientSSPIAuth
|
|
function SecPackageName(var aSecContext: TSecContext): RawUTF8;
|
|
|
|
/// Force using aSecKerberosSPN for server identification
|
|
// - aSecKerberosSPN is the Service Principal Name, registered in domain, e.g.
|
|
// 'mymormotservice/myserver.mydomain.tld@MYDOMAIN.TLD'
|
|
procedure ClientForceSPN(const aSecKerberosSPN: RawUTF8);
|
|
|
|
/// Force loading server credentials from specified keytab file
|
|
// - by default, clients may authenticate to any service principal
|
|
// in the default keytab (/etc/krb5.keytab or the value of the KRB5_KTNAME
|
|
// environment variable)
|
|
procedure ServerForceKeytab(const aKeytab: RawUTF8);
|
|
|
|
const
|
|
/// HTTP header to be set for authentication
|
|
SECPKGNAMEHTTPWWWAUTHENTICATE = 'WWW-Authenticate: Negotiate';
|
|
/// HTTP header pattern received for authentication
|
|
SECPKGNAMEHTTPAUTHORIZATION = 'AUTHORIZATION: NEGOTIATE ';
|
|
|
|
var
|
|
/// Dictionary for converting fully qualified domain names to NT4-style NetBIOS names
|
|
// - to use same value for TSQLAuthUser.LogonName on all platforms user name
|
|
// changed from 'username@MYDOMAIN.TLD' to 'MYDOMAIN\username'
|
|
// - when converting fully qualified domain name to NT4-style NetBIOS name
|
|
// ServerDomainMap first checked. If domain name not found, then it's truncated on first dot,
|
|
// e.g. 'user1@CORP.ABC.COM' changed to 'CORP\user1'
|
|
// - you can change domain name conversion by registering names at server startup, e.g.
|
|
// ServerDomainMap.Add('CORP.ABC.COM', 'ABCCORP') change conversion for previuos
|
|
// example to 'ABCCORP\user1'
|
|
// - use only if automatic conversion (truncate on first dot) do it wrong
|
|
ServerDomainMap: TSynNameValue;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
var
|
|
ForceSecKerberosSPN: RawUTF8;
|
|
|
|
function ClientSSPIAuthWorker(var aSecContext: TSecContext;
|
|
const aInData: RawByteString; const aSecKerberosSPN: RawUTF8;
|
|
out aOutData: RawByteString): Boolean;
|
|
var TargetName: gss_name_t;
|
|
MajStatus, MinStatus: Cardinal;
|
|
InBuf: gss_buffer_desc;
|
|
OutBuf: gss_buffer_desc;
|
|
CtxReqAttr: Cardinal;
|
|
CtxAttr: Cardinal;
|
|
begin
|
|
TargetName := nil;
|
|
if aSecKerberosSPN <> '' then begin
|
|
InBuf.length := Length(aSecKerberosSPN);
|
|
InBuf.value := Pointer(aSecKerberosSPN);
|
|
MajStatus := gss_import_name(MinStatus, @InBuf, GSS_KRB5_NT_PRINCIPAL_NAME, TargetName);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to import server SPN');
|
|
end;
|
|
|
|
try
|
|
CtxReqAttr := GSS_C_INTEG_FLAG or GSS_C_CONF_FLAG;
|
|
if TargetName <> nil then
|
|
CtxReqAttr := CtxReqAttr or GSS_C_MUTUAL_FLAG;
|
|
|
|
InBuf.length := Length(aInData);
|
|
InBuf.value := Pointer(aInData);
|
|
|
|
OutBuf.length := 0;
|
|
OutBuf.value := nil;
|
|
|
|
MajStatus := gss_init_sec_context(MinStatus, aSecContext.CredHandle,
|
|
aSecContext.CtxHandle, TargetName, GSS_C_MECH_SPNEGO,
|
|
CtxReqAttr, GSS_C_INDEFINITE, nil, @InBuf, nil, @OutBuf, @CtxAttr, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to initialize security context');
|
|
|
|
Result := (MajStatus and GSS_S_CONTINUE_NEEDED) <> 0;
|
|
|
|
SetString(aOutData, PAnsiChar(OutBuf.value), OutBuf.length);
|
|
gss_release_buffer(MinStatus, OutBuf);
|
|
finally
|
|
if TargetName <> nil then
|
|
gss_release_name(MinStatus, TargetName);
|
|
end;
|
|
end;
|
|
|
|
function ClientSSPIAuth(var aSecContext: TSecContext;
|
|
const aInData: RawByteString; const aSecKerberosSPN: RawUTF8;
|
|
out aOutData: RawByteString): Boolean;
|
|
var MajStatus, MinStatus: Cardinal;
|
|
SecKerberosSPN: RawUTF8;
|
|
begin
|
|
RequireGSSAPI;
|
|
if aSecContext.CredHandle = nil then begin
|
|
aSecContext.CreatedTick64 := GetTickCount64();
|
|
MajStatus := gss_acquire_cred(MinStatus, nil, GSS_C_INDEFINITE, nil,
|
|
GSS_C_INITIATE, aSecContext.CredHandle, nil, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to acquire credentials for current user');
|
|
end;
|
|
if aSecKerberosSPN<>'' then
|
|
SecKerberosSPN := aSecKerberosSPN else
|
|
SecKerberosSPN := ForceSecKerberosSPN;
|
|
Result := ClientSSPIAuthWorker(aSecContext, aInData, SecKerberosSPN, aOutData);
|
|
end;
|
|
|
|
function ClientSSPIAuthWithPassword(var aSecContext: TSecContext;
|
|
const aInData: RawByteString; const aUserName: RawUTF8;
|
|
const aPassword: RawUTF8; out aOutData: RawByteString): Boolean;
|
|
var MajStatus, MinStatus: Cardinal;
|
|
InBuf: gss_buffer_desc;
|
|
UserName: gss_name_t;
|
|
begin
|
|
RequireGSSAPI;
|
|
if aSecContext.CredHandle = nil then begin
|
|
aSecContext.CreatedTick64 := GetTickCount64();
|
|
InBuf.length := Length(aUserName);
|
|
InBuf.value := Pointer(aUserName);
|
|
MajStatus := gss_import_name(MinStatus, @InBuf, GSS_KRB5_NT_PRINCIPAL_NAME, UserName);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to import UserName');
|
|
InBuf.length := Length(aPassword);
|
|
InBuf.value := Pointer(aPassword);
|
|
MajStatus := gss_acquire_cred_with_password(MinStatus, UserName, @InBuf,
|
|
GSS_C_INDEFINITE, nil, GSS_C_INITIATE, aSecContext.CredHandle, nil, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to acquire credentials for specified user');
|
|
end;
|
|
Result := ClientSSPIAuthWorker(aSecContext, aInData, ForceSecKerberosSPN, aOutData);
|
|
end;
|
|
|
|
function ServerSSPIAuth(var aSecContext: TSecContext;
|
|
const aInData: RawByteString; out aOutData: RawByteString): Boolean;
|
|
var MajStatus, MinStatus: Cardinal;
|
|
InBuf: gss_buffer_desc;
|
|
OutBuf: gss_buffer_desc;
|
|
CtxAttr: Cardinal;
|
|
begin
|
|
RequireGSSAPI;
|
|
|
|
if aSecContext.CredHandle = nil then begin
|
|
aSecContext.CreatedTick64 := GetTickCount64();
|
|
if IdemPChar(Pointer(aInData), 'NTLMSSP') then
|
|
raise ESynGSSAPI.CreateFmt('NTLM authentication not supported by GSSAPI library',[]);
|
|
MajStatus := gss_acquire_cred(MinStatus, nil, GSS_C_INDEFINITE, nil,
|
|
GSS_C_ACCEPT, aSecContext.CredHandle, nil, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to aquire credentials for service');
|
|
end;
|
|
|
|
InBuf.length := Length(aInData);
|
|
InBuf.value := PByte(aInData);
|
|
|
|
OutBuf.length := 0;
|
|
OutBuf.value := nil;
|
|
|
|
MajStatus := gss_accept_sec_context(MinStatus, aSecContext.CtxHandle,
|
|
aSecContext.CredHandle, @InBuf, nil, nil, nil, @OutBuf, @CtxAttr, nil, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to accept client credentials');
|
|
|
|
Result := (MajStatus and GSS_S_CONTINUE_NEEDED) <> 0;
|
|
|
|
SetString(aOutData, PAnsiChar(OutBuf.value), OutBuf.length);
|
|
gss_release_buffer(MinStatus, OutBuf);
|
|
end;
|
|
|
|
procedure ConvertUserName(P: PUTF8Char; Len: PtrUInt; out aUserName: RawUTF8);
|
|
var DomainStart, DomainEnd: PUTF8Char;
|
|
Index: Integer;
|
|
Domain: RawUTF8;
|
|
begin
|
|
// Assume GSSAPI buffer is null-terminated
|
|
Assert(P[Len] = #0);
|
|
// Change user name from 'username@MYDOMAIN.TLD' to 'MYDOMAIN\username'
|
|
DomainStart := PosChar(P, '@');
|
|
if DomainStart<>nil then begin
|
|
DomainStart^ := #0;
|
|
Inc(DomainStart);
|
|
Index := ServerDomainMap.Find(DomainStart);
|
|
if Index<0 then begin
|
|
DomainEnd := PosChar(DomainStart, '.');
|
|
if DomainEnd<>nil then
|
|
DomainEnd^ := #0;
|
|
Domain := DomainStart;
|
|
end else
|
|
Domain := ServerDomainMap.List[Index].Value;
|
|
aUserName := FormatUTF8('%\%', [Domain, P]);
|
|
end else
|
|
// Unknown user name format, leave as is
|
|
SetString(aUserName, P, Len);
|
|
end;
|
|
|
|
procedure ServerSSPIAuthUser(var aSecContext: TSecContext; out aUserName: RawUTF8);
|
|
var MajStatus, MinStatus: Cardinal;
|
|
SrcName: gss_name_t;
|
|
OutBuf: gss_buffer_desc;
|
|
NameType: gss_OID;
|
|
begin
|
|
RequireGSSAPI;
|
|
MajStatus := gss_inquire_context(MinStatus, aSecContext.CtxHandle,
|
|
@SrcName, nil, nil, nil, nil, nil, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to inquire security context information (src_name)');
|
|
try
|
|
OutBuf.length := 0;
|
|
OutBuf.value := nil;
|
|
MajStatus := gss_display_name(MinStatus, SrcName, @OutBuf, @NameType);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to obtain name for authenticated user');
|
|
if gss_compare_oid(NameType, GSS_KRB5_NT_PRINCIPAL_NAME) then begin
|
|
ConvertUserName(PUTF8Char(OutBuf.value), OutBuf.length, aUserName);
|
|
end;
|
|
gss_release_buffer(MinStatus, OutBuf);
|
|
finally
|
|
gss_release_name(MinStatus, SrcName);
|
|
end;
|
|
end;
|
|
|
|
function SecPackageName(var aSecContext: TSecContext): RawUTF8;
|
|
var MajStatus, MinStatus: Cardinal;
|
|
MechType: gss_OID;
|
|
OutBuf: gss_buffer_desc;
|
|
begin
|
|
RequireGSSAPI;
|
|
MajStatus := gss_inquire_context(MinStatus, aSecContext.CtxHandle,
|
|
nil, nil, nil, @MechType, nil, nil, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to inquire security context information (mech_type)');
|
|
OutBuf.length := 0;
|
|
OutBuf.value := nil;
|
|
MajStatus := gss_inquire_saslname_for_mech(MinStatus, MechType, nil, @OutBuf, nil);
|
|
GSSCheck(MajStatus, MinStatus, 'Failed to obtain name for mech');
|
|
SetString(Result, PAnsiChar(OutBuf.value), OutBuf.length);
|
|
gss_release_buffer(MinStatus, OutBuf);
|
|
end;
|
|
|
|
procedure ClientForceSPN(const aSecKerberosSPN: RawUTF8);
|
|
begin
|
|
ForceSecKerberosSPN := aSecKerberosSPN;
|
|
end;
|
|
|
|
procedure ServerForceKeytab(const aKeytab: RawUTF8);
|
|
begin
|
|
if Assigned(krb5_gss_register_acceptor_identity) then begin
|
|
krb5_gss_register_acceptor_identity(Pointer(aKeytab));
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
ServerDomainMap.Init({casesensitive=}false);
|
|
end.
|