view release on metacpan or  search on metacpan

Radius.pm  view on Meta::CPAN

        $serv_port = $SERVICES{$service};
    }

    $self->{'timeout'} = $h{'TimeOut'} ? $h{'TimeOut'} : 5;
    $self->{'localaddr'} = $h{'LocalAddr'};
    $self->{'secret'} = $h{'Secret'};
    $self->{'message_auth'} = exists $h{'Rfc3579MessageAuth'} ? $h{'Rfc3579MessageAuth'} : 1;

    if ($h{'NodeList'}) {
        # contains resolved node list in text representation
        $self->{'node_list_a'} = {};
        foreach my $node_a (@{$h{'NodeList'}}) {
            my ($n_host, $n_port) = split(/:/, $node_a);
            $n_port ||= $serv_port;
            my @hostinfo = gethostbyname($n_host);
            if (!scalar(@hostinfo)) {
                print STDERR "Can't resolve node hostname '$n_host': $! - skipping it!\n" if $debug;
                next;
            }

            my $ip = inet_ntoa($hostinfo[4]);
            print STDERR "Adding ".$ip.':'.$n_port." to node list.\n" if $debug;
            # store split address to avoid additional parsing later
            $self->{'node_list_a'}->{$ip.':'.$n_port} = [$ip, $n_port];
        }

        if (!scalar(keys %{$self->{'node_list_a'}})) {
            return $self->set_error('ESOCKETFAIL', 'Empty node list.');
        }
    }

    if ($h{'Host'}) {
        ($host, $port) = split(/:/, $h{'Host'});
        $port ||= $serv_port;
        print STDERR "Using Radius server $host:$port\n" if $debug;

        my @hostinfo = gethostbyname($host);
        if (!scalar(@hostinfo)) {
            if ($self->{'node_list_a'}) {
                print STDERR "Can't resolve hostname '$host'\n" if $debug;
                return $self;
            }

            return $self->set_error('ESOCKETFAIL', "Can't resolve hostname '".$host."'.");
        }

        my $ip = inet_ntoa($hostinfo[4]);

        # if Host used with NodeList - it must be from the list
        if ($self->{'node_list_a'} && !exists($self->{'node_list_a'}->{$ip.':'.$port})) {
            print STDERR "'$host' doesn't exist in node list - ignoring it!\n" if $debug;
            return $self;
        }

        # set as active node
        $self->{'node_addr_a'} = $ip.':'.$port;

        my %io_sock_args = (
            Type      => SOCK_DGRAM,
            Proto     => 'udp',
            Timeout   => $self->{timeout},
            LocalAddr => $self->{localaddr},
            PeerAddr  => $host,
            PeerPort  => $port,
        );

        $self->{sock} = IO::Socket::INET->new(%io_sock_args)
            or return $self->set_error('ESOCKETFAIL', $IO::Socket::errstr);
    }

    return $self;
}

