diff --git a/pkgtool.pm~ b/pkgtool.pm~ deleted file mode 100644 index d884054..0000000 --- a/pkgtool.pm~ +++ /dev/null @@ -1,3627 +0,0 @@ -package pkgtool; - -use strict; - -require Exporter; -@pkgtool::ISA = qw(Exporter); -@pkgtool::EXPORT = qw( - get_cfg_syntax - get_hostname - get_default_dnsdomain - read_installed_patches - read_installed_packages - read_present_devices - read_installed_infs - scan_package_dirs - scan_driver_dir - handle_pkg - get_install_sets -); - -use logging; -use cfgparser; -use sysinfo; - -use Symbol 'gensym'; -use Cwd; -use Fcntl qw(:DEFAULT :mode);; -use File::Spec; -use Sys::Hostname; -use IPC::Open3; -use Win32; -use Win32::File; -use Win32::IPConfig; -use Win32::API; -use Win32::TieRegistry; -use Win32::File::VersionInfo; -use Win32API::File qw(:Func :Misc :FILE_SHARE_ :GENERIC_); -use LWP::UserAgent; - -my $driver_syntax = { - Type => 'map', - Elements => { - Type => 'struct', - Check => \&check_cfg_drvdef, - Keywords => { - 'description' => { - Type => 'string', - Mandatory => 1 - }, - 'inf-file' => { - Type => 'string', - Mandatory => 1 - }, - 'cert-file' => { - Type => 'string' - }, - 'device-filter' => { - Type => 'list', - Mandatory => 1, - Elements => { - Type => 'struct', - Keywords => { - 'bus' => { - Type => 'string', - Mandatory => 1 - }, - 'device' => { - Type => 'string', - Mandatory => 1 - } - } - } - } - } - } -}; - -my $pkgdef_syntax = { - Type => 'map', - Elements => { - Type => 'struct', - Check => \&check_cfg_pkgdef, - Keywords => { - 'description' => { - Type => 'string', - Mandatory => 1 - }, - 'source-directory' => { - Type => 'string', - Mandatory => 1 - }, - 'user-product' => { - Type => 'integer' - }, - 'available' => { - Type => 'string' - }, - 'patching-version' => { - Type => 'string' - }, - 'install-check' => { - Type => 'string' - }, - 'match' => { - Type => 'list', - Elements => { - Type => 'struct', - Keywords => { - 'expression' => { - Type => 'string', - Mandatory => 1 - } - } - } - }, - 'version-source' => { - Type => 'string' - }, - 'extract-version-field' => { - Type => 'integer' - }, - 'extract-version-regex' => { - Type => 'string' - }, - 'extract-version' => { - Type => 'list', - Elements => { - Type => 'struct', - Check => \&check_cfg_extract_step, - Keywords => { - 'type' => { - Type => 'string', - Mandatory => 1 - }, - 'variable' => { - Type => 'string' - }, - 'expression' => { - Type => 'string' - } - } - } - }, - 'match-version-condition' => { - Type => 'string' - }, - 'match-version' => { - Type => 'string' - }, - 'install' => { - Type => 'list', - Elements => { - Type => 'struct', - Check => \&check_cfg_install_step, - Keywords => { - 'type' => { - Type => 'string', - Mandatory => 1 - }, - 'condition' => { - Type => 'string' - }, - 'ignore-failure' => { - Type => 'integer' - }, - 'background' => { - Type => 'integer' - }, - 'recurse' => { - Type => 'integer' - }, - 'chdir' => { - Type => 'string' - }, - 'variable' => { - Type => 'string' - }, - 'filename' => { - Type => 'string' - }, - 'expression' => { - Type => 'string' - }, - 'source-file' => { - Type => 'string' - }, - 'target-file' => { - Type => 'string' - }, - 'parameters' => { - Type => 'list', - Elements => { - Type => 'string' - } - } - } - } - }, - 'remove' => { - Type => 'list', - Elements => { - Type => 'struct', - Check => \&check_cfg_remove_step, - Keywords => { - 'type' => { - Type => 'string', - Mandatory => 1 - }, - 'condition' => { - Type => 'string' - }, - 'ignore-failure' => { - Type => 'integer' - }, - 'background' => { - Type => 'integer' - }, - 'recurse' => { - Type => 'integer' - }, - 'chdir' => { - Type => 'string' - }, - 'variable' => { - Type => 'string' - }, - 'filename' => { - Type => 'string' - }, - 'expression' => { - Type => 'string' - }, - 'source-file' => { - Type => 'string' - }, - 'target-file' => { - Type => 'string' - }, - 'parameters' => { - Type => 'list', - Elements => { - Type => 'string' - } - } - } - } - }, - 'remove-parameters' => { - Type => 'list', - Elements => { - Type => 'string' - } - }, - 'package-versions' => { - Type => 'map', - Elements => { - Type => 'or', - Options => [{ - Type => 'string' - }, { - Type => 'struct', - Check => \&check_cfg_pkg_version_struct, - Keywords => { - 'type' => { - Type => 'string', - Mandatory => 1 - }, - 'expression' => { - Type => 'string' - } - } - }] - } - } - } - } -}; - -my $patchdef_syntax = { - Type => 'map', - Elements => { - Type => 'struct', - Keywords => { - 'description' => { - Type => 'string', - Mandatory => 1 - }, - 'base-directory' => { - Type => 'string', - Mandatory => 1 - }, - 'available' => { - Type => 'string' - }, - 'patches' => { - Type => 'list', - Mandatory => 1, - Elements => { - Type => 'struct', - Check => \&check_cfg_patchdef, - Keywords => { - 'source-directory' => { - Type => 'string', - Mandatory => 1 - }, - 'source-file' => { - Type => 'string' - }, - 'available' => { - Type => 'string' - }, - 'chdir' => { - Type => 'string', - }, - 'packages' => { - Type => 'list', - Elements => { - Type => 'string' - } - }, - 'kb' => { - Type => 'list', - Mandatory => 1, - Elements => { - Type => 'string' - } - }, - 'style' => { - Type => 'string', - Mandatory => 1 - }, - 'kbname' => { - Type => 'string' - }, - 'prefix' => { - Type => 'string' - }, - 'edition' => { - Type => 'string' - }, - 'arch' => { - Type => 'string' - }, - 'suffix' => { - Type => 'string' - }, - 'parameters' => { - Type => 'list', - Elements => { - Type => 'string' - } - } - } - } - } - } - } -}; - -my $driver_cfg_syntax = { - Type => 'struct', - Keywords => { - 'driver' => $driver_syntax, - } -}; - -my $pkgdef_cfg_syntax = { - Type => 'struct', - Keywords => { - 'base-directory' => { - Type => 'string', - }, - 'available' => { - Type => 'string' - }, - 'package-def' => $pkgdef_syntax, - 'patch-def' => $patchdef_syntax - } -}; - -my $global_cfg_syntax = { - Type => 'struct', - Keywords => { - 'install-server' => { - Type => 'string', - Mandatory => 1 - }, - 'install-share' => { - Type => 'string', - Mandatory => 1 - }, - 'install-path' => { - Type => 'string', - Mandatory => 1 - }, - 'log-directory' => { - Type => 'string', - Mandatory => 1 - }, - 'generic-msi-parameters' => { - Type => 'list', - Elements => { - Type => 'string' - } - }, - 'generic-variables' => { - Type => 'list', - Elements => { - Type => 'struct', - Keywords => { - 'variable' => { - Type => 'string', - Mandatory => 1 - }, - 'expression' => { - Type => 'string', - Mandatory => 1 - } - } - } - - }, - 'logging' => { - Type => 'list', - Elements => { - Type => 'struct', - Keywords => { - 'type' => { - Type => 'string', - Mandatory => 1, - }, - 'channel' => { - Type => 'map', - Mandatory => 1, - Elements => { - Type => 'string' - } - }, - 'path' => { - Type => 'string' - }, - 'rotate' => { - Type => 'struct', - Keywords => { - 'name' => { - Type => 'string', - Mandatory => 1, - }, - 'max-kb' => { - Type => 'integer' - }, - 'max-num' => { - Type => 'integer' - } - } - } - } - } - }, - 'scan' => { - Type => 'struct', - Keywords => { - 'filename' => { - Type => 'string', - Mandatory => 1 - }, - 'max-depth' => { - Type => 'integer' - }, - 'directories' => { - Type => 'list', - Mandatory => 1, - Elements => { - Type => 'string' - } - } - } - }, - 'drivers' => { - Type => 'struct', - Keywords => { - 'filename' => { - Type => 'string', - Mandatory => 1 - } - } - }, - 'mbr-drive' => { - Type => 'string' - }, - 'package-sets' => { - Type => 'map', - Elements => { - Type => 'list', - Elements => { - Type => 'string' - } - } - }, - 'packages' => { - Type => 'list', - Mandatory => 1, - Elements => { - Type => 'struct', - Keywords => { - 'name' => { - Type => 'string', - Mandatory => 1 - }, - 'condition' => { - Type => 'string' - }, - 'mbr-source-file' => { - Type => 'string' - }, - 'driver-directory' => { - Type => 'string' - }, - 'remove-version' => { - Type => 'string' - }, - 'install-version' => { - Type => 'string' - }, - 'patch-packages' => { - Type => 'list', - Elements => { - Type => 'string' - } - }, - 'directory' => { - Type => 'string' - }, - 'acls' => { - Type => 'list', - Elements => { - Type => 'list', - Elements => { - Type => 'string' - } - } - }, - 'user' => { - Type => 'string' - }, - 'password' => { - Type => 'string' - }, - 'fullname' => { - Type => 'string' - }, - 'pwexpires' => { - Type => 'string' - }, - 'pwchange' => { - Type => 'integer' - }, - 'deleted' => { - Type => 'integer' - }, - 'enabled' => { - Type => 'integer' - }, - 'filename' => { - Type => 'string' - }, - 'max-depth' => { - Type => 'integer' - } - } - } - } - } -}; - -sub get_cfg_syntax () -{ - return $global_cfg_syntax; -} - -#$Registry->Delimiter('/'); -$Registry->ArrayValues(1); - -sub get_hostname () -{ - return hostname(); -} - -sub get_default_dnsdomain () -{ - my $hostname = get_hostname(); - return undef unless defined $hostname; - my $ipconfig = Win32::IPConfig->new($hostname); - return undef unless defined $ipconfig; - my $found; - foreach my $adapter ($ipconfig->get_adapters()) { - my $domain = $adapter->get_domain(); - next unless defined $domain; - $found = $domain; - last; - } - return $found; -} - -sub get_registry_value ($) -{ - my ($node) = @_; - - my $value = $$node[0]; - return undef unless defined $value; - my $type = $$node[1]; - if ($type == 4 && $value =~ /^0x[0-9a-f]+$/oi) { - # REG_DWORD - return hex($value); - } - return $value; -} - -sub read_os_patches ($$) -{ - my ($patches, $registry) = @_; - - foreach my $name ($registry->SubKeyNames) { - my $sub = $registry->{$name}; - next unless defined $sub; - my $installname = get_registry_value($sub->{'InstallName'}); - my $installclient = get_registry_value($sub->{'InstallClient'}); - my $state = get_registry_value($sub->{'CurrentState'}); - next unless defined $installname && defined $installclient; - next unless $installname =~ /^[^~]*KB(\d[0-9a-zA-Z]+)~/o; - my $original = $installclient eq 'DISM Package Manager Provider'; - my $update = $installclient eq 'WindowsUpdateAgent'; - next unless $original || $update; - my $kb = $1; - my $number = $kb =~ /^(\d+)/o ? $1 : $kb; - my $p = $$patches{$kb}; - if (! defined $p) { - $p = $$patches{$kb} = { - Type => 'OS', - Packages => { OS => 1 }, - InstallName => $name, - InstallClient => $installclient, - Original => $original, - Update => $update, - KB => $kb, - Number => $number, - Current => 0, - Flags => 0 - }; - } - if (defined $state) { - $$p{Flags} |= $state; - $$p{Current} = 1 if $state & 0x20; - } - } -} - -sub xread_pkg_patches ($$) -{ - my ($patches, $registry) = @_; - - foreach my $pkgname ($registry->SubKeyNames) { - my $pkg = $registry->{$pkgname}; - next unless defined $pkg; - foreach my $kbname ($pkg->SubKeyNames) { - next unless defined $kbname && $kbname =~ /KB(\d[0-9a-zA-Z]+)/o; - my $kb =$1; - my $sub = $pkg->{$kbname}; - next unless defined $sub; - my $installername = get_registry_value($sub->{'InstallerName'}); - my $state = get_registry_value($sub->{'ThisVersionInstalled'}); - my $update = defined $installername && $installername eq 'Windows Installer'; - my $number = $kb =~ /^(\d+)/o ? $1 : $kb; - my $p = $$patches{$kb}; - if (! defined $p) { - $p = $$patches{$kb} = { - Type => 'Package', - Packages => {}, - InstallClient => $installername, - Original => ! $update, - Update => $update, - KB => $kb, - Number => $number, - Flags => 0 - }; - } - ${$$p{Packages}}{$pkgname} = 1; - if (defined $state && $state eq 'Y') { - $$p{Flags} |= 0x20; - $$p{Current} = 1; - } - } - } -} - -sub read_pkg_patches ($$) -{ - my ($patches, $registry) = @_; - - foreach my $id ($registry->SubKeyNames) { - my $pkg = $registry->{$id}; - next unless defined $pkg; - my $props = $pkg->{'InstallProperties'}; - next unless defined $props; - my $regpatches = $pkg->{'Patches'}; - next unless defined $regpatches; - my $pkgname = get_registry_value($props->{'DisplayName'}); - next unless defined $pkgname; - foreach my $patchid ($regpatches->SubKeyNames) { - my $patch = $regpatches->{$patchid}; - next unless defined $patch; - my $dispname = get_registry_value($patch->{'DisplayName'}); - my $url = get_registry_value($patch->{'MoreInfoURL'}); - my $kb; - if (defined $dispname && $dispname =~ /KB(\d[0-9a-zA-Z]+)/o) { - $kb = $1; - } - elsif (defined $url && $url =~ /^http.*\/kb\/(\d[0-9a-zA-Z]+)$/o) { - $kb = $1; - } - else { - next; - } - my $state = get_registry_value($patch->{'State'}); - my $number = $kb =~ /^(\d+)/o ? $1 : $kb; - my $p = $$patches{$kb}; - if (! defined $p) { - $p = $$patches{$kb} = { - Type => 'Package', - Packages => {}, - Original => 0, - Update => 1, - KB => $kb, - Number => $number, - Current => 0, - Flags => 0 - }; - } - ${$$p{Packages}}{$pkgname} = 1; - if (defined $state && $state =~ /^1$/o) { - $$p{Flags} |= 0x20; - $$p{Current} = 1; - } - } - } -} - -sub read_packages ($$$$) -{ - my ($packages, $registry, $wow6432, $userdata) = @_; - - foreach my $name ($registry->SubKeyNames) { - my $sub = $registry->{$name}; - next unless defined $sub; - if ($userdata) { - $sub = $sub->{'InstallProperties'}; - next unless defined $sub; - } - my $pub = get_registry_value($sub->{'Publisher'}); - my $dispname = get_registry_value($sub->{'DisplayName'}); - my $dispver = get_registry_value($sub->{'DisplayVersion'}); - my $instdate = get_registry_value($sub->{'InstallDate'}); - my $instloc = get_registry_value($sub->{'InstallLocation'}); - my $syscomp = get_registry_value($sub->{'SystemComponent'}); - my $parentkeyname = get_registry_value($sub->{'ParentKeyName'}); - my $wininst = get_registry_value($sub->{'WindowsInstaller'}); - my $reltype = get_registry_value($sub->{'ReleaseType'}); - my $uninst = get_registry_value($sub->{'UninstallString'}); - my $quninst = get_registry_value($sub->{'QuietUninstallString'}); -# next if defined $syscomp && $syscomp && ! $userdata; - next if defined $parentkeyname; - - my $winid; - if ($name =~ /^\{([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])-([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])-([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])-([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])-([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])([0-9A-F])\}$/oi) { - $winid = $8.$7.$6.$5.$4.$3.$2.$1.$12.$11.$10.$9.$16.$15.$14.$13.$18.$17.$20.$19.$22.$21.$24.$23.$26.$25.$28.$27.$30.$29.$32.$31; - } - my $inst = { - Name => $name, - WinID => $winid, - Publisher => $pub, - DisplayName => $dispname, - DisplayVersion =>$dispver, - InstallDate => $instdate, - InstallLocation => $instloc, - SystemComponent => $syscomp, - WindowsInstaller => $wininst, - ReleaseType => $reltype, - Type => $wow6432 ? 'wow6432' : 'normal', - Uninstall => $uninst, - QUninstall => $quninst, - UserPackage => $userdata - }; - $$packages{$name} = $inst; - } -} - -sub get_exe_version ($$) -{ - my ($channel, $path) = @_; - - print_log($channel, DEBUG3, 'Trying to get package version from exe %s', $path); - my $info = GetFileVersionInfo($path); - return undef unless defined $info; - print_log($channel, DEBUG3, 'Found version number %s', $info->{'ProductVersion'}); - return $info->{'ProductVersion'}; -} - -sub read_installed_patches ($) -{ - my ($db) = @_; - - delete $$db{PatchesChanged}; - my $patches = {}; - my $winmajor = get_win_major(); - if ($winmajor >= 6) { - my $cbspatches = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Component Based Servicing\\Packages\\', { Access => 'KEY_READ' }); - if (! defined $cbspatches) { - print_log('global', ERROR, 'Cannot find registry entry: %s', 'HKLM\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Component Based Servicing\\Packages'); - return undef; - } - read_os_patches($patches, $cbspatches); - } -# my $updates = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Updates\\', { Access => 'KEY_READ' }); -# if (! defined $updates) { -# print_log('global', ERROR, 'Cannot find registry entry: %s', 'HKLM\\SOFTWARE\\Microsoft\\Updates'); -# return undef; -# } - my $updates = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Installer\\UserData\\S-1-5-18\\Products\\', { Access => 'KEY_READ' }); - if (! defined $updates) { - print_log('global', ERROR, 'Cannot find registry entry: %s', 'HKLM\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Installer\\UserData\\S-1-5-18\\Products'); - return undef; - } - read_pkg_patches($patches, $updates); - $$db{Patches} = $patches; - return $db; - -} - -sub refresh_installed_patches ($) -{ - my ($db) = @_; - - print_log('global', DEBUG4, 'Refreshing patches'); - if (defined $$db{Patches}) { - return unless defined $$db{PatchesChanged}; - print_log('global', DEBUG1, 'Rereading changed patch database from registry'); - } - read_installed_patches($db); -} - -sub read_installed_packages ($) -{ - my ($db) = @_; - - delete $$db{Changed}; - my $packages = {}; - my $uninst = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' }); - if (! defined $uninst) { - print_log('global', ERROR, 'Cannot find registry entry: %s', 'HKLM\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall'); - return undef; - } - read_packages($packages, $uninst, 0, 0); - $uninst = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' }); - if (defined $uninst) { - read_packages($packages, $uninst, 1, 0); - } - $uninst = $Registry->Open('HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' }); - if (defined $uninst) { - read_packages($packages, $uninst, 0, 0); - } - $uninst = $Registry->Open('HKEY_CURRENT_USER\\Software\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' }); - if (defined $uninst) { - read_packages($packages, $uninst, 1, 0); - } - my $specpackages = {}; - my $products = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Installer\\UserData\\S-1-5-18\\Products\\', { Access => 'KEY_READ' }); - if (defined $products) { - read_packages($specpackages, $products, 0, 1); - } - $products = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Installer\\UserData\\S-1-5-18\\Products\\', { Access => 'KEY_READ' }); - if (defined $products) { - read_packages($specpackages, $products, 1, 1); - } - $$db{Installed} = $packages; - $$db{InstalledSpec} = $specpackages; - return $db; -} - -sub refresh_installed_packages ($) -{ - my ($db) = @_; - - if (defined $$db{Installed}) { - return unless defined $$db{Changed}; - print_log('global', DEBUG1, 'Rereading changed package database from registry'); - } - read_installed_packages($db); -} - -sub read_devices ($$) -{ - my ($devices, $registry) = @_; - - foreach my $busname ($registry->SubKeyNames) { - my $bus = $registry->{$busname}; - next unless defined $bus; - foreach my $devname ($bus->SubKeyNames) { - my $inst = { - Bus => $busname, - Device => $devname - }; - my $device = $busname.'\\'.$devname; - $$devices{$device} = $inst; - } - } -} - -sub read_present_devices ($) -{ - my ($db) = @_; - - my $devices = {}; - my $uninst = $Registry->Open('HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Enum\\', { Access => 'KEY_READ' }); - if (! defined $uninst) { - print_log('global', ERROR, 'Cannot find registry entry: %s', 'HKLM\\SYSTEM\\CurrentControlSet\\Enum'); - return undef; - } - read_devices($devices, $uninst); - $$db{Devices} = $devices; - return $db; -} - -sub read_installed_infs ($) -{ - my ($db) = @_; - - my $directory = $ENV{'SYSTEMROOT'}.'\\Inf'; - my $infs = {}; - print_log('global', DEBUG3, 'Scanning directory %s for .INF files', $directory); - if (! opendir(DIR, $directory)) { - print_log('global', ERROR, 'Cannot read directory %s: %s', $directory, $!); - return undef; - } - while (1) { - my $name = readdir(DIR); - last unless defined $name; - next if $name eq '.' || $name eq '..'; - next unless $name =~ /\.inf$/io; - my $path = $directory.'\\'.$name; - my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size) = stat($path); - if (! defined $size) { - print_log('global', INFO, 'Cannot read .INF file size for %s: %s', $path, $!); - next; - } - my $inf = { - Path => $path, - Filename => $name, - Size => $size - }; - $$infs{$path} = $inf; - print_log('global', DEBUG3, 'Found .INF file %s (%d bytes)', $path, $size); - } - closedir(DIR); - $$db{INFs} = $infs; - return $db; -} - -sub check_cfg_drvdef ($$) -{ - return 1; -} - -sub check_cfg_pkgdef ($$) -{ - my ($install, $label) = @_; - - if (! defined $$install{'install-check'} && ! defined $$install{'match'}) { - print_log('pkg', ERROR, 'Package definition "match" or "install-check" at %s', $label); - return 0; - } - if (! defined $$install{'match-version-condition'} && ! defined $$install{'match-version'}) { - print_log('pkg', ERROR, 'Package definition "match-version" or "match-version-condition" at %s', $label); - return 0; - } - - return 1; -} - -sub check_cfg_patchdef ($$) -{ - my ($patch, $label) = @_; - - my $style = $$patch{style}; - if ($style eq 'exe') { - } - elsif ($style eq 'msu') { - } - elsif ($style eq 'msp') { - } - elsif ($style eq 'cab') { - } - else { - print_log('pkg', ERROR, 'Unknown patch style at %s', $label.': '.$style); - return 0; - } - - return 1; -} - -sub check_cfg_extract_step ($$) -{ - my ($install, $label) = @_; - - my $type = $$install{type}; - - if ($type eq 'setvar') { - if (! defined $$install{'variable'} || $$install{'variable'} eq '') { - print_log('pkg', ERROR, 'Version extraction step missing "variable" at %s', $label); - return 0; - } - if (! defined $$install{'expression'} && ! defined $$install{'filename'}) { - print_log('pkg', ERROR, 'Version extraction step missing "expression" or "filename" at %s', $label); - return 0; - } - } - else { - print_log('pkg', ERROR, 'Unknown install step type at %s', $label.': '.$type); - return 0; - } - - return 1; -} - -sub check_cfg_install_step ($$) -{ - my ($install, $label) = @_; - - my $type = $$install{type}; - - if ($type eq 'setvar') { - if (! defined $$install{'variable'} || $$install{'variable'} eq '') { - print_log('pkg', ERROR, 'Install step missing "variable" at %s', $label); - return 0; - } - if (! defined $$install{'expression'} && ! defined $$install{'filename'}) { - print_log('pkg', ERROR, 'Install step missing "expression" or "filename" at %s', $label); - return 0; - } - } - elsif ($type eq 'msi') { - if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'msp') { - if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'run') { - if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'file') { - if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label); - return 0; - } - if (! defined $$install{'target-file'} || $$install{'target-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "target-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'delete-file') { - if (! defined $$install{'target-file'} || $$install{'target-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "target-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'delete-dir') { - if (! defined $$install{'target-file'} || $$install{'target-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "target-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'reg') { - if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') { - print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'remove-pkg') { - } - else { - print_log('pkg', ERROR, 'Unknown install step type at %s', $label.': '.$type); - return 0; - } - - return 1; -} - -sub check_cfg_remove_step ($$) -{ - my ($remove, $label) = @_; - - my $type = $$remove{type}; - - if ($type eq 'setvar') { - if (! defined $$remove{'variable'} || $$remove{'variable'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "variable" at %s', $label); - return 0; - } - if (! defined $$remove{'expression'} && ! defined $$remove{'filename'}) { - print_log('pkg', ERROR, 'Remove step missing "expression" or "filename" at %s', $label); - return 0; - } - } - elsif ($type eq 'msi') { - if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'run') { - if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'file') { - if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label); - return 0; - } - if (! defined $$remove{'target-file'} || $$remove{'target-file'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "target-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'delete-file') { - if (! defined $$remove{'target-file'} || $$remove{'target-file'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "target-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'delete-dir') { - if (! defined $$remove{'target-file'} || $$remove{'target-file'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "target-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'reg') { - if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') { - print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label); - return 0; - } - } - elsif ($type eq 'remove-pkg') { - } - else { - print_log('pkg', ERROR, 'Unknown remove step type at %s', $label.': '.$type); - return 0; - } - - return 1; -} - -sub check_cfg_pkg_version_struct ($$) -{ - my ($option, $label) = @_; - - my $type = $$option{type}; - - if ($type eq 'expression') { - if (! defined $$option{'expression'}) { - print_log('pkg', ERROR, 'Package version option missing "expression" at %s', $label); - return 0; - } - } - else { - print_log('pkg', ERROR, 'Unknown package version option type at %s', $label.': '.$type); - return 0; - } - - return 1; -} - -sub evaluate_expression ($$$$) -{ - my ($channel, $vars, $inst, $expression) = @_; - - my $value = eval $expression; - my $error = $@; - if (defined $error && $error ne '') { - $error =~ s/\r?\n[ \t]*$//os; - $error =~ s/\r?\n[ \t]*/ /gos; - return (undef, $error); - } - return ($value, undef); -} - -sub check_condition ($$$) -{ - my ($channel, $vars, $condition) = @_; - - my ($value, $error) = evaluate_expression($channel, $vars, {}, $condition); - - if (defined $error && $error ne '') { - return (undef, sprintf('Evaluating condition expression %s failed: %s', - $condition, $error)); - } - print_log($channel, DEBUG2, 'Condition expression result: %s', defined $value ? $value : ''); - return (defined $value && $value ? 1 : 0); -} - -sub match_package_version ($$$$) -{ - my ($def, $inst, $instver, $desired) = @_; - - my $vars = { - pkgversion => $desired - }; - my $matchvercond = $$def{'match-version-condition'}; - my $matchversion = $$def{'match-version'}; - if (defined $matchvercond) { - my ($value, $error) = evaluate_expression('global', $vars, { version => $instver }, $matchvercond); - - if (defined $error && $error ne '') { - print_log('global', WARNING, 'Evaluating version match condition expression %s failed: %s', - $matchvercond, $error); - return 0; - } - print_log('global', DEBUG2, 'Version match condition expression result: %s', defined $value ? $value : ''); - return 1 if defined $value && $value; - } - else { - my $matchversubst = substitute_variables($vars, $matchversion, 0); - - return 1 if $instver =~ /^${matchversubst}$/i; - } - - return 0; -} - -sub set_extract_var ($$$$$) -{ - my ($channel, $vars, $inst, $varname, $expression) = @_; - - my ($value, $error) = evaluate_expression($channel, $vars, $inst, $expression); - - if (defined $error && $error ne '') { - return sprintf('Evaluating variable %s expression %s failed: %s', - $varname, $expression, $error); - } - print_log($channel, DEBUG3, 'Expression result: %s', defined $value ? $value : ''); - if (defined $value) { - $$vars{$varname} = $value; - } - else { - delete $$vars{$varname}; - } - return undef; -} - -sub extract_package_version ($$$$$) -{ - my ($channel, $def, $inst, $basedir, $config) = @_; - - my $dispname = $$inst{DisplayName}; - return undef unless defined $dispname; - my $dispver = $$inst{DisplayVersion}; - $dispver = defined $dispver && $dispver ne '' ? ' ('.$dispver.')' : ''; - print_log($channel, DEBUG3, 'Extracting version number for %s%s', $dispname, $dispver); - - my $extractsteps = $$def{'extract-version'}; - if (defined $extractsteps) { - my $vars = get_default_vars($config); - my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, 'pkg'); - $$vars{appdir} = $appdir; - - my $i = 0; - foreach my $step (@$extractsteps) { - my $type = $$step{type}; - $i++; - print_log($channel, DEBUG3, 'Extract step #%d type %s', $i, $type); - - my $error; - if ($type eq 'setvar') { - my $varname = $$step{variable}; - my $expression = $$step{expression}; - print_log($channel, DEBUG3, 'Evaluating variable %s expression %s in step #%d', - $varname, $expression, $i); - $error = set_extract_var($channel, $vars, $inst, $varname, $expression); - } - if (defined $error) { - print_log($channel, ERROR, 'Version extraction failed in step #%d: %s', $i, $error); - return undef; - } - my $pkgversion = $$vars{pkgversion}; - return $pkgversion if defined $pkgversion && $pkgversion ne ''; - } - print_log($channel, DEBUG3, 'No steps resulted in valid package version'); - } - - my $sourcename = $$def{'version-source'}; - $sourcename = 'DisplayVersion' unless defined $sourcename; - my $sourcever = $$inst{$sourcename}; - if (! defined $sourcever) { - print_log($channel, DEBUG3, 'No package version source empty'); - return undef; - } - print_log($channel, DEBUG3, 'Source version number field %s: %s', $sourcename, $sourcever); - my $extract = $$def{'extract-version-regex'}; - if (defined $extract) { - my $field = $$def{'extract-version-field'}; - $field = 1 unless defined $field && $field =~ /^\d+$/o; - print_log($channel, DEBUG3, 'Extracting with regex "%s" from match %s', $extract, $field); - $field-- if $field > 0; - my $results = [$sourcever =~ /^${extract}$/]; - my $result = $$results[$field]; - $sourcever = $result if defined $result; - } - print_log($channel, DEBUG3, 'Result: %s', $sourcever); - return $sourcever; -} - -sub match_package_def ($$$) -{ - my ($def, $inst, $vars) = @_; - - my $dispname = $$inst{DisplayName}; - return 0 unless defined $dispname; - my $dispver = $$inst{DisplayVersion}; - $dispver = defined $dispver && $dispver ne '' ? ' ('.$dispver.')' : ''; - - print_log('global', DEBUG4, 'Trying to match package %s%s%s%s to definition %s', - $dispname, - defined $$inst{SystemComponent} ? ' SC='.$$inst{SystemComponent} : '', - defined $$inst{WindowsInstaller} ? ' WI='.$$inst{WindowsInstaller} : '', - $dispver, $$def{description}); - my $matchlist = $$def{'match'}; - foreach my $matchentry (@$matchlist) { - my $expression = $$matchentry{expression}; - my ($value, $error) = evaluate_expression('global', $vars, $inst, $expression); - - if (defined $error && $error ne '') { - print_log('global', DEBUG4, 'Evaluating match expression %s failed: %s', - $expression, $error); - next; - } - print_log('global', DEBUG4, 'Expression result: %s', defined $value ? $value : ''); - return 1 if defined $value && $value; - } - return 0; -} - -sub sort_package ($$) -{ - my ($a, $b) = @_; - - if (! defined $a) { - return 0 unless defined $b; - return 1; - } - return -1 unless defined $b; - - my $auninst = $$a{Uninstall}; - my $aquninst = $$a{QUninstall}; - $auninst = $aquninst if defined $aquninst; - my $buninst = $$b{Uninstall}; - my $bquninst = $$b{QUninstall}; - $buninst = $aquninst if defined $bquninst; - - my $amsi = $auninst =~ /msiexec/io; - my $bmsi = $buninst =~ /msiexec/io; - if (! $amsi) { - return 0 unless defined $bmsi; - return 1; - } - return -1 unless defined $bmsi; - - return $$a{Name} cmp $$b{Name}; -} - -sub sort_packages_to_remove ($) -{ - my ($pkglist) = @_; - - return [sort sort_package @$pkglist]; -} - -sub find_installed_packages ($$$$$$$) -{ - my ($channel, $def, $db, $name, $basedir, $config, $userproduct) = @_; - - my $vars = get_default_vars($config); - set_datetime_vars($vars); - my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, $channel); - $$vars{appdir} = $appdir; - - my $list = []; - if (defined $$def{'match'}) { - refresh_installed_packages($db); - my $installed = $$db{Installed}; - foreach my $instname (sort keys %$installed) { - my $inst = $$installed{$instname}; - next unless defined $inst; - push @$list, $inst if match_package_def($def, $inst, $vars); - } - if ($userproduct) { - my $installed = $$db{InstalledSpec}; - foreach my $instname (sort keys %$installed) { - my $inst = $$installed{$instname}; - next unless defined $inst; - push @$list, $inst if match_package_def($def, $inst, $vars); - } - } - } - elsif (defined $$def{'install-check'}) { - my $check = $$def{'install-check'}; - - print_log($channel, DEBUG2, 'Evaluating install check expression %s', $check); - my ($result, $error) = check_condition($channel, $vars, $check); - if (! defined $result) { - print_log($channel, INFO, 'Ignoring package %s install check: %s', $name, $error); - next; - } - print_log($channel, INFO, 'Package %s install check: %s', $name, ($check ? 'found' : 'not found')); - if ($check) { - push @$list, { - DisplayName => $$def{description} - }; - } - } - else { - print_log($channel, ERROR, 'Invalid package definition %s (neither "match", nor "install-check" defined)', $name); - return undef; - } - return $list; -} - -sub unflag_file ($$) -{ - my ($channel, $path) = @_; - - my $attrs = 0; - if (! Win32::File::GetAttributes($path, $attrs)) { - return 'Cannot read attributes for '.$path; - } - my $newattrs = $attrs & ~(SYSTEM|HIDDEN|READONLY); - return undef if $attrs == $newattrs; - print_log($channel, DEBUG3, 'Trying to clear attributes for %s', $path); - if (! Win32::File::SetAttributes($path, $newattrs)) { - return 'Cannot set attributes for '.$path; - } - return undef; -} - -sub create_directory_for ($$) -{ - my ($channel, $path) = @_; - - $path = File::Spec->canonpath($path); - my ($vol, $dir, $file) = File::Spec->splitpath($path); - $dir =~ s/^\\//o; - $dir =~ s/\\$//o; - my $base = $vol; - foreach my $subdirname (split(/\\/, $dir)) { - $base .= '\\'.$subdirname; - print_log($channel, DEBUG3, 'Checking %s', $base); - next if -d $base; - return sprintf('Cannot create directory %s: %s', $base, $!) - unless mkdir($base); - print_log($channel, DEBUG3, 'Created directory %s', $base); - } - return undef; -} - -sub clear_sub_dir ($$$); - -sub clear_sub_dir ($$$) -{ - my ($channel, $parent, $filename) = @_; - - return sprintf('Cannot read directory %s: %s', $parent, $!) - unless opendir(DIR, $parent); - $filename =~ s/\\/\\\\/o; - $filename =~ s/\./\\\./o; - $filename =~ s/\*/\.\*/o; - $filename =~ s/\?/\.\?/o; - $filename =~ s/\(/\\\(/o; - $filename =~ s/\)/\\\)/o; - my $subdirs = []; - my $files = []; - print_log($channel, DEBUG3, 'Scanning directory %s for %s', $parent, $filename); - while (1) { - my $name = readdir(DIR); - last unless defined $name; - next if $name eq '.' || $name eq '..'; - my $path = $parent.'\\'.$name; - my $matches = $name =~ /^${filename}$/; - print_log($channel, DEBUG3, 'Found %s%s', $path, $matches ? ' - matches' : ''); - next unless $matches; - if (-d $path) { - push @$subdirs, $path; - } - else { - push @$files, $path; - } - } - closedir(DIR); - foreach my $subdir (@$subdirs) { - clear_sub_dir($channel, $subdir, '*'); - print_log($channel, DEBUG3, 'Removing directory %s', $subdir); - my $error = unflag_file($channel, $subdir); - return $error if defined $error; - return sprintf('Cannot remove directory %s: %s', $subdir, $!) - unless rmdir($subdir); - } - foreach my $file (@$files) { - print_log($channel, DEBUG3, 'Removing file %s', $file); - my $error = unflag_file($channel, $file); - return $error if defined $error; - return sprintf('Cannot remove file %s: %s', $file, $!) - unless unlink($file); - } -} - -sub delete_dir_file ($$$$) -{ - my ($direntry, $channel, $recurse, $targetfile) = @_; - - print_log($channel, DEBUG1, 'Deleting %s%s %s', - $direntry ? 'directory' : 'file', $recurse ? ' recursively' : '', $targetfile); - - my $path = File::Spec->canonpath($targetfile); - my ($vol, $dir, $file) = File::Spec->splitpath($path); - if ($file eq '') { - return sprintf('Invalid empty last component in path: %s', $targetfile); - } - $dir =~ s/\\$//o; - clear_sub_dir($channel, $vol.$dir, $file); - return undef; -} - -sub copy_file ($$$) -{ - my ($channel, $sourcefile, $targetfile) = @_; - - print_log($channel, DEBUG1, 'Copying file %s to %s', $sourcefile, $targetfile); - - return sprintf('Cannot open source file %s for copying: %s', $sourcefile, $!) - unless sysopen(SOURCE, $sourcefile, O_RDONLY); - - my $error = create_directory_for($channel, $targetfile); - if (defined $error) { - close(SOURCE); - return $error; - } - if (-f $targetfile) { - $error = unflag_file($channel, $targetfile); - if (defined $error) { - close(SOURCE); - return $error; - } - } - if (! sysopen(TARGET, $targetfile, O_RDWR|O_CREAT|O_TRUNC)) { - $error = sprintf('Cannot create target file %s for copying: %s', $targetfile, $!); - close(SOURCE); - return $error; - } - while (1) { - my $buffer; - my $len = sysread(SOURCE, $buffer, 65536); - if (! defined $len) { - $error = sprintf('Error reading source file %s for copying: %s', $sourcefile, $!); - close(TARGET); - close(SOURCE); - unlink($targetfile); - return $error; - } - last if $len == 0; - my $sofar = 0; - while ($sofar < $len) { - my $done = syswrite(TARGET, $buffer, $len - $sofar, $sofar); - if (! defined $done) { - $error = sprintf('Error writing target file %s for copying: %s', $targetfile, $!); - close(TARGET); - close(SOURCE); - unlink($targetfile); - return $error; - } - last if $done == 0; - $sofar += $done; - } - } - close(TARGET); - close(SOURCE); - return undef; -} - -sub run_exe ($$$$$$$;$) -{ - my ($channel, $db, $vars, $chdir, $program, $paramlist, $bg, $getresult) = @_; - - my $params = ''; - if (defined $paramlist && scalar @$paramlist > 0) { - foreach my $param (@$paramlist) { - $param = substitute_variables($vars, $param, 0, undef, $channel) - if defined $vars && $param =~ /%[^%]*%/o; - $params .= ' '.$param; - } - } - if (defined $chdir) { - print_log($channel, DEBUG1, 'Changing current directory to %s', $chdir); - return (sprintf('Cannot change current directory to %s: %s', $chdir, $!), -1) - unless chdir($chdir); - } - print_log($channel, DEBUG1, 'Running exe %s%s', $program, $params); - - return (sprintf('Cannot find executable file %s: %s', $program, $!), -1) - unless -f $program; - return (sprintf('Cannot dup STDIN: %s', $!), -1) - unless open(IN, '<&STDIN'); - return (sprintf('Cannot dup STDERR: %s', $!), -1) - unless open(ERR, '>&STDERR'); - eval { - my $reader = $bg ? undef : gensym; - my $pid = open3('<&IN', $bg ? '>&ERR' : $reader, $bg ? '>&ERR' : $reader, $program, @$paramlist); - if (defined $db) { - $$db{Changed} = 1; - $$db{PatchesChanged} = 1; - print_log('global', DEBUG4, 'Invalidating packages & patches'); - } - if (! $bg) { - while (<$reader>) { - s/\r?\n$//o; - print_log($channel, INFO, '%s', $_); - push @$getresult, $_ if defined $getresult && ref($getresult) eq 'ARRAY'; - } - } - waitpid($pid, 0) unless $bg; - close($reader) unless $bg; - }; - my $exitcode; - if ($bg) { - $exitcode = 0; - print_log($channel, DEBUG1, 'Leaving process in background'); - } - else { - $exitcode = $? >> 8; - my $signal = $? & 255; - print_log($channel, DEBUG1, 'Exit code: %d, signal: %d', $exitcode, $signal); - } - close(IN); - close(ERR); - return (sprintf('Executable %s exit code: %d', $program, $exitcode), $exitcode) if $exitcode; - return (undef, undef); -} - -sub remove_package_uninstall ($$$$$$$$$) -{ - my ($uninst, $channel, $vars, $paramlist, $dispname, $printver, $db, $counters, $removecontext) = @_; - - $uninst =~ s/(msiexec[^ ]* )\/i/$1\/X/io; - $uninst =~ s/(msiexec[^ ]* )/$1\/qb \/norestart \/passive /io; - print_log($channel, DEBUG2, 'Uninstall command: %s', $uninst); - if (! defined $$removecontext{exename}) { - $$removecontext{exename} = substitute_variables($vars, '%systemroot%/System32/cmd.exe', 1, undef, $channel); - my $params = ''; - if (defined $paramlist && scalar @$paramlist > 0) { - foreach my $param (@$paramlist) { - $param = substitute_variables($vars, $param, 0, undef, $channel) - if $param =~ /%[^%]*%/o; - $params .= ' '.$param; - } - } - $params = ' '.$params unless $params eq ''; - $$removecontext{params} = $params; - } - $uninst .= $$removecontext{params}; - my ($error, $exitcode) = run_exe($channel, $db, $vars, undef, $$removecontext{exename}, ['/C', $uninst], 0); - if (defined $error) { - if (defined $exitcode && $exitcode == 194) { - print_log($channel, INFO, 'Ignoring package %s%s removal exit code: %s', - $dispname, $printver, $exitcode); - $$counters{RebootFlag} = 1; - } - else { - push @{$$counters{FailList}}, $dispname; - $$counters{FailCount}++; - return $error; - } - } - push @{$$counters{RemovedList}}, $dispname; - $$counters{RemovedCount}++; - return undef; -} - -sub remove_package_fallback ($$$$$$$$$$$) -{ - my ($channel, $vars, $paramlist, $inst, $condition, $dispname, $ver, $printver, $db, $counters, $removecontext) = @_; - - print_log($channel, DEBUG1, 'Removing package %s%s%s', $dispname, $printver, - defined $condition ? ' with true condition' : ''); - - my $uninst = $$vars{uninstallstring}; - return sprintf('Cannot remove package %s%s, no remove steps defined and no UninstallString registry entry found', - $dispname, $ver) unless defined $uninst; - return remove_package_uninstall($uninst, $channel, $vars, $paramlist, $dispname, $printver, $db, $counters, $removecontext); -} - -sub remove_package_steps ($$$$$$$$$$$$$$$$) -{ - my ($channel, $removesteps, $paramlist, $inst, $condition, $ver, $printver, - $db, $def, $name, $dispname, $basedir, $genericmsiparams, - $config, $counters, $removecontext) = @_; - - my $version = $ver; - $version = '' unless defined $version; - print_log($channel, INFO, 'Removing package %s version %s', $dispname, $version); - - my $uninst = $$inst{Uninstall}; - my $quninst = $$inst{QUninstall}; - $quninst = $uninst unless defined $quninst; - - my $vars = get_default_vars($config); - set_datetime_vars($vars); - $$vars{pkgname} = $name; - $$vars{pkgdispname} = $dispname; - $$vars{pkgversion} = $version; - $$vars{uninstallstring} = $quninst if defined $quninst; - my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, $channel); - $$vars{appdir} = $appdir; - - my $realremove = 0; - my $i = 0; - foreach my $step (@$removesteps) { - my $type = $$step{type}; - $i++; - print_log($channel, DEBUG2, 'Removal step #%d type %s', $i, $type); - - my $error; - my $exitcode; - my $ignore = $$step{'ignore-failure'}; - $ignore = 0 unless defined $ignore; - - my $condition = $$step{condition}; - if (defined $condition && $type ne 'remove-pkg') { - print_log($channel, DEBUG2, 'Evaluating condition expression %s in step #%d', - $condition, $i); - ($condition, $error) = check_condition($channel, $vars, $condition); - if (! defined $condition) { - print_log($channel, INFO, 'Ignoring step #%d: %s', $i, $error); - next; - } - if (! $condition) { - print_log($channel, INFO, 'Ignoring step #%d with false condition', $i); - next; - } - print_log($channel, INFO, 'Executing step #%d with true condition', $i); - } - - if ($type eq 'remove-pkg') { - my $paramlist = $$step{parameters}; - $paramlist = [] unless defined $paramlist; - $error = remove_package_fallback($channel, $vars, $paramlist, $inst, $condition, $dispname, - $ver, $printver, $db, $counters, $removecontext); - delete $$vars{'installed-version'}; - $realremove = 1 unless defined $error; - } - elsif ($type eq 'run') { - my $bg = defined $$step{background} && $$step{background}; - my $chdir = defined $$step{chdir} ? - substitute_variables($vars, $$step{chdir}, 1, $appdir, $channel) : undef; - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel); - my $paramlist = $$step{parameters}; - $paramlist = [] unless defined $paramlist; - ($error, $exitcode) = run_exe($channel, $db, $vars, $chdir, $sourcefile, $paramlist, $bg); - } - elsif ($type eq 'msi') { - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel); - my $exename = substitute_variables($vars, '%systemroot%/System32/msiexec.exe', 1, undef, $channel); - my $paramlist = $$step{parameters}; - $paramlist = [] unless defined $paramlist; - unshift @$paramlist, '/x', $sourcefile; - if (-f $sourcefile) { - push @$paramlist, @$genericmsiparams if defined $genericmsiparams; - ($error, $exitcode) = run_exe($channel, $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find MSI file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - elsif ($type eq 'reg') { - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel); - my $exename = substitute_variables($vars, '%systemroot%/System32/reg.exe', 1, undef, $channel); - my $paramlist = ['import', $sourcefile]; - if (-f $sourcefile) { - ($error, $exitcode) = run_exe($channel, $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find REG file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - elsif ($type eq 'file') { - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel); - my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1); - $error = copy_file($channel, $sourcefile, $targetfile); - } - elsif ($type eq 'delete-file') { - my $recurse = $$step{recurse}; - $recurse = defined $recurse && $recurse; - my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1); - $error = delete_dir_file(0, $channel, $recurse, $targetfile); - } - elsif ($type eq 'delete-dir') { - my $recurse = $$step{recurse}; - $recurse = defined $recurse && $recurse; - my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1); - $error = delete_dir_file(1, $channel, $recurse, $targetfile); - } - elsif ($type eq 'setvar') { - my $varname = $$step{variable}; - my $expression = $$step{expression}; - my $filename = $$step{filename}; - if (defined $expression) { - print_log($channel, DEBUG2, 'Evaluating variable %s expression %s in step #%d', - $varname, $expression, $i); - $error = set_install_var($channel, $vars, $varname, $expression); - } - else { - print_log($channel, DEBUG2, 'Evaluating variable %s filename %s in step #%d', - $varname, $filename, $i); - my $file = substitute_variables($vars, $filename, 1, $appdir, $channel); - $$vars{$varname} = $file; - } - } - if (defined $error) { - $ignore = 1 if defined $exitcode && ($exitcode == 194 || $exitcode == 63); - if (! $ignore) { - return sprintf('Removal failed in step #%d: %s', $i, $error); - } - print_log($channel, INFO, 'Ignoring failed step #%d: %s', $i, $error); - } - } - - print_log($channel, INFO, 'Finished removing package %s version %s', $dispname, $version); - if (! $realremove) { - push @{$$counters{RemovedList}}, $dispname; - $$counters{RemovedCount}++; - } - return undef; -} - -sub remove_packages ($$$$$$$$$$$$) -{ - my ($channel, $vars, $def, $name, $paramlist, $list, $condition, $db, - $basedir, $genericmsiparams, $config, $counters) = @_; - - my $removecontext = {}; - $list = sort_packages_to_remove($list); - foreach my $inst (@$list) { - my $dispname = $$inst{DisplayName}; - my $ver = extract_package_version($channel, $def, $inst, $basedir, $config); - $ver = $$inst{DisplayVersion} unless defined $ver; - my $printver = defined $ver ? ' ('.$ver.')' : ''; - if (defined $condition) { - $$vars{'installed-version'} = $ver; - - print_log($channel, DEBUG2, 'Evaluating package removal condition expression %s', $condition); - my ($result, $error) = check_condition($channel, $vars, $condition); - if (! defined $result) { - print_log($channel, INFO, 'Ignoring package %s%s: %s', - $dispname, $printver, $error); - next; - } - if (! $result) { - print_log($channel, INFO, 'Ignoring package %s%s with false condition', - $dispname, $printver); - next; - } - } - my $error; - my $removesteps = $$def{remove}; - if (defined $removesteps) { - $error = remove_package_steps($channel, $removesteps, $paramlist, $inst, $condition, $ver, $printver, - $db, $def, $name, $dispname, $basedir, $genericmsiparams, $config, $counters, $removecontext); - } - else { - my $uninst = $$inst{Uninstall}; - my $quninst = $$inst{QUninstall}; - $quninst = $uninst unless defined $quninst; - - my $set = 0; - if (defined $quninst && ! defined $$vars{uninstallstring}) { - $$vars{uninstallstring} = $quninst; - $set =1; - } - $error = remove_package_fallback($channel, $vars, $paramlist, $inst, $condition, $dispname, - $ver, $printver, $db, $counters, $removecontext); - delete $$vars{uninstallstring} if $set; - } - return $error if defined $error; - } - return undef; -} - -sub set_install_var ($$$$) -{ - my ($channel, $vars, $varname, $expression) = @_; - - my ($value, $error) = evaluate_expression($channel, $vars, {}, $expression); - - if (defined $error && $error ne '') { - return sprintf('Evaluating variable %s expression %s failed: %s', - $varname, $expression, $error); - } - print_log($channel, DEBUG2, 'Expression result: %s', defined $value ? $value : ''); - if (defined $value) { - $$vars{$varname} = $value; - } - else { - delete $$vars{$varname}; - } - return undef; -} - -sub remove_package ($$$$$$$$) -{ - my ($db, $def, $name, $list, $basedir, $genericmsiparams, $config, $counters) = @_; - - set_current_pkg_name($name); - - my $vars = get_default_vars($config); - set_datetime_vars($vars); - $$vars{pkgname} = $name; - my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, 'pkg'); - $$vars{appdir} = $appdir; - - my $paramlist = $$def{'remove-parameters'}; - $paramlist = [] unless defined $paramlist; - my $error = remove_packages('pkg', $vars, $def, $name, $paramlist, - [map { $$_[1] } @$list], undef, $db, $basedir, $genericmsiparams, $config, $counters); - print_log('pkg', ERROR, 'Package removal failed: %s', $error) if defined $error; - - set_current_pkg_name(undef); - return defined $error ? 0 : 1; -} - -sub install_package ($$$$$$$$$) -{ - my ($db, $def, $inst, $name, $version, $basedir, $genericmsiparams, $config, $counters) = @_; - - my $installsteps = $$def{install}; - if (! defined $installsteps) { - push @{$$counters{DoneList}}, $name; - $$counters{DoneCount}++; - return 1; - } - - set_current_pkg_name($name); - - print_log('pkg', INFO, 'Installing package %s version %s', $name, $version); - - my $vars = get_default_vars($config); - set_datetime_vars($vars); - $$vars{pkgname} = $name; - $$vars{pkgversion} = $version; - my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, 'pkg'); - $$vars{appdir} = $appdir; - - my $i = 0; - foreach my $step (@$installsteps) { - my $type = $$step{type}; - $i++; - print_log('pkg', DEBUG2, 'Install step #%d type %s', $i, $type); - - my $error; - my $exitcode; - my $ignore = $$step{'ignore-failure'}; - $ignore = 0 unless defined $ignore; - - my $condition = $$step{condition}; - if (defined $condition && $type ne 'remove-pkg') { - print_log('pkg', DEBUG2, 'Evaluating condition expression %s in step #%d', - $condition, $i); - ($condition, $error) = check_condition('pkg', $vars, $condition); - if (! defined $condition) { - print_log('pkg', INFO, 'Ignoring step #%d: %s', $i, $error); - next; - } - if (! $condition) { - print_log('pkg', INFO, 'Ignoring step #%d with false condition', $i); - next; - } - print_log('pkg', INFO, 'Executing step #%d with true condition', $i); - } - - if ($type eq 'remove-pkg') { - my $paramlist = $$step{parameters}; - $paramlist = [] unless defined $paramlist; - my $list = find_installed_packages('pkg', $def, $db, $name, $basedir, $config, 0); - if (defined $list) { - $error = remove_packages('pkg', $vars, $def, $name, $paramlist, $list, $condition, - $db, $basedir, $genericmsiparams, $config, $counters); - delete $$vars{'installed-version'}; - } - else { - $error = 'Invalid package definition'; - } - } - elsif ($type eq 'run') { - my $bg = defined $$step{background} && $$step{background}; - my $chdir = defined $$step{chdir} ? - substitute_variables($vars, $$step{chdir}, 1, $appdir, 'pkg') : undef; - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg'); - my $paramlist = $$step{parameters}; - $paramlist = [] unless defined $paramlist; - ($error, $exitcode) = run_exe('pkg', $db, $vars, $chdir, $sourcefile, $paramlist, $bg); - } - elsif ($type eq 'msi') { - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg'); - my $exename = substitute_variables($vars, '%systemroot%/System32/msiexec.exe', 1, undef, 'pkg'); - my $paramlist = $$step{parameters}; - $paramlist = [] unless defined $paramlist; - unshift @$paramlist, '/i', $sourcefile; - if (-f $sourcefile) { - push @$paramlist, @$genericmsiparams if defined $genericmsiparams; - ($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find MSI file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - elsif ($type eq 'msp') { - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg'); - my $exename = substitute_variables($vars, '%systemroot%/System32/msiexec.exe', 1, undef, 'pkg'); - my $paramlist = $$step{parameters}; - $paramlist = [] unless defined $paramlist; - unshift @$paramlist, '/p', $sourcefile; - if (-f $sourcefile) { - ($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find MSP file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - elsif ($type eq 'reg') { - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg'); - my $exename = substitute_variables($vars, '%systemroot%/System32/reg.exe', 1, undef, 'pkg'); - my $paramlist = ['import', $sourcefile]; - if (-f $sourcefile) { - ($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find REG file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - elsif ($type eq 'file') { - my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg'); - my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1); - $error = copy_file('pkg', $sourcefile, $targetfile); - } - elsif ($type eq 'delete-file') { - my $recurse = $$step{recurse}; - $recurse = defined $recurse && $recurse; - my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1); - $error = delete_dir_file(0, 'pkg', $recurse, $targetfile); - } - elsif ($type eq 'delete-dir') { - my $recurse = $$step{recurse}; - $recurse = defined $recurse && $recurse; - my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1); - $error = delete_dir_file(1, 'pkg', $recurse, $targetfile); - } - elsif ($type eq 'setvar') { - my $varname = $$step{variable}; - my $expression = $$step{expression}; - my $filename = $$step{filename}; - if (defined $expression) { - print_log('pkg', DEBUG2, 'Evaluating variable %s expression %s in step #%d', - $varname, $expression, $i); - $error = set_install_var('pkg', $vars, $varname, $expression); - } - else { - print_log('pkg', DEBUG2, 'Evaluating variable %s filename %s in step #%d', - $varname, $filename, $i); - my $file = substitute_variables($vars, $filename, 1, $appdir, 'pkg'); - $$vars{$varname} = $file; - } - } - if (defined $error) { - $ignore = 1 if defined $exitcode && ($exitcode == 194 || $exitcode == 63); - if (! $ignore) { - print_log('pkg', ERROR, 'Installation failed in step #%d: %s', $i, $error); - set_current_pkg_name(undef); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - print_log('pkg', INFO, 'Ignoring failed step #%d: %s', $i, $error); - } - } - - print_log('pkg', INFO, 'Finished installing package %s version %s', $name, $version); - set_current_pkg_name(undef); - push @{$$counters{InstalledList}}, $name; - $$counters{InstalledCount}++; - return 1; -} - -sub pkgdef_get_desired_version ($$$$$) -{ - my ($config, $name, $base_directory, $def, $version) = @_; - - return undef unless defined $version; - my $versions = $$def{'package-versions'}; - if (defined $versions) { - my $found = $$versions{$version}; - if (defined $found) { - if (ref($found) eq 'HASH') { - my $etype = $$found{type}; - print_log('global', DEBUG4, 'Evaluating desired version %s %s in definition %s', - $etype, $version, $$def{description}); - if ($etype eq 'expression') { - my $vars = get_default_vars($config); - set_datetime_vars($vars); - $$vars{pkgname} = $name; - $$vars{packageversion} = $version; - my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $base_directory, 'pkg'); - $$vars{appdir} = $appdir; - - my $expression = $$found{expression}; - my ($value, $error) = evaluate_expression('global', $vars, $def, $expression); - - if (defined $error && $error ne '') { - print_log('global', DEBUG4, 'Evaluating desired version expression %s failed: %s', - $expression, $error); - return undef; - } - print_log('global', DEBUG4, 'Desired version expression result: %s', defined $value ? $value : ''); - return $value; - } - } - return $found; - } - } - return $version; -} - -sub pkgdef_check_availability ($$$) -{ - my ($def, $name, $config) = @_; - - my $condition = $$def{available}; - return (undef, undef) unless defined $condition; - - print_log('global', DEBUG2, 'Evaluating condition expression %s for package %s', - $condition, $name); - my $vars = get_default_vars($config); - $$vars{pkgname} = $name; - my $error; - ($condition, $error) = check_condition('global', $vars, $condition); - return (undef, $error) unless defined $condition; - return ($condition); -} - -sub patchsetdef_check_availability ($$$) -{ - my ($pdef, $name, $config) = @_; - - my $condition = $$pdef{available}; - return (undef, undef) unless defined $condition; - - print_log('global', DEBUG2, 'Evaluating condition expression %s for patch set %s', - $condition, $name); - my $vars = get_default_vars($config); - $$vars{patchsetname} = $name; - my $error; - ($condition, $error) = check_condition('global', $vars, $condition); - return (undef, $error) unless defined $condition; - return ($condition); -} - -sub patchdef_check_availability ($$$$) -{ - my ($pdef, $patchdef, $name, $config) = @_; - - my $condition = $$patchdef{available}; - return (undef, undef) unless defined $condition; - - print_log('global', DEBUG2, 'Evaluating condition expression %s for patch set %s patches %s', - $condition, $name, join(',', @{$$patchdef{kb}})); - my $vars = get_default_vars($config); - $$vars{patchsetname} = $name; - my $error; - ($condition, $error) = check_condition('global', $vars, $condition); - return (undef, $error) unless defined $condition; - return ($condition); -} - -sub pkg_check_condition ($$$) -{ - my ($pkg, $name, $config) = @_; - - my $condition = $$pkg{condition}; - return (undef, undef) unless defined $condition; - - print_log('global', DEBUG2, 'Evaluating condition expression %s for package/patch %s', - $condition, $name); - my $vars = get_default_vars($config); - $$vars{pkgname} = $name; - my $error; - ($condition, $error) = check_condition('global', $vars, $condition); - return (undef, $error) unless defined $condition; - return ($condition); -} - -sub scan_package_dir ($$$$); - -sub scan_package_dir ($$$$) -{ - my ($config, $dir, $maxdepth, $filename) = @_; - - print_log('global', DEBUG1, 'Scanning package directory %s for %d levels', $dir, $maxdepth); - - if (! opendir(DIR, $dir)) { - print_log('global', ERROR, 'Cannot scan directory %s', $dir); - return 1; - } - my $subdirs = []; - my $files = []; - while (1) { - my $name = readdir(DIR); - last unless defined $name; - next if $name eq '.' || $name eq '..'; - my $path = $dir.'\\'.$name; - push @$subdirs, $path if $maxdepth > 0 && -d $path; - push @$files, $path if $name eq $filename; - } - closedir(DIR); - - $maxdepth--; - foreach my $path (@$subdirs) { - my $error = scan_package_dir($config, $path, $maxdepth, $filename); - return $error if defined $error; - } - - my $pkgdefs = $$config{'package-def'}; - my $patchdefs = $$config{'patch-def'}; - foreach my $path (@$files) { - print_log('global', DEBUG1, 'Found package definition file %s', $path); - my $addconfig = parse_cfg_file($path, $pkgdef_cfg_syntax); - return 1 unless defined $addconfig; - my $addpkgdefs = $$addconfig{'package-def'}; - if (defined $addpkgdefs) { - foreach my $key (keys %$addpkgdefs) { - my $def = $$addpkgdefs{$key}; - $pkgdefs = $$config{'package-def'} = {} unless defined $pkgdefs; - if (defined $$pkgdefs{$key}) { - print_log('global', WARNING, 'Found package re-definition for %s in file %s', $key, $path); - next; - } - $$def{'definition-directory'} = $dir; - $$pkgdefs{$key} = $def; - print_log('global', DEBUG3, 'Found package definition for %s (%s) in file %s', $key, $$def{description}, $path); - } - } - my $addpatchdefs = $$addconfig{'patch-def'}; - if (defined $addpatchdefs) { - foreach my $key (keys %$addpatchdefs) { - my $def = $$addpatchdefs{$key}; - $patchdefs = $$config{'patch-def'} = {} unless defined $patchdefs; - if (defined $$patchdefs{$key}) { - print_log('global', WARNING, 'Found patch set re-definition for %s in file %s', $key, $path); - next; - } - $$def{'definition-directory'} = $dir; - $$patchdefs{$key} = $def; - print_log('global', DEBUG3, 'Found patch set definition for %s (%s) in file %s', $key, $$def{description}, $path); - } - } - } - - return undef; -} - -sub scan_package_dirs ($$) -{ - my ($config, $basedir) = @_; - - my $scan = $$config{scan}; - return undef unless defined $scan; - - my $filename = $$scan{filename}; - my $maxdepth = $$scan{'max-depth'}; - my $dirs = $$scan{directories}; - return undef unless defined $filename && defined $dirs; - $maxdepth = 1 unless defined $maxdepth; - - print_log('global', INFO, 'Scanning package directories'); - - my $vars = get_default_vars($config); - foreach my $dir (@$dirs) { - my $scandir = substitute_variables($vars, $dir, 1, $basedir, 'global'); - my $error = scan_package_dir($config, $scandir, $maxdepth, $filename); - return $error if defined $error; - } - return undef; -} - -sub scan_driver_subdir ($$$$$); - -sub scan_driver_subdir ($$$$$) -{ - my ($config, $drvconfig, $dir, $maxdepth, $filename) = @_; - - print_log('global', DEBUG1, 'Scanning driver directory %s for %d levels', $dir, $maxdepth); - - if (! opendir(DIR, $dir)) { - print_log('global', INFO, 'Cannot scan directory %s', $dir); - return undef; - } - my $subdirs = []; - my $files = []; - while (1) { - my $name = readdir(DIR); - last unless defined $name; - next if $name eq '.' || $name eq '..'; - my $path = $dir.'\\'.$name; - push @$subdirs, $path if $maxdepth > 0 && -d $path; - push @$files, $path if $name eq $filename; - } - closedir(DIR); - - $maxdepth--; - foreach my $path (@$subdirs) { - my $error = scan_driver_subdir($config, $drvconfig, $path, $maxdepth, $filename); - return $error if defined $error; - } - - my $drvdefs = $$drvconfig{'driver'}; - foreach my $path (@$files) { - print_log('global', DEBUG1, 'Found driver definition file %s', $path); - my $addconfig = parse_cfg_file($path, $driver_cfg_syntax); - return 1 unless defined $addconfig; - my $adddrvdefs = $$addconfig{'driver'}; - if (defined $adddrvdefs) { - foreach my $key (keys %$adddrvdefs) { - my $def = $$adddrvdefs{$key}; - $drvdefs = $$drvconfig{'driver'} = {} unless defined $drvdefs; - if (defined $$drvdefs{$key}) { - print_log('global', WARNING, 'Found driver re-definition for %s in file %s', $key, $path); - next; - } - $$def{'definition-directory'} = $dir; - $$drvdefs{$key} = $def; - print_log('global', DEBUG3, 'Found driver definition for %s (%s) in file %s', $key, $$def{description}, $path); - } - } - } - - return undef; -} - -sub scan_driver_dir ($$$) -{ - my ($config, $basedir, $drvconfig) = @_; - - my $filename = $$drvconfig{'filename'}; - my $maxdepth = $$drvconfig{'max-depth'}; - my $dir = $$drvconfig{'driver-directory'}; - return undef unless defined $filename && defined $dir; - - print_log('global', INFO, 'Scanning driver directory %s', $dir); - - my $vars = get_default_vars($config); - my $scandir = substitute_variables($vars, $dir, 1, $basedir, 'global'); - return scan_driver_subdir($config, $drvconfig, $scandir, $maxdepth, $filename); -} - -sub match_package_version_for_processing ($$$) -{ - my ($instver, $op, $ver) = @_; - - return 1 if $op eq '*'; - return $instver eq $ver if $op eq '='; - if ($op eq '~') { - return 0 unless substr($instver, 0, length($ver)) eq $ver; - return length($instver) == length($ver) || - substr($instver, length($ver), 1) =~ /^[^0-9]$/o; - } - my $splitinstver = [split(/\./, $instver)]; - my $splitremovever = [split(/\./, $ver)]; - while (1) { - my $a = shift @$splitinstver; - my $b = shift @$splitremovever; - $a = '' unless defined $a; - $b = '' unless defined $b; - my $rc = $a =~ /^\d+$/o && $b =~ /^\d+$/o ? $a <=> $b : $a cmp $b; - return $op =~ /^/o if $rc > 0; - } - return $op =~ /=$/o; -} - -sub assess_pkg ($$$$$$$$) -{ - my ($config, $base_directory, $db, $name, $desired, $remove, $def, $update) = @_; - - my $removeop; - my $removever; - if (defined $remove) { - my $removeversion = pkgdef_get_desired_version($config, $name, $base_directory, $def, $remove); - $remove = $removeversion if defined $removeversion; - if ($remove =~ /^(\*|<|>|<=|>=|=|~)(.*)$/o) { - $removeop = $1; - $removever = $2; - } - else { - $removeop = '~'; - $removever = $remove; - } - } - my $patching = $$def{'patching-version'}; - my $patchingop; - my $patchingver; - if (defined $patching) { - my $patchingversion = pkgdef_get_desired_version($config, $name, $base_directory, $def, $patching); - $patching = $patchingversion if defined $patchingversion; - if ($patching =~ /^(\*|<|>|<=|>=|=|~)(.*)$/o) { - $patchingop = $1; - $patchingver = $2; - } - else { - $patchingop = '~'; - $patchingver = $patching; - } - } - my $list = find_installed_packages('global', $def, $db, $name, $base_directory, $config, 0); - return (undef, undef, undef) unless defined $list; - my $found; - my $foundtopatch = defined $patching ? [] : undef; - my $toinstall; - my $toremove = []; - if (scalar @$list > 0) { - my $ok = 0; - my $instlist = []; - foreach my $inst (@$list) { - my $instver = extract_package_version('global', $def, $inst, - $base_directory, $config); - next unless defined $instver; - push @$instlist, $instver; - if (defined $desired && - match_package_version($def, $inst, $instver, $desired)) { - $found = $inst; - $ok = 1; - } - if (defined $foundtopatch && - match_package_version_for_processing($instver, $patchingop, $patchingver)) { - push @$foundtopatch, [$instver, $inst]; - } - if (defined $removever && - match_package_version_for_processing($instver, $removeop, $removever)) { - push @$toremove, [$instver, $inst]; - } - } - my $todo = ''; - my $param = ''; - my $rtodo = ''; - my $rparam = ''; - if (scalar @$toremove > 0) { - $rtodo = $update ? ' - removing version ' : ' REMOVE '; - $rparam = join(', ', sort map { $$_[0] } @$toremove); - } - if ($ok) { - $todo = ' OK' if $rtodo eq ''; - } - elsif (! defined $desired) { - $todo = $update ? ' - nothing to do' : '' if $rtodo eq ''; - } - elsif (defined $foundtopatch) { - if (scalar @$foundtopatch > 0) { - $todo = $update ? ' - installing version ' : ' INSTALL '; - $param = $desired; - $toinstall = $desired; - } - else { - $todo = ' - no versions found to patch to version '; - $param = $desired; - } - } - else { - $todo = $update ? ' - installing version ' : ' INSTALL '; - $param = $desired; - $toinstall = $desired; - } - print_log('global', WARNING, 'Package %s installed: %s%s%s%s%s', - $name, - join(', ', sort @$instlist), - $rtodo, $rparam, $todo, $param); - } - else { - my $todo; - my $param = ''; - my $leave = 0; - if (! defined $desired) { - $todo = $update ? ' - nothing to do' : ''; - } - else { - $todo = $update ? ' - installing version ' : ' INSTALL '; - $param = $desired; - $toinstall = $desired; - } - print_log('global', WARNING, 'Package %s not installed%s%s', - $name, $todo, $param); - } - return ($found, $toinstall, $toremove); -} - -sub drop_pkg_cache ($) -{ - my ($db) = @_; - - delete $$db{PkgCache}; -} - -sub get_pkg_instances ($$$$$) -{ - my ($config, $base_directory, $db, $name, $def) = @_; - - my $cache = $$db{PkgCache}; - $cache = $$db{PkgCache} = {} unless defined $cache; - - my $instance = $$cache{$name}; - if (! defined $instance) { - my $list = find_installed_packages('global', $def, $db, $name, $base_directory, $config, 1); - $list = [] unless defined $list; - $instance = { - Found => $list - }; - $$cache{$name} = $instance; - } - return $instance; -} - -sub assess_patch ($$$$$$$$$) -{ - my ($config, $base_directory, $db, $name, $pdef, $patchdef, $kb, $update, $counters) = @_; - - my $pkgdefs = $$config{'package-def'}; - my $pkglist = $$patchdef{packages}; - my $foundpkgs = {}; - if (defined $pkglist) { - foreach my $pkgname (@$pkglist) { - if ($pkgname eq 'OS') { - print_log('global', DEBUG3, 'Patch %s references OS (always present)', $kb); - $$foundpkgs{OS} = { - OS => 'OS' - }; - next; - } - my $def = $$pkgdefs{$pkgname}; - if (! defined $def) { - print_log('global', DEBUG3, 'Patch %s references package %s (no definition)', $kb, $pkgname); - next; - } - my $instance = get_pkg_instances($config, $base_directory, $db, $pkgname, $def); - if (! defined $instance) { - print_log('global', DEBUG3, 'Patch %s references package %s (no instance returned)', $kb, $pkgname); - next; - } - my $list = $$instance{Found}; - if (! defined $list) { - print_log('global', DEBUG3, 'Patch %s references package %s (no instance list returned)', $kb, $pkgname); - next; - } - if (scalar @$list > 0) { - my $found = {}; - foreach my $inst (@$list) { - my $dispname = $$inst{DisplayName}; - next unless defined $dispname && $dispname ne ''; - $$found{$dispname} = $pkgname; - } - $$foundpkgs{$pkgname} = $found; - print_log('global', DEBUG3, 'Patch %s references package %s (present): %s', - $kb, $pkgname, join(',', sort keys %$found)); - } - else { - print_log('global', DEBUG3, 'Patch %s references package %s (not present)', $kb, $pkgname); - } - } - } - else { - print_log('global', DEBUG3, 'Patch %s has no package reference (OS referenced - always present)', $kb); - $pkglist = ['OS']; - $$foundpkgs{OS} = { - OS => 'OS' - }; - } - if (scalar keys %$foundpkgs == 0) { - print_log('global', WARNING, 'Patch %s: no referenced packages found - NOT NEEDED', $kb); - return 1; - } - - my $vars = get_default_vars($config); - set_datetime_vars($vars); - my $basedir = substitute_variables($vars, $$pdef{'base-directory'}, 1, $base_directory, 'pkg'); - $$vars{basedir} = $basedir; - my $patchdir = substitute_variables($vars, $$patchdef{'source-directory'}, 1, $basedir, 'pkg'); - $$vars{patchdir} = $patchdir; - $$vars{patch} = $kb; - my $number = $kb =~ /^(\d+)/o ? $1 : $kb; - my $extra = $kb =~ /^\d+([^0-9].*)$/o ? '-'.$1 : ''; - $$vars{patchnum} = $number; - $$vars{patchextra} = $extra; - - refresh_installed_patches($db); - - my $patches = $$db{Patches}; - my $foundpatch = $$patches{$kb}; - - if (defined $foundpatch) { - my $foundforpkgs = $$foundpatch{Packages}; - my $missing = []; - my $found = []; - foreach my $dispname (sort keys %$foundforpkgs) { - print_log('global', DEBUG4, 'Patch %s found installed for package (%s)', $kb, $dispname); - } - foreach my $pkgname (sort keys %$foundpkgs) { - my $founddispnames = $$foundpkgs{$pkgname}; - my $any = 0; - foreach my $dispname (sort keys %$founddispnames) { - if (defined $$foundforpkgs{$dispname}) { - print_log('global', DEBUG4, 'Patch %s found installed for referenced package %s (%s)', - $kb, $pkgname, $dispname); - $any = 1; - last; - } - } - if ($any) { - push @$found, $pkgname; - print_log('global', DEBUG3, 'Patch %s installed for referenced package %s', $kb, $pkgname); - } - else { - push @$missing, $pkgname; - print_log('global', DEBUG3, 'Patch %s not installed for any referenced package %s', $kb, $pkgname); - } - } - if (scalar @$missing == 0) { - print_log('global', WARNING, 'Patch %s: installed for all required packages - OK', $kb); - return 1; - } - print_log('global', WARNING, 'Patch %s: %s%s%smissing for packages %s - %s', - $kb, (scalar @$found > 0 ? 'installed for ' : ''), - join(',', @$found), (scalar @$found > 0 ? ', ' : ''), - join(',', @$missing), $update ? 'installing' : 'NEEDED'); - } - else { - print_log('global', WARNING, 'Patch %s: not installed - %s', - $kb, $update ? 'installing' : 'NEEDED'); - } - push @{$$counters{ToInstallList}}, $kb; - $$counters{ToInstallCount}++; - return 0; -} - -sub install_patch ($$$$$$$) -{ - my ($config, $base_directory, $db, $pdef, $patchdef, $kb, $counters) = @_; - - my $name = 'patch'; - set_current_pkg_name($name); - - print_log('pkg', INFO, 'Installing patch %s', $kb); - - my $vars = get_default_vars($config); - set_datetime_vars($vars); - $$vars{pkgname} = $name; - $$vars{patch} = $kb; - my $number = $kb =~ /^(\d+)/o ? $1 : $kb; - my $extra = $kb =~ /^\d+([^0-9].*)$/o ? '-'.$1 : ''; - $$vars{patchnum} = $number; - $$vars{patchextra} = $extra; - my $basedir = substitute_variables($vars, $$pdef{'base-directory'}, 1, $base_directory, 'pkg'); - $$vars{basedir} = $basedir; - my $patchdir = substitute_variables($vars, $$patchdef{'source-directory'}, 1, $basedir, 'pkg'); - $$vars{patchdir} = $patchdir; - $$vars{patchprefix} = defined $$patchdef{prefix} ? $$patchdef{prefix} : 'Windows'.get_win_version().'-'; - $$vars{patchkbname} = defined $$patchdef{kbname} ? $$patchdef{kbname} : 'KB'; - $$vars{patchedition} = defined $$patchdef{edition} ? $$patchdef{edition} : ''; - $$vars{patcharch} = defined $$patchdef{arch} ? $$patchdef{arch} : '-'.$$vars{xarch}; - $$vars{patchsuffix} = defined $$patchdef{suffix} ? $$patchdef{suffix} : ''; - - my $style = $$patchdef{style}; - $$vars{patchext} = $style eq 'exe' ? '.exe' : $style eq 'msu' ? '.msu' : $style eq 'msp' ? '.msp' : $style eq 'cab' ? '.cab' : ''; - - my $sourcespec = $$patchdef{'source-file'}; - $sourcespec = '%patchprefix%%patchkbname%%patchnum%%patchextra%%patchedition%%patcharch%%patchsuffix%%patchext%' unless defined $sourcespec; - my $sourcefile = substitute_variables($vars, $sourcespec, 1, $patchdir, 'pkg'); - - my $error; - my $exitcode; - if ($style eq 'exe') { - my $chdir = defined $$patchdef{chdir} ? - substitute_variables($vars, $$patchdef{chdir}, 1, $patchdir, 'pkg') : undef; - my $paramlist = $$patchdef{parameters}; - $paramlist = ['/quiet', '/norestart'] unless defined $paramlist; - unshift @$paramlist, $sourcefile; - my $sourcefile = $$config{'proxy-command'}; - ($error, $exitcode) = run_exe('pkg', $db, $vars, $chdir, $sourcefile, $paramlist, 0); - } - elsif ($style eq 'msu') { - my $exename = substitute_variables($vars, '%systemroot%/System32/wusa.exe', 1, undef, 'pkg'); - my $paramlist = $$patchdef{parameters}; - $paramlist = ['/quiet', '/norestart'] unless defined $paramlist; - unshift @$paramlist, $sourcefile; - if (-f $sourcefile) { - ($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find MSU file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - elsif ($style eq 'msp') { - my $exename = substitute_variables($vars, '%systemroot%/System32/msiexec.exe', 1, undef, 'pkg'); - my $paramlist = $$patchdef{parameters}; - $paramlist = ['REINSTALL=ALL', 'REINSTALLMODE=omus'] unless defined $paramlist; - unshift @$paramlist, '/p', $sourcefile; - push @$paramlist, '/quiet', '/norestart'; - if (-f $sourcefile) { - ($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find MSP file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - elsif ($style eq 'cab') { - my $exename = substitute_variables($vars, '%systemroot%/System32/dism.exe', 1, undef, 'pkg'); - my $paramlist = ['/online', '/add-package', '/packagepath:'.$sourcefile]; - push @$paramlist, @{$$patchdef{parameters}} if defined $$patchdef{parameters}; - if (-f $sourcefile) { - ($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0); - } - else { - $error = sprintf('Cannot find CAB file %s: %s', $sourcefile, $!); - $exitcode = -1; - } - } - if (defined $error) { - if (defined $exitcode && ($exitcode == 194 || $exitcode == 63)) { - print_log('pkg', INFO, 'Ignoring patch %s installation exit code: %s', $kb, $exitcode); - $$counters{RebootFlag} = 1; - } - else { - print_log('pkg', ERROR, 'Patch %s installation failed: %s', $kb, $error); - set_current_pkg_name(undef); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - } - - print_log('pkg', INFO, 'Finished installing patch %s', $kb); - set_current_pkg_name(undef); - push @{$$counters{InstalledList}}, $name; - $$counters{InstalledCount}++; - return 1; -} - -sub parse_header ($) -{ - my ($line) = @_; - - my $list = []; - my $keywords = {}; - my $index = 0; - $line =~ s/^\s+//o; - while ($line =~ /^([^\s]+)(\s*)(.*)$/o) { - my $name = $1; - my $post = $2; - $line = $3; - my $length = length($name) + length($post); - if (! defined $$keywords{$name}) { - push @$list, $name; - $$keywords{$name} = { - Name => $name, - StartPos => $index, - Length => $length - }; - } - $index += $length; - } - return ($list, $keywords); -} - -sub parse_line ($$$) -{ - my ($header, $keywords, $line) = @_; - - my $row = {}; - foreach my $name (@$header) { - my $kw = $$keywords{$name}; - next unless defined $kw; - if ($$kw{StartPos} < length($line)) { - my $value = substr($line, $$kw{StartPos}, $$kw{Length}); - if (defined $value) { - $value =~ s/^\s+//o; - $value =~ s/\s+$//o; - $$row{$name} = $value; - } - } - } - return $row; -} - -sub parse_wmic ($) -{ - my ($result) = @_; - - my $header; - my $keywords; - my $list = []; - foreach my $line (@$result) { - next if $line =~ /^ *$/o; - if (! defined $header) { - ($header, $keywords) = parse_header($line); - next; - } - push @$list, parse_line($header, $keywords, $line); - } - return ($header, $list); -} - -sub do_net_user ($$;$$$$) -{ - my ($username, $delete, $password, $fullname, $enabled, $pwchange) = @_; - - my $sourcefile = $ENV{systemroot}.'\\System32\\net.exe'; - my $paramlist = ['user', $username]; - if (! $delete) { - push @$paramlist, '"'.$password.'"' if defined $password; - push @$paramlist, '/expires:never'; - push @$paramlist, '/passwordchg:'.($pwchange ? 'yes' : 'no'); - push @$paramlist, '/active:'.($enabled ? 'yes' : 'no'); - push @$paramlist, '/fullname:"'.$fullname.'"'; - } - push @$paramlist, $delete ? '/delete' : '/add'; - my ($error, $exitcode) = run_exe('global', undef, undef, undef, $sourcefile, $paramlist, 0); - if (defined $error) { - print_log('global', ERROR, 'Error %s user %s: %s', - $delete ? 'deleting' : 'creating', $username, $error); - return 0; - } - if ($delete) { - print_log('global', DEBUG1, 'Deleted user entry %s', $username); - } - else { - print_log('global', DEBUG1, 'Created user entry %s', $username); - } - return 1; -} - -sub do_modify_user ($$$$$) -{ - my ($username, $fullname, $enabled, $pwchange, $pwexpires) = @_; - - my $sourcefile = $ENV{systemroot}.'\\System32\\wbem\\wmic.exe'; - my $paramlist = ['useraccount', 'where', '"Name=\''.$username.'\'"']; - my $first = 1; - if (defined $fullname) { - push @$paramlist, $first ? 'set' : ','; - push @$paramlist, 'FullName="'.$fullname.'"'; - $first = 0; - } - if (defined $enabled) { - push @$paramlist, $first ? 'set' : ','; - push @$paramlist, 'Disabled='.($enabled ? 'FALSE' : 'TRUE'); - $first = 0; - } - if (defined $pwexpires) { - push @$paramlist, $first ? 'set' : ','; - push @$paramlist, 'PasswordExpires='.($pwexpires ? 'TRUE' : 'FALSE'); - $first = 0; - } - if (defined $pwchange) { - push @$paramlist, $first ? 'set' : ','; - push @$paramlist, 'PasswordChangeable='.($pwchange ? 'TRUE' : 'FALSE'); - $first = 0; - } - my ($error, $exitcode) = run_exe('global', undef, undef, undef, $sourcefile, $paramlist, 0); - if (defined $error) { - print_log('global', ERROR, 'Error modifying user %s: %s', $username, $error); - return 0; - } - print_log('global', DEBUG1, 'Modified user entry %s', $username); - return 1; -} - -sub install_cert ($) -{ - my ($certpath) = @_; - - my $sourcefile = $ENV{systemroot}.'\\System32\\certmgr.exe'; - my $paramlist = ['-add', $certpath, '-c', '-s', '-r', 'localMachine', 'TrustedPublisher']; - my ($error, $exitcode) = run_exe('global', undef, undef, undef, $sourcefile, $paramlist, 0); - if (defined $error) { - print_log('global', ERROR, 'Error installing certificate %s: %s', - $certpath, $error); - return 0; - } - print_log('global', DEBUG1, 'Installed certifiate %s', $certpath); - return 1; -} - -sub install_pnp_driver ($) -{ - my ($infpath) = @_; - - my $sourcefile = $ENV{systemroot}.'\\System32\\pnputil.exe'; - my $paramlist = ['-i', '-a', $infpath]; - my ($error, $exitcode) = run_exe('global', undef, undef, undef, $sourcefile, $paramlist, 0); - if (defined $error) { - print_log('global', ERROR, 'Error installing extra driver %s: %s', - $infpath, $error); - return 0; - } - print_log('global', DEBUG1, 'Installed extra driver %s', $infpath); - return 1; -} - -sub check_if_driver_matches ($$) -{ - my ($db, $drvdef) = @_; - - my $filter = $$drvdef{'device-filter'}; - return 0 unless defined $filter; - - my $devices = $$db{Devices}; - foreach my $devpath (sort keys %$devices) { - my $device = $$devices{$devpath}; - next unless defined $device; - my $busname = $$device{Bus}; - my $devname = $$device{Device}; - - my $matches = 0; - foreach my $filtrow (@$filter) { - my $busfilter = $$filtrow{bus}; - my $devfilter = $$filtrow{device}; - next unless defined $busfilter && defined $devfilter; - next unless $busname =~ /$busfilter/ && $devname =~ /$devfilter/; - $matches = 1; - last; - } - return 1; - } - - return 0; -} - -sub handle_driver ($$$$$$) -{ - my ($config, $base_directory, $db, $pkg, $counters, $update) = @_; - - my $name = $$pkg{name}; - my $error = scan_driver_dir($config, $base_directory, $pkg); - if (defined $error) { - print_log('global', INFO, 'Skipping driver set %s because no driver directory', $name); - push @{$$counters{SkipList}}, $name; - $$counters{SkipCount}++; - return 0; - } - my $drvdefs = $$pkg{'driver'}; - if (! defined $drvdefs) { - print_log('global', INFO, 'Skipping driver set %s because no driver definition found', $name); - push @{$$counters{SkipList}}, $name; - $$counters{SkipCount}++; - return 0; - } - foreach my $drvname (sort keys %$drvdefs) { - my $drvdef = $$drvdefs{$drvname}; - my $drvinstname = $name.'/'.$drvname; - - - my $infpath = $$drvdef{'definition-directory'}.'/'.$$drvdef{'inf-file'}; - my $certpath = defined $$drvdef{'cert-file'} ? $$drvdef{'definition-directory'}.'/'.$$drvdef{'cert-file'} : undef; - if (! -r $infpath) { - print_log('global', INFO, 'Skipping driver %s because .INF file %s not found', $drvinstname, $infpath); - push @{$$counters{FailList}}, $drvinstname; - $$counters{FailCount}++; - next; - } - if (defined $certpath && ! -r $certpath) { - print_log('global', INFO, 'Skipping driver %s because cert file %s not found', $drvinstname, $certpath); - push @{$$counters{FailList}}, $drvinstname; - $$counters{FailCount}++; - next; - } - print_log('global', DEBUG2, 'Checking if driver %s is needed', $drvinstname); - my $needed = check_if_driver_matches($db, $drvdef); - if (! $needed) { - print_log('global', INFO, 'Skipping driver %s because relevant device is not present', $drvinstname); - push @{$$counters{SkipList}}, $drvinstname; - $$counters{SkipCount}++; - next; - } - # check if present - print_log('global', WARNING, 'Driver %s to install: not installed - %s', - $drvinstname, $update? 'installing '.$infpath : 'INSTALL'); - if ($update) { - my $rc = 1; - if (defined $certpath) { - $rc = install_cert($certpath); - } - if ($rc) { - $rc = install_pnp_driver($infpath); - } - if (! $rc) { - push @{$$counters{FailList}}, $drvinstname; - $$counters{FailCount}++; - } - else { - push @{$$counters{InstalledList}}, $drvinstname; - $$counters{InstalledCount}++; - } - } - else { - push @{$$counters{ToInstallList}}, $drvinstname; - $$counters{ToInstallCount}++; - } - } - return 1; -} - -sub read_mbr_file ($$) -{ - my ($config, $pkg) = @_; - - my $vars = get_default_vars($config); - set_datetime_vars($vars); - - my $sourcefile = substitute_variables($vars, $$pkg{'mbr-source-file'}, 1, $$vars{pkgtooldir}, 'global'); - if (! -f $sourcefile) { - print_log('global', ERROR, 'Cannot find MBR template file %s: %s', $sourcefile, $!); - return undef; - } - if (! sysopen(MBR, $sourcefile, O_RDONLY)) { - print_log('global', ERROR, 'Cannot open MBR template file %s: %s', $sourcefile, $!); - return undef; - } - my $buffer = ''; - my $offs = 0; - while (1) { - my $into; - my $rc = sysread(MBR, $into, 4096, $offs); - if (! defined $rc) { - print_log('global', ERROR, 'Cannot read MBR template file %s: %s', $sourcefile, $!); - close(MBR); - return undef; - } - last unless $rc; - $buffer .= $into; - } - close(MBR); - print_log('global', DEBUG1, 'Finished reading MBR template of %d bytes', length($buffer)); - return $buffer; -} - -sub print_mbr ($$$$) -{ - my ($channel, $level, $caption, $content) = @_; - - print_log($channel, $level, '%s', $caption); - my $len = length($content); - for (my $offs = 0; $offs < $len; $offs += 16) { - my $index; - my $buf = sprintf("%04.4x ", $offs); - for ($index = 0; $index < 16 && $offs + $index < $len; $index++) { - my $chr = substr($content, $offs + $index, 1); - $buf .= sprintf(" %02.2x", ord($chr)); - } - for (; $index < 16; $index++) { - $buf .= " "; - } - $buf .= " "; - for ($index = 0; $index < 16 && $offs + $index < $len; $index++) { - my $chr = substr($content, $offs + $index, 1); - $chr = '.' if ord($chr) < 32 || ord($chr) >= 127; - $buf .= $chr; - } - print_log($channel, $level, '%s', $buf); - } -} - -sub handle_mbr ($$$$) -{ - my ($config, $pkg, $counters, $update) = @_; - - my $name = $$pkg{name}; - my $mbrdrive = $$config{'mbr-drive'}; - if (! defined $mbrdrive || $mbrdrive eq '') { - print_log('global', INFO, 'Skipping MBR check because MBR drive is not specified'); - push @{$$counters{SkipList}}, $name; - $$counters{SkipCount}++; - return 0; - } - my $mbrtemplate = read_mbr_file($config, $pkg); - if (! defined $mbrtemplate) { - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - my $readsize = int((length($mbrtemplate) + 511) / 512) * 512; - if (! $readsize) { - print_log('global', INFO, 'Skipping MBR check because MBR template is empty'); - push @{$$counters{SkipList}}, $name; - $$counters{SkipCount}++; - return 0; - } - my $fh = CreateFile($mbrdrive, GENERIC_READ()|GENERIC_WRITE(), FILE_SHARE_READ()|FILE_SHARE_WRITE(), [], OPEN_EXISTING(), 0, []); - if (! $fh) { - print_log('global', ERROR, 'Error opening MBR drive %s: %s', $mbrdrive, fileLastError()); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - my $mbrblock; - if (! ReadFile($fh, $mbrblock, $readsize, [], [])) { - print_log('global', ERROR, 'Error reading MBR drive %s: %s', $mbrdrive, fileLastError()); - CloseHandle($fh); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - if (length($mbrblock) < $readsize) { - print_log('global', ERROR, 'Short read of %d bytes instead of %d from MBR drive %s: %s', - length($mbrblock), $readsize, $mbrdrive, fileLastError()); - CloseHandle($fh); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - print_log('global', DEBUG1, 'Finished reading MBR of %d bytes', length($mbrblock)); - print_mbr('global', DEBUG3, 'MBR found:', $mbrblock); - if (substr($mbrblock, 0, length($mbrtemplate)) eq $mbrtemplate) { - print_log('global', WARNING, 'MBR template %s checked: OK', $name); - CloseHandle($fh); - return 1; - } - print_log('global', WARNING, 'MBR template %s checked - %s', $name, $update ? 'installing' : 'INSTALL'); - if ($update) { - if (! SetFilePointer($fh, 0, 0, FILE_BEGIN)) { - print_log('global', ERROR, 'Error seeking to beginning of MBR drive %s: %s', - $mbrdrive, fileLastError()); - CloseHandle($fh); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - if (length($mbrblock) > length($mbrtemplate)) { - $mbrtemplate .= substr($mbrblock, length($mbrtemplate), length($mbrblock)-length($mbrtemplate)); - print_mbr('global', DEBUG3, 'MBR to write:', $mbrtemplate); - } - my $written = 0; - if (! WriteFile($fh, $mbrtemplate, length($mbrblock), $written, [])) { - print_log('global', ERROR, 'Error writing MBR drive %s: %s', $mbrdrive, fileLastError()); - CloseHandle($fh); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - if ($written < length($mbrblock)) { - print_log('global', ERROR, 'Short write of %d bytes instead of %d from MBR drive %s: %s', - $written, length($mbrblock), $mbrdrive, fileLastError()); - CloseHandle($fh); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - push @{$$counters{InstalledList}}, $name; - $$counters{InstalledCount}++; - } - else { - push @{$$counters{ToInstallList}}, $name; - $$counters{ToInstallCount}++; - } - CloseHandle($fh); - return 1; -} - -sub do_acls ($$$) -{ - my ($pkg, $directory, $acls) = @_; - - foreach my $acl (@$acls) { - my $sourcefile = $ENV{systemroot}.'\\System32\\icacls.exe'; - my $paramlist = [$directory, @$acl]; - my $result = []; - my ($error, $exitcode) = run_exe('global', undef, undef, undef, $sourcefile, $paramlist, 0, $result); - if (defined $error) { - print_log('global', ERROR, 'Error setting ACL %s for directory %s: %s', join(',', map { '"'.$_.'"' } @$acl), $directory, $error); - return 0; - } - } - return 1; -} - -sub do_directory ($$) -{ - my ($pkg, $directory) = @_; - - if (! -d $directory) { - print_log('global', DEBUG1, 'Creating directory %s', $directory); - if (! mkdir($directory)) { - print_log('global', ERROR, 'Error creating directory %s: %s', $directory, $!); - return 0; - } - my $acls = $$pkg{acls}; - if (defined $acls) { - my $rc = do_acls($pkg, $directory, $acls); - if (! $rc) { - print_log('global', DEBUG1, 'Removing directory %s', $directory); - if (! rmdir($directory)) { - print_log('global', ERROR, 'Error removing directory %s: %s', $directory, $!); - } - return 0; - } - } - } - return 1; -} - -sub handle_directory ($$$$$) -{ - my ($config, $pkg, $base_directory, $counters, $update) = @_; - - my $name = $$pkg{name}; - my $vars = get_default_vars($config); - set_datetime_vars($vars); - my $directory = substitute_variables($vars, $$pkg{'directory'}, 1, $base_directory, 'global'); - - my $found = -d $directory; - if ($found) { - print_log('global', WARNING, 'Directory %s to create: %s exists - OK', - $name, $directory); - } - else { - print_log('global', DEBUG1, 'Directory %s not found', $directory); - print_log('global', WARNING, 'Directory %s to create: %s does not exist - %s', - $name, $directory, $update? 'creating' : 'CREATE'); - if ($update) { - my $rc = do_directory($pkg, $directory); - if (! $rc) { - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - push @{$$counters{InstalledList}}, $name; - $$counters{InstalledCount}++; - } - else { - push @{$$counters{ToInstallList}}, $name; - $$counters{ToInstallCount}++; - } - } - return 1; -} - -sub handle_user ($$$) -{ - my ($pkg, $counters, $update) = @_; - - my $name = $$pkg{name}; - my $username = $$pkg{'user'}; - my $password = $$pkg{'password'}; - my $deleted = $$pkg{'deleted'}; - $deleted = defined $deleted && $deleted; - my $enabled = $$pkg{'enabled'}; - $enabled = defined $enabled && $enabled; - my $pwchange = $$pkg{'pwchange'}; - $pwchange = defined $pwchange && $pwchange; - my $fullname = $$pkg{'fullname'}; - $fullname = '' unless defined $fullname; - my $pwexpires = $$pkg{'pwexpires'}; - $pwexpires = defined $pwexpires && $pwexpires; - - my $sourcefile = $ENV{systemroot}.'\\System32\\wbem\\wmic.exe'; - my $paramlist = ['useraccount', 'where', '"name=\''.$username.'\'"']; - my $result = []; - my ($error, $exitcode) = run_exe('global', undef, undef, undef, $sourcefile, $paramlist, 0, $result); - if (defined $error) { - print_log('global', ERROR, 'Error checking for user %s: %s', $username, $error); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - my $header; - my $found; - if (defined $$result[0] && $$result[0] !~ /No Instance/o) { - my $lcusername = lc($username); - ($header, $result) = parse_wmic($result); - foreach my $row (@$result) { - my $rowname = $$row{Name}; - next unless defined $rowname; - $found = $row if lc($rowname) eq $username; - last; - } - } - if (defined $found) { - my $rowname = $$found{Name}; - my $rowdis = $$found{Disabled}; - my $rowfullname = $$found{FullName}; - my $rowpwexpires = $$found{PasswordExpires}; - my $rowpwchange = $$found{PasswordChangeable}; - $rowfullname = '' unless defined $rowfullname; - $rowpwexpires = defined $rowpwexpires && $rowpwexpires =~ /TRUE/io; - $rowdis = defined $rowdis && $rowdis =~ /TRUE/io; - $rowpwchange = defined $rowpwchange && $rowpwchange =~ /TRUE/io; - print_log('global', DEBUG1, 'Found user entry name:%s %s fullname:%s pwexpires:%s pwchangeable:%s', - $rowname, $rowdis ? 'disabled' : 'enabled', $rowfullname, - $rowpwexpires ? 'yes' : 'no', $rowpwchange ? 'yes' : 'no'); - if ($deleted) { - print_log('global', WARNING, 'User %s to delete: account %s exists - %s', - $name, $username, $update ? 'deleting' : 'DELETE'); - if ($update) { - my $rc = do_net_user($username, 1); - if (! $rc) { - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - push @{$$counters{RemovedList}}, $name; - $$counters{RemovedCount}++; - } - else { - push @{$$counters{ToRemoveList}}, $name; - $$counters{ToRemoveCount}++; - } - } - else { - my $changedis = ($rowdis && $enabled) || (! $rowdis && ! $enabled); - my $changepwchange = ($rowpwchange && ! $pwchange) || (! $rowpwchange && $pwchange); - my $changepwexpires = ($rowpwexpires && ! $pwexpires) || (! $rowpwexpires && $pwexpires); - my $changefullname = $rowfullname ne $fullname; - if ($changedis || $changepwchange || $changepwexpires || $changefullname) { - print_log('global', WARNING, 'User %s to create: account %s exists, needs modification - %s', - $name, $username, $update? 'modifying' : 'MODIFY'); - if ($update) { - my $rc = do_modify_user($username, $changefullname ? $fullname : undef, - $changedis ? $enabled : undef, - $changepwchange ? $pwchange : undef, - $changepwexpires ? $pwexpires : undef); - if (! $rc) { - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - push @{$$counters{InstalledList}}, $name; - $$counters{InstalledCount}++; - } - else { - push @{$$counters{ToInstallList}}, $name; - $$counters{ToInstallCount}++; - } - } - else { - print_log('global', WARNING, 'User %s to create: account %s exists - OK', - $name, $username); - } - } - } - else { - print_log('global', DEBUG1, 'User entry %s not found', $username); - if ($deleted) { - print_log('global', WARNING, 'User %s to delete: account %s does not exist - OK', - $name, $username); - } - else { - print_log('global', WARNING, 'User %s to create: account %s does not exist - %s', - $name, $username, $update? 'creating' : 'CREATE'); - if ($update) { - my $rc = do_net_user($username, 0, $password, $fullname, $enabled, $pwchange); - $rc = do_modify_user($username, undef, undef, undef, $pwexpires) if $rc; - if (! $rc) { - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return 0; - } - push @{$$counters{InstalledList}}, $name; - $$counters{InstalledCount}++; - } - else { - push @{$$counters{ToInstallList}}, $name; - $$counters{ToInstallCount}++; - } - } - } - return 1; -} - -sub handle_pkg ($$$$$$) -{ - my ($config, $base_directory, $db, $pkg, $counters, $update) = @_; - - my $name = $$pkg{name}; - my ($condcheck, $error) = pkg_check_condition($pkg, $name, $config); - if (defined $error) { - print_log('global', INFO, 'Ignoring package/patch %s: %s', $name, $error); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return; - } - if (defined $condcheck) { - if (! $condcheck) { - print_log('global', INFO, 'Skipping package/patch %s on false condition', $name); - push @{$$counters{SkipList}}, $name; - $$counters{SkipCount}++; - return; - } - print_log('global', DEBUG1, 'Considering package/patch %s with true condition', $name); - } - - if (defined $$pkg{'user'}) { - return handle_user($pkg, $counters, $update); - } - if (defined $$pkg{'directory'}) { - return handle_directory($config, $pkg, $base_directory, $counters, $update); - } - if (defined $$pkg{'mbr-source-file'}) { - return handle_mbr($config, $pkg, $counters, $update); - } - if (defined $$pkg{'driver-directory'}) { - return handle_driver($config, $base_directory, $db, $pkg, $counters, $update); - } - - my $pkgdefs = $$config{'package-def'}; - my $patchdefs = $$config{'patch-def'}; - my $def = $$pkgdefs{$name}; - my $pdef = $$patchdefs{$name}; - if (! defined $def && ! defined $pdef) { - print_log('global', WARNING, 'No package or patch definition %s found', $name); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return; - } - - if (defined $def) { - my ($condcheck, $error) = pkgdef_check_availability($def, $name, $config); - if (defined $error) { - print_log('global', INFO, 'Ignoring package %s: %s', $name, $error); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return; - } - if (defined $condcheck) { - if (! $condcheck) { - print_log('global', INFO, 'Skipping package %s on false condition', $name); - push @{$$counters{SkipList}}, $name; - $$counters{SkipCount}++; - return; - } - print_log('global', DEBUG1, 'Considering package %s with true condition', $name); - } - - my $desired = pkgdef_get_desired_version($config, $name, $base_directory, $def, $$pkg{'install-version'}); - my ($found, $toinstall, $toremove) = assess_pkg($config, $base_directory, $db, - $name, $desired, $$pkg{'remove-version'}, $def, $update); - if (! defined $found && ! defined $toinstall && ! defined $toremove) { - print_log('global', INFO, 'Ignoring package %s: Invalid package', $name); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return; - } - if (scalar @$toremove > 0) { - push @{$$counters{ToRemoveList}}, $name; - $$counters{ToRemoveCount} += scalar @$toremove; - } - if (defined $toinstall) { - push @{$$counters{ToInstallList}}, $name; - $$counters{ToInstallCount}++; - } - if ($update) { - remove_package($db, $def, $name, $toremove, $base_directory, - $$config{'generic-msi-parameters'}, $config, $counters) - if scalar @$toremove > 0; - install_package($db, $def, $found, $name, $desired, $base_directory, - $$config{'generic-msi-parameters'}, $config, $counters) - if defined $toinstall; - } - } - if (defined $pdef) { - my ($condcheck, $error) = patchsetdef_check_availability($pdef, $name, $config); - if (defined $error) { - print_log('global', INFO, 'Ignoring patch set %s: %s', $name, $error); - push @{$$counters{FailList}}, $name; - $$counters{FailCount}++; - return; - } - if (defined $condcheck) { - if (! $condcheck) { - print_log('global', INFO, 'Skipping patch set %s on false condition', $name); - push @{$$counters{SkipList}}, $name; - $$counters{SkipCount}++; - return; - } - print_log('global', DEBUG1, 'Considering patch set %s with true condition', $name); - } - drop_pkg_cache($db); - my $patchlist = $$pdef{patches}; - foreach my $patchdef (@$patchlist) { - ($condcheck, $error) = patchdef_check_availability($pdef, $patchdef, $name, $config); - if (defined $error) { - print_log('global', INFO, 'Ignoring patch set %s patches %s: %s', $name, join(',', @{$$patchdef{kb}}), $error); - push @{$$counters{FailList}}, @{$$patchdef{kb}}; - $$counters{FailCount} += scalar @{$$patchdef{kb}}; - next; - } - if (defined $condcheck) { - if (! $condcheck) { - print_log('global', INFO, 'Skipping patch set %s patches %s on false condition', $name, join(',', @{$$patchdef{kb}})); - push @{$$counters{SkipList}}, @{$$patchdef{kb}}; - $$counters{SkipCount} += @{$$patchdef{kb}}; - next; - } - print_log('global', DEBUG1, 'Considering patch set %s patches %s with true condition', $name, join(',', @{$$patchdef{kb}})); - } - - foreach my $kb (@{$$patchdef{kb}}) { - my $leave = assess_patch($config, $base_directory, $db, $name, $pdef, $patchdef, $kb, $update, $counters); - if ($update && ! $leave) { - install_patch($config, $base_directory, $db, $pdef, $patchdef, $kb, $counters); - } - } - } - } -} - -sub get_install_sets ($) -{ - my ($config) = @_; - - my $url = 'http://'.$$config{'install-host'}.$$config{'install-path'}; - print_log('global', DEBUG1, 'Getting package configuration from \'%s\'', $url); - my $ua = LWP::UserAgent->new; - my $response = $ua->get($url); - if (! $response->is_success) { - print_log('global', ERROR, 'Error getting package configuration from \'%s\': %s', $url, $response->status_line); - return 1; - } - my $flags = {}; - my $globalflags = {}; - my $pkgsets = $$config{'package-sets'}; - $pkgsets = {} unless defined $pkgsets; - foreach my $line (split /\n/, $response->decoded_content) { - chomp $line; - print_log('global', DEBUG3, 'Received response line: %s', $line); - next unless $line =~ /^([^=]+)=(.*)$/o; - my $key = $1; - my $value = $2; - if ($key eq 'pkgset') { - my $pkgset = $$pkgsets{$value}; - if (defined $pkgset) { - print_log('global', DEBUG1, 'Found package set %s', $value); - foreach my $pkgflag (@$pkgset) { - if (! defined $$flags{$pkgflag}) { - print_log('global', DEBUG1, 'Adding package flag %s', $pkgflag); - $$flags{$pkgflag} = 1; - } - } - } - else { - print_log('global', ERROR, 'Undefined packaget set %s', $value); - } - next; - } - if ($key eq 'pkg') { - if (! defined $$flags{$value}) { - print_log('global', DEBUG1, 'Adding package flag %s', $value); - $$flags{$value} = 1; - } - } - if ($key eq 'flag') { - my $flag; - if ($value =~ /^([^=]+)=(.*)$/o) { - $flag = $1; - $value = $2; - } - else { - $flag = $value; - $value = 1; - } - if (! defined $$globalflags{$flag}) { - print_log('global', DEBUG1, 'Adding global flag %s=%s', $flag, $value); - $$globalflags{$flag} = $value; - } - } - } - my $genvars = $$config{'generic-variables'}; - foreach my $pkgflag (keys %$flags) { - push @$genvars, { - variable => 'set-'.$pkgflag, - expression => 1 - }; - } - foreach my $flag (keys %$globalflags) { - my $value = $$globalflags{$flag}; - push @$genvars, { - variable => $flag, - expression => $value - }; - } - return undef; -} - -1;