Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
345 lines (297 sloc) 13.8 KB
/// 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) 2018 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) 2018
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 *****
Version 1.18
- initial release, as an alternative to SynSSPIAuth.pas for Linux servers
}
{$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(False);
end.