From e18df382f5cee047da7c387bee619dd46a1c17a3 Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Thu, 13 Aug 2026 14:42:50 +0200 Subject: [PATCH] fix(windows): handle font and package .zip format errors during package installation Quietly handle invalid font files while installing, and cleanly abort install of broken packages. Report the errors to Sentry but do not crash. Fixes: #12812 Fixes: KEYMAN-WINDOWS-45K Fixes: KEYMAN-WINDOWS-6S8 Fixes: KEYMAN-WINDOWS-430 Fixes: KEYMAN-WINDOWS-7T3 Fixes: KEYMAN-WINDOWS-7SY Fixes: KEYMAN-WINDOWS-42Z --- .../Keyman.Configuration.UI.InstallFile.pas | 38 ++- .../kmcomapi/processes/font/kpinstallfont.pas | 35 +- .../processes/package/kpinstallpackage.pas | 315 +++++++++--------- 3 files changed, 215 insertions(+), 173 deletions(-) diff --git a/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas b/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas index c6ee3564ae..4e9b2154a5 100644 --- a/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas +++ b/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas @@ -35,6 +35,7 @@ uses Keyman.Configuration.UI.KeymanProtocolHandler, Keyman.Configuration.UI.MitigationForWin10_1803, kmint, + Keyman.System.KeymanSentryClient, UfrmHTML, UfrmInstallKeyboard; @@ -149,24 +150,25 @@ var IsPackage: Boolean; BCP47Tag: string; begin - Result := False; FPackage := nil; FKeyboard := nil; for i := 0 to FileNames.Count - 1 do begin + FilenameBCP47 := Filenames[i].Split(['=']); + Filename := FilenameBCP47[0]; + try + kmcom.Errors.Clear; kmcom.Keyboards.Refresh; kmcom.Keyboards.Apply; - FilenameBCP47 := Filenames[i].Split(['=']); - Filename := FilenameBCP47[0]; IsPackage := AnsiSameText(ExtractFileExt(FileName), '.kmp'); if not FileExists(FileName) then begin if not ASilent then ShowMessage('File: ' + Filename + ' location not available to Admin User'); - Exit; + Exit(False); end; if IsPackage then begin @@ -189,14 +191,34 @@ begin except on E:EOleException do begin - if kmcom.Errors.Count = 0 then Raise; - if not ASilent then - for j := 0 to kmcom.Errors.Count - 1 do + if kmcom.Errors.Count = 0 then + begin + // An unknown error has occurred in kmcomapi, so we need to abort + // because state is unknown; this will be reported through the normal + // exception handling mechanism by re-raising + raise; + end; + + for j := 0 to kmcom.Errors.Count - 1 do + begin + TKeymanSentryClient.ReportMessage('TInstallFile was unable to install "'+FilenameBCP47[0]+'"; error: '+kmcom.Errors[j].Description, True); + if not ASilent then ShowMessage(kmcom.Errors[j].Description); - Exit; + end; + + kmcom.Errors.Clear; + Exit(False); end; end; + for j := 0 to kmcom.Errors.Count - 1 do + begin + TKeymanSentryClient.ReportMessage('TInstallFile encountered a recoverable error when installing "'+FilenameBCP47[0]+'"; error: '+kmcom.Errors[j].Description, True); + if not ASilent then + ShowMessage(kmcom.Errors[j].Description); + end; + kmcom.Errors.Clear; + FPackage := nil; FKeyboard := nil; end; diff --git a/windows/src/engine/kmcomapi/processes/font/kpinstallfont.pas b/windows/src/engine/kmcomapi/processes/font/kpinstallfont.pas index fa9fbc9da0..b745f53801 100644 --- a/windows/src/engine/kmcomapi/processes/font/kpinstallfont.pas +++ b/windows/src/engine/kmcomapi/processes/font/kpinstallfont.pas @@ -1,18 +1,18 @@ (* Name: kpinstallfont Copyright: Copyright (C) SIL International. - Documentation: - Description: + Documentation: + Description: Create Date: 14 Sep 2006 Modified Date: 3 Feb 2015 Authors: mcdurdin - Related Files: - Dependencies: + Related Files: + Dependencies: - Bugs: - Todo: - Notes: + Bugs: + Todo: + Notes: History: 14 Sep 2006 - mcdurdin - Fix bug where registry was still in read-only state 30 May 2007 - mcdurdin - I850 - Fix font installation under Vista 19 Jun 2007 - mcdurdin - I815 - Install font for current user @@ -43,12 +43,21 @@ var begin Result := False; - with TTTInfo.Create(src_filename, [tfNames]) do try - fontnm := FullName; - finally - Free; - end; + with TTTInfo.Create(src_filename, [tfNames]) do + try + fontnm := FullName; + finally + Free; + end; + except + on E:Exception do + begin + WarnFmt(KMN_W_InstallFont_CannotInstallFont, + VarArrayOf([ExtractFileName(src_filename), E.Message, 0])); + Exit; + end; + end; filename := GetFolderPath(CSIDL_FONTS) + ExtractFileName(src_filename); @@ -107,7 +116,7 @@ begin VarArrayOf([ExtractFileName(filename), SysErrorMessage(GetLastError), Integer(GetLastError)])); Exit; end; - + Result := True; // font should be uninstalled - it will be loaded by Keyman (I815) end; end; diff --git a/windows/src/engine/kmcomapi/processes/package/kpinstallpackage.pas b/windows/src/engine/kmcomapi/processes/package/kpinstallpackage.pas index 98edfbf3fb..2c1c5131cb 100644 --- a/windows/src/engine/kmcomapi/processes/package/kpinstallpackage.pas +++ b/windows/src/engine/kmcomapi/processes/package/kpinstallpackage.pas @@ -163,177 +163,188 @@ begin inf := nil; FZip := TZipFile.Create; try - FZip.Open(FileName, TZipMode.zmRead); - - InfFile := ''; - - for i := 0 to FZip.FileCount - 1 do - begin - FZip.Extract(i, buf, False); - if LowerCase(FZip.Filename[i]) = PackageFile_KMPInf then - InfFile := FZip.Filename[i] - else if LowerCase(FZip.Filename[i]) = PackageFile_KMPJSON then - JsonFile := FZip.Filename[i]; - end; - - if (InfFile = '') and (JsonFile = '') then - Error(KMN_E_PackageInstall_UnableToFindInfFile); - - inf := TKMPInfFile.Create; - if JsonFile <> '' then - begin - inf.FileName := FTempOutPath + JsonFile; - inf.LoadJson; - end - else - begin - inf.FileName := FTempOutPath + InfFile; - inf.LoadIni; - end; - - inf.CheckFiles(FTempOutPath); - - { Check keyboards to install are valid } - - SetLength(ki, inf.Files.Count); - for i := 0 to inf.Files.Count - 1 do - begin - if inf.Files[i].FileType = ftKeymanFile then - begin - try - GetKeyboardInfo(FTempOutPath + inf.Files[i].FileName, False, ki[i]); - except - on E:EKMXError do - ErrorFmt(KMN_E_Install_InvalidFile, VarArrayOf([ExtractFileName(FileName), E.Message])); - end; - end; - end; - - { Install registry entries } - - PackageName := GetShortPackageName(FileName); - dest := GetPackageInstallPath(FileName) + '\'; - - if PackageInstalled(PackageName, FInstByAdmin) and not (ipForce in Options) then - Error(KMN_E_PackageInstall_PackageAlreadyInstalled); - - with TRegistryErrorControlled.Create do // I2890 try - RootKey := HKEY_LOCAL_MACHINE; - - if not OpenKey(SRegKey_InstalledPackages_LM+'\'+PackageName, True) then // I2890 - RaiseLastRegistryError; - - WriteString(SRegValue_PackageFile, dest + PackageFile_KMPInf); - WriteString(SRegValue_PackageDescription, inf.Info.Desc[PackageInfoEntryTypeNames[pietName]]); - finally - Free; - end; - - { Copy files } - - ForceDirectories(ExtractFileDir(dest)); - - for i := 0 to inf.Files.Count - 1 do - begin - FSrcFileName := inf.Files[i].FileName; - - if not CopyFileCleanAttr(PChar(FTempOutPath + FSrcFileName), PChar(dest + FSrcFileName), False) then // I4574 + FZip.Open(FileName, TZipMode.zmRead); + except + on E:EZipException do begin - FErrorValue := GetLastError; - if inf.Files[i].FileType = ftFont - then WarnFmt(KMN_E_PackageInstall_UnableToCopyFile, VarArrayOf([FTempOutPath + inf.Files[i].FileName + ' ['+SysErrorMessage(FErrorValue)+']', dest + inf.Files[i].FileName])) - else ErrorFmt(KMN_E_PackageInstall_UnableToCopyFile, VarArrayOf([FTempOutPath + inf.Files[i].FileName + ' ['+SysErrorMessage(FErrorValue)+']', dest + inf.Files[i].FileName])); + ErrorFmt(KMN_E_Install_InvalidFile, VarArrayOf([ExtractFileName(FileName), E.Message, 0])); + raise; end; end; - { Install the keyboards, packages and fonts } + try + InfFile := ''; - for i := 0 to inf.Files.Count - 1 do - begin - case inf.Files[i].FileType of - ftKeymanFile: - InstallKeyboard(dest + inf.Files[i].FileName); - - ftPackageFile: - with TKPInstallPackage.Create(Context) do - try - Execute(dest + inf.Files[i].FileName, Options); - finally - Free; - end; - end; - end; - - { Install the visual keyboards -- must be after keyboard installs } - - for i := 0 to inf.Files.Count - 1 do - begin - if inf.Files[i].FileType = ftVisualKeyboard then + for i := 0 to FZip.FileCount - 1 do begin - try - with TKPInstallVisualKeyboard.Create(Context) do - try - // TODO: we should probably try and do this by the keyboard install instead so - // that we can deprecate the associatedKeyboard field in .kvk - Execute(FTempOutPath + inf.Files[i].FileName, ''); - finally - Free; - end; - except - on E:EOleException do - WarnFmt(KMN_W_InstallPackage_KVK_Error, VarArrayOf([PackageName, inf.Files[i].FileName, E.Message])); - end; + FZip.Extract(i, buf, False); + if LowerCase(FZip.Filename[i]) = PackageFile_KMPInf then + InfFile := FZip.Filename[i] + else if LowerCase(FZip.Filename[i]) = PackageFile_KMPJSON then + JsonFile := FZip.Filename[i]; end; - end; - { Install start menu items } + if (InfFile = '') and (JsonFile = '') then + Error(KMN_E_PackageInstall_UnableToFindInfFile); - with TKPInstallPackageStartMenu.Create(inf, PackageName, dest) do // I4324 - try - Execute(True, ''); - finally - Free; - end; + inf := TKMPInfFile.Create; + if JsonFile <> '' then + begin + inf.FileName := FTempOutPath + JsonFile; + inf.LoadJson; + end + else + begin + inf.FileName := FTempOutPath + InfFile; + inf.LoadIni; + end; - { Install fonts } + inf.CheckFiles(FTempOutPath); - with TIniFile.Create(dest + 'fonts.inf') do - try + { Check keyboards to install are valid } + + SetLength(ki, inf.Files.Count); for i := 0 to inf.Files.Count - 1 do - if inf.Files[i].FileType = ftFont then - with TKPInstallFont.Create(Context) do + begin + if inf.Files[i].FileType = ftKeymanFile then + begin try - if not Execute(dest + inf.Files[i].FileName) - then WriteString('UninstallFonts', inf.Files[i].FileName, 'False') - else WriteString('UninstallFonts', inf.Files[i].FileName, 'True'); - finally - Free; + GetKeyboardInfo(FTempOutPath + inf.Files[i].FileName, False, ki[i]); + except + on E:EKMXError do + ErrorFmt(KMN_E_Install_InvalidFile, VarArrayOf([ExtractFileName(FileName), E.Message])); end; - UpdateFile; + end; + end; + + { Install registry entries } + + PackageName := GetShortPackageName(FileName); + dest := GetPackageInstallPath(FileName) + '\'; + + if PackageInstalled(PackageName, FInstByAdmin) and not (ipForce in Options) then + Error(KMN_E_PackageInstall_PackageAlreadyInstalled); + + with TRegistryErrorControlled.Create do // I2890 + try + RootKey := HKEY_LOCAL_MACHINE; + + if not OpenKey(SRegKey_InstalledPackages_LM+'\'+PackageName, True) then // I2890 + RaiseLastRegistryError; + + WriteString(SRegValue_PackageFile, dest + PackageFile_KMPInf); + WriteString(SRegValue_PackageDescription, inf.Info.Desc[PackageInfoEntryTypeNames[pietName]]); + finally + Free; + end; + + { Copy files } + + ForceDirectories(ExtractFileDir(dest)); + + for i := 0 to inf.Files.Count - 1 do + begin + FSrcFileName := inf.Files[i].FileName; + + if not CopyFileCleanAttr(PChar(FTempOutPath + FSrcFileName), PChar(dest + FSrcFileName), False) then // I4574 + begin + FErrorValue := GetLastError; + if inf.Files[i].FileType = ftFont + then WarnFmt(KMN_E_PackageInstall_UnableToCopyFile, VarArrayOf([FTempOutPath + inf.Files[i].FileName + ' ['+SysErrorMessage(FErrorValue)+']', dest + inf.Files[i].FileName])) + else ErrorFmt(KMN_E_PackageInstall_UnableToCopyFile, VarArrayOf([FTempOutPath + inf.Files[i].FileName + ' ['+SysErrorMessage(FErrorValue)+']', dest + inf.Files[i].FileName])); + end; + end; + + { Install the keyboards, packages and fonts } + + for i := 0 to inf.Files.Count - 1 do + begin + case inf.Files[i].FileType of + ftKeymanFile: + InstallKeyboard(dest + inf.Files[i].FileName); + + ftPackageFile: + with TKPInstallPackage.Create(Context) do + try + Execute(dest + inf.Files[i].FileName, Options); + finally + Free; + end; + end; + end; + + { Install the visual keyboards -- must be after keyboard installs } + + for i := 0 to inf.Files.Count - 1 do + begin + if inf.Files[i].FileType = ftVisualKeyboard then + begin + try + with TKPInstallVisualKeyboard.Create(Context) do + try + // TODO: we should probably try and do this by the keyboard install instead so + // that we can deprecate the associatedKeyboard field in .kvk + Execute(FTempOutPath + inf.Files[i].FileName, ''); + finally + Free; + end; + except + on E:EOleException do + WarnFmt(KMN_W_InstallPackage_KVK_Error, VarArrayOf([PackageName, inf.Files[i].FileName, E.Message])); + end; + end; + end; + + { Install start menu items } + + with TKPInstallPackageStartMenu.Create(inf, PackageName, dest) do // I4324 + try + Execute(True, ''); + finally + Free; + end; + + { Install fonts } + + with TIniFile.Create(dest + 'fonts.inf') do + try + for i := 0 to inf.Files.Count - 1 do + if inf.Files[i].FileType = ftFont then + with TKPInstallFont.Create(Context) do + try + if not Execute(dest + inf.Files[i].FileName) + then WriteString('UninstallFonts', inf.Files[i].FileName, 'False') + else WriteString('UninstallFonts', inf.Files[i].FileName, 'True'); + finally + Free; + end; + UpdateFile; + finally + Free; + end; + + PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); + + { Run the commandline, if set } + + prog := Trim(inf.Options.ExecuteProgram); + if prog <> '' then + begin + prog := StringReplace(prog, '$keyman', ExtractFileDir(GetKeymanInstallPath), [rfIgnoreCase, rfReplaceAll]); + if not ExecuteProgram(prog, PChar(ExtractFileDir(dest)), errmsg) then + WarnFmt(KMN_W_InstallPackage_CannotRunExternalProgram, VarArrayOf([prog, errmsg])); + end; + + { Complete } finally - Free; + for i := 0 to FZip.FileCount - 1 do + DeleteFileCleanAttr(FTempOutPath + FZip.FileName[i]); // I4574 + inf.Free; end; - - PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); - - { Run the commandline, if set } - - prog := Trim(inf.Options.ExecuteProgram); - if prog <> '' then - begin - prog := StringReplace(prog, '$keyman', ExtractFileDir(GetKeymanInstallPath), [rfIgnoreCase, rfReplaceAll]); - if not ExecuteProgram(prog, PChar(ExtractFileDir(dest)), errmsg) then - WarnFmt(KMN_W_InstallPackage_CannotRunExternalProgram, VarArrayOf([prog, errmsg])); - end; - - { Complete } finally - for i := 0 to FZip.FileCount - 1 do - DeleteFileCleanAttr(FTempOutPath + FZip.FileName[i]); // I4574 - RemoveDir(Copy(FTempOutPath, 1, Length(FTempOutPath)-1)); FZip.Free; - inf.Free; + RemoveDir(Copy(FTempOutPath, 1, Length(FTempOutPath)-1)); end; finally Context.Control.AutoApply := FAutoApply;