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