fix(windows): handle edge cases using default language

Fixes #5091.

If the user has a default language that is not a minimal BCP47 tag, such
as `zh-Hans-CN` vs `zh-CN`, or if the default language does not have a
mapping in our `TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47`
function, then kmshell would crash on install of a keyboard that had no
language metadata specified (i.e. neither legacy metadata in .kmx nor
modern metadata in .kmp).

This crash arose because the elevated instance of kmshell would install
a local-machine reference to `zh-CN` (as it back-translated from a
LangID), but the current user install would look for `zh-Hans-CN`, read
from the Windows registry `HKCU\Control Panel\International\User Profile`.

To further complicate matters, it is possible for the current user to
have a different default language than the elevated user on the machine.
Keyman was assuming that the default language was the same in both
cases.

This fix passes in the current user's default BCP47 and LangID to the
elevated portion of the keyboard install, so we can guarantee that
keyboard install which needs to use the default language, actually
installs for the current user's actual language code, and not a
canonicalized version (or a totally different code in the case of
elevation to an alternate admin user account).
This commit is contained in:
Marc Durdin 2021-09-17 06:37:23 +10:00
parent fe980889ae
commit a8a19b2a2e
10 changed files with 156 additions and 26 deletions

View file

@ -33,7 +33,11 @@ type
class function GetFirstLanguage(Keyboard: IKeymanKeyboardFile): string; overload;
/// <summary>Get the BCP47 tag for the user's default language</summary>
class function GetUserDefaultLanguage: string; static;
class function GetUserDefaultLanguage: string; overload; static;
class procedure GetUserDefaultLanguage(var BCP47: string; var LangID: Integer); overload; static;
/// <summary>Get the -default-lang parameter string for kmshell</summary>
class function GetUserDefaultLangParameterString: string; static;
private
class function GetKeyboardLanguage(const KeyboardID,
BCP47Tag: string): IKeymanKeyboardLanguageInstalled; static;
@ -152,7 +156,7 @@ begin
if RegistrationRequired then
begin
// This calls back into TTIPMaintenance.RegisterTip
if WaitForElevatedConfiguration(0, '-register-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'"') <> 0 then
if WaitForElevatedConfiguration(0, '-register-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" '+GetUserDefaultLangParameterString) <> 0 then
Exit(False);
end;
@ -204,16 +208,61 @@ begin
Result := False;
end;
class function TTIPMaintenance.GetUserDefaultLangParameterString: string;
var
LangID: Integer;
BCP47: string;
begin
GetUserDefaultLanguage(BCP47, LangID);
Result := '-default-lang '+BCP47+' '+IntToHex(LangID,4);
end;
class function TTIPMaintenance.GetUserDefaultLanguage: string;
var
LangID: Integer;
begin
GetUserDefaultLanguage(Result, LangID);
end;
class procedure TTIPMaintenance.GetUserDefaultLanguage(var BCP47: string; var LangID: Integer);
var
r: TRegistry;
tags: TStringList;
v: string;
keys: TStringList;
key: string;
function GetLangIDFromValueName: Integer;
var
values: TStringList;
v: string;
begin
// In HKCU\Control Panel\International\User Profile\<bcp47>, already opened
// by the caller, look for a value name such as '0453:00000453' or
// '0804:{81D4E9C9-1D3B-41BC-9E6C-4B40BF79E35E}{FA550B04-5AD7-411F-A5AC-CA038EC515D7}'
// and grab the LangID from there.
values := TStringList.Create;
try
r.GetValueNames(values);
for v in values do
begin
if Copy(v, 5, 1) = ':' then
begin
Result := StrToIntDef('$' + Copy(v, 1, 4), 0);
if Result > 0 then
Exit;
end;
end;
finally
values.Free;
end;
Result := 0;
end;
begin
// Fallback result
Result := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(HKLToLanguageID(GetDefaultHKL));
LangID := HKLToLanguageID(GetDefaultHKL);
BCP47 := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(LangID);
// For Win10, look in CPL/International/UserProfile
r := TRegistry.Create;
@ -232,7 +281,8 @@ begin
if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + key) and
r.ValueExists(v) then
begin
Result := key;
BCP47 := key;
LangID := GetLangIDFromValueName;
Break;
end;
end;
@ -248,7 +298,9 @@ begin
r.ReadMultiString(SRegValue_CPIUP_Languages, tags);
if tags.Count > 0 then
begin
Result := tags[0].Trim;
BCP47 := tags[0].Trim;
if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + tags[0].Trim) then
LangID := GetLangIDFromValueName;
end;
finally
tags.Free;

