diff --git a/lib/Redis.pm b/lib/Redis.pm index 4c5da20..fccb821 100644 --- a/lib/Redis.pm +++ b/lib/Redis.pm @@ -7,7 +7,6 @@ package Redis; use warnings; use strict; -use IO::Socket::INET; use IO::Socket::UNIX; use IO::Select; use IO::Handle; @@ -24,6 +23,18 @@ use constant EWOULDBLOCK => eval {Errno::EWOULDBLOCK} || -1E9; use constant EAGAIN => eval {Errno::EAGAIN} || -1E9; use constant EINTR => eval {Errno::EINTR} || -1E9; +our $io_socket_module_name; +BEGIN { + # prefer using module IO::Socket::IP if available, + # otherwise fall back to IO::Socket::INET6 or to IO::Socket::INET + if (eval { require IO::Socket::IP }) { + $io_socket_module_name = 'IO::Socket::IP'; + } elsif (eval { require IO::Socket::INET6 }) { + $io_socket_module_name = 'IO::Socket::INET6'; + } elsif (eval { require IO::Socket::INET }) { + $io_socket_module_name = 'IO::Socket::INET'; + } +} sub new { my $class = shift; @@ -64,19 +75,34 @@ sub new { } } - if ($args{sock}) { - $self->{server} = $args{sock}; - $self->{builder} = sub { IO::Socket::UNIX->new($_[0]->{server}) }; - } - else { - $self->{server} = $args{server} || '127.0.0.1:6379'; - $self->{builder} = sub { - IO::Socket::INET->new( - PeerAddr => $_[0]->{server}, - Proto => 'tcp', - ); - }; + { my @servers; + if ($args{sock}) { + $args{sock} =~ m{^/} + or die "A unix socket path must be absolute: $args{sock}\n"; + push(@servers, $args{sock}); + } + if ($args{server}) { + push(@servers, ref $args{server} ? @{$args{server}} : $args{server}); + } + push(@servers, '127.0.0.1:6379', '[::1]:6379') if !@servers; + $self->{server} = \@servers; } + $self->{builder} = sub { + my $self = $_[0]; + my $sock; + for my $server (@{$self->{server}}) { + if ($server =~ m{^/}) { + $sock = IO::Socket::UNIX->new($server); + } else { + $sock = $io_socket_module_name->new( + PeerAddr => $server, + Proto => 'tcp', + ); + } + last if $sock; + } + $sock; + }; $self->{is_subscriber} = 0; $self->{subscribers} = {}; @@ -475,7 +501,8 @@ sub __build_sock { my ($self) = @_; $self->{sock} = $self->{builder}->($self) - || confess("Could not connect to Redis server at $self->{server}: $!"); + || confess(sprintf("Could not connect to Redis server at %s: %s", + join(", ",@{$self->{server}}), $!)); if (exists $self->{password}) { try { $self->auth($self->{password}) } @@ -722,7 +749,7 @@ __END__ =head1 SYNOPSIS - ## Defaults to $ENV{REDIS_SERVER} or 127.0.0.1:6379 + ## Defaults to $ENV{REDIS_SERVER} or 127.0.0.1:6379 or [::1]:6379 my $redis = Redis->new; my $redis = Redis->new(server => 'redis.example.com:8080'); @@ -887,10 +914,11 @@ utf-8 flag turned on. =head3 new - my $r = Redis->new; # $ENV{REDIS_SERVER} or 127.0.0.1:6379 + my $r = Redis->new; # $ENV{REDIS_SERVER} or 127.0.0.1:6379 or [::1]:6379 - my $r = Redis->new( server => '192.168.0.1:6379', debug => 0 ); + my $r = Redis->new( server => 'localhost:6379', debug => 0 ); my $r = Redis->new( server => '192.168.0.1:6379', encoding => undef ); + my $r = Redis->new( server => '[::1]:6379', encoding => undef ); my $r = Redis->new( sock => '/path/to/sock' ); my $r = Redis->new( reconnect => 60, every => 5000 ); my $r = Redis->new( password => 'boo' ); @@ -899,12 +927,22 @@ utf-8 flag turned on. my $r = Redis->new( name => sub { "cache-for-$$" }); The C<< server >> parameter specifies the Redis server we should connect to, -via TCP. Use the 'IP:PORT' format. If no C<< server >> option is present, we -will attempt to use the C<< REDIS_SERVER >> environment variable. If neither of -those options are present, it defaults to '127.0.0.1:6379'. +via TCP. Use the 'IP:PORT' format. If no C<< server >> option is present, +we will attempt to use the C<< REDIS_SERVER >> environment variable. +The IP part can be a host name or an IPv4 or an IPv6 address. An IPv6 address +must be enclosed in square brackets, e.g. '[::1]:6379'. If neither the +C<< server >> parameter nor the C<< sock >> parameter are present, it attempts +connection to 127.0.0.1:6379 or (if that fails) to [::1]:6379. + +An INET6 (IPv6) protocol family is supported starting with redis server 2.8.0. +For communication over an IP socket (of any protocol family) the Redis module +will attempt to use an underlying module IO::Socket::IP if available, falling +back to older IO::Socket::INET6, and as a last resort use IO::Socket::INET +which has no support for IPv6. Alternatively you can use the C<< sock >> parameter to specify the path of the -UNIX domain socket where the Redis server is listening. +UNIX domain socket where the Redis server is listening. The specified path +must be absolute (starting with a slash). The C<< REDIS_SERVER >> can be used for UNIX domain sockets too. The following formats are supported: @@ -925,6 +963,14 @@ unix:/path/to/sock =item * +[::1]:11011 + +=item * + +localhost:11011 + +=item * + tcp:127.0.0.1:11011 =back diff --git a/t/01-basic.t b/t/01-basic.t index 483c153..39227d9 100755 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -98,7 +98,7 @@ ok(my $nr_keys = $o->dbsize, 'dbsize'); like( exception { $o->lpush('foo', 'bar') }, - qr/\[lpush\] ERR Operation against a key holding the wrong kind of value,/, + qr/\[lpush\] (?:ERR|WRONGTYPE) Operation against a key holding the wrong kind of value,/, 'Error responses throw exception' ); @@ -351,7 +351,7 @@ ok(!$o->ping(), 'ping() will be false after shutdown()'); sleep(1); like( exception { Redis->new(server => $srv) }, - qr/Could not connect to Redis server at $srv/, + qr/Could not connect to Redis server at \Q$srv\E/, 'Failed connection throws exception' ); diff --git a/t/04-pipeline.t b/t/04-pipeline.t index 78a6750..9385b6c 100755 --- a/t/04-pipeline.t +++ b/t/04-pipeline.t @@ -69,7 +69,7 @@ pipeline_ok 'transaction', [rpush => ['clunk' => 'oops'], 'QUEUED'], [get => ['clunk'], 'QUEUED'], [ exec => [], - [['OK', undef], [undef, 'ERR Operation against a key holding the wrong kind of value'], ['eth', undef],] + [['OK', undef], [undef, re(qr{^(?:ERR|WRONGTYPE) Operation against a key holding the wrong kind of value$})], ['eth', undef],] ], ); @@ -80,7 +80,7 @@ subtest 'transaction with error and no pipeline' => sub { is($r->get('clunk'), 'QUEUED', 'transactional GET'); like( exception { $r->exec }, - qr{\[exec\] ERR Operation against a key holding the wrong kind of value,}, + qr{\[exec\] (?:ERR|WRONGTYPE) Operation against a key holding the wrong kind of value,}, 'synchronous EXEC dies for intervening error' ); }; diff --git a/t/07-reconnect.t b/t/07-reconnect.t index 950b1cb..e19844b 100755 --- a/t/07-reconnect.t +++ b/t/07-reconnect.t @@ -73,7 +73,7 @@ subtest "Bad commnands don't trigger reconnect" => sub { my $prev_sock = "$r->{sock}"; like( exception { $r->set(bad => reconnect => 1) }, - qr{ERR wrong number of arguments for 'set' command}, + qr{ERR wrong number of arguments for 'set' command|\[set\] ERR syntax error}, 'Bad commands still die', ); is("$r->{sock}", $prev_sock, "... and don't trigger a reconnect"); diff --git a/t/tlib/Test/SpawnRedisServer.pm b/t/tlib/Test/SpawnRedisServer.pm index 11c6af9..02ead25 100644 --- a/t/tlib/Test/SpawnRedisServer.pm +++ b/t/tlib/Test/SpawnRedisServer.pm @@ -9,6 +9,36 @@ use IPC::Cmd qw(can_run); use POSIX ":sys_wait_h"; use base qw( Exporter ); +our($io_socket_module_name, $have_inet4, $have_inet6); + +BEGIN { + # prefer using module IO::Socket::IP if available, + # otherwise fall back to IO::Socket::INET6 or to IO::Socket::INET + if (eval { require IO::Socket::IP }) { + $io_socket_module_name = 'IO::Socket::IP'; + } elsif (eval { require IO::Socket::INET6 }) { + $io_socket_module_name = 'IO::Socket::INET6'; + } elsif (eval { require IO::Socket::INET }) { + $io_socket_module_name = 'IO::Socket::INET'; + } + $have_inet4 = # can we create a PF_INET socket? + defined $io_socket_module_name && eval { + my $sock = + $io_socket_module_name->new(LocalAddr => '0.0.0.0', Proto => 'tcp'); + $sock->close or die "error closing socket: $!" if $sock; + $sock ? 1 : undef; + }; + $have_inet6 = # can we create a PF_INET6 socket? + defined $io_socket_module_name && + $io_socket_module_name ne 'IO::Socket::INET' && + eval { + my $sock = + $io_socket_module_name->new(LocalAddr => '::', Proto => 'tcp'); + $sock->close or die "error closing socket: $!" if $sock; + $sock ? 1 : undef; + }; +} + our @EXPORT = qw( redis ); our @EXPORT_OK = qw( redis reap ); @@ -24,7 +54,12 @@ sub redis { my ($fh, $fn) = File::Temp::tempfile(); $port++; - my $addr = "127.0.0.1:$port"; + + # ensure the test can run on an IPv6-only host (has no 127.0.0.1 address) + my $loopback_ip_addr = $have_inet6 && !$have_inet4 ? '::1' : '127.0.0.1'; + + my $addr = $loopback_ip_addr =~ /:/ ? "[$loopback_ip_addr]:$port" + : "$loopback_ip_addr:$port"; unlink("redis-server-$addr.log"); unlink('dump.rdb'); @@ -34,7 +69,7 @@ sub redis { appendonly no daemonize no port $port - bind 127.0.0.1 + bind $loopback_ip_addr loglevel debug logfile redis-server-$addr.log ");