3306 lines
96 KiB
Perl
3306 lines
96 KiB
Perl
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 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-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_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 : '<undef>');
|
|
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 : '<undef>');
|
|
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 : '<undef>');
|
|
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 to definition %s',
|
|
$dispname, $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 : '<undef>');
|
|
return 1 if defined $value && $value;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub sort_package ($$)
|
|
{
|
|
my ($a, $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;
|
|
|
|
if (! defined $a) {
|
|
return 0 unless defined $b;
|
|
return 1;
|
|
}
|
|
return -1 unless defined $b;
|
|
|
|
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_packages ($$$$$$$$$$)
|
|
{
|
|
my ($channel, $vars, $def, $paramlist, $list, $condition, $db, $basedir, $config, $counters) = @_;
|
|
|
|
my $params;
|
|
my $exename;
|
|
$list = sort_packages_to_remove($list);
|
|
foreach my $inst (@$list) {
|
|
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',
|
|
$$inst{DisplayName}, $printver, $error);
|
|
next;
|
|
}
|
|
if (! $result) {
|
|
print_log($channel, INFO, 'Ignoring package %s%s with false condition',
|
|
$$inst{DisplayName}, $printver);
|
|
next;
|
|
}
|
|
}
|
|
|
|
print_log($channel, DEBUG1, 'Removing package %s%s%s', $$inst{DisplayName}, $printver,
|
|
defined $condition ? ' with true condition' : '');
|
|
|
|
my $uninst = $$inst{Uninstall};
|
|
my $quninst = $$inst{QUninstall};
|
|
return sprintf('Cannot remove package %s%s, no UninstallString registry entry found',
|
|
$$inst{DisplayName}, $ver) unless defined $uninst || defined $quninst;
|
|
$uninst = $quninst if defined $quninst;
|
|
$uninst =~ s/(msiexec[^ ]* )\/i/$1\/X/io;
|
|
$uninst =~ s/(msiexec[^ ]* )/$1\/qb \/norestart \/passive /io;
|
|
print_log($channel, DEBUG2, 'Uninstall command: %s', $uninst);
|
|
$exename = substitute_variables($vars, '%systemroot%/System32/cmd.exe', 1, undef, 'pkg')
|
|
unless defined $exename;
|
|
if (! defined $params) {
|
|
$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 '';
|
|
}
|
|
$uninst .= $params;
|
|
my ($error, $exitcode) = run_exe($channel, $db, $vars, undef, $exename, ['/C', $uninst], 0);
|
|
if (defined $error) {
|
|
if (defined $exitcode && $exitcode == 194) {
|
|
print_log($channel, INFO, 'Ignoring package %s%s removal exit code: %s',
|
|
$$inst{DisplayName}, $printver, $exitcode);
|
|
$$counters{RebootFlag} = 1;
|
|
}
|
|
else {
|
|
push @{$$counters{FailList}}, $$inst{DisplayName};
|
|
$$counters{FailCount}++;
|
|
return $error;
|
|
}
|
|
}
|
|
push @{$$counters{RemovedList}}, $$inst{DisplayName};
|
|
$$counters{RemovedCount}++;
|
|
}
|
|
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 : '<undef>');
|
|
if (defined $value) {
|
|
$$vars{$varname} = $value;
|
|
}
|
|
else {
|
|
delete $$vars{$varname};
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub remove_package ($$$$$$$)
|
|
{
|
|
my ($db, $def, $name, $list, $basedir, $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, $paramlist,
|
|
[map { $$_[1] } @$list], undef, $db, $basedir, $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, $paramlist, $list, $condition, $db, $basedir, $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 : '<undef>');
|
|
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 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, $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 $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;
|
|
}
|
|
}
|
|
}
|
|
my $genvars = $$config{'generic-variables'};
|
|
foreach my $pkgflag (keys %$flags) {
|
|
push @$genvars, {
|
|
variable => 'set-'.$pkgflag,
|
|
expression => 1
|
|
};
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
1;
|