Commit: dca7e1d8f8b6c961e03d3274683c2b0d0ef6be79 - libnet-dhcp6-perl (git)

恥ずかしい勘違いから生まれた、DHCP6の不要かつ部分的な実装

Commit MetaInfo

• Revision: dca7e1d8f8b6c961e03d3274683c2b0d0ef6be79 (tree)
• Zeit: 2021-08-11 23:35:27
• Autor: dyknon <dyknon@user...>
• Commiter: dyknon

Log Message

add Net::DHCP6::Option::DnsServer

Ändern Zusammenfassung

• modified: Net/DHCP6/AbstractOption/DUID.pm
• modified: Net/DHCP6/AbstractOption/List.pm
• modified: Net/DHCP6/Message.pm
• add: Net/DHCP6/Option/DnsServer.pm
• modified: Net/DHCP6/Option/OptionRequest.pm
• add: Net/DHCP6/Value/Ipv6Addr.pm

Diff

--- a/Net/DHCP6/AbstractOption/DUID.pm
+++ b/Net/DHCP6/AbstractOption/DUID.pm
@@ -22,7 +22,7 @@ sub new {
         $self = \$opts{data};
     }elsif(@_ == 1){
         $self = shift;
-        $self = \$self if(!ref $self);
+        $self = \$self if(!length ref $self);
     }elsif(lc($_[0]) eq "llt" && @_ == 4){
         shift;  #llt
         $self = \(pack("S>S>L>", 1, shift, shift) . shift);

--- a/Net/DHCP6/AbstractOption/List.pm
+++ b/Net/DHCP6/AbstractOption/List.pm
@@ -35,6 +35,12 @@ sub serialize_elem { ... }
 # must overridden
 sub consume_elem { ... }
 
+# may overridden
+sub coerce {
+    my $class_or_self = shift;
+    shift;
+}
+
 sub all_elems {
     my $self = shift;
     @$self;

--- a/Net/DHCP6/Message.pm
+++ b/Net/DHCP6/Message.pm
@@ -20,7 +20,7 @@ sub gen_xid {
 sub new {
     my $class = shift;
     my $type = shift;
-    my $id = ref $_[0] ? undef : shift;
+    my $id = length ref $_[0] ? undef : shift;
     unless(defined $id){
         $id = $class->gen_xid;
     }

--- /dev/null
+++ b/Net/DHCP6/Option/DnsServer.pm
@@ -0,0 +1,33 @@
+package Net::DHCP6::Option::DnsServer;
+# RFC3646 3.
+
+use strict;
+use warnings;
+use Net::DHCP6::AbstractOption::Vector;
+use Net::DHCP6::Parameters qw/DHCP6_OPT_DNS_SERVERS/;
+use Net::DHCP6::Value::Ipv6Addr;
+
+our $VERSION = "0.0.1";
+our @ISA = qw/Net::DHCP6::AbstractOption::Vector/;
+
+use constant code   => DHCP6_OPT_DNS_SERVERS;
+use constant name   => "DnsServer";
+use constant len_elem => 16;
+
+sub serialize_elem {
+    my $class_or_self = shift;
+    shift->raw;
+}
+
+sub parse_elem {
+    my $class_or_self = shift;
+    Net::DHCP6::Value::Ipv6Addr->from_bytes(shift);
+}
+
+sub coerce {
+    my $class_or_self = shift;
+    Net::DHCP6::Value::Ipv6Addr->new(shift);
+}
+
+__PACKAGE__->register_option;
+1;

--- a/Net/DHCP6/Option/OptionRequest.pm
+++ b/Net/DHCP6/Option/OptionRequest.pm
@@ -23,5 +23,12 @@ sub parse_elem {
     unpack("S>", shift);
 }
 
+sub coerce {
+    my $class_or_self = shift;
+    my $val = 0+shift;
+    die "out of range" if($val < 0 || $val >= 2**16);
+    $val;
+}
+
 __PACKAGE__->register_option;
 1;

--- /dev/null
+++ b/Net/DHCP6/Value/Ipv6Addr.pm
@@ -0,0 +1,169 @@
+package Net::DHCP6::Value::Ipv6Addr;
+
+use strict;
+use warnings;
+
+our $VERSION = "0.0.1";
+
+sub new {
+    my $class = shift;
+    if(@_ == 0){
+        $class->from_array(0, 0, 0, 0, 0, 0, 0, 0);
+    }elsif(@_ == 1){
+        my $self = shift;
+        if(ref $self eq ""){
+            $class->from_str($self);
+        }elsif(ref $self eq "ARRAY" && !eval{$self->isa("ARRAY")}){
+            $class->from_array(@$self);
+        }elsif(eval{$self->DOES(__PACKAGE__)}){
+            $class->from_bytes($self->raw);
+        }elsif(eval{$self->DOES("Math::BigInt")}){
+            $class->from_bigint($self);
+        }else{
+            $class->from_str("$self");
+        }
+    }else{
+        $class->from_array(@_);
+    }
+}
+
+# RFC4291 2.2.
+sub from_str {
+    my $class = shift;
+    my $str = shift;
+
+# disallow multiple "::"
+    die if($str =~ /:::|::.*::/);
+
+# disallow zero length pieces other than "::"
+    die if($str =~ /^:(?!:)/);
+    die if($str =~ /(?<!:):$/);
+
+# test other restrictions of ipv6 address syntax
+    die if($str !~ /^([0-9a-fA-F:]+)((?<=:)[0-9]+(?:\.[0-9]+){3})?$/);
+
+# extract ipv4 part if it exists
+    my $v4part;
+    if($2){
+        $str = $1 . "0:0"; # placeholder of ipv4 part
+        $v4part = pack "C*", map{
+            die if($_ >= 256);
+            $_;
+        }split(/\./, $2);
+    }
+
+    my @parts = split(/:/, $str, -1);
+    if($str =~ /^::/){
+        shift @parts;
+    }
+    if($str =~ /::$/){
+        pop @parts;
+    }
+    my $zeros = 8 - @parts + 1;
+
+    my $self = pack "S>*", map{
+        if(length $_){
+# decode hex
+            die if(hex($_) >= 0x10000);
+            hex($_);
+        }else{
+# replace :: with *one or more* zeros
+            die if($zeros == 0);
+            (0) x $zeros;
+        }
+    } @parts;
+    die "invalid length" if(length $self != 16);
+
+# concatenate ipv4 part
+    if(defined $v4part){
+        $self = substr($self, 0, 12) . $v4part;
+    }
+
+    $class->from_bytes($self);
+}
+
+sub from_bytes {
+    my $class = shift;
+    my $value = shift;
+    die "invalid length" if(length $value != 16);
+    my $self = \$value;
+    bless $self, $class;
+}
+
+sub from_bigint {
+    my $class = shift;
+    my $raw = "\0"x16 . shift->to_bytes;  # big endian = network byte order
+    my $sould_zeros = substr($raw, 0, length($raw) - 16);
+    die "out of range" if($sould_zeros ne "\0" x length($sould_zeros));
+    $class->from_bytes(substr($raw, length($raw) - 16));
+}
+
+sub from_array {
+    my $class = shift;
+    my $self;
+    if(@_ == 16){
+        $self = pack "C*", @_;
+    }elsif(@_ == 8){
+        $self = pack "S>*", @_;
+    }else{
+        die "invalid length";
+    }
+    $class->from_bytes($self);
+}
+
+# RFC4291 2.2.
+# RFC5952 4.
+sub str {
+    my $self = shift;
+    my @parts = unpack "S>*", $$self;
+
+    my $start_mzeros;
+    my $length_mzeros = 0;
+    {
+        my $start_zeros;
+        my $length_zeros = 0;
+        while(my ($i, $v) = each(@parts)){
+            if($v){
+                if($length_zeros > $length_mzeros){
+                    $start_mzeros = $start_zeros;
+                    $length_mzeros = $length_zeros;
+                }
+                $length_zeros = 0;
+            }else{
+                if($length_zeros++ == 0){
+                    $start_zeros = $i;
+                }
+            }
+        }
+        if($length_zeros > $length_mzeros){
+            $start_mzeros = $start_zeros;
+            $length_mzeros = $length_zeros;
+        }
+    }
+
+    @parts = map{sprintf "%x", $_} @parts;
+    if($length_mzeros > 1){
+        my $i1 = $start_mzeros - 1;
+        my $i2 = $start_mzeros + $length_mzeros;
+        @parts = (@parts[0..$i1], "", @parts[$i2..$#parts]);
+    }
+    if($parts[0] eq ""){
+        unshift @parts, "";
+    }
+    if($parts[$#parts] eq ""){
+        push @parts, "";
+    }
+    join(":", @parts);
+}
+
+sub raw {
+    my $self = shift;
+    $$self;
+}
+
+use overload (
+    '""' => sub {
+        my $self = shift;
+        $self->str;
+    }
+);