#!/usr/bin/perl -w
#
# $Id: lgp_edit.pl,v 1.20 2005/08/07 02:29:32 jmates Exp $
#
# Copyright (c) 2005, Alex Dioso.
# All rights reserved.
#
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
#
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
#####################################################################
#
# When I have free time I need to look into using the different binary file
# editing options with perl.  For more info see:
# Oreilly: Perl Cookbook 8.20 "Reading or Writing Unicode from a Filehandle"
# 
# Does binary using hex strings.  Do not put spaces between hex chars like how
# regedit displays it.  Also it is 2 hex chars per binary char.
# 
# Registry Policy File Format
# http://msdn.microsoft.com/library/default.asp?url=/library/en-us/policy/policy/registry_policy_file_format.asp
# I think the body is 2 bytes per char for International stuff
# 
# The interesting policy files are in
# %WINDIR%\system32\GroupPolicy
# Machine\Registry.pol and User\Registry.pol
# 
#
# gPCMachineExtensionNames and gPCUserExtensionNames follow this format:
# 
# [{<GUID of client-side extension>}{<GUID of MMC extension>}
# {<GUID of second MMC extension if appropriate>}]
# [repeat first section as appropriate]
#
# GUID for client-side extensions can be found in:
# HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\GPExtensions
#
# GUID of MMC extension can be found in:
# HKLM\SOFTWARE\Microsoft\MMC\SnapIns
#
# I don't know where to find which policy needs which GUID, except by adding
# the policy using gpedit.msc and then checking gpt.ini for what GUIDs were
# added.  There are GUIDs in the Adm files (System32\GroupPolicy\Adm).
# 
# Current gpt.ini file versions can be found in
# HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Group Policy\State
# Machine\GPO-List\*\Version
# and
# (USERSID)\GPO-List\*\Version
# This script will search for the highest version there and increment it
# accordingly. I am going to assume that there is only one GPO (but there could
# be more) so I will only take GPO-List\0\Version.
#
# Currently I can only think of how these GUIDs can be added.  Once they are
# added to gpt.ini, they lose all ties to the policy they were added with
# unless we keep track of it somewhere else.  When we remove a policy, it's
# GUID will remain because we don't know if the remaining policies need that
# GUID.

use strict;
use Getopt::Long;
use Config::Tiny;
use Win32::TieRegistry ( Delimiter=>"/" );

BEGIN {
  open SAVEOUT, ">&1";
  open SAVERRR, ">&2";
}

END {
  close SAVEOUT;
  close SAVERRR;
}

# Header section of a Registry.pol file, looks like it is stored in
# little-endian format
use constant REGFILE_SIGNATURE => 67655250;
use constant MAX_VER           => 99999999;

# How much to increment the gpt.ini version for each type of policy change
use constant USER_INC           => 65535;
use constant MACHINE_INC        => 1;

# Names to use in gpt.ini
use constant USER_EXT           => "gPCUserExtensionNames";
use constant MACHINE_EXT        => "gPCMachineExtensionNames";

# Found in WinNT.h
use constant REG_NONE                       => 0;
use constant REG_SZ                         => 1;
use constant REG_EXPAND_SZ                  => 2;
use constant REG_BINARY                     => 3;
use constant REG_DWORD                      => 4;
use constant REG_DWORD_BIG_ENDIAN           => 5;
use constant REG_LINK                       => 6;
use constant REG_MULTI_SZ                   => 7;
use constant REG_RESOURCE_LIST              => 8;
use constant REG_FULL_RESOURCE_DESCRIPTOR   => 9;
use constant REG_RESOURCE_REQUIREMENTS_LIST => 10;
use constant REG_QWORD                      => 11;

# Boolean
use constant FALSE => 0;
use constant TRUE  => 1;

# Important file locations
# Just going to assume these are static
my $windir = $ENV{WINDIR};
my $system32 = "$windir\\system32";
my $grouppolicy = "$system32\\GroupPolicy";
my $gpt_ini = "$grouppolicy\\gpt.ini";
my $user_dir = "$grouppolicy\\User";
my $machine_dir = "$grouppolicy\\Machine";
my $pol_file = "Registry.pol";

my %opts;
GetOptions(\%opts, "u|user", "m|machine", 'a', 'x', 'c', "k=s", "v=s", "t=i", "d=s", 'w', 'r', "g=s");

usage() unless (exists $opts{'u'} or exists $opts{'m'});
usage() if (exists $opts{'u'} and exists $opts{'m'});