sub send_packet {
    my ($self, $type, $retransmit) = @_;

    $self->{attributes} //= '';

    my $data;
    my $length = 20 + length($self->{attributes});

    if (!$retransmit) {
        $request_id = ($request_id + 1) & 0xff;
    }

    $self->set_error;
    if ($type == ACCOUNTING_REQUEST || $type == DISCONNECT_REQUEST || $type == COA_REQUEST) {
        $self->{authenticator} = "\0" x 16;
        $self->{authenticator} = $self->calc_authenticator($type, $request_id, $length);
    } else {
        $self->gen_authenticator unless defined $self->{authenticator};
    }

    if (($self->{message_auth} && ($type == ACCESS_REQUEST)) || ($type == STATUS_SERVER)) {
        $length += $RFC3579_MSG_AUTH_ATTR_LEN;
        # RFC 9716 section 4.2: Message-Authenticator SHOULD be the first
        # attribute in Access-Request, immediately after the 20-octet
        # header, so a Blast-RADIUS-aware server can authenticate the
        # packet before parsing the rest of the attributes.
        my $msg_auth_header = pack('C C', $RFC3579_MSG_AUTH_ATTR_ID, $RFC3579_MSG_AUTH_ATTR_LEN);
        $data = pack('C C n', $type, $request_id, $length)
                . $self->{authenticator}
                . $msg_auth_header
                . "\0" x ($RFC3579_MSG_AUTH_ATTR_LEN - 2)
                . $self->{attributes};

        my $msg_authenticator = $self->hmac_md5($data, $self->{secret});
        $data = pack('C C n', $type, $request_id, $length)
                . $self->{authenticator}
                . $msg_auth_header
                . $msg_authenticator
                . $self->{attributes};
        if ($debug) {
            print STDERR "RFC3579 Message-Authenticator: "._ascii_to_hex($msg_authenticator)." was added to request.\n";
        }
    } else {
        $data = pack('C C n', $type, $request_id, $length)
                . $self->{authenticator}
                . $self->{attributes};
    }

    if ($debug) {
        print STDERR "Sending request:\n";
        print STDERR HexDump($data);
    }

    my $res;
    if (defined($self->{sock})) {
        $debug and STDERR->say(
            sprintf 'Sending request to%s: %s',
            defined($self->{node_list_a}) ? ' active node' : '',
            $self->{node_addr_a},
        );
        $res = $self->{sock}->send($data) || $self->set_error('ESENDFAIL', $OS_ERROR);
    } elsif (defined($self->{sock_list}) && @{$self->{sock_list}}) {
        $debug and STDERR->say('Re-sending request to all cluster nodes.');
        foreach my $sock (@{$self->{sock_list}}) {
            $debug and STDERR->say('Re-sending request to: '.$sock->peerhost.':'.$sock->peerport);
            $res = $sock->send($data) || $self->set_error('ESENDFAIL', $OS_ERROR);
        }
    } else {
        $debug and STDERR->say('Sending request to all cluster nodes.');

        # build a lookup of already-open sockets (active node) to reuse
        my %open_socks;
        if (defined($self->{sock})) {
            $open_socks{$self->{node_addr_a}} = $self->{sock};
            $self->{sock} = undef;
        }

        my %io_sock_args = (
            Type      => SOCK_DGRAM,
            Proto     => 'udp',
            Timeout   => $self->{timeout},
            LocalAddr => $self->{localaddr},
        );

        my $sock_list = $self->{sock_list} = [];
        foreach my $node (keys %{$self->{node_list_a}}) {
            $debug and STDERR->say('Sending request to: '.$node);

            my $sock = $open_socks{$node};
            if (!defined($sock)) {
                @io_sock_args{qw(PeerAddr PeerPort)} = @{$self->{node_list_a}->{$node}};
                $sock = IO::Socket::INET->new(%io_sock_args)
                    or return $self->set_error('ESOCKETFAIL', $IO::Socket::errstr);
            }

            $res = $sock->send($data) || $self->set_error('ESENDFAIL', $OS_ERROR);
            if ($res) {
                push @{$sock_list}, $sock;
            }
        }
    }

    return $res;
}

sub recv_packet {
    my ($self, $detect_bad_id) = @_;
    my ($data, $type, $id, $length, $auth, $sh, $resp_attributes);

    $self->set_error;

    if (defined($self->{'sock_list'}) && scalar(@{$self->{'sock_list'}})) {
        $sh = IO::Select->new(@{$self->{'sock_list'}}) or return $self->set_error('ESELECTFAIL');
    } elsif (defined($self->{'sock'})) {
        $sh = IO::Select->new($self->{'sock'}) or return $self->set_error('ESELECTFAIL');
    } else {
        return $self->set_error('ESELECTFAIL');
    }

    my $timeout = $self->{'timeout'};

    my ( @ready, $from_addr_n, $start_time );
    while ($timeout > 0){
        $start_time = time();

        @ready = $sh->can_read($timeout);
        my $errno = $OS_ERROR;  # capture before any later op can clobber $!

        $timeout -= time() - $start_time;

        if (!@ready) {
            if (($errno == EINTR) && ($timeout > 0)) {
                next;
            }
            return $self->set_error('ETIMEOUT', $errno);
        }

        $from_addr_n = $ready[0]->recv($data, 65536);
        last if (defined($from_addr_n));

        if (!defined($self->{sock_list})) {