package Net::Hacky::Detect::IP;

use 5.006;
use strict;
use warnings;
use Try::Tiny;
use Capture::Tiny ':all';
use IO::Socket::INET;
use File::Temp qw( tempfile );

=head1 NAME

Net::Hacky::Detect::IP - Hackily try different methods of attaining local system IPs

=head1 WARNING

This module does not yet support returning IPv6 addresses, though will do soon!

=head1 README

I am working on a lot cleaner version of this module, that uses the detected OS and acts from there, however I do not havea
access to a vast amount of machines, if you would like to help me, please read 'Bugs' and use the corrosponding tracker, to
submit: Your OS, What binaries are on the system for showing ip information, the output of the command, the output of 'uname -a'
and any other relevant data.

=head1 VERSION

Version 0.014

=cut

our $VERSION = '0.014';

my $tools = {
    unix => {
        tools => [[qw(netstat -an4)],[qw(netstat -an6)],[qw(ip addr show)],[qw(ifconfig)],[qw(sockstat -4)],[qw(sockstat -6)]],
        paths => [qw(/bin/ /sbin/ /usr/sbin/ /usr/bin/)]
    },
    windows => {
        tools => [[qw(netstat -an)],[qw(ipconfig)],[qw(cscript)]],
        paths => [""]
    }
};

my $cscript = <<'EOF';

On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration")

For Each objItem In colItems
    For Each objValue In objItem.IPAddress
        If objValue <> "" Then
        WScript.Echo objValue
        End If
    Next
Next

EOF

=head1 SYNOPSIS

    use Net::Hacky::Detect::IP;
    my @ips = @{ Net::Hacky::Detect::IP->scan() };
    foreach my $ip (@ips) {
        print "Detected ip: $ip\n";
    }

=head1 DESCRIPTION 

Hackily concatenate output from multiple system commands then attempt to find valid ips from it, once found they are 
tested for connectability then returned. This is not pretty nor very clever but extracting system ips is a nightmare
however you go about it and this method appears to be the more reliable.

=head1 METHODS

=head2 scan

Attempt to find local system ips, returns a list of [] if nothing found.

=cut

sub scan {
    my $return = [];
    my $os = 'unix';
    
    if ($^O =~ m#win#i) { $os = 'windows' } 

    # Some short cuts and initial scalars for storing things in
    my $dumps = "";
    my $short = $tools->{$os};
    my $winScript;

    # Go searching for something we can use
    foreach my $tool ( @{ $short->{tools} } ) {
        my ($cmd,@args) = @{$tool};
        foreach my $path ( @{ $short->{paths} } ) {
            # Full path to the binary
            my $fullpath = "$path$cmd";

            # Storage space for the execution returns
            my ($merged, @result);

            # If this is a call for cscript, we need to act differently..
            if ($cmd eq 'cscript') {
                $winScript = File::Temp::tempdir() . '\\' . 'findip.vbs';
                open(my $fh,'>',$winScript);
                print $fh $cscript;
                close($fh);

                push @args,$winScript;
            }
            
            # If we are on unix we do not need to execute everything we can check the path exists.
            next if ( $os eq 'unix' && !-e $fullpath );
            
            # Execute and collect;
            try {
                ($merged, @result) = capture_merged{ system($fullpath,@args) };
            };

            # Execute and store output within the script
            $dumps .= $merged ;
        }
    }

    # Check we found anything at all
    if (length($dumps) < 10) { return [] }
    
    # Ok we did find something ...first extract remove all \n
    ($dumps) =~ s#\n# #g;
    
    # Then convert into an array split into words
    my @possibleIP = split(/\s+/,$dumps);
    
    # Make sure we only look at unique ips
    my $unique;
    
    # Validate all the ips, for speed we will do a silly check first
    foreach my $testIP (@possibleIP) {
        if ($testIP =~ m#(\d+\.\d+\.\d+\.\d+)#) {
            # Copy $1 to $IP because it looks prettier
            my $IP = $1;
            
            # Check we have not already dealt with this ip and its valid
            next if ($unique->{$IP});
            $unique->{$IP} = 1;
            if (!_checkIPv4(4,$IP)) { next }

            # Push the valid ip into the return space
            push @$return,$IP;
        }
    }
    return $return;
}

=head1 INTERNAL METHODFS

=head2 _checkIPv4

Check an IPv4 is valid and usable, takes 2 mandatory arguments;

a '4' or '6' to designate an IPv4 or IPv6 address and the host its self as an ip not hostname.

=cut


sub _checkIPv4 {
    my ($version,$host) = @_;
    
    if (!$version || !$host) {
        warn "Incorrect number of arguments, returning fail";
        return 0;
    }

    # By default fail the bind
    my $bindfail = 0;
    
    if ($version == 4) {
        # Split the ip into relevent blocks
        my @ip = split(/\./,$host);

        # Do a more precise check (This should rule out all netmasks and broadcasts)
        return 0 if ($ip[0] <= 0 || $ip[0] >= 255);
        return 0 if ($ip[1] < 0 || $ip[1] > 255);
        return 0 if ($ip[2] < 0 || $ip[2] > 255);
        return 0 if ($ip[3] <= 0 || $ip[3] >= 255);
        
        # Now lets try listen on the ip.. see if we can bind to it, try three times on
        # random ports incase we bump into a busy one.
        for (1..3) {
            my $fail=1;
            my $port = 1024+int(rand(65410));
            my $sock = IO::Socket::INET->new(
                LocalAddr   =>  $host,
                LocalPort   =>  $port,
                Proto       =>  'tcp',
                ReuseAddr   =>  1
            ) or $fail = 0;
            if ($fail) {
                $bindfail=1;
                last;
            }
        }
    }
    
    return $bindfail;
}


=head1 AUTHOR

Paul G Webster, C<< <daemon at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests through the authors code repository at c<https://gitlab.com/paul-g-webster/PL-Net-Hacky-Detect-IP>

=head1 SUPPORT

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

    perldoc Net::Hacky::Detect::IP


You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-Hacky-Detect-IP>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-Hacky-Detect-IP>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-Hacky-Detect-IP/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2017 Paul G Webster.

This program is distributed under the (Simplified) BSD License:
L<http://www.opensource.org/licenses/BSD-2-Clause>

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


=cut

1; # End of Net::Hacky::Detect::IP