View file

@ -169,12 +169,12 @@ begin
if Length(FilenameBCP47) > 1
then RegisterKeyboardPackageLanguage(FPackage, FilenameBCP47[1])
else RegisterKeyboardPackageLanguage(FPackage, '');
// The keyboard will be installed for current user as a separate step
// The keyboard will be installed for current user as a separate step
end
else
begin
FKeyboard := (kmcom.Keyboards as IKeymanKeyboardsInstalled2).Install2(FileName, True);
if Length(FilenameBCP47) > 1
if (Length(FilenameBCP47) > 1) and (Trim(FilenameBCP47[1]) <> '')
then BCP47Tag := FilenameBCP47[1]
else BCP47Tag := TTIPMaintenance.GetFirstLanguage(FKeyboard);
TTIPMaintenance.DoRegister(FKeyboard.ID, BCP47Tag);

View file

@ -303,7 +303,8 @@ begin
Manager.UpdateProgress('Installing Keyboard', 0, 0);
t := TTempFileManager.Get('.log');
try
if WaitForElevatedConfiguration(GetForegroundWindow, '-log "'+t.Name+'" -s -i "'+FInstallFile+'='+BCP47Tag+'" -nowelcome') = 0 then
if WaitForElevatedConfiguration(GetForegroundWindow, '-log "'+t.Name+'" -s -i "'+FInstallFile+'='+BCP47Tag+'"'+
' -nowelcome '+TTIPMaintenance.GetUserDefaultLangParameterString) = 0 then
begin
// install the keyboard tip
if not InstallTipForKeyboard(BCP47Tag) then

View file

@ -195,7 +195,8 @@ begin
end;
function Init(var FMode: TKMShellMode; KeyboardFileNames: TStrings; var FSilent, FForce, FNoWelcome: Boolean;
var FLogFile, FQuery: string; var FDisablePackages, FDefaultUILanguage: string; var FStartWithConfiguration: Boolean; var FParentWindow: THandle): Boolean;
var FLogFile, FQuery: string; var FDisablePackages, FDefaultUILanguage: string; var FStartWithConfiguration: Boolean;
var FParentWindow: THandle; var FDefaultBCP47: string; var FDefaultLangID: Integer): Boolean;
var
s: string;
i: Integer;
@ -269,7 +270,13 @@ begin
FQuery := Trim(FQuery);
end
else if Copy(s, 1, 3) = '-ur' then UnRegCRC := StrToIntDef('$'+Copy(s, 4, 8), 0)
else if s = '-default-lang' then
begin
Inc(i);
FDefaultBCP47 := ParamStr(i);
Inc(i);
FDefaultLangID := StrToIntDef('$'+ParamStr(i), 0);
end
// Controls from Keyman Engine
else if s = '-showhint' then FMode := fmShowHint
else if s = '-parentwindow' then
@ -301,7 +308,8 @@ begin
end;
procedure RunKMCOM(FMode: TKMShellMode; KeyboardFileNames: TStrings; FSilent, FForce, FNoWelcome: Boolean;
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean; FParentWindow: THandle); forward;
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean; FParentWindow: THandle;
const FDefaultBCP47: string; FDefaultLangID: Integer); forward;
procedure Run;
var
@ -312,7 +320,8 @@ var
FForce: Boolean;
FParentWindow: THandle;
FLogFile: string;
FDisablePackages, FDefaultUILanguage: string;
FDefaultLangID: Integer;
FDefaultBCP47, FDisablePackages, FDefaultUILanguage: string;
FStartWithConfiguration: Boolean;
begin
RegisterControlClasses;
@ -320,7 +329,7 @@ begin
KeyboardFileNames := TStringList.Create;
try
FParentWindow := 0;
if not Init(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow) then
if not Init(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow, FDefaultBCP47, FDefaultLangID) then
begin
//TODO: TUtilExecute.Shell(PChar('hh.exe mk:@MSITStore:'+ExtractFilePath(KMShellExe)+'keyman.chm::/context/keyman_usage.html'), SW_SHOWNORMAL);
Exit;
@ -328,7 +337,7 @@ begin
if not LoadKMCOM then Exit;
try
RunKMCOM(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow);
RunKMCOM(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow, FDefaultBCP47, FDefaultLangID);
finally
kmcom := nil;
end;
@ -366,8 +375,10 @@ begin
end;
procedure RunKMCOM(FMode: TKMShellMode; KeyboardFileNames: TStrings; FSilent, FForce, FNoWelcome: Boolean;
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean; FParentWindow: THandle);
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean;
FParentWindow: THandle; const FDefaultBCP47: string; FDefaultLangID: Integer);
var
kdl: IKeymanDefaultLanguage;
FIcon: string;
FMutex: TKeymanMutex; // I2720
function FirstKeyboardFileName: WideString;
@ -440,6 +451,12 @@ begin
if FileExists(FIcon) then
Application.Icon.LoadFromFile(FIcon);
if (FDefaultBCP47 <> '') or (FDefaultLangID <> 0) then
begin
if Supports(kmcom, IKeymanDefaultLanguage, kdl) then
kdl.SetDefaultLanguage(FDefaultBCP47, FDefaultLangID);
end;
case FMode of
fmKeyboardWelcome: // I2569
ShowKeyboardWelcome(FirstKeyboardFileName);

