winupd/pkgtool.pm

package pkgtool;

use strict;

require Exporter;
@pkgtool::ISA = qw(Exporter);
@pkgtool::EXPORT = qw(
	get_cfg_syntax
	get_hostname
	get_default_dnsdomain
	read_installed_patches
	read_installed_packages
	read_present_devices
	read_installed_infs
	scan_package_dirs
	scan_driver_dir
	handle_pkg
	get_install_sets
);

use logging;
use cfgparser;
use sysinfo;

use Symbol 'gensym';
use Cwd;
use Fcntl qw(:DEFAULT :mode);;
use File::Spec;
use Sys::Hostname;
use Digest::MD5;
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 => 'or',
				Options => [{
					Type => 'string'
				}, {
					Type => 'struct',
					Check => \&check_cfg_patching_version_struct,
					Keywords => {
						'type' => {
							Type => 'string',
							Mandatory => 1
						},
						'expression' => {
							Type => 'string'
						}
					}
				}]
			},
			'install-check' => {
				Type => 'string'
			},
			'match' => {
				Type => 'list',
				Elements => {
					Type => 'struct',
					Keywords => {
						'expression' => {
							Type => 'string',
							Mandatory => 1
						}
					}
				}
			},
			'version-source' => {
				Type => 'string'
			},
			'extract-version-field' => {
				Type => 'integer'
			},
			'extract-version-regex' => {
				Type => 'string'
			},
			'extract-version' => {
				Type => 'list',
				Elements => {
					Type => 'struct',
					Check => \&check_cfg_extract_step,
					Keywords => {
						'type' => {
							Type => 'string',
							Mandatory => 1
						},
						'variable' => {
							Type => 'string'
						},
						'expression' => {
							Type => 'string'
						}
					}
				}
			},
			'match-version-condition' => {
				Type => 'string'
			},
			'match-version' => {
				Type => 'string'
			},
			'install' => {
				Type => 'list',
				Elements => {
					Type => 'struct',
					Check => \&check_cfg_install_step,
					Keywords => {
						'type' => {
							Type => 'string',
							Mandatory => 1
						},
						'condition' => {
							Type => 'string'
						},
						'ignore-failure' => {
							Type => 'integer'
						},
						'background' => {
							Type => 'integer'
						},
						'recurse' => {
							Type => 'integer'
						},
						'chdir' => {
							Type => 'string'
						},
						'variable' => {
							Type => 'string'
						},
						'filename' => {
							Type => 'string'
						},
						'expression' => {
							Type => 'string'
						},
						'source-file' => {
							Type => 'string'
						},
						'target-file' => {
							Type => 'string'
						},
						'parameters' => {
							Type => 'list',
							Elements => {
								Type => 'string'
							}
						}
					}
				}
			},
			'remove' => {
				Type => 'list',
				Elements => {
					Type => 'struct',
					Check => \&check_cfg_remove_step,
					Keywords => {
						'type' => {
							Type => 'string',
							Mandatory => 1
						},
						'condition' => {
							Type => 'string'
						},
						'ignore-failure' => {
							Type => 'integer'
						},
						'background' => {
							Type => 'integer'
						},
						'recurse' => {
							Type => 'integer'
						},
						'chdir' => {
							Type => 'string'
						},
						'variable' => {
							Type => 'string'
						},
						'filename' => {
							Type => 'string'
						},
						'expression' => {
							Type => 'string'
						},
						'source-file' => {
							Type => 'string'
						},
						'target-file' => {
							Type => 'string'
						},
						'parameters' => {
							Type => 'list',
							Elements => {
								Type => 'string'
							}
						}
					}
				}
			},
			'remove-parameters' => {
				Type => 'list',
				Elements => {
					Type => 'string'
				}
			},
			'package-versions' => {
				Type => 'map',
				Elements => {
					Type => 'or',
					Options => [{
						Type => 'string'
					}, {
						Type => 'struct',
						Check => \&check_cfg_pkg_version_struct,
						Keywords => {
							'type' => {
								Type => 'string',
								Mandatory => 1
							},
							'expression' => {
								Type => 'string'
							}
						}
					}]
				} 
			}
		}
	}
};

my $patchdef_syntax = {
	Type => 'map',
	Elements => {
		Type => 'struct',
		Keywords => {
			'description' => {
				Type => 'string',
				Mandatory => 1
			},
			'base-directory' => {
				Type => 'string',
				Mandatory => 1
			},
			'available' => {
				Type => 'string'
			},
			'patches' => {
				Type => 'list',
				Mandatory => 1,
				Elements => {
					Type => 'struct',
					Check => \&check_cfg_patchdef,
					Keywords => {
						'source-directory' => {
							Type => 'string',
							Mandatory => 1
						},
						'source-file' => {
							Type => 'string'
						},
						'available' => {
							Type => 'string'
						},
						'chdir' => {
							Type => 'string',
						},
						'packages' => {
							Type => 'list',
							Elements => {
								Type => 'string'
							} 
						},
						'kb' => {
							Type => 'list',
							Mandatory => 1,
							Elements => {
								Type => 'string'
							} 
						},
						'style' => {
							Type => 'string',
							Mandatory => 1
						},
						'kbname' => {
							Type => 'string'
						},
						'prefix' => {
							Type => 'string'
						},
						'edition' => {
							Type => 'string'
						},
						'arch' => {
							Type => 'string'
						},
						'suffix' => {
							Type => 'string'
						},
						'parameters' => {
							Type => 'list',
							Elements => {
								Type => 'string'
							}
						}
					}
				}
			}
		}
	}
};

my $driver_cfg_syntax = {
	Type => 'struct',
	Keywords => {
		'driver' => $driver_syntax,
	}
};

my $pkgdef_cfg_syntax = {
	Type => 'struct',
	Keywords => {
		'base-directory' => {
			Type => 'string',
		},
		'available' => {
			Type => 'string'
		},
		'package-def' => $pkgdef_syntax,
		'patch-def' => $patchdef_syntax
	}
};

my $global_cfg_syntax = {
	Type => 'struct',
	Keywords => {
		'install-server' => {
			Type => 'string',
			Mandatory => 1
		},
		'install-share' => {
			Type => 'string',
			Mandatory => 1
		},
		'install-path' => {
			Type => 'string',
			Mandatory => 1
		},
		'msupdate-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 => 'or',
						Options => [{
							Type => 'string'
						}, {
							Type => 'struct',
							Check => \&check_cfg_remove_version_struct,
							Keywords => {
								'type' => {
									Type => 'string',
									Mandatory => 1
								},
								'expression' => {
									Type => 'string'
								}
							}
						}]
					},
					'install-version' => {
						Type => 'or',
						Options => [{
							Type => 'string'
						}, {
							Type => 'struct',
							Check => \&check_cfg_install_version_struct,
							Keywords => {
								'type' => {
									Type => 'string',
									Mandatory => 1
								},
								'expression' => {
									Type => 'string'
								}
							}
						}]
					},
					'patch-packages' => {
						Type => 'list',
						Elements => {
							Type => 'string'
						}
					},
					'directory' => {
						Type => 'string'
					},
					'acls' => {
						Type => 'list',
						Elements => {
							Type => 'list',
							Elements => {
								Type => 'string'
							}
						}
					},
					'group' => {
						Type => 'string'
					},
					'members' => {
						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;
	print "hostname: $hostname\n";
	my $ipconfig = Win32::IPConfig->new($hostname);
	return undef unless defined $ipconfig;
	my $found;
	foreach my $adapter ($ipconfig->get_adapters()) {
		my $name = $adapter->get_name();
		my $domain = $adapter->get_domain();
		next unless defined $name and defined $domain;
		next unless $name =~ /^Ethernet/o;
		$found = $domain;
		last;
	}
	if (! defined $found) {
		foreach my $adapter ($ipconfig->get_adapters()) {
			my $name = $adapter->get_name();
			my $desc = $adapter->get_description();
			my $domain = $adapter->get_domain();
			next unless defined $name and defined $domain;
			$found = $domain;
			last;
		}
	}
	return $found;
}

sub is_part_of_domain (;$)
{
	my ($vars) = @_;

	my $wbem = get_wbem_info();
	if (defined $wbem && $$wbem{'PartOfDomain'}) {
		$$vars{'current_domain'} = $$wbem{Domain};
		return 1;
	}
	$$vars{'current_domain'} = '';
	return 0;
}

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, $pkgs, $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;
		my $original = $installclient eq 'DISM Package Manager Provider';
		my $update = $installclient eq 'WindowsUpdateAgent';
		next unless $original || $update;
		if ($installname =~ /^[^~]*KB(\d[0-9a-zA-Z]+)~/o) {
			my $kb = $1;
			my $number = $kb =~ /^(\d+)/o ? $1 : $kb;
			if ($installname =~ /^[^~]*KB\d[0-9a-zA-Z]+~[^~]*~[^~]*~[^~]*~(\d+(\.\d+)*)/o) {
				my $version = $1;
				if (defined $version && $version ne '') {
					my @versionlist = split /\./, $version;
					my $revnum = $versionlist[2];
					if (defined $revnum && $revnum =~ /^\d+$/o && $revnum > 1) {
						$kb .= 'v'.$revnum;
					}
				}
			}
			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;
			}
			print_log('global', DEBUG3, 'Found OS patch information for %s: kbnum=%s current=%s', $kb, $number, $$p{Current});
		}
		if ($name =~ /^([^~]*)~([^~]*)~([^~]*)~([^~]*)~([^~]*)$/o) {
			my $pkg = $$pkgs{$name};
			if (! defined $pkg) {
				my $pkgname = $1;
				my $key = $2;
				my $arch = $3;
				my $pkgver = $5;
				$pkg = $$pkgs{$name} = {
					Type => 'OS',
					Packages => { OS => 1 },
					InstallName => $name,
					PackageName => $pkgname,
					PackageVersion => $pkgver,
					Arch => $arch,
					InstallClient => $installclient,
					Original => $original,
					Update => $update,
					Current => 0,
					Flags => 0
				};
			}
			if (defined $state) {
				$$pkg{Flags} |= $state;
				$$pkg{Current} = 1 if $state & 0x20;
			}
		}
	}
}