if (exists $opts{'a'} or exists $opts{'x'} or exists $opts{'c'}) {
  usage() if exists $opts{'a'} and exists $opts{'x'};
  usage() if exists $opts{'a'} and exists $opts{'c'};
  usage() if exists $opts{'x'} and exists $opts{'c'};
  usage() unless exists $opts{'k'} and exists $opts{'v'} and
    (exists $opts{'u'} or exists $opts{'m'});
}

if (exists $opts{'a'} or exists $opts{'c'}) {
  usage() unless exists $opts{'t'} and exists $opts{'d'};
}

if (exists $opts{'a'}) {
  usage() unless exists $opts{'g'};
}

umask 022;

my %reg_keys;
my $pol_version = "00000001";
my $policy = exists $opts{'u'} ? $user_dir : $machine_dir;
mkdir $policy unless -d $policy;
$policy .= "\\$pol_file";
my $increment = exists $opts{'u'} ? USER_INC : MACHINE_INC;

unless (Load_Pol($policy, \$pol_version, \%reg_keys)) {
  die "Error loading $policy!\n";
}

###############################################################################
# Add the given policy
if (exists $opts{'a'}) {
  # If key already exists just change the settings
  $reg_keys{ $opts{'k'} }{ $opts{'v'} }{"type"} = $opts{'t'};
  if ($opts{'t'} == REG_SZ or
      $opts{'t'} == REG_EXPAND_SZ or
      $opts{'t'} == REG_MULTI_SZ) {
    $reg_keys{ $opts{'k'} }{ $opts{'v'} }{"size"} = 2 * (length($opts{'d'}) + 1);
  }
  # Binary data, 2 bits in input per byte
  else {
    $reg_keys{ $opts{'k'} }{ $opts{'v'} }{"size"} = length($opts{'d'}) / 2;
  }
  $reg_keys{ $opts{'k'} }{ $opts{'v'} }{"data"} = $opts{'d'};
  Write_Pol($policy, $pol_version, \%reg_keys);

  # Always set gpt.ini version to what the registry thinks it should be
  Update_gpt_ini($gpt_ini , exists $opts{'u'} ? 'u':'m', $opts{'g'});

}

###############################################################################
# Remove the given policy
elsif (exists $opts{'x'}) {
  die "Error: key and value don't exist!\n"
    unless (exists $reg_keys{ $opts{'k'} }{ $opts{'v'} });

  delete $reg_keys{ $opts{'k'} }{ $opts{'v'} };
  delete $reg_keys{ $opts{'k'} } unless (keys %{ $reg_keys{ $opts{'k'} } });
  Write_Pol($policy, $pol_version, \%reg_keys);

}

###############################################################################
# Check if the given policy exists
elsif (exists $opts{'c'}) {
  if (exists $reg_keys{ $opts{'k'} }{ $opts{'v'} }) {
    if ($reg_keys{ $opts{'k'} } { $opts{'v'} }{ "type" } eq $opts{'t'} and
        $reg_keys{ $opts{'k'} } { $opts{'v'} }{ "data" } eq $opts{'d'}) {
      exit(0);
    }
  }
  exit(1);
}

###############################################################################
# Print out the current policy
elsif (not exists $opts{'r'}) {
  Print_Pol(exists $opts{'u'} ? "-u" : "-m", \%reg_keys);

  if (exists $opts{'w'}) {
    Write_Pol("foo.pol", $pol_version, \%reg_keys);
  }
}

###############################################################################
# Reload the policy
if (exists $opts{'r'}) {
  exec "gpupdate", "/force";
}


###############################################################################
# SUBS
###############################################################################

###############################################################################
# Note version stored in hex (wtf).
sub Update_gpt_ini {
  my $gpt_ini = shift;
  my $u_or_m = shift;
  my @guids = split(/,/, shift);
  my $ver_loc = "GPO-List/0/Version";

  unless (-e $gpt_ini) {
    open(GPT_INI, ">$gpt_ini");
    print GPT_INI "[General]\n";
    print GPT_INI "gPCFunctionalityVersion=2\n";
    close(GPT_INI);
  }
  my $gpt_ini_hash = Config::Tiny->read($gpt_ini);

  # How much to increment by
  my $incr = $u_or_m eq "u" ? USER_INC: MACHINE_INC;
  my $name = $u_or_m eq "u" ? USER_EXT: MACHINE_EXT;

  my $GPO = $Registry->{"LMachine/SOFTWARE/Microsoft/Windows/CurrentVersion/Group Policy/State"};

  unless (exists $gpt_ini_hash->{'General'}->{'Version'}) {
    $gpt_ini_hash->{'General'}->{'Version'} = 1;
  }

  for my $state (keys %{$GPO}) {
    if (exists $GPO->{"$state$ver_loc"}) {
      if (hex($GPO->{"$state$ver_loc"}) >
          $gpt_ini_hash->{'General'}->{'Version'}) {
        $gpt_ini_hash->{'General'}->{'Version'} = hex($GPO->{"$state$ver_loc"});
      }
    }
  }

  for my $guid (@guids) {
    $gpt_ini_hash->{'General'}->{$name} .= $guid unless
      exists $gpt_ini_hash->{'General'}->{$name} and
      $gpt_ini_hash->{'General'}->{$name} =~ m/\Q$guid/;
  }

  $gpt_ini_hash->{'General'}->{'Version'} += $incr;

  $gpt_ini_hash->write($gpt_ini);
}

