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'}  = $h{'Rfc3579MessageAuth'};

    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', $@);
    }

    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;
        $data = pack('C C n', $type, $request_id, $length)
                . $self->{authenticator}
                . $self->{attributes}
                . pack('C C', $RFC3579_MSG_AUTH_ATTR_ID, $RFC3579_MSG_AUTH_ATTR_LEN)
                . "\0" x ($RFC3579_MSG_AUTH_ATTR_LEN - 2);

        my $msg_authenticator = $self->hmac_md5($data, $self->{secret});
        $data = pack('C C n', $type, $request_id, $length)
                . $self->{authenticator}
                . $self->{attributes}
                . pack('C C', $RFC3579_MSG_AUTH_ATTR_ID, $RFC3579_MSG_AUTH_ATTR_LEN)
                . $msg_authenticator;
        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->{'node_list_a'})) {
        if ($debug) { print STDERR 'Sending request to: '.$self->{'node_addr_a'}."\n"; }
        $res = $self->{'sock'}->send($data) || $self->set_error('ESENDFAIL', $!);
    } else {
        if (!$retransmit && defined($self->{'sock'})) {
            if ($debug) { print STDERR 'Sending request to active node: '.$self->{'node_addr_a'}."\n"; }
            $res = $self->{'sock'}->send($data) || $self->set_error('ESENDFAIL', $!);
        } else {
            if ($debug) { print STDERR "ReSending request to all cluster nodes.\n"; }
            $self->{'sock'} = undef;
            $self->{'sock_list'} = [];
            my %io_sock_args = (
                        Type => SOCK_DGRAM,
                        Proto => 'udp',
                        Timeout => $self->{'timeout'},
                        LocalAddr => $self->{'localaddr'},
            );
            foreach my $node (keys %{$self->{'node_list_a'}}) {
                if ($debug) { print STDERR 'Sending request to: '.$node."\n"; }
                $io_sock_args{'PeerAddr'} = $self->{'node_list_a'}->{$node}->[0];
                $io_sock_args{'PeerPort'} = $self->{'node_list_a'}->{$node}->[1];
                my $new_sock = IO::Socket::INET->new(%io_sock_args)
                    or return $self->set_error('ESOCKETFAIL', $@);
                $res = $new_sock->send($data) || $self->set_error('ESENDFAIL', $!);
                if ($res) {
                    push @{$self->{'sock_list'}}, $new_sock;
                }
                $res ||= $res;
            }
        }
    }
    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;
    my $from_addr_n;
    my ($start_time, $end_time);
    while ($timeout > 0){
        $start_time = time();
        @ready = $sh->can_read($timeout) or return $self->set_error('ETIMEOUT', $!);
        $end_time = time();
        $timeout -= $end_time - $start_time;
        $from_addr_n = $ready[0]->recv($data, 65536);
        if (defined($from_addr_n)) {
            last;
        }
        if (!defined($from_addr_n) && !defined($self->{'sock_list'})) {
            return $self->set_error('ERECVFAIL', $!);
        }elsif ($debug) {
            print STDERR "Received error/event from one peer:".$!."\n";
        }
    }

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

    if (defined($self->{'sock_list'})) {
        # the sending attempt was 'broadcast' to all cluster nodes
        # switching to single active node