sub read_pkg_patches ($$$)
{
	my ($patches, $pkgs, $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;
			}
			print_log('global', DEBUG3, 'Found package patch information for %s/%s: kbnum=%s current=%s', $kb, $pkgname, $number, $$p{Current});
		}
	}
}

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 $instsrc = get_registry_value($sub->{'InstallSource'});
		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,
			InstallSource => $instsrc,
			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 $pkgs = {};
	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, $pkgs, $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, $pkgs, $updates);
	$$db{Patches} = $patches;
	$$db{Pkgs} = $pkgs;
	return $db;
}

sub refresh_installed_patches ($)
{
	my ($db) = @_;

	print_log('global', DEBUG4, 'Refreshing patches');
	if (defined $$db{Patches}) {
		return unless defined $$db{PatchesChanged};
		print_log('global', DEBUG1, 'Rereading changed patch database from registry');
	}
	read_installed_patches($db);
}

sub read_installed_packages ($)
{
	my ($db) = @_;

	delete $$db{Changed};
	my $packages = {};
	my $uninst = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' });
	if (! defined $uninst) {
		print_log('global', ERROR, 'Cannot find registry entry: %s', 'HKLM\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall');
		return undef;
	}
	read_packages($packages, $uninst, 0, 0);
	$uninst = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' });
	if (defined $uninst) {
		read_packages($packages, $uninst, 1, 0);
	}
	$uninst = $Registry->Open('HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' });
	if (defined $uninst) {
		read_packages($packages, $uninst, 0, 0);
	}
	$uninst = $Registry->Open('HKEY_CURRENT_USER\\Software\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\', { Access => 'KEY_READ' });
	if (defined $uninst) {
		read_packages($packages, $uninst, 1, 0);
	}
	my $specpackages = {};
	my $products = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Installer\\UserData\\S-1-5-18\\Products\\', { Access => 'KEY_READ' });
	if (defined $products) {
		read_packages($specpackages, $products, 0, 1);
	}
	$products = $Registry->Open('HKEY_LOCAL_MACHINE\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Installer\\UserData\\S-1-5-18\\Products\\', { Access => 'KEY_READ' });
	if (defined $products) {
		read_packages($specpackages, $products, 1, 1);
	}
	$$db{Installed} = $packages;
	$$db{InstalledSpec} = $specpackages;
	return $db;
}

sub refresh_installed_packages ($)
{
	my ($db) = @_;

	if (defined $$db{Installed}) {
		return unless defined $$db{Changed};
		print_log('global', DEBUG1, 'Rereading changed package database from registry');
	}
	read_installed_packages($db);
}

sub read_devices ($$)
{
	my ($devices, $registry) = @_;
	
	foreach my $busname ($registry->SubKeyNames) {
		my $bus = $registry->{$busname};
		next unless defined $bus;
		foreach my $devname ($bus->SubKeyNames) {
			my $inst = {
				Bus => $busname,
				Device => $devname
			};
			my $device = $busname.'\\'.$devname;
			$$devices{$device} = $inst;
		}
	}
}

sub read_present_devices ($)
{
	my ($db) = @_;

	my $devices = {};
	my $uninst = $Registry->Open('HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Enum\\', { Access => 'KEY_READ' });
	if (! defined $uninst) {
		print_log('global', ERROR, 'Cannot find registry entry: %s', 'HKLM\\SYSTEM\\CurrentControlSet\\Enum');
		return undef;
	}
	read_devices($devices, $uninst);
	$$db{Devices} = $devices;
	return $db;
}

sub read_installed_infs ($)
{
	my ($db) = @_;

	my $directory = $ENV{'SYSTEMROOT'}.'\\Inf';
	my $infs = {};
	print_log('global', DEBUG3, 'Scanning directory %s for .INF files', $directory);
	if (! opendir(DIR, $directory)) {
		print_log('global', ERROR, 'Cannot read directory %s: %s', $directory, $!);
		return undef;
	}
	while (1) {
		my $name = readdir(DIR);
		last unless defined $name;
		next if $name eq '.' || $name eq '..';
		next unless $name =~ /\.inf$/io;
		my $path = $directory.'\\'.$name;
		my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size) = stat($path);
		if (! defined $size) {
			print_log('global', INFO, 'Cannot read .INF file size for %s: %s', $path, $!);
			next;
		}
		my $inf = {
			Path => $path,
			Filename => $name,
			Size => $size
		};
		$$infs{$path} = $inf;
		print_log('global', DEBUG3, 'Found .INF file %s (%d bytes)', $path, $size);
	}
	closedir(DIR);
	$$db{INFs} = $infs;
	return $db;
}

sub check_cfg_drvdef ($$)
{
	return 1;
}

sub check_cfg_pkgdef ($$)
{
	my ($install, $label) = @_;

	if (! defined $$install{'install-check'} && ! defined $$install{'match'}) {
		print_log('pkg', ERROR, 'Package definition "match" or "install-check" at %s', $label);
		return 0;
	}
	if (! defined $$install{'match-version-condition'} && ! defined $$install{'match-version'}) {
		print_log('pkg', ERROR, 'Package definition "match-version" or "match-version-condition" at %s', $label);
		return 0;
	}

	return 1;
}

sub check_cfg_patchdef ($$)
{
	my ($patch, $label) = @_;

	my $style = $$patch{style};
	if ($style eq 'exe') {
	}
	elsif ($style eq 'msu') {
	}
	elsif ($style eq 'msp') {
	}
	elsif ($style eq 'cab') {
	}
	else {
		print_log('pkg', ERROR, 'Unknown patch style at %s', $label.': '.$style);
		return 0;
	}

	return 1;
}

sub check_cfg_extract_step ($$)
{
	my ($install, $label) = @_;

	my $type = $$install{type};

	if ($type eq 'setvar') {
		if (! defined $$install{'variable'} || $$install{'variable'} eq '') {
			print_log('pkg', ERROR, 'Version extraction step missing "variable" at %s', $label);
			return 0;
		}
		if (! defined $$install{'expression'} && ! defined $$install{'filename'}) {
			print_log('pkg', ERROR, 'Version extraction step missing "expression" or "filename" at %s', $label);
			return 0;
		}
	}
	else {
		print_log('pkg', ERROR, 'Unknown install step type at %s', $label.': '.$type);
		return 0;
	}

	return 1;
}