sub Write_Pol {
  my $filename    = shift;
  my $pol_version = shift;
  my $reg_keys    = shift;

  unless (open(REGPOL, ">$filename")) {
    print STDERR "Can't open $filename!\n";
    return FALSE;
  }
  binmode(REGPOL);

  # Bumping the policy version seems to mess things up.
  #$pol_version++;

  write_dword(REGFILE_SIGNATURE, *REGPOL);
  write_dword($pol_version, *REGPOL);

  foreach my $key (keys %reg_keys) {
    foreach my $value (keys %{ $reg_keys{$key} }) {
      write_dchar('[', *REGPOL);
      write_string_semi($key,  *REGPOL);
      write_string_semi($value, *REGPOL);
      write_int_semi($reg_keys{$key}{$value}{"type"}, *REGPOL);
      write_int_semi($reg_keys{$key}{$value}{"size"}, *REGPOL);
      if ($reg_keys{$key}{$value}{"type"} == REG_SZ or
          $reg_keys{$key}{$value}{"type"} == REG_EXPAND_SZ or
          $reg_keys{$key}{$value}{"type"} == REG_MULTI_SZ) {
        write_string($reg_keys{$key}{$value}{"data"}, *REGPOL);
      } else {
        write_binary_string($reg_keys{$key}{$value}{"data"}, *REGPOL);
      }
      write_dchar(']', *REGPOL);
    }
  }

  close(REGPOL);

}

# Print out in .ini format for use with policy module
sub Print_Pol {
  my $u_or_m = shift;
  my $reg_keys = shift;
  foreach my $key (keys %reg_keys) {
    foreach my $value (keys %{ $reg_keys{$key} }) {
      print "[windows]\n";
      print "  file    = $u_or_m\n";
      print "  key     = $key\n";
      print "  value   = $value\n";
      foreach my $field (qw/type size data/) {
        print "  $field    = $reg_keys{$key}{$value}{$field}\n";
      }
      print "\n";
    }
  }
}

# Load the Policy file
sub Load_Pol {
  my $filename    = shift;
  my $pol_version = shift;
  my $reg_keys    = shift;

  my $buffer       = "";
  my $current_char = '';

  #if the policy file doesn't exist, create it
  unless (-e "$filename" ) {
    unless (open(REGPOL, ">$filename")) {
      print STDERR "Can't create $filename!\n";
      return FALSE;
    }
    close(REGPOL);
    Write_Pol($filename, $$pol_version, $reg_keys);
  }

  unless (open(REGPOL, "<$filename")) {
    print STDERR "Can't open $filename!\n";
    return FALSE;
  }

  binmode(REGPOL);

  # Verify that the file is a Registry.pol file
  get_dword(\$buffer, *REGPOL);
  unless ($buffer == REGFILE_SIGNATURE) {
    print STDERR "$filename is not a Registry.pol file.\n";
    return FALSE;
  }

  # Get the version of the file
  get_dword(\$$pol_version, *REGPOL);

  # Read in the [
  while (get_dchar(\$current_char, *REGPOL)) {
    my $key   = "";
    my $value = "";
    my $type  = "";
    my $size  = "";
    my $data  = "";

    if ($current_char ne '[') {
      print STDERR "Error in $filename, did not expect $current_char.\n";
      return FALSE;
    }

    get_to_semi(\$key, *REGPOL);

    get_to_semi(\$value, *REGPOL);

    get_int_to_semi(\$type, *REGPOL);

    get_int_to_semi(\$size, *REGPOL);

    get_data($type, $size, \$data, *REGPOL);

    get_dchar(\$current_char, *REGPOL);
    if ($current_char ne ']') {
      print STDERR "Error in $filename, did not expect $current_char.\n";
      return FALSE;
    }


    $reg_keys{$key}{$value}{'type'} = $type;
    $reg_keys{$key}{$value}{'size'} = $size;
    $reg_keys{$key}{$value}{'data'} = $data;
  }
  close(REGPOL);
  return TRUE;
}

sub get_data {
  my $type = shift;
  my $size = shift;
  my $data = shift;
  (*FILE) = @_;
  $$data = "";
  my $current_char;

  if ($type == REG_SZ or $type == REG_EXPAND_SZ or $type == REG_MULTI_SZ) {
    for (1..($size/2)) {
      if (not get_dchar(\$current_char, *REGPOL)) {
        return FALSE;
      }
      $$data = $$data . $current_char;
    }
    # Trailing char for REG_SZ ?
    chop $$data;
  } else {
    for (1..$size) {
      if (not get_byte(\$current_char, *REGPOL)) {
        return FALSE;
      }
      $$data = $$data . $current_char;
    }
  }
  # Not needed, size accounts for it.
  # read in remaining nul
  # get_dchar(undef, *REGPOL);
}

sub get_int_to_semi {
  my $entry = shift;
  (*FILE) = @_;
  my $temp = "";
  $$entry = 0;

  # assuming 2 bytes constant
  for (0..1) {
    read(FILE, $temp, 1);
    $$entry += ord($temp) * (256**$_);
  }

  # Swallow the semicolon
  get_dchar(undef, *REGPOL);
  get_dchar(undef, *REGPOL);
}

sub get_to_semi {
  my $entry = shift;
  (*FILE) = @_;
  my $temp = "";
  $$entry = "";
  while (get_dchar(\$temp, *FILE)) {
    last if ($temp eq ';');
    $$entry = $$entry . $temp;
  }

  # chop trailing nul
  chop($$entry);
}

sub get_dword {
  my $buffer = shift;
  (*FILE) = @_;
  read(FILE, $$buffer, 4);
  my $size = 2 * length($$buffer);
  $$buffer = unpack("H$size", reverse($$buffer));
}

sub get_dchar {
  my $current_char = shift;
  (*FILE) = @_;
  my $status = get_dbyte(\$$current_char, *FILE);
  if ($status == TRUE) {
    $$current_char = chr $$current_char;
  }
  return $status;
}

sub get_dbyte {
  my $current_char = shift;
  (*FILE) = @_;
  if (eof FILE) {
    return FALSE;
  }
  read(FILE, $$current_char, 2);
  $$current_char = hex unpack("H4", reverse($$current_char));
  return TRUE;
}

sub get_byte {
  my $current_char = shift;
  (*FILE) = @_;
  if (eof FILE) {
    return FALSE;
  }
  read(FILE, $$current_char, 1);
  $$current_char = unpack("H2", $$current_char);
  return TRUE;
}

sub write_string_semi {
  my $buffer = shift;
  (*FILE) = @_;
  write_string($buffer, *FILE);
  write_dchar(';', *FILE);
}

sub write_string {
  my $buffer = shift;
  (*FILE) = @_;
  for (0 .. length($buffer) - 1) {
    write_dchar(substr($buffer, $_, 1), *FILE);
  }
  write_dbyte("00", *FILE);
}

sub write_binary_string {
  my $buffer = shift;
  (*FILE) = @_;
  for (0 .. (length($buffer) - 1)/2) {
    write_byte(substr($buffer, ($_*2), 2), *FILE);
  }
}

sub write_int_semi {
  my $buffer = shift;
  (*FILE) = @_;
  my $temp;

  # Assuming 2 bytes max
  $temp = $buffer % 256;
  print FILE chr($temp);
  
  $buffer -= $temp;
  $temp = $buffer / 256;
  print FILE chr($temp);

  # If it turns out that you can store more than 65535 in a registry entry
  # the following should work
  # 
  # my $count = 0;
  # while ($buffer > 0) {
  #   $temp = $buffer/(256**$count);
  #   $temp = $temp % 256;
  #   print FILE chr($temp);
  #   $buffer -= $temp * (256**$count);
  #   $count++;
  # }

  write_dbyte("00", *FILE);
  write_dchar(';', *FILE);

}

sub write_dchar {
  my $buffer = shift;
  (*FILE) = @_;
  print FILE pack("a2", $buffer);
}

sub write_dbyte {
  my $buffer = shift;
  (*FILE) = @_;
  print FILE pack("H4", $buffer);
}

sub write_byte {
  my $buffer = shift;
  (*FILE) = @_;
  print FILE pack("H2", $buffer);
}

sub write_dword {
  my $buffer = shift;
  (*FILE) = @_;
  print FILE scalar reverse pack("H8", $buffer);
}

sub usage {
  print
"\nusage: $0 [((-a -g GUID|-c) -t KEYTYPE -d DATA)|-x -k \"KEY\" -v \"VALUE\"] [-r] -(u)ser|(m)achine\n";
  exit;
}