Commit: 3a2139426df753d37656236297caa3d9e00dc28c - libnet-dhcp6-perl (git)

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

Commit MetaInfo

• Revision: 3a2139426df753d37656236297caa3d9e00dc28c (tree)
• Zeit: 2021-08-11 04:20:49
• Autor: dyknon <dyknon@user...>
• Commiter: dyknon

Log Message

sending packet OK.

Ändern Zusammenfassung

• add: Makefile
• modified: Net/DHCP6/Message.pm
• add: Net/DHCP6/MessageExchange.pm
• modified: Net/DHCP6/Option.pm
• modified: Net/DHCP6/Option/ElapsedTime.pm
• modified: Net/DHCP6/Option/OptionRequest.pm
• modified: Net/DHCP6/Parameters.pm
• modified: Net/DHCP6/SimpleOption.pm
• add: Net/DHCP6/Stateless.pm
• add: test.pl

Diff

--- /dev/null
+++ b/Makefile
@@ -0,0 +1,2 @@
+test:
+	sudo perl test.pl

--- a/Net/DHCP6/Message.pm
+++ b/Net/DHCP6/Message.pm
@@ -4,17 +4,21 @@ package Net::DHCP6::Message;
 use strict;
 use warnings;
 
-our $VERSION = "0.0.1"
+our $VERSION = "0.0.1";
 
 # TODO: should be crypto-safe RNG?
 our $RNG = sub{ int rand shift };
 