sub check_cfg_install_step ($$)
{
	my ($install, $label) = @_;

	my $type = $$install{type};

	if ($type eq 'setvar') {
		if (! defined $$install{'variable'} || $$install{'variable'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "variable" at %s', $label);
			return 0;
		}
		if (! defined $$install{'expression'} && ! defined $$install{'filename'}) {
			print_log('pkg', ERROR, 'Install step missing "expression" or "filename" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'msi') {
		if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'msp') {
		if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'run') {
		if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'file') {
		if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label);
			return 0;
		}
		if (! defined $$install{'target-file'} || $$install{'target-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "target-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'delete-file') {
		if (! defined $$install{'target-file'} || $$install{'target-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "target-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'delete-dir') {
		if (! defined $$install{'target-file'} || $$install{'target-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "target-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'reg') {
		if (! defined $$install{'source-file'} || $$install{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Install step missing "source-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'remove-pkg') {
	}
	else {
		print_log('pkg', ERROR, 'Unknown install step type at %s', $label.': '.$type);
		return 0;
	}

	return 1;
}

sub check_cfg_remove_step ($$)
{
	my ($remove, $label) = @_;

	my $type = $$remove{type};

	if ($type eq 'setvar') {
		if (! defined $$remove{'variable'} || $$remove{'variable'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "variable" at %s', $label);
			return 0;
		}
		if (! defined $$remove{'expression'} && ! defined $$remove{'filename'}) {
			print_log('pkg', ERROR, 'Remove step missing "expression" or "filename" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'msi') {
		if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'run') {
		if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'file') {
		if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label);
			return 0;
		}
		if (! defined $$remove{'target-file'} || $$remove{'target-file'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "target-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'delete-file') {
		if (! defined $$remove{'target-file'} || $$remove{'target-file'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "target-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'delete-dir') {
		if (! defined $$remove{'target-file'} || $$remove{'target-file'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "target-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'reg') {
		if (! defined $$remove{'source-file'} || $$remove{'source-file'} eq '') {
			print_log('pkg', ERROR, 'Remove step missing "source-file" at %s', $label);
			return 0;
		}
	}
	elsif ($type eq 'remove-pkg') {
	}
	else {
		print_log('pkg', ERROR, 'Unknown remove step type at %s', $label.': '.$type);
		return 0;
	}

	return 1;
}

sub check_cfg_pkg_version_struct ($$)
{
	my ($option, $label) = @_;

	my $type = $$option{type};

	if ($type eq 'expression') {
		if (! defined $$option{'expression'}) {
			print_log('pkg', ERROR, 'Package version option missing "expression" at %s', $label);
			return 0;
		}
	}
	else {
		print_log('pkg', ERROR, 'Unknown package version option type at %s', $label.': '.$type);
		return 0;
	}

	return 1;
}

sub check_cfg_patching_version_struct ($$)
{
	my ($option, $label) = @_;

	my $type = $$option{type};

	if ($type eq 'expression') {
		if (! defined $$option{'expression'}) {
			print_log('pkg', ERROR, 'Package patching version option missing "expression" at %s', $label);
			return 0;
		}
	}
	else {
		print_log('pkg', ERROR, 'Unknown package patching version option type at %s', $label.': '.$type);
		return 0;
	}

	return 1;
}

sub check_cfg_install_version_struct ($$)
{
	my ($option, $label) = @_;

	my $type = $$option{type};

	if ($type eq 'expression') {
		if (! defined $$option{'expression'}) {
			print_log('pkg', ERROR, 'Install version option missing "expression" at %s', $label);
			return 0;
		}
	}
	else {
		print_log('pkg', ERROR, 'Unknown install version option type at %s', $label.': '.$type);
		return 0;
	}

	return 1;
}

sub check_cfg_remove_version_struct ($$)
{
	my ($option, $label) = @_;

	my $type = $$option{type};

	if ($type eq 'expression') {
		if (! defined $$option{'expression'}) {
			print_log('pkg', ERROR, 'Remove version option missing "expression" at %s', $label);
			return 0;
		}
	}
	else {
		print_log('pkg', ERROR, 'Unknown remove 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, name => $$inst{Name} }, $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%s%s to definition %s',
		$dispname,
		defined $$inst{SystemComponent} ? ' SC='.$$inst{SystemComponent} : '',
		defined $$inst{WindowsInstaller} ? ' WI='.$$inst{WindowsInstaller} : '',
		$dispver, $$def{description});
	my $matchlist = $$def{'match'};
	foreach my $matchentry (@$matchlist) {
		my $expression = $$matchentry{expression};
		my ($value, $error) = evaluate_expression('global', $vars, $inst, $expression);

		if (defined $error && $error ne '') {
			print_log('global', DEBUG4, 'Evaluating match expression %s failed: %s',
				$expression, $error);
			next;
		}
		print_log('global', DEBUG4, 'Expression result: %s', defined $value ? $value : '<undef>');
		return 1 if defined $value && $value;
	}
	return 0;
}

sub sort_package ($$)
{
	my ($a, $b) = @_;

	if (! defined $a) {
		return 0 unless defined $b;
		return 1;
	}
	return -1 unless defined $b;

	my $auninst = $$a{Uninstall};
	my $aquninst = $$a{QUninstall};
	$auninst = $aquninst if defined $aquninst;
	my $buninst = $$b{Uninstall};
	my $bquninst = $$b{QUninstall};
	$buninst = $aquninst if defined $bquninst;

	my $amsi = $auninst =~ /msiexec/io;
	my $bmsi = $buninst =~ /msiexec/io;
	if (! $amsi) {
		return 0 unless defined $bmsi;
		return 1;
	}
	return -1 unless defined $bmsi;

	return $$a{Name} cmp $$b{Name};
}

sub sort_packages_to_remove ($)
{
	my ($pkglist) = @_;

	return [sort sort_package @$pkglist];
}

sub find_installed_packages ($$$$$$$)
{
	my ($channel, $def, $db, $name, $basedir, $config, $userproduct) = @_;

	my $vars = get_default_vars($config);
	set_datetime_vars($vars);
	my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, $channel);
	$$vars{appdir} = $appdir;

	my $list = [];
	if (defined $$def{'match'}) {
		refresh_installed_packages($db);
		my $installed = $$db{Installed};
		foreach my $instname (sort keys %$installed) {
			my $inst = $$installed{$instname};
			next unless defined $inst;
			push @$list, $inst if match_package_def($def, $inst, $vars);
		}
		if ($userproduct) {
			my $installed = $$db{InstalledSpec};
			foreach my $instname (sort keys %$installed) {
				my $inst = $$installed{$instname};
				next unless defined $inst;
				push @$list, $inst if match_package_def($def, $inst, $vars);
			}
		}
	}
	elsif (defined $$def{'install-check'}) {
		my $check = $$def{'install-check'};

		print_log($channel, DEBUG2, 'Evaluating install check expression %s', $check);
		my ($result, $error) = check_condition($channel, $vars, $check);
		if (! defined $result) {
			print_log($channel, INFO, 'Ignoring package %s install check: %s', $name, $error);
			next;
		}
		print_log($channel, INFO, 'Package %s install check: %s', $name, ($check ? 'found' : 'not found'));
		if ($check) {
			push @$list, {
				DisplayName => $$def{description}
			};
		}
	}
	else {
		print_log($channel, ERROR, 'Invalid package definition %s (neither "match", nor "install-check" defined)', $name);
		return undef;
	}
	return $list;
}

sub unflag_file ($$)
{
	my ($channel, $path) = @_;

	my $attrs = 0;
	if (! Win32::File::GetAttributes($path, $attrs)) {
		return 'Cannot read attributes for '.$path;
	}
	my $newattrs = $attrs & ~(SYSTEM|HIDDEN|READONLY);
	return undef if $attrs == $newattrs;
	print_log($channel, DEBUG3, 'Trying to clear attributes for %s', $path);
	if (! Win32::File::SetAttributes($path, $newattrs)) {
		return 'Cannot set attributes for '.$path;
	}
	return undef;
}

sub create_directory_for ($$)
{
	my ($channel, $path) = @_;

	$path = File::Spec->canonpath($path);
	my ($vol, $dir, $file) = File::Spec->splitpath($path);
	$dir =~ s/^\\//o;
	$dir =~ s/\\$//o;
	my $base = $vol;
	foreach my $subdirname (split(/\\/, $dir)) {
		$base .= '\\'.$subdirname;
		print_log($channel, DEBUG3, 'Checking %s', $base);
		next if -d $base;
		return sprintf('Cannot create directory %s: %s', $base, $!)
			unless mkdir($base);
		print_log($channel, DEBUG3, 'Created directory %s', $base);
	}
	return undef;	
}

sub clear_sub_dir ($$$);

sub clear_sub_dir ($$$)
{
	my ($channel, $parent, $filename) = @_;

	return sprintf('Cannot read directory %s: %s', $parent, $!)
		unless opendir(DIR, $parent);
	$filename =~ s/\\/\\\\/o;
	$filename =~ s/\./\\\./o;
	$filename =~ s/\*/\.\*/o;
	$filename =~ s/\?/\.\?/o;
	$filename =~ s/\(/\\\(/o;
	$filename =~ s/\)/\\\)/o;
	my $subdirs = [];
	my $files = [];
	print_log($channel, DEBUG3, 'Scanning directory %s for %s', $parent, $filename);
	while (1) {
		my $name = readdir(DIR);
		last unless defined $name;
		next if $name eq '.' || $name eq '..';
		my $path = $parent.'\\'.$name;
		my $matches = $name =~ /^${filename}$/;
		print_log($channel, DEBUG3, 'Found %s%s', $path, $matches ? ' - matches' : '');
		next unless $matches;
		if (-d $path) {
			push @$subdirs, $path;
		}
		else {
			push @$files, $path;
		}
	}
	closedir(DIR);
	foreach my $subdir (@$subdirs) {
		clear_sub_dir($channel, $subdir, '*');
		print_log($channel, DEBUG3, 'Removing directory %s', $subdir);
		my $error = unflag_file($channel, $subdir);
		return $error if defined $error;
		return sprintf('Cannot remove directory %s: %s', $subdir, $!)
			unless rmdir($subdir);
	}
	foreach my $file (@$files) {
		print_log($channel, DEBUG3, 'Removing file %s', $file);
		my $error = unflag_file($channel, $file);
		return $error if defined $error;
		return sprintf('Cannot remove file %s: %s', $file, $!)
			unless unlink($file);
	}
}

sub delete_dir_file ($$$$)
{
	my ($direntry, $channel, $recurse, $targetfile) = @_;

	print_log($channel, DEBUG1, 'Deleting %s%s %s',
		$direntry ? 'directory' : 'file', $recurse ? ' recursively' : '', $targetfile);

	my $path = File::Spec->canonpath($targetfile);
	my ($vol, $dir, $file) = File::Spec->splitpath($path);
	if ($file eq '') {
		return sprintf('Invalid empty last component in path: %s', $targetfile);
	}
	$dir =~ s/\\$//o;
	clear_sub_dir($channel, $vol.$dir, $file);
	return undef;
}

sub copy_file ($$$)
{
	my ($channel, $sourcefile, $targetfile) = @_;

	print_log($channel, DEBUG1, 'Copying file %s to %s', $sourcefile, $targetfile);

	return sprintf('Cannot open source file %s for copying: %s', $sourcefile, $!)
		unless sysopen(SOURCE, $sourcefile, O_RDONLY);

	my $error = create_directory_for($channel, $targetfile);
	if (defined $error) {
		close(SOURCE);
		return $error;
	}
	if (-f $targetfile) {
		$error = unflag_file($channel, $targetfile);
		if (defined $error) {
			close(SOURCE);
			return $error;
		}
	}
	if (! sysopen(TARGET, $targetfile, O_RDWR|O_CREAT|O_TRUNC)) {
		$error = sprintf('Cannot create target file %s for copying: %s', $targetfile, $!);
		close(SOURCE);
		return $error;
	}
	while (1) {
		my $buffer;
		my $len = sysread(SOURCE, $buffer, 65536);
		if (! defined $len) {
			$error = sprintf('Error reading source file %s for copying: %s', $sourcefile, $!);
			close(TARGET);
			close(SOURCE);
			unlink($targetfile);
			return $error;
		}
		last if $len == 0;
		my $sofar = 0;
		while ($sofar < $len) {
			my $done = syswrite(TARGET, $buffer, $len - $sofar, $sofar);
			if (! defined $done) {
				$error = sprintf('Error writing target file %s for copying: %s', $targetfile, $!);
				close(TARGET);
				close(SOURCE);
				unlink($targetfile);
				return $error;
			}
			last if $done == 0;
			$sofar += $done;
		}
	}
	close(TARGET);
	close(SOURCE);
	return undef;
}

sub run_exe ($$$$$$$;$)
{
	my ($channel, $db, $vars, $chdir, $program, $paramlist, $bg, $getresult) = @_;

	my $params = '';
	if (defined $paramlist && scalar @$paramlist > 0) {
		foreach my $param (@$paramlist) {
			$param = substitute_variables($vars, $param, 0, undef, $channel)
				if defined $vars && $param =~ /%[^%]*%/o;
			$params .= ' '.$param;
		}
	}
	if (defined $chdir) {
		print_log($channel, DEBUG1, 'Changing current directory to %s', $chdir);
		return (sprintf('Cannot change current directory to %s: %s', $chdir, $!), -1)
			unless chdir($chdir);
	}
	print_log($channel, DEBUG1, 'Running exe %s%s', $program, $params);

	return (sprintf('Cannot find executable file %s: %s', $program, $!), -1)
		unless -f $program;
	return (sprintf('Cannot dup STDIN: %s', $!), -1)
		unless open(IN, '<&STDIN');
	return (sprintf('Cannot dup STDERR: %s', $!), -1)
		unless open(ERR, '>&STDERR');
	eval {
		my $reader = $bg ? undef : gensym;
		my $pid = open3('<&IN', $bg ? '>&ERR' : $reader, $bg ? '>&ERR' : $reader, $program, @$paramlist);
		if (defined $db) {
			$$db{Changed} = 1;
			$$db{PatchesChanged} = 1;
			print_log('global', DEBUG4, 'Invalidating packages & patches');
		}
		if (! $bg) {
			while (<$reader>) {
				s/\r?\n$//o;
				print_log($channel, INFO, '%s', $_);
				push @$getresult, $_ if defined $getresult && ref($getresult) eq 'ARRAY';
			}
		}
		waitpid($pid, 0) unless $bg;
		close($reader) unless $bg;
	};
	my $exitcode;
	if ($bg) {
		$exitcode = 0;
		print_log($channel, DEBUG1, 'Leaving process in background');
	}
	else {
		$exitcode = $? >> 8;
		my $signal = $? & 255;
		print_log($channel, DEBUG1, 'Exit code: %d, signal: %d', $exitcode, $signal);
	}
	close(IN);
	close(ERR);
	return (sprintf('Executable %s exit code: %d', $program, $exitcode), $exitcode) if $exitcode;
	return (undef, undef);
}

sub remove_package_uninstall ($$$$$$$$$)
{
	my ($uninst, $channel, $vars, $paramlist, $dispname, $printver, $db, $counters, $removecontext) = @_;

	$uninst =~ s/(msiexec[^ ]* )\/i/$1\/X/io;
	$uninst =~ s/(msiexec[^ ]* )/$1\/qb \/norestart \/passive /io;
	print_log($channel, DEBUG2, 'Uninstall command: %s', $uninst);
	if (! defined $$removecontext{exename}) {
		$$removecontext{exename} = substitute_variables($vars, '%systemroot%/System32/cmd.exe', 1, undef, $channel);
		my $params = '';
		if (defined $paramlist && scalar @$paramlist > 0) {
			foreach my $param (@$paramlist) {
				$param = substitute_variables($vars, $param, 0, undef, $channel)
					if $param =~ /%[^%]*%/o;
				$params .= ' '.$param;
			}
		}
		$params = ' '.$params unless $params eq '';
		$$removecontext{params} = $params;
	}
	$uninst .= $$removecontext{params};
	my ($error, $exitcode) = run_exe($channel, $db, $vars, undef, $$removecontext{exename}, ['/C', $uninst], 0);
	if (defined $error) {
		if (defined $exitcode && $exitcode == 194) {
			print_log($channel, INFO, 'Ignoring package %s%s removal exit code: %s',
				$dispname, $printver, $exitcode);
			$$counters{RebootFlag} = 1;
		}
		else {
			push @{$$counters{FailList}}, $dispname;
			$$counters{FailCount}++;
			return $error;
		}
	}
	push @{$$counters{RemovedList}}, $dispname;
	$$counters{RemovedCount}++;
	return undef;
}

sub remove_package_fallback ($$$$$$$$$$$)
{
	my ($channel, $vars, $paramlist, $inst, $condition, $dispname, $ver, $printver, $db, $counters, $removecontext) = @_;

	print_log($channel, DEBUG1, 'Removing package %s%s%s', $dispname, $printver,
		defined $condition ? ' with true condition' : '');

	my $uninst = $$vars{uninstallstring};
	return sprintf('Cannot remove package %s%s, no remove steps defined and no UninstallString registry entry found',
		$dispname, $ver) unless defined $uninst;
	return remove_package_uninstall($uninst, $channel, $vars, $paramlist, $dispname, $printver, $db, $counters, $removecontext);
}

sub remove_package_steps ($$$$$$$$$$$$$$$$)
{
	my ($channel, $removesteps, $paramlist, $inst, $condition, $ver, $printver,
		$db, $def, $name, $dispname, $basedir, $genericmsiparams,
		$config, $counters, $removecontext) = @_;

	my $version = $ver;
	$version = '' unless defined $version;
	print_log($channel, INFO, 'Removing package %s version %s', $dispname, $version);

	my $uninst = $$inst{Uninstall};
	my $quninst = $$inst{QUninstall};
	$quninst = $uninst unless defined $quninst;

	my $vars = get_default_vars($config);
	set_datetime_vars($vars);
	$$vars{pkgname} = $name;
	$$vars{pkgdispname} = $dispname;
	$$vars{pkgversion} = $version;
	$$vars{uninstallstring} = $quninst if defined $quninst;
	my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, $channel);
	$$vars{appdir} = $appdir;

	my $realremove = 0;
	my $i = 0;
	foreach my $step (@$removesteps) {
		my $type = $$step{type};
		$i++;
		print_log($channel, DEBUG2, 'Removal step #%d type %s', $i, $type);

		my $error;
		my $exitcode;
		my $ignore = $$step{'ignore-failure'};
		$ignore = 0 unless defined $ignore;

		my $condition = $$step{condition};
		if (defined $condition && $type ne 'remove-pkg') {
			print_log($channel, DEBUG2, 'Evaluating condition expression %s in step #%d',
				$condition, $i);
			($condition, $error) = check_condition($channel, $vars, $condition);
			if (! defined $condition) {
				print_log($channel, INFO, 'Ignoring step #%d: %s', $i, $error);
				next;
			}
			if (! $condition) {
				print_log($channel, INFO, 'Ignoring step #%d with false condition', $i);
				next;
			}
			print_log($channel, INFO, 'Executing step #%d with true condition', $i);
		}

		if ($type eq 'remove-pkg') {
			my $paramlist = $$step{parameters};
			$paramlist = [] unless defined $paramlist;
			$error =  remove_package_fallback($channel, $vars, $paramlist, $inst, $condition, $dispname,
				$ver, $printver, $db, $counters, $removecontext);
			delete $$vars{'installed-version'};
			$realremove = 1 unless defined $error;
		}
		elsif ($type eq 'run') {
			my $bg = defined $$step{background} && $$step{background};
			my $chdir = defined $$step{chdir} ?
				substitute_variables($vars, $$step{chdir}, 1, $appdir, $channel) : undef;
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel);
			my $paramlist = $$step{parameters};
			$paramlist = [] unless defined $paramlist;
			($error, $exitcode) = run_exe($channel, $db, $vars, $chdir, $sourcefile, $paramlist, $bg);
		}
		elsif ($type eq 'msi') {
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel);
			my $exename = substitute_variables($vars, '%systemroot%/System32/msiexec.exe', 1, undef, $channel);
			my $paramlist = $$step{parameters};
			$paramlist = [] unless defined $paramlist;
			unshift @$paramlist, '/x', $sourcefile;
			if (-f $sourcefile) {
				push @$paramlist, @$genericmsiparams if defined $genericmsiparams;
				($error, $exitcode) = run_exe($channel, $db, $vars, undef, $exename, $paramlist, 0);
			}
			else {
				$error = sprintf('Cannot find MSI file %s: %s', $sourcefile, $!);
				$exitcode = -1;
			}
		}
		elsif ($type eq 'reg') {
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel);
			my $exename = substitute_variables($vars, '%systemroot%/System32/reg.exe', 1, undef, $channel);
			my $paramlist = ['import', $sourcefile];
			if (-f $sourcefile) {
				($error, $exitcode) = run_exe($channel, $db, $vars, undef, $exename, $paramlist, 0);
			}
			else {
				$error = sprintf('Cannot find REG file %s: %s', $sourcefile, $!);
				$exitcode = -1;
			}
		}
		elsif ($type eq 'file') {
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, $channel);
			my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1);
			$error = copy_file($channel, $sourcefile, $targetfile);
		}
		elsif ($type eq 'delete-file') {
			my $recurse = $$step{recurse};
			$recurse = defined $recurse && $recurse;
			my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1);
			$error = delete_dir_file(0, $channel, $recurse, $targetfile);
		}
		elsif ($type eq 'delete-dir') {
			my $recurse = $$step{recurse};
			$recurse = defined $recurse && $recurse;
			my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1);
			$error = delete_dir_file(1, $channel, $recurse, $targetfile);
		}
		elsif ($type eq 'setvar') {
			my $varname = $$step{variable};
			my $expression = $$step{expression};
			my $filename = $$step{filename};
			if (defined $expression) {
				print_log($channel, DEBUG2, 'Evaluating variable %s expression %s in step #%d',
					$varname, $expression, $i);
				$error = set_install_var($channel, $vars, $varname, $expression);
			}
			else {
				print_log($channel, DEBUG2, 'Evaluating variable %s filename %s in step #%d',
					$varname, $filename, $i);
				my $file = substitute_variables($vars, $filename, 1, $appdir, $channel);
				$$vars{$varname} = $file;
			}
		}
		if (defined $error) {
			$ignore = 1 if defined $exitcode && ($exitcode == 194 || $exitcode == 63);
			if (! $ignore) {
		                return sprintf('Removal failed in step #%d: %s', $i, $error);
			}
			print_log($channel, INFO, 'Ignoring failed step #%d: %s', $i, $error);
		}
	}

	print_log($channel, INFO, 'Finished removing package %s version %s', $dispname, $version);
	if (! $realremove) {
		push @{$$counters{RemovedList}}, $dispname;
		$$counters{RemovedCount}++;
	}
	return undef;
}

sub remove_packages ($$$$$$$$$$$$)
{
	my ($channel, $vars, $def, $name, $paramlist, $list, $condition, $db,
		$basedir, $genericmsiparams, $config, $counters) = @_;

	my $removecontext = {};
	$list = sort_packages_to_remove($list);
	foreach my $inst (@$list) {
		my $dispname = $$inst{DisplayName};
		my $ver = extract_package_version($channel, $def, $inst, $basedir, $config);
		$ver = $$inst{DisplayVersion} unless defined $ver;
		my $printver = defined $ver ? ' ('.$ver.')' : '';
		if (defined $condition) {
			$$vars{'installed-version'} = $ver;

			print_log($channel, DEBUG2, 'Evaluating package removal condition expression %s', $condition);
			my ($result, $error) = check_condition($channel, $vars, $condition);
			if (! defined $result) {
				print_log($channel, INFO, 'Ignoring package %s%s: %s',
					$dispname, $printver, $error);
				next;
			}
			if (! $result) {
				print_log($channel, INFO, 'Ignoring package %s%s with false condition',
					$dispname, $printver);
				next;
			}
		}
		my $error;
		my $removesteps = $$def{remove};
		if (defined $removesteps) {
			$error = remove_package_steps($channel, $removesteps, $paramlist, $inst, $condition, $ver, $printver,
				$db, $def, $name, $dispname, $basedir, $genericmsiparams, $config, $counters, $removecontext);
		}
		else {
			my $uninst = $$inst{Uninstall};
			my $quninst = $$inst{QUninstall};
			$quninst = $uninst unless defined $quninst;

			my $set = 0;
			if (defined $quninst && ! defined $$vars{uninstallstring}) {
				$$vars{uninstallstring} = $quninst;
				$set =1;
			}
			$error = remove_package_fallback($channel, $vars, $paramlist, $inst, $condition, $dispname,
				$ver, $printver, $db, $counters, $removecontext);
			delete $$vars{uninstallstring} if $set;
		}
		return $error if defined $error;
	}
	return undef;
}

sub set_install_var ($$$$)
{
	my ($channel, $vars, $varname, $expression) = @_;

	my ($value, $error) = evaluate_expression($channel, $vars, {}, $expression);

	if (defined $error && $error ne '') {
		return sprintf('Evaluating variable %s expression %s failed: %s',
			$varname, $expression, $error);
	}
	print_log($channel, DEBUG2, 'Expression result: %s', defined $value ? $value : '<undef>');
	if (defined $value) {
		$$vars{$varname} = $value;
	}
	else {
		delete $$vars{$varname};
	}
	return undef;
}

sub remove_package ($$$$$$$$)
{
	my ($db, $def, $name, $list, $basedir, $genericmsiparams, $config, $counters) = @_;

	set_current_pkg_name($name);

	my $vars = get_default_vars($config);
	set_datetime_vars($vars);
	$$vars{pkgname} = $name;
	my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, 'pkg');
	$$vars{appdir} = $appdir;

	my $paramlist = $$def{'remove-parameters'};
	$paramlist = [] unless defined $paramlist;
	my $error = remove_packages('pkg', $vars, $def, $name, $paramlist,
		[map { $$_[1] } @$list], undef, $db, $basedir, $genericmsiparams, $config, $counters);
	print_log('pkg', ERROR, 'Package removal failed: %s', $error) if defined $error;

	set_current_pkg_name(undef);
	return defined $error ? 0 : 1;
}

sub install_package ($$$$$$$$$)
{
	my ($db, $def, $inst, $name, $version, $basedir, $genericmsiparams, $config, $counters) = @_;

	my $installsteps = $$def{install};
	if (! defined $installsteps) {
		push @{$$counters{DoneList}}, $name;
		$$counters{DoneCount}++;
		return 1;
	}

	set_current_pkg_name($name);

	print_log('pkg', INFO, 'Installing package %s version %s', $name, $version);

	my $vars = get_default_vars($config);
	set_datetime_vars($vars);
	$$vars{pkgname} = $name;
	$$vars{pkgversion} = $version;
	my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $basedir, 'pkg');
	$$vars{appdir} = $appdir;

	my $i = 0;
	foreach my $step (@$installsteps) {
		my $type = $$step{type};
		$i++;
		print_log('pkg', DEBUG2, 'Install step #%d type %s', $i, $type);

		my $error;
		my $exitcode;
		my $ignore = $$step{'ignore-failure'};
		$ignore = 0 unless defined $ignore;

		my $condition = $$step{condition};
		if (defined $condition && $type ne 'remove-pkg') {
			print_log('pkg', DEBUG2, 'Evaluating condition expression %s in step #%d',
				$condition, $i);
			($condition, $error) = check_condition('pkg', $vars, $condition);
			if (! defined $condition) {
				print_log('pkg', INFO, 'Ignoring step #%d: %s', $i, $error);
				next;
			}
			if (! $condition) {
				print_log('pkg', INFO, 'Ignoring step #%d with false condition', $i);
				next;
			}
			print_log('pkg', INFO, 'Executing step #%d with true condition', $i);
		}

		if ($type eq 'remove-pkg') {
			my $paramlist = $$step{parameters};
			$paramlist = [] unless defined $paramlist;
	                my $list = find_installed_packages('pkg', $def, $db, $name, $basedir, $config, 0);
	                if (defined $list) {
				$error = remove_packages('pkg', $vars, $def, $name, $paramlist, $list, $condition,
					$db, $basedir, $genericmsiparams, $config, $counters);
				delete $$vars{'installed-version'};
			}
			else {
				$error = 'Invalid package definition';
			}
		}
		elsif ($type eq 'run') {
			my $bg = defined $$step{background} && $$step{background};
			my $chdir = defined $$step{chdir} ?
				substitute_variables($vars, $$step{chdir}, 1, $appdir, 'pkg') : undef;
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg');
			my $paramlist = $$step{parameters};
			$paramlist = [] unless defined $paramlist;
			($error, $exitcode) = run_exe('pkg', $db, $vars, $chdir, $sourcefile, $paramlist, $bg);
		}
		elsif ($type eq 'msi') {
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg');
			my $exename = substitute_variables($vars, '%systemroot%/System32/msiexec.exe', 1, undef, 'pkg');
			my $paramlist = $$step{parameters};
			$paramlist = [] unless defined $paramlist;
			unshift @$paramlist, '/i', $sourcefile;
			if (-f $sourcefile) {
				push @$paramlist, @$genericmsiparams if defined $genericmsiparams;
				($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0);
			}
			else {
				$error = sprintf('Cannot find MSI file %s: %s', $sourcefile, $!);
				$exitcode = -1;
			}
		}
		elsif ($type eq 'msp') {
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg');
			my $exename = substitute_variables($vars, '%systemroot%/System32/msiexec.exe', 1, undef, 'pkg');
			my $paramlist = $$step{parameters};
			$paramlist = [] unless defined $paramlist;
			unshift @$paramlist, '/p', $sourcefile;
			if (-f $sourcefile) {
				($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0);
			}
			else {
				$error = sprintf('Cannot find MSP file %s: %s', $sourcefile, $!);
				$exitcode = -1;
			}
		}
		elsif ($type eq 'reg') {
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg');
			my $exename = substitute_variables($vars, '%systemroot%/System32/reg.exe', 1, undef, 'pkg');
			my $paramlist = ['import', $sourcefile];
			if (-f $sourcefile) {
				($error, $exitcode) = run_exe('pkg', $db, $vars, undef, $exename, $paramlist, 0);
			}
			else {
				$error = sprintf('Cannot find REG file %s: %s', $sourcefile, $!);
				$exitcode = -1;
			}
		}
		elsif ($type eq 'file') {
			my $sourcefile = substitute_variables($vars, $$step{'source-file'}, 1, $appdir, 'pkg');
			my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1);
			$error = copy_file('pkg', $sourcefile, $targetfile);
		}
		elsif ($type eq 'delete-file') {
			my $recurse = $$step{recurse};
			$recurse = defined $recurse && $recurse;
			my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1);
			$error = delete_dir_file(0, 'pkg', $recurse, $targetfile);
		}
		elsif ($type eq 'delete-dir') {
			my $recurse = $$step{recurse};
			$recurse = defined $recurse && $recurse;
			my $targetfile = substitute_variables($vars, $$step{'target-file'}, 1);
			$error = delete_dir_file(1, 'pkg', $recurse, $targetfile);
		}
		elsif ($type eq 'setvar') {
			my $varname = $$step{variable};
			my $expression = $$step{expression};
			my $filename = $$step{filename};
			if (defined $expression) {
				print_log('pkg', DEBUG2, 'Evaluating variable %s expression %s in step #%d',
					$varname, $expression, $i);
				$error = set_install_var('pkg', $vars, $varname, $expression);
			}
			else {
				print_log('pkg', DEBUG2, 'Evaluating variable %s filename %s in step #%d',
					$varname, $filename, $i);
				my $file = substitute_variables($vars, $filename, 1, $appdir, 'pkg');
				$$vars{$varname} = $file;
			}
		}
		if (defined $error) {
			$ignore = 1 if defined $exitcode && ($exitcode == 194 || $exitcode == 63);
			if (! $ignore) {
				print_log('pkg', ERROR, 'Installation failed in step #%d: %s', $i, $error);
				set_current_pkg_name(undef);
				push @{$$counters{FailList}}, $name;
				$$counters{FailCount}++;
				return 0;
			}
			print_log('pkg', INFO, 'Ignoring failed step #%d: %s', $i, $error);
		}
	}

	print_log('pkg', INFO, 'Finished installing package %s version %s', $name, $version);
	set_current_pkg_name(undef);
	push @{$$counters{InstalledList}}, $name;
	$$counters{InstalledCount}++;
	return 1;
}

sub pkgdef_get_desired_version ($$$$$)
{
	my ($config, $name, $base_directory, $def, $version) = @_;

	return undef unless defined $version;
	if (ref($version) eq 'HASH') {
		my $etype = $$version{type};
		print_log('global', DEBUG4, 'Evaluating version reference %s in definition %s',
			$etype, $$def{description});
		if ($etype eq 'expression') {
			my $vars = get_default_vars($config);
			set_datetime_vars($vars);
			$$vars{pkgname} = $name;
			my $appdir = substitute_variables($vars, $$def{'source-directory'}, 1, $base_directory, 'pkg');
			$$vars{appdir} = $appdir;

			my $expression = $$version{expression};
			my ($value, $error) = evaluate_expression('global', $vars, $def, $expression);

			if (defined $error && $error ne '') {
				print_log('global', DEBUG4, 'Evaluating version reference expression %s failed: %s',
					$expression, $error);
				return undef;
			}
			print_log('global', DEBUG4, 'Version reference expression result: %s', defined $value ? $value : '<undef>');
			$version = $value;
		}
	}
	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, $pvars) = @_;

	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;
	$$pvars = $vars;
	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 get_patch_vars ($$$$$)
{
	my ($config, $base_directory, $pdef, $patchdef, $kb) = @_;

	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 $kbnum = $kb;
	my $number;
	my $extra;
	if ($kb =~ /^([^\/]+)\/(.+)*$/o) {
		$kbnum = $1;
		$number = $2;
		$extra = '';
	}
	elsif ($kb =~ /^(\d+)([^0-9].*)$/o) {
		$number = $1;
		$extra = '-'.$2;
	}
	else {
		$number = $kb;
		$extra = '';
	}
	$$vars{patchkbnum} = $kbnum;
	$$vars{patchnum} = $number;
	$$vars{patchextra} = $extra;
	$$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');
	$$vars{sourcefile} = $sourcefile;
	my $pkgid = substitute_variables($vars, $sourcespec, 0, undef, 'pkg');
	$$vars{packageid} = $1 if $pkgid =~ /^(.*)\.msu$/oi;
	return $vars;
}

sub get_msupdate_info ($$$)
{
	my ($config, $pkgid, $vars) = @_;

	return undef unless defined $pkgid;
	my $urlpkgid = $pkgid;
	my $url = 'http://'.$$config{'install-host'}.$$config{'msupdate-path'}.'?id='.$urlpkgid;
	print_log('global', DEBUG1, 'Getting patch information from \'%s\'', $url);
	my $ua = LWP::UserAgent->new;
	my $response = $ua->get($url);
	if (! $response->is_success) {
		print_log('global', ERROR, 'Error getting patch information from \'%s\': %s', $url, $response->status_line);
		return 1;
	}
	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;
		$$vars{'mspatch_'.$key} = $value;
		print_log('global', DEBUG1, 'Found patch information %s=%s', $key, $value);
	}
	if (defined $$vars{mspatch_pkg_name} && defined $$vars{mspatch_pkg_key} &&
		defined $$vars{mspatch_pkg_arch} && defined $$vars{mspatch_pkg_version}) {
		$$vars{pkgname} = $$vars{mspatch_pkg_name}.'~'.$$vars{mspatch_pkg_key}.'~'.$$vars{mspatch_pkg_arch}.'~~'.$$vars{mspatch_pkg_version};
	}
	return undef;
}

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_patch_vars($config, $base_directory, $pdef, $patchdef, $kb);
	refresh_installed_patches($db);
	return 1 if defined get_msupdate_info($config, $$vars{packageid}, $vars);
	my $pkgname = $$vars{pkgname};
	my $patches = $$db{Patches};
	my $pkgs = $$db{Pkgs};
	my $patchdbname = $kb =~ /^([^\/]+)\.*$/o ? $1 : $kb;
	my $foundpatch = $$patches{$patchdbname};
	my $foundpkg = defined $pkgname ? $$pkgs{$pkgname} : undef;
	if (defined $foundpkg) {
		my $foundforpkgs = $$foundpkg{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');
	}
	elsif (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_patch_vars($config, $base_directory, $pdef, $patchdef, $kb);
	$$vars{pkgname} = $name;

	my $error;
	my $exitcode;
	my $style = $$patchdef{style};
	my $patchdir = $$vars{patchdir};
	my $sourcefile = $$vars{sourcefile};
	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, '/norestart'];
		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_net_group_member ($$)
{
	my ($groupname, $member) = @_;

	my $sourcefile = $ENV{systemroot}.'\\System32\\net.exe';
	my $paramlist = ['localgroup', $groupname, $member, '/add'];
	my ($error, $exitcode) = run_exe('global', undef, undef, undef, $sourcefile, $paramlist, 0);
	if (defined $error) {
		print_log('global', ERROR, 'Error adding user %s to group %s: %s',
			$member, $groupname, $error);
		return 0;
	}
	print_log('global', DEBUG1, 'Added user %s to group %s', $member, $groupname);
	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};
		print_log('global', DEBUG4, 'Checking device %s %s', $busname, $devname);
		my $matches = 0;
		foreach my $filtrow (@$filter) {
			my $busfilter = $$filtrow{bus};
			my $devfilter = $$filtrow{device};
			next unless defined $busfilter && defined $devfilter;
			print_log('global', DEBUG4, '  against filter %s %s', $busfilter, $devfilter);
			next unless $busname =~ /$busfilter/ && $devname =~ /$devfilter/;
			print_log('global', DEBUG4, '  match found!');
			$matches = 1;
			last;
		}
		return 1 if $matches;
	}
	print_log('global', DEBUG4, 'No match found');
	return 0;
}

sub get_file_checksum ($)
{
	my ($path) = @_;

	local *FILE;
	my $ctx = Digest::MD5->new;
	if (! open(FILE, '<', $path)) {
		print_log('global', ERROR, 'Cannot open file %s: %s', $path, $!);
		return undef;
	}
	if (! defined binmode(FILE)) {
		print_log('global', ERROR, 'Cannot read file %s: %s', $path, $!);
		close(FILE);
		return undef;
	}
	$ctx->addfile(*FILE);
	close(FILE);
	return $ctx->hexdigest;
}

sub compare_file_chksum ($$)
{
	my ($path, $chksum) = @_;

	my $infchksum = get_file_checksum($path);
	if (! defined $infchksum) {
		return 0;
	}
	return $infchksum eq $chksum;
}

sub check_if_driver_present ($$$)
{
	my ($db, $drvdef, $infpath) = @_;

	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size) = stat($infpath);
	if (! defined $size) {
		print_log('global', INFO, 'Cannot read .INF file size for %s: %s', $infpath, $!);
		return 0;
	}
	my $infchksum = get_file_checksum($infpath);
	if (! defined $infchksum) {
		return 0;
	}
	my $infs = $$db{INFs};
	if (! defined $infs) {
		print_log('global', INFO, 'Missing INF database');
		return 0;
	}
	foreach my $inf (values %$infs) {
		next unless $$inf{Size} == $size;
		if (compare_file_chksum($$inf{Path}, $infchksum)) {
			print_log('global', INFO, 'Found driver %s installed as %s', $infpath, $$inf{Path});
			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 no relevant device is present', $drvinstname);
			push @{$$counters{SkipList}}, $drvinstname;
			$$counters{SkipCount}++;
			next;
		}
		my $present = check_if_driver_present($db, $drvdef, $infpath);
		if ($present) {
			print_log('global', WARNING, 'Driver %s already installed%s',
				$drvinstname, $update ? ' - nothing to do' : '');
		}
		else {
			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, $vars, $directory, $acls) = @_;

	foreach my $acl (@$acls) {
		my $sourcefile = $ENV{systemroot}.'\\System32\\icacls.exe';
		print_log('global', INFO, 'acl list: %s', join(',', @$acl));
		$acl = [map { substitute_variables($vars, $_, 0, undef, 'global') } @$acl];
		my $paramlist = [$directory, @$acl];
		print_log('global', INFO, 'param list: %s', join(',', @$paramlist));
		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, $vars, $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, $vars, $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, $vars, $base_directory, $counters, $update) = @_;

	my $name = $$pkg{name};
	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, $vars, $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_group ($$$$)
{
	my ($pkg, $vars, $counters, $update) = @_;

	my $name = $$pkg{name};
	my $hostname = $ENV{'COMPUTERNAME'};
	my $groupname = $$pkg{'group'};
	my $members = $$pkg{'members'};
	$members = [] unless defined $members;
	if (defined $vars) {
		$groupname = substitute_variables($vars, $groupname, 0, undef, 'global')
			if $groupname =~ /%[^%]*%/o;
		$members = [map { $_ =~ /%[^%]*%/o ? substitute_variables($vars, $_, 0, undef, 'global') : $_ } @$members];
	}

	my $sourcefile = $ENV{systemroot}.'\\System32\\wbem\\wmic.exe';
	my $paramlist = ['path', 'win32_groupuser', 'where', '(groupcomponent="win32_group.name=\''.$groupname.'\',domain=\''.$hostname.'\'")'];
	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 group %s: %s', $groupname, $error);
		push @{$$counters{FailList}}, $name;
		$$counters{FailCount}++;
		return 0;
	}
	my $header;
	my $found;
	my $users = {};
	my $groups = {};
	if (defined $$result[0] && $$result[0] !~ /No Instance/o) {
		($header, $result) = parse_wmic($result);
		foreach my $row (@$result) {
			my $member = $$row{PartComponent};
			next unless defined $member;

			if ($member =~ /Win32_Group\.Domain="([^"]*)",Name="([^"]*)"/oi) {
				my $domain = lc($1);
				my $group = lc($2);
				$$groups{$domain.'\\'.$group} = 1;
			}
			elsif ($member =~ /Win32_UserAccount\.Domain="([^"]*)",Name="([^"]*)"/oi) {
				my $domain = lc($1);
				my $user = lc($2);
				$$groups{$domain.'\\'.$user} = 1;
			}
		}
	}

	foreach my $member (@$members) {
		my $name = lc($member);
		if (defined $$groups{$name} || defined $$users{$name}) {
				print_log('global', WARNING, 'User %s a member of group %s - OK',
					$member, $groupname);
		}
		else {
			print_log('global', WARNING, 'User %s not a member of group %s - %s',
				$member, $groupname, $update ? 'adding' : 'ADD');
			if ($update) {
				my $rc = do_net_group_member($groupname, $member);
				if (! $rc) {
					push @{$$counters{FailList}}, $groupname.'/'.$member;
					$$counters{FailCount}++;
					next;
				}
				push @{$$counters{InstalledList}}, $groupname.'/'.$member;
				$$counters{InstalledCount}++;
			}
			else {
				push @{$$counters{ToInstallList}}, $groupname.'/'.$member; 
				$$counters{ToInstallCount}++;
			}
		}
	}

	return 1;
}

sub handle_user ($$$$)
{
	my ($pkg, $vars, $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;
	if (defined $vars) {
		$username = substitute_variables($vars, $username, 0, undef, 'global')
			if $username =~ /%[^%]*%/o;
		$fullname = substitute_variables($vars, $fullname, 0, undef, 'global')
			if $fullname =~ /%[^%]*%/o;
	}

	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 $vars;
	my $pvars = \$vars;
	my $name = $$pkg{name};
	my ($condcheck, $error) = pkg_check_condition($pkg, $name, $config, $pvars);
	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, $vars, $counters, $update);
	}
	if (defined $$pkg{'group'}) {
		return handle_group($pkg, $vars, $counters, $update);
	}
	if (defined $$pkg{'directory'}) {
		return handle_directory($config, $pkg, $vars, $base_directory, $counters, $update);
	}
	if (defined $$pkg{'mbr-source-file'}) {
		return handle_mbr($config, $pkg, $counters, $update);
	}
	if (defined $$pkg{'driver-directory'}) {
		return handle_driver($config, $base_directory, $db, $pkg, $counters, $update);
	}

	my $pkgdefs = $$config{'package-def'};
	my $patchdefs = $$config{'patch-def'};
	my $def = $$pkgdefs{$name};
	my $pdef = $$patchdefs{$name};
	if (! defined $def && ! defined $pdef) {
		print_log('global', WARNING, 'No package or patch definition %s found', $name);
		push @{$$counters{FailList}}, $name;
		$$counters{FailCount}++;
		return;
	}

	if (defined $def) {
		my ($condcheck, $error) = pkgdef_check_availability($def, $name, $config);
		if (defined $error) {
			print_log('global', INFO, 'Ignoring package %s: %s', $name, $error);
			push @{$$counters{FailList}}, $name;
			$$counters{FailCount}++;
			return;
		}
		if (defined $condcheck) {
			if (! $condcheck) {
				print_log('global', INFO, 'Skipping package %s on false condition', $name);
				push @{$$counters{SkipList}}, $name;
				$$counters{SkipCount}++;
				return;
			}
			print_log('global', DEBUG1, 'Considering package %s with true condition', $name);
		}

		my $desired = pkgdef_get_desired_version($config, $name, $base_directory, $def, $$pkg{'install-version'});
		my ($found, $toinstall, $toremove) = assess_pkg($config, $base_directory, $db,
			$name, $desired, $$pkg{'remove-version'}, $def, $update);
		if (! defined $found && ! defined $toinstall && ! defined $toremove) {
			print_log('global', INFO, 'Ignoring package %s: Invalid package', $name);
			push @{$$counters{FailList}}, $name;
			$$counters{FailCount}++;
			return;
		}
		if (scalar @$toremove > 0) {
			push @{$$counters{ToRemoveList}}, $name; 
			$$counters{ToRemoveCount} += scalar @$toremove;
		}
		if (defined $toinstall) {
			push @{$$counters{ToInstallList}}, $name; 
			$$counters{ToInstallCount}++;
		}
		if ($update) {
			remove_package($db, $def, $name, $toremove, $base_directory,
				$$config{'generic-msi-parameters'}, $config, $counters)
				if scalar @$toremove > 0;
			install_package($db, $def, $found, $name, $desired, $base_directory,
				$$config{'generic-msi-parameters'}, $config, $counters)
				if defined $toinstall;
		}
	}
	if (defined $pdef) {
		my ($condcheck, $error) = patchsetdef_check_availability($pdef, $name, $config);
		if (defined $error) {
			print_log('global', INFO, 'Ignoring patch set %s: %s', $name, $error);
			push @{$$counters{FailList}}, $name;
			$$counters{FailCount}++;
			return;
		}
		if (defined $condcheck) {
			if (! $condcheck) {
				print_log('global', INFO, 'Skipping patch set %s on false condition', $name);
				push @{$$counters{SkipList}}, $name;
				$$counters{SkipCount}++;
				return;
			}
			print_log('global', DEBUG1, 'Considering patch set %s with true condition', $name);
		}
		drop_pkg_cache($db);
		my $patchlist = $$pdef{patches};
		foreach my $patchdef (@$patchlist) {
			($condcheck, $error) = patchdef_check_availability($pdef, $patchdef, $name, $config);
			if (defined $error) {
				print_log('global', INFO, 'Ignoring patch set %s patches %s: %s', $name, join(',', @{$$patchdef{kb}}), $error);
				push @{$$counters{FailList}}, @{$$patchdef{kb}};
				$$counters{FailCount} += scalar @{$$patchdef{kb}};
				next;
			}
			if (defined $condcheck) {
				if (! $condcheck) {
					print_log('global', INFO, 'Skipping patch set %s patches %s on false condition', $name, join(',', @{$$patchdef{kb}}));
					push @{$$counters{SkipList}}, @{$$patchdef{kb}};
					$$counters{SkipCount} += @{$$patchdef{kb}};
					next;
				}
				print_log('global', DEBUG1, 'Considering patch set %s patches %s with true condition', $name, join(',', @{$$patchdef{kb}}));
			}

			foreach my $kb (@{$$patchdef{kb}}) {
				my $leave = assess_patch($config, $base_directory, $db, $name, $pdef, $patchdef, $kb, $update, $counters);
				if ($update && ! $leave) {
					install_patch($config, $base_directory, $db, $pdef, $patchdef, $kb, $counters);
				}
			}
		}
	}
}

sub get_install_sets ($)
{
	my ($config) = @_;

	my $url = 'http://'.$$config{'install-host'}.$$config{'install-path'};
	print_log('global', DEBUG1, 'Getting package configuration from \'%s\'', $url);
	my $ua = LWP::UserAgent->new;
	my $response = $ua->get($url);
	if (! $response->is_success) {
		print_log('global', ERROR, 'Error getting package configuration from \'%s\': %s', $url, $response->status_line);
		return 1;
	}
	my $flags = {};
	my $globalflags = {};
	my $pkgsets = $$config{'package-sets'};
	$pkgsets = {} unless defined $pkgsets;
	foreach my $line (split /\n/, $response->decoded_content) {
		chomp $line;
		print_log('global', DEBUG3, 'Received response line: %s', $line);
		next unless $line =~ /^([^=]+)=(.*)$/o;
		my $key = $1;
		my $value = $2;
		if ($key eq 'pkgset') {
			my $pkgset = $$pkgsets{$value};
			if (defined $pkgset) {
				print_log('global', DEBUG1, 'Found package set %s', $value);
				foreach my $pkgflag (@$pkgset) {
					if (! defined $$flags{$pkgflag}) {
						print_log('global', DEBUG1, 'Adding package flag %s', $pkgflag);
						$$flags{$pkgflag} = 1;
					}
				}
			}
			else {
				print_log('global', WARNING, 'Unknown package set %s', $value);
			}
			next;
		}
		if ($key eq 'pkg') {
			if (! defined $$flags{$value}) {
				print_log('global', DEBUG1, 'Adding package flag %s', $value);
				$$flags{$value} = 1;
			}
		}
		if ($key eq 'flag') {
			my $flag;
			if ($value =~ /^([^=]+)=(.*)$/o) {
				$flag = $1;
				$value = $2;
			}
			else {
				$flag = $value;
				$value = 1;
			}
			if (! defined $$globalflags{$flag}) {
				print_log('global', DEBUG1, 'Adding global flag %s=%s', $flag, $value);
				$$globalflags{$flag} = $value;
			}
		}
	}
	my $genvars = $$config{'generic-variables'};
	foreach my $pkgflag (keys %$flags) {
		push @$genvars, {
			variable => 'set-'.$pkgflag,
			expression => 1
		};
	}
	foreach my $flag (keys %$globalflags) {
		my $value = $$globalflags{$flag};
		push @$genvars, {
			variable => $flag,
			expression => $value
		};
	}
	return undef;
}

1;