File Coverage

blib/lib/Net/DHCP/Windows/Netsh/Parse.pm

Criterion	Covered	Total	%
statement	88	98	89.8
branch	30	44	68.1
condition	12	21	57.1
subroutine	10	10	100.0
pod	5	6	83.3
total	145	179	81.0

package Net::DHCP::Windows::Netsh::Parse;

use 5.006;
use strict;
use warnings;
use JSON;

=head1 NAME

Net::DHCP::Windows::Netsh::Parse - Parses the output from 'netsh dhcp server dump'

=head1 VERSION

Version 0.1.0

=cut

our $VERSION = '0.1.0';


=head1 SYNOPSIS

    use Net::DHCP::Windows::Netsh::Parse;

    my $parser=Net::DHCP::Windows::Netsh::Parse->new;

    eval{
        $parser->parse( $dump );
    };
    if ( $@ ){
        print "It failed with... ".$@."\n";
    }

    # no white space
    my $json=$parser->json(0);

    # now with useful white space
    $json=$parser->json(0);

=head1 METHODS

=head2 new

This initiates the object.

No arguments are taken.

    my $parser=Net::DHCP::Windows::Netsh::Parse->new;

=cut

sub new {
	my $self={
			  servers=>{},
			  };
	bless $self;

	return $self;
}

=head2 parse

This parses a dump from netsh.

Only one option is taken and that is a string.

Nothing is returned. It will die if it fails to parse.

    eval{
        $parser->parse( $dump );
    };
    if ( $@ ){
        print "It failed with... ".$@."\n";
    }

=cut

sub parse{
	my $self=$_[0];
	my $data=$_[1];

	if ( ! defined( $data ) ){
		die( 'Nothing defined to parse' );
	}

	# break it appart and grab only the relevant lines
	# removing the pointless comments and blank lines
	my @lines=grep( /^Dhcp\ Server/ , split( /\n/, $data ));

	# Don'y really care about lines matching like....
	# Dhcp Server \\winboot Add Class "Default Routing and Remote Access Class" "User class for remote access clients" 525241532e4d6963726f736f6674 0 b
	# Dhcp Server \\winboot Set DatabaseName "dhcp.mdb"
	# Dhcp Server \\winboot Add Optiondef 36 "Ethernet Encapsulation" BYTE 0 comment="0=>client should use ENet V2; 1=> IEEE 802.3" 0
	# Dhcp Server \\winboot v6 Add Class "Microsoft Windows Options" "Microsoft vendor-specific options for Windows Clients" 4d53465420352e30 1 b 311
	# Dhcp Server \\winboot v6 Add Optiondef 21 "SIP Server Domain Name List " STRING 1 comment="Domain Name of SIP servers available to the client " ""
	#
	# set is case sensitive... we want stuff like...
	# Dhcp Server \\winboot set optionvalue 15 STRING "foo.bar"
	@lines=grep( !/^Dhcp\ Server\ [\\A-Za-z\.0-9]+\ Add\ Class/ , @lines );
	@lines=grep( !/^Dhcp\ Server\ [\\A-Za-z\.0-9]+\ v6\ Add\ Class/ , @lines );
	@lines=grep( !/^Dhcp\ Server\ [\\A-Za-z\.0-9]+\ Set/ , @lines );
	@lines=grep( !/^Dhcp\ Server\ [\\A-Za-z\.0-9]+\ Add\ Optiondef/ , @lines );
	@lines=grep( !/^Dhcp\ Server\ [\\A-Za-z\.0-9]+\ v6\ Add\ Optiondef/ , @lines );

	foreach my $line( @lines ){
		# these will always be the same, just need to define something there
		# garbage1=Dhcp garbage2=Server
		my ( $garbage1, $garbage2, $server, $command, $the_rest)=split( /\ +/, $line, 5);

		if ( $command eq 'set' ){
			# Dhcp Server \\winboot set optionvalue 15 STRING "foo.bar"
			# Dhcp Server \\winboot set optionvalue 6 IPADDRESS "10.202.97.1" "10.202.97.2"
			# Dhcp Server \\winboot set optionvalue 66 STRING "10.93.192.10"
			# Dhcp Server \\winboot set optionvalue 67 STRING "linux"
			# Dhcp Server \\winboot set optionvalue 60 STRING "PXEClient"
			my @the_rest=split(/\ +/, $the_rest);

			if (
				( $the_rest[0] eq 'optionvalue' ) &&
				( $the_rest[1] =~ /^[0-9]+$/ ) &&
				defined( $the_rest[3] )
				){

				my @values;
				my $the_rest_location=3;
				while(defined( $the_rest[$the_rest_location] )){
					push(@values, $the_rest[$the_rest_location]);
					$the_rest_location++;
				}

				$self->add_option($server, 'default', $the_rest[1], \@values);
			}
		}elsif( $command eq 'add' ){
			# Dhcp Server \\winboot add scope 10.40.10.0 255.255.254.0 "it.ord" ""
			# Dhcp Server \\winboot add scope 10.31.129.248 255.255.255.248 "ipkvm.sjc" "The NEW ipkvm.sjc after 10.93.180.216/29 was swiped"
			my @the_rest=split(/\ +/, $the_rest, 4);

			if (
				( $the_rest[0] eq 'scope' ) &&
				defined( $the_rest[1] ) &&
				defined( $the_rest[2] )
				){
				$self->add_scope($server, $the_rest[1], $the_rest[2], $the_rest[3]);
			}
		}elsif( $command =~ /^[Ss]cope$/ ){
			# Dhcp Server \\winboot Scope 10.31.129.248 Add iprange 10.31.129.251 10.31.129.254
			# Dhcp Server \\winboot Scope 10.31.110.0 set optionvalue 51 DWORD "1800"
			# Dhcp Server \\winboot Scope 10.31.110.0 set optionvalue 3 IPADDRESS "10.31.110.1"
			my @the_rest=split(/\ +/, $the_rest);

			if (
				( $the_rest[1] eq 'set' ) &&
				( $the_rest[2] eq 'optionvalue' )
				){
				my @values;

				my $the_rest_location=5;
				while(defined( $the_rest[$the_rest_location] )){
					push(@values, $the_rest[$the_rest_location]);
					$the_rest_location++;
				}

				$self->add_option($server, $the_rest[0], $the_rest[3], \@values);
			}elsif(
				   ( $the_rest[1] eq 'Add' ) &&
				   ( $the_rest[2] eq 'iprange' )
				   ){
				my @values=($the_rest[3].' '.$the_rest[4]);
				$self->add_option($server, $the_rest[0], 'range', \@values);
			}
		}
	}
}

=head2 hash_ref

This returns the current hash reference for the parsed data.

    my $hash_ref=$parser->hash_ref;

=cut

sub hash_ref{
	return $_[0]->{servers};
}

=head2 json

This returns the parsed data as JSON.

One option is taken and that is either a 0/1 for
if it should be made nice and pretty.

    # no white space
    my $json=$parser->json(0);

    # now with useful white space
    $json=$parser->json(0);

=head1 DATA STRUCTURE

The structure of it is as below for both the return
hash ref or JSON.

   $hostname=>{$scope}=>{
                         $options=>{
                                     $option_id=>[]
                                    },
                         mask=>subnet mask,
                         desc=>description,
                        }

The $option_id will always be numeric, except for one special
case, which is range. That option contains a array of ranges
that the scope in question uses with in that subnet. Each item
the array represents one range. The format is as below for the
string.

    $start_ip $end_ip

Hostname will always have \\ removed, so \\winboot
becomes just winboot.

$scope is going to be the base address of the subnet.

=cut

sub json{
	my $self=$_[0];
	my $pretty=$_[1];

	my $json=JSON->new;
	$json->pretty( $pretty );

	return $json->encode( $self->{servers} );
}

=head1 INTERNAL FUNCTIONS

=head2 add_options

This adds a option for a scope.

    $hostname = Hostname of the DHCP server.
    $scope = scope name
    $option = DHCP option integer
    $values = array ref of values

    $parser->( $hostname, $scope, $option, \@values );

=cut

sub add_option{
	my $self=$_[0];
	my $hostname=$_[1];
	my $scope=$_[2];
	my $option=$_[3];
	my $values=$_[4];

	# make sure we have everything we need
	# split up so we produce a more useful error
	if ( !defined( $hostname ) ){
		die('No hostname specified');
	}elsif( !defined( $scope ) ){
		die('No scope specified');
	}elsif( !defined( $option ) ){
		die('No option specified');
	}elsif( !defined( $values->[0] ) ){
		die('No option specified');
	}

	# skip over lines like this...
	# Dhcp Server \\winboot Scope 10.40.10.0 set optionvalue 51 DWORD user="Default BOOTP Class" "1800"
	if (
		( $option eq '51' ) &&
		( $values->[0] =~ /^[Uu]/ )
		){
		return 1;
	}

	$hostname=~s/^\\+//;

	if ( ! defined( $self->{servers}{$hostname} ) ){
		$self->{servers}{$hostname}={};
	}

	if ( ! defined( $self->{servers}{$hostname}{$scope} ) ){
		$self->{servers}{$hostname}{$scope}={};
	}

	if ( ! defined( $self->{servers}{$hostname}{$scope}{$option} ) ){
		$self->{servers}{$hostname}{$scope}{$option}=[];
	}

	# process each value
	foreach my $value ( @{ $values } ){
		# windows adds " to each of these
		$value=~s/^\"//;
		$value=~s/\"$//;
		push( @{ $self->{servers}{$hostname}{$scope}{$option} }, $value );
	}

	return 1;
}

=head2 add_scope

This adds a new scope.

    $hostname = Hostname of the DHCP server.
    $scope = scope name
    $mask = subnet mask for the scope
    $desc = description

    $parser->( $hostname, $scope, $mask, $desc );

=cut

sub add_scope{
	my $self=$_[0];
	my $hostname=$_[1];
	my $scope=$_[2];
	my $mask=$_[3];
	my $desc=$_[4];

	# make sure we have everything we need
	# split up so we produce a more useful error
	if ( !defined( $hostname ) ){
		die('No hostname specified');
	}elsif( !defined( $scope ) ){
		die('No scope specified');
	}elsif( !defined( $mask ) ){
		die('No subnet mask specified');
	}elsif( !defined( $desc ) ){
		die('No subnet description specified');
	}

	$hostname=~s/^\\+//;

	if ( ! defined( $self->{servers}{$hostname} ) ){
		$self->{servers}{$hostname}={};
	}

	if ( ! defined( $self->{servers}{$hostname}{$scope} ) ){
		$self->{servers}{$hostname}{$scope}={};
	}

	$self->{servers}{$hostname}{$scope}{mask}=$mask;
	$self->{servers}{$hostname}{$scope}{desc}=$desc;

	return 1;
}

=head1 AUTHOR

Zane C. Bowers-Hadley, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::DHCP::Windows::Netsh::Parse


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)


=cut

1; # End of Net::DHCP::Windows::Netsh::Parse