View file

@ -48,7 +48,7 @@ uses
keymansysteminfo;
type
TKeyman = class(TAutoObject, IKeyman, IIntKeyman, IKeymanBCP47Canonicalization)
TKeyman = class(TAutoObject, IKeyman, IIntKeyman, IKeymanBCP47Canonicalization, IKeymanDefaultLanguage)
private
FInitialized: Boolean;
FContext: TKeymanContext;
@ -84,6 +84,8 @@ type
// Reimplement as a special case for this interface
function SerializeXML(Flags: TOleEnum; const ImagePath: WideString; out References: OleVariant): WideString; safecall;
{ IKeymanDefaultLanguage }
procedure SetDefaultLanguage(const BCP47: WideString; LangID: Integer); safecall;
public
procedure Initialize; override;
destructor Destroy; override;
@ -290,6 +292,12 @@ begin
end;
end;
procedure TKeyman.SetDefaultLanguage(const BCP47: WideString; LangID: Integer);
begin
FContext.DefaultBCP47 := BCP47;
FContext.DefaultLangID := LangID;
end;
procedure TKeyman.Set_AutoApply(Value: WordBool);
begin
if not FInitialized then raise Exception.Create(SErrorUninitialised);

View file

@ -12,7 +12,7 @@ unit keymanapi_TLB;
// ************************************************************************ //
// $Rev: 52393 $
// File generated on 1/02/2021 8:52:41 AM from Type Library described below.
// File generated on 16/09/2021 6:54:44 PM from Type Library described below.
// ************************************************************************ //
// Type Lib: C:\Projects\keyman\app\windows\src\engine\kmcomapi\kmcomapi (1)
@ -93,6 +93,7 @@ const
IID_IKeymanKeyboardLanguageInstalled2: TGUID = '{414C26E6-BFAC-4A70-9EA1-E525BA9BBA7E}';
IID_IKeymanKeyboardLanguagesInstalled2: TGUID = '{628FF2E6-B490-462E-8FC7-7AE53B9D392C}';
CLASS_Keyman: TGUID = '{CF46549D-4D2D-4679-A2E1-23A815F172F8}';
IID_IKeymanDefaultLanguage: TGUID = '{77BAB934-B7DF-4304-AFA6-B8F6BEC16516}';
// *********************************************************************//
// Declaration of Enumerations defined in Type Library
@ -257,6 +258,8 @@ type
IKeymanKeyboardLanguageInstalled2Disp = dispinterface;
IKeymanKeyboardLanguagesInstalled2 = interface;
IKeymanKeyboardLanguagesInstalled2Disp = dispinterface;
IKeymanDefaultLanguage = interface;
IKeymanDefaultLanguageDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
@ -1765,6 +1768,26 @@ type
out References: OleVariant): WideString; dispid 401;
end;
// *********************************************************************//
// Interface: IKeymanDefaultLanguage
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {77BAB934-B7DF-4304-AFA6-B8F6BEC16516}
// *********************************************************************//
IKeymanDefaultLanguage = interface(IDispatch)
['{77BAB934-B7DF-4304-AFA6-B8F6BEC16516}']
procedure SetDefaultLanguage(const DefaultBCP47: WideString; DefaultLangID: Integer); safecall;
end;
// *********************************************************************//
// DispIntf: IKeymanDefaultLanguageDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {77BAB934-B7DF-4304-AFA6-B8F6BEC16516}
// *********************************************************************//
IKeymanDefaultLanguageDisp = dispinterface
['{77BAB934-B7DF-4304-AFA6-B8F6BEC16516}']
procedure SetDefaultLanguage(const DefaultBCP47: WideString; DefaultLangID: Integer); dispid 201;
end;
// *********************************************************************//
// The Class CoKeyman provides a Create and CreateRemote method to
// create instances of the default interface IKeyman exposed by

View file

@ -32,6 +32,8 @@ type
private
FKeyman: TObject;
FController: TKeymanController;
FDefaultBCP47: string;
FDefaultLangID: Integer;
function GetErrors: IIntKeymanErrors;
function GetKeyboards: IIntKeymanKeyboardsInstalled;
function GetPackages: IIntKeymanPackagesInstalled;
@ -50,6 +52,9 @@ type
property SystemInfo: IIntKeymanSystemInfo read GetSystemInfo;
property Control: IIntKeymanControl read GetControl;
property Controller: TKeymanController read FController;
property DefaultBCP47: string read FDefaultBCP47 write FDefaultBCP47;
property DefaultLangID: Integer read FDefaultLangID write FDefaultLangID;
end;
implementation

View file

@ -124,7 +124,7 @@
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
<DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
<Debugger_HostApplication>..\..\desktop\kmshell\kmshell.exe</Debugger_HostApplication>
<Debugger_HostApplication>..\..\desktop\kmshell\bin\win32\debug\kmshell.exe</Debugger_HostApplication>
<VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<Debugger_RunParams>-c</Debugger_RunParams>
<DCC_UseMSBuildExternally>false</DCC_UseMSBuildExternally>

View file

@ -6,7 +6,7 @@
// However, when applying changes via the Editor this file will be regenerated
// and comments or formatting changes will be lost.
// ************************************************************************ //
// File generated on 1/02/2021 8:52:42 AM (- $Rev: 12980 $, 9519671).
// File generated on 16/09/2021 6:54:45 PM (- $Rev: 12980 $, 32940875).
[
uuid(F16E2A9A-DA46-4EA3-BFF3-BA46B480C961),
@ -66,6 +66,7 @@ library keymanapi
interface IKeymanKeyboardLanguageInstalled2;
interface IKeymanKeyboardLanguagesInstalled2;
interface IKeymanBCP47Canonicalization;
interface IKeymanDefaultLanguage;
[
@ -1019,6 +1020,17 @@ library keymanapi
HRESULT _stdcall GetFullTagList([in] BSTR Tag, [out, retval] VARIANT* Result);
};
[
uuid(77BAB934-B7DF-4304-AFA6-B8F6BEC16516),
dual,
oleautomation
]
interface IKeymanDefaultLanguage: IDispatch
{
[id(0x000000C9)]
HRESULT _stdcall SetDefaultLanguage([in] BSTR DefaultBCP47, [in] long DefaultLangID);
};
[
uuid(CF46549D-4D2D-4679-A2E1-23A815F172F8),
version(10.0)

View file

@ -326,6 +326,7 @@ var
kpil: TKPInstallKeyboardLanguage;
ml: TMitigateWin10_1803.TMitigatedLanguage;
KeyboardName: string;
FDefaultBCP47: string;
type
TWSLCallback = reference to procedure(r: TRegistryErrorControlled);
@ -366,7 +367,11 @@ begin
ErrorFmt(KMN_E_Install_InvalidFile, VarArrayOf([ExtractFileName(FileName), E.Message]));
end;
FDefaultHKL := GetDefaultHKL;
FDefaultHKL := Context.DefaultLangID;
if FDefaultHKL = 0 then
FDefaultHKL := GetDefaultHKL;
FDefaultBCP47 := Context.DefaultBCP47;
KeyboardID := GetShortKeyboardName(FileName);
@ -456,12 +461,6 @@ begin
begin
FLanguages := GetLanguageCodesFromKeyboard(ki);
//
// Final fallback is to install against default language for system // I4607
//
if Length(FLanguages) = 0 then
AddLanguage(HKLToLanguageID(FDefaultHKL));
for i := 0 to High(Flanguages) do
if TMitigateWin10_1803.IsMitigationRequired(FLanguages[i], ml) then
begin
@ -483,6 +482,19 @@ begin
i: Integer;
BCP47Tag: string;
begin
if Length(FLanguages) = 0 then
begin
//
// Final fallback is to install against default language for system
//
kpil := TKPInstallKeyboardLanguage.Create(Context);
try
kpil.RegisterTip(KeyboardID, FDefaultBCP47, KeyboardName, FDefaultHKL, FIconFileName, ''); //TODO: language name
finally
kpil.Free;
end;
r.WriteString(FDefaultBCP47, ''); // TODO: language name
end;
for i := 0 to High(FLanguages) do
begin
BCP47Tag := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(FLanguages[i]);