+sub gen_xid {
+    $RNG->(2**24);
+}
+
 sub new {
     my $class = shift;
     my $type = shift;
     my $id = ref $_[0] ? undef : shift;
     unless(defined $id){
-        $id = $RNG->(2**24);
+        $id = $class->gen_xid;
     }
     my $self = {
         type    => $type,
@@ -88,3 +92,15 @@ sub parse {
     }
     $class->new($type, $xid, @option);
 }
+
+use overload (
+    '""' => sub {
+        my $self = shift;
+        my $name = "Message" . $self->type;
+        "($name " . sprintf("xid=0x%06x", $self->xid)
+            . join("", map{" $_"} $self->options)
+            . ")";
+    }
+);
+
+1;

--- /dev/null
+++ b/Net/DHCP6/MessageExchange.pm
@@ -0,0 +1,235 @@
+package Net::DHCP6::MessageExchange;
+# RFC8415 15.
+
+use strict;
+use warnings;
+
+use Exporter;
+use Net::DHCP6::Message;
+use Net::DHCP6::Parameters qw(
+    DHCP6_ADDR_ALL_SERVERS
+    DHCP6_PORT_CLIENT
+    DHCP6_PORT_SERVER
+);
+use Socket qw/getaddrinfo AF_INET6 SOCK_DGRAM AI_PASSIVE/;
+use POSIX qw/EAGAIN EWOULDBLOCK/;
+use Time::HiRes;
+use IO::Select;
+
+our @ISA = qw/Exporter/;
+our @EXPORT_OK = qw/NEXT LAST/;
+our $VERSION = "0.0.1";
+our $bufsize = 2 ** 16;
+
+sub get_default_local_address {
+    my @ai = getaddrinfo(undef, DHCP6_PORT_CLIENT, {
+        flags => AI_PASSIVE,
+        family => AF_INET6,
+        socktype => SOCK_DGRAM,
+    });
+    die $ai[0] if("$ai[0]");
+    $ai[1]->{addr};
+}
+sub get_default_peer_address {
+    my @ai = getaddrinfo(DHCP6_ADDR_ALL_SERVERS, DHCP6_PORT_SERVER, {
+        flags => 0,
+        family => AF_INET6,
+        socktype => SOCK_DGRAM,
+    });
+    die $ai[0] if("$ai[0]");
+    $ai[1]->{addr};
+}
+
+use constant NEXT   => 0;
+use constant LAST   => 1;
+
+sub new {
+    my $class = shift;
+    my %args = @_;
+    if(!exists $args{sock}){
+        $args{sock} = IO::Socket::IP->new(
+            Family      => AF_INET6,
+            Type        => SOCK_DGRAM,
+            Blocking    => 0,
+        ) or die "error while creating socket: $@";
+        $args{local} //= undef;
+    }
+    if(exists $args{local}){
+        $args{local} //= get_default_local_address;
+        $args{sock}->bind($args{local}) or die "error while binding: $!";
+        delete $args{local};
+    }
+    my $self = {
+        %args,
+        xid => $args{xid} // Net::DHCP6::Message::gen_xid,
+        peer => $args{peer} // get_default_peer_address,
+        start => undef,
+        rt => undef,
+        sumrt => 0,
+        rc => 0,
+    };
+    bless $self, $class;
+}
+
+sub irt { ... }
+sub mrc { ... }
+sub mrt { ... }
+sub mrd { ... }
+sub failed { ... }
+sub recved { ... }
+
+sub now {
+    my $self = shift;
+    Time::HiRes::time;
+}
+sub sock {
+    my $self = shift;
+    $self->{sock};
+}
+sub xid {
+    my $self = shift;
+    $self->{xid};
+}
+sub peer {
+    my $self = shift;
+    $self->{peer};
+}
+sub start {
+    my $self = shift;
+    $self->{start};
+}
+sub elapsed {
+    my $self = shift;
+    return undef if(!defined $self->start);
+    $self->now() - $self->start();
+}
+sub rt {
+    my $self = shift;
+    $self->{rt};
+}
+sub rc {
+    my $self = shift;
+    $self->{rc};
+}
+sub rand {
+    my $self = shift;
+    rand(0.2) - 0.1;
+}
+sub sumrt {
+    my $self = shift;
+    $self->{sumrt};
+}
+sub timer_req {
+    my $self = shift;
+    my $diff = $self->sumrt() - $self->elapsed();
+    $diff < 0 ? 0 : $diff;
+}
+
+sub next_rt {
+    my $self = shift;
+    my $rt_prev = $self->rt;
+    my $rt;
+    if(defined $rt_prev){
+        $rt = 2 * $rt_prev + $self->rand() * $rt_prev;
+    }else{
+        $rt = $self->irt() + $self->rand() * $self->irt();
+    }
+    if($self->mrt && $rt > $self->mrt){
+        $rt = $self->mrt() + $self->rand() * $self->mrt();
+    }
+    $self->{rt} = $rt;
+}
+
+sub next_sumrt {
+    my $self = shift;
+    if(
+        $self->mrd && $self->{sumrt} > $self->mrd ||
+        $self->mrc && $self->{rc}++ > $self->mrc
+    ){
+        $self->{sumrt} = undef;
+        return undef;
+    }
+    $self->{sumrt} += $self->next_rt;
+    if($self->mrd && $self->{sumrt} > $self->mrd){
+        $self->{sumrt} = $self->mrd;
+    }
+    $self->{sumrt};
+}
+
+sub send {
+    my $self = shift;
+    my $mes = $self->message;
+    $self->sock->send($mes->serialize, 0, $self->peer)
+        or die "sending error: $!";
+}
+
+sub next {
+    my $self = shift;
+    if(defined $self->start){
+        my $recved = $self->recv;
+        goto EXIT if(!$recved);
+        goto EXIT if($recved->xid != $self->xid);
+        if($self->recved($recved) == LAST){
+            return LAST;
+        }
+
+EXIT:
+        if($self->elapsed >= $self->sumrt){
+            if(!defined $self->next_sumrt){
+                $self->failed;
+                return LAST;
+            }
+            $self->send;
+        }
+        return NEXT;
+    }else{
+        $self->flush_recv;
+        $self->send;
+        $self->{start} = $self->now;
+        $self->next_sumrt;
+        return NEXT;
+    }
+}
+
+sub recv {
+    my $self = shift;
+    my $buf;
+    my $from = $self->sock->recv($buf, $bufsize, 0);
+    if(!defined $from){
+        if($! == EAGAIN || $! == EWOULDBLOCK){
+            return undef;
+        }else{
+            die "socket io error: $!";
+        }
+    }
+    my $parsed = eval { Net::DHCP6::Message->parse($buf); };
+    if(wantarray){
+        ($parsed, $from);
+    }else{
+        $parsed;
+    }
+}
+
+sub flush_recv {
+    my $self = shift;
+    while(1){
+        my $buf;
+        my $from = $self->sock->recv($buf, 1, 0);
+        if(!defined $from){
+            if($! == EAGAIN || $! == EWOULDBLOCK){
+                last;
+            }else{
+                die "socket io error";
+            }
+        }
+        last if(length $buf == 0);
+    }
+}
+
+sub loop {
+    my $self = shift;
+    my $select = IO::Select->new($self->sock);
+    while($self->next == NEXT){
+        $select->can_read($self->timer_req);
+    }
+}

--- a/Net/DHCP6/Option.pm
+++ b/Net/DHCP6/Option.pm
@@ -4,7 +4,7 @@ package Net::DHCP6::Option;
 use strict;
 use warnings;
 
-our $VERSION = "0.0.1"
+our $VERSION = "0.0.1";
 our %OptionPkgs;
 
 # should overridden
@@ -57,12 +57,12 @@ sub parse {
 
 sub register_option {
     my $class = shift;
-    $OptionPkgs{$class->code} = $class;
+    $OptionPkgs{+$class->code} = $class;
 }
 
 sub find_subclass {
     my $class = shift;
-    my $code = shift;
+    my $code = +shift;
 
     if($class eq __PACKAGE__ && exists $OptionPkgs{$code}){
         $OptionPkgs{$code};
@@ -81,16 +81,30 @@ sub import {
         my ($full, $snake);
         if($import eq "raw"){
             $full = "Net::DHCP6::Option";
-            $snake = "raw";
+            $snake = "";
         }else{
             require "Net/DHCP6/Option/$import.pm";
             $full = "Net::DHCP6::Option::$import";
             $snake = $import;
             $snake =~ s/[^A-Z_]\K(?=[A-Z]+)/_/g;
             $snake = lc $snake;
+            $snake = "_" . $snake;
+        }
+        {
+            no strict "refs";
+            *{"${into}::d6opt_new${snake}"} = sub{ $full->new(@_); };
         }
-        *{"${into}::d6opt_new_${snake}"} = sub{ $full->new(@_); };
     }
 }
 
+use overload (
+    '""' => sub {
+        my $self = shift;
+        my $name = $self->name // "Option$self->code";
+        "($name 0x"
+            . join("", map{sprintf("%02x", $_)}unpack("C*", $self->data))
+            . ")";
+    }
+);
+
 1;

--- a/Net/DHCP6/Option/ElapsedTime.pm
+++ b/Net/DHCP6/Option/ElapsedTime.pm
@@ -6,13 +6,20 @@ use warnings;
 use Net::DHCP6::SimpleOption;
 use Net::DHCP6::Parameters qw/DHCP6_OPT_ELAPSED_TIME/;
 
-our $VERSION = "0.0.1"
+our $VERSION = "0.0.1";
 our @ISA = qw/Net::DHCP6::SimpleOption/;
 
 use constant code   => DHCP6_OPT_ELAPSED_TIME;
 use constant name   => "ElapsedTime";
 use constant len    => 2;
 
+sub new_special {
+    my $class = shift;
+    my $val = shift;
+    my $self = ref $val ? $val : \int($val * 100);
+    bless $self, $class;
+}
+
 sub data {
     my $self = shift;
     die "out of range" unless($self->time >= 0 && $self->time < 2**16);

--- a/Net/DHCP6/Option/OptionRequest.pm
+++ b/Net/DHCP6/Option/OptionRequest.pm
@@ -6,7 +6,7 @@ use warnings;
 use Net::DHCP6::Option;
 use Net::DHCP6::Parameters qw/DHCP6_OPT_ORO/;
 
-our $VERSION = "0.0.1"
+our $VERSION = "0.0.1";
 our @ISA = qw/Net::DHCP6::Option/;
 
 use constant code   => DHCP6_OPT_ORO;
@@ -35,6 +35,7 @@ sub len {
 
 sub data {
     my $self = shift;
+    die "out of range" if(join "", map{$_ < 0 || $_ >= 2**16} @$self);
     pack("S>*", @$self);
 }
 

--- a/Net/DHCP6/Parameters.pm
+++ b/Net/DHCP6/Parameters.pm
@@ -4,7 +4,7 @@ package Net::DHCP6::Parameters;
 use strict;
 use warnings;
 
-our $VERSION = "0.0.1"
+our $VERSION = "0.0.1";
 
 use Exporter;
 our @ISA = ("Exporter");
@@ -12,7 +12,18 @@ our @ISA = ("Exporter");
 our @EXPORT_OK;
 our %EXPORT_TAGS;
 
-our %MessageType = (
+# RFC8415 7.
+use constant DHCP6_NETWORK_CONSTANTS => (
+    DHCP6_ADDR_ALL_SERVERS      => "ff05::1:2",
+    DHCP6_ADDR_ALL_ONLY_SERVERS => "ff05::1:3",
+    DHCP6_PORT_CLIENT           => 546,
+    DHCP6_PORT_SERVER           => 547,
+);
+use constant {DHCP6_NETWORK_CONSTANTS};
+push @EXPORT_OK, keys %{{DHCP6_NETWORK_CONSTANTS}};
+$EXPORT_TAGS{NetworkConstant} = [keys %{{DHCP6_NETWORK_CONSTANTS}}];
+
+use constant DHCP6_MESSAGE_TYPES => (
     DHCP6_MT_SOLICIT            => 1,
     DHCP6_MT_ADVERTISE          => 2,
     DHCP6_MT_REQUEST            => 3,
@@ -49,11 +60,11 @@ our %MessageType = (
     DHCP6_MT_STATE              => 34,
     DHCP6_MT_CONTACT            => 35,
 );
-use constant \%MessageType;
-push @EXPORT_OK, keys %MessageType;
-$EXPORT_TAGS{MessageType} = [keys %MessageType];
+use constant {DHCP6_MESSAGE_TYPES};
+push @EXPORT_OK, keys %{{DHCP6_MESSAGE_TYPES}};
+$EXPORT_TAGS{MessageType} = [keys %{{DHCP6_MESSAGE_TYPES}}];
 
-our %OptionCode = (
+use constant DHCP6_OPTION_CODES => (
     DHCP6_OPT_CLIENTID                  => 1,
     DHCP6_OPT_SERVERID                  => 2,
     DHCP6_OPT_IA_NA                     => 3,
@@ -196,11 +207,11 @@ our %OptionCode = (
     DHCP6_OPT_V6_DOTS_ADDRESS           => 142,
     DHCP6_OPT_IPv6_ADDRESS_ANDSF        => 143,
 );
-use constant \%OptionCode;
-push @EXPORT_OK, keys %OptionCode;
-$EXPORT_TAGS{OptionCode} = [keys %OptionCode];
+use constant {DHCP6_OPTION_CODES};
+push @EXPORT_OK, keys %{{DHCP6_OPTION_CODES}};
+$EXPORT_TAGS{OptionCode} = [keys %{{DHCP6_OPTION_CODES}}];
 
-our %StatusCode = (
+use constant DHCP6_STATUS_CODES => (
     DHCP_ST_SUCCESS                     => 0,
     DHCP_ST_UNSPEC_FAIL                 => 1,
     DHCP_ST_NO_ADDRS_AVAIL              => 2,
@@ -225,8 +236,8 @@ our %StatusCode = (
     DHCP_ST_DNS_UPDATE_NOT_SUPPORTED    => 21,
     DHCP_ST_EXCESSIVE_TIME_SKEW         => 22,
 );
-use constant \%StatusCode;
-push @EXPORT_OK, keys %StatusCode;
-$EXPORT_TAGS{StatusCode} = [keys %StatusCode];
+use constant {DHCP6_STATUS_CODES};
+push @EXPORT_OK, keys %{{DHCP6_STATUS_CODES}};
+$EXPORT_TAGS{StatusCode} = [keys %{{DHCP6_STATUS_CODES}}];
 
 1;

--- a/Net/DHCP6/SimpleOption.pm
+++ b/Net/DHCP6/SimpleOption.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Net::DHCP6::Option;
 
-our $VERSION = "0.0.1"
+our $VERSION = "0.0.1";
 our @ISA = qw/Net::DHCP6::Option/;
 
 sub new {

--- /dev/null
+++ b/Net/DHCP6/Stateless.pm
@@ -0,0 +1,83 @@
+package Net::DHCP6::Stateless;
+# RFC8415 6.1.
+# RFC8415 18.2.6.
+
+use strict;
+use warnings;
+
+use Net::DHCP6::MessageExchange qw/NEXT LAST/;
+
+use Net::DHCP6::Parameters qw(
+    DHCP6_MT_REPLY
+    DHCP6_MT_INFORMATION_REQUEST
+    DHCP6_OPT_INF_MAX_RT
+    DHCP6_OPT_INFORMATION_REFRESH_TIME
+);
+use Net::DHCP6::Message;
+use Net::DHCP6::Option qw/ElapsedTime OptionRequest/;
+
+our $VERSION = "0.0.1";
+our @ISA = qw/Net::DHCP6::MessageExchange/;
+
+use constant irt => 1;
+use constant mrc => 0;
+use constant mrd => 0;
+
+sub add_elements_if_not_exists {
+    my $array = shift;
+    for my $elem(@_){
+        if(!grep{$_ == $elem} @$array){
+            push @$array, $elem;
+        }
+    }
+}
+
+sub new {
+    my $class = shift;
+    my %opts = @_;
+    die "requesting options are not given" if(ref $opts{request} ne "ARRAY");
+
+    $opts{mrt} //= 3600;
+    if($opts{auto_request} // 1){
+        add_elements_if_not_exists($opts{request},
+            DHCP6_OPT_INF_MAX_RT,
+            DHCP6_OPT_INFORMATION_REFRESH_TIME
+        );
+    }
+    delete $opts{auto_request};
+    $opts{failed} //= sub{};
+    $opts{recved} //= sub{ 1; };
+
+    Net::DHCP6::MessageExchange::new($class, %opts);
+}
+
+sub mrt {
+    my $self = shift;
+    $self->{mrt};
+}
+
+sub failed {
+    my $self = shift;
+    $self->{failed}->();
+}
+
+sub recved {
+    my $self = shift;
+    my $recved = shift;
+    return NEXT if($recved->type != DHCP6_MT_REPLY);
+    $self->{recved}->($recved) ? LAST : NEXT;
+}
+
+sub requests {
+    my $self = shift;
+    @{$self->{request}}
+}
+
+sub message {
+    my $self = shift;
+    Net::DHCP6::Message->new(DHCP6_MT_INFORMATION_REQUEST,
+        d6opt_new_option_request($self->requests),
+        d6opt_new_elapsed_time($self->elapsed // 0),
+    );
+}
+

--- /dev/null
+++ b/test.pl
@@ -0,0 +1,22 @@
+#!/bin/perl
+
+use strict;
+use warnings;
+use lib ".";
+
+use IO::Socket::IP;
+use Data::Dumper;
+
+use Net::DHCP6::Parameters qw(
+    DHCP6_OPT_DNS_SERVERS
+);
+use Net::DHCP6::Stateless;
+
+my $client = Net::DHCP6::Stateless->new(
+    request => [],
+    failed  => sub{print("timeout\n");},
+    recved  => sub{print(shift."\n"); 1;},
+);
+
+local $| = 1;
+$client->loop;