ZOOKEEPER-3714: zkperl: Add (Cyrus) SASL authentication support to Perl client

This patch allows one to access the C client Cyrus SASL support (ZOOKEEPER-1112) from the Perl binding by passing a `--with-sasl2` flag (and, optionally, header and lib locations):

        perl Makefile.PL \
            --with-sasl2 \
            --sasl2-include=/path/to/sasl2/include \
            --sasl2-lib=/path/to/sasl2/lib

When enabled, `Net::ZooKeeper->new(...)` admits a new key, `sasl_options`, which can be used to automatically authenticate with the server during connections (including reconnects).

Some of the preparatory work for this contribution, which is available in the other commits, may also fix [ZOOKEEPER-3303](https://issues.apache.org/jira/browse/ZOOKEEPER-3303), which is about compilation issues.  The resulting patch builds with GCC 8.3.0 in a (moderately) "hardened" environment; it also passes all enabled tests.

Author: Damien Diederen <dd@crosstwine.com>

Reviewers: Norbert Kalmar <nkalmar@apache.org>

Closes #1243 from ztzg/ZOOKEEPER-3714-zkperl-sasl-support

zookeeper-contrib/zookeeper-contrib-zkperl/Makefile.PL

@@ -28,21 +28,25 @@ my $ZOO_REQUIRED_VERSION = qr{^$ZOO_MAJOR_VERSION\.\d+.\d+$}ismx;
 my @zk_inc_paths;
 my @zk_lib_paths;
 
+my $with_sasl2 = 0;
+my @sasl2_inc_paths;
+my @sasl2_lib_paths;
+
 GetOptions(
     'zookeeper-include=s' => \@zk_inc_paths,
-    'zookeeper-lib=s' => \@zk_lib_paths
+    'zookeeper-lib=s' => \@zk_lib_paths,
+    'with-sasl2!' => \$with_sasl2,
+    'sasl2-include=s' => \@sasl2_inc_paths,
+    'sasl2-lib=s' => \@sasl2_lib_paths
 );
 
-my $zk_inc_paths = join(' ', map("-I$_", @zk_inc_paths));
-my $zk_lib_paths = join(' ', map("-L$_", @zk_lib_paths));
-
-$zk_inc_paths .= ' ' unless ($zk_inc_paths eq '');
-$zk_lib_paths .= ' ' unless ($zk_lib_paths eq '');
+my $zk_inc = (join(' ', map("-I$_", @zk_inc_paths)) . ' -I.');
+my $zk_libs = (join(' ', map("-L$_", @zk_lib_paths)) . ' -lzookeeper_mt');
 
 my $cc = $Config{'cc'};
 my $check_file = 'build/check_zk_version';
 
-my $check_out = qx($cc $zk_inc_paths $zk_lib_paths -I. -o $check_file $check_file.c 2>&1);
+my $check_out = qx($cc $zk_inc -o $check_file $check_file.c $zk_libs 2>&1);
 
 if ($?) {
     if ($check_out =~ /zookeeper_version\.h/) {
@@ -63,11 +67,21 @@ elsif ($zk_ver !~ $ZOO_REQUIRED_VERSION) {
   warn "Net::ZooKeeper requires ZooKeeper 3.x, found $zk_ver!";
 }
 
+my @inc = ($zk_inc);
+my @libs = ($zk_libs);
+my %mmopt = ();
+
+if ($with_sasl2) {
+    push(@inc, join(' ', map("-I$_", @sasl2_inc_paths)));
+    push(@libs, join(' ', map("-L$_", @sasl2_lib_paths)) . ' -lsasl2');
+    $mmopt{DEFINE} = '-DHAVE_CYRUS_SASL_H';
+}
+
 WriteMakefile(
-    'INC'          => "$zk_inc_paths-I.",
-    'LIBS'         => [ "$zk_lib_paths-lzookeeper_mt" ],
+    'INC'          => join(' ', @inc),
+    'LIBS'         => \@libs,
     'NAME'         => 'Net::ZooKeeper',
     'VERSION_FROM' => 'ZooKeeper.pm',
-    'clean'        => { 'FILES' => 'build/check_zk_version.o' }
+    'clean'        => { 'FILES' => 'build/check_zk_version.o' },
+    %mmopt,
 );
-

zookeeper-contrib/zookeeper-contrib-zkperl/README

@@ -32,6 +32,15 @@ ZooKeeper C include files.
 The path supplied to the --zookeeper-lib option should identify
 the directory that contains the libzookeeper_mt library.
 
+If the C client supports Cyrus SASL (ZOOKEEPER-1112), it can also be
+enabled in the Perl binding by passing a --with-sasl2 flag (and,
+optionally, non-standard locations):
+
+    perl Makefile.PL \
+        --with-sasl2 \
+        --sasl2-include=/path/to/sasl2/include \
+        --sasl2-lib=/path/to/sasl2/lib
+
 When running "make test", if no ZK_TEST_HOSTS environment
 variable is set, many tests will be skipped because no connection
 to a ZooKeeper server is available.  To execute these tests,
@@ -44,6 +53,18 @@ The tests expect to have full read/write/create/delete/admin
 ZooKeeper permissions under this path.  If no ZK_TEST_PATH
 variable is defined, the root ZooKeeper path ("/") is used.
 
+The ZK_TEST_SASL_OPTIONS environment variable, if defined, provides a
+JSON-encoded map of SASL authentication options, enabling SASL tests.
+E.g.,
+
+    {
+       "host": "zk-sasl-md5",
+       "mechlist": "DIGEST-MD5",
+       "service": "zookeeper",
+       "user": "bob",
+       "password_file": "bob.secret"
+    }
+
 DEPENDENCIES
 
 Version 3.1.1 of ZooKeeper is required at a minimum.

zookeeper-contrib/zookeeper-contrib-zkperl/ZooKeeper.pm

@@ -688,7 +688,8 @@ The following methods are defined for the Net::ZooKeeper class.
   $zkh = Net::ZooKeeper->new('host1:7000,host2:7000');
   $zkh = Net::ZooKeeper->new('host1:7000,host2:7000',
                              'session_timeout' => $session_timeout,
-                             'session_id' => $session_id);
+                             'session_id' => $session_id,
+                             'sasl_options' => $sasl_options);
 
 Creates a new Net::ZooKeeper handle object and attempts to
 connect to the one of the servers of the given ZooKeeper
@@ -725,6 +726,33 @@ initial connection request; again, the actual timeout period to
 which the server agrees will be available subsequently as the
 value of the C<session_timeout> attribute.
 
+If a C<'sasl_options'> option is provided, it is used to automatically
+SASL-authenticate with the server during connections (including
+reconnects).  Here is a brief description of the recognized keys;
+please refer to the C client documentation for details:
+
+=over 5
+
+=item service => VALUE
+
+=item host => VALUE
+
+=item mechlist => VALUE
+
+These map to the corresponding fields of C<zoo_sasl_params_t> from the
+library.
+
+=item user => VALUE
+
+=item realm => VALUE
+
+=item password_file => VALUE
+
+These map to the corresponding parameters of
+C<zoo_sasl_make_basic_callbacks> from the library.
+
+=back
+
 Upon successful connection (i.e., after the success of a method
 which requires communication with the server), the C<session_id>
 attribute will hold a short binary string which represents the

zookeeper-contrib/zookeeper-contrib-zkperl/ZooKeeper.xs

@@ -28,7 +28,9 @@
 #include <limits.h>                     /* CHAR_BIT */
 #include <sys/time.h>                   /* gettimeofday() */
 
+#define THREADED
 #include <zookeeper/zookeeper.h>
+#undef THREADED
 
 #include "build/check_zk_version.h"
 
@@ -758,6 +760,13 @@ zk_new(package, hosts, ...)
         char *hosts
     PREINIT:
         int recv_timeout = DEFAULT_RECV_TIMEOUT_MSEC;
+#ifdef HAVE_CYRUS_SASL_H
+        zoo_sasl_params_t sasl_params = { 0 };
+        const char *sasl_user = NULL;
+        const char *sasl_realm = NULL;
+        const char *sasl_password_file = NULL;
+        int use_sasl = 0;
+#endif /* HAVE_CYRUS_SASL_H */
         const clientid_t *client_id = NULL;
         zk_t *zk;
         zk_handle_t *handle;
@@ -792,12 +801,61 @@ zk_new(package, hosts, ...)
                     Perl_croak(aTHX_ "invalid session ID");
                 }
             }
+#ifdef HAVE_CYRUS_SASL_H
+            else if (strcaseEQ(key, "sasl_options")) {
+                SV *hash_sv = ST(i + 1);
+                HV *hash;
+                char *key;
+                I32 key_length;
+                SV *value;
+
+                if (!SvROK(hash_sv) || SvTYPE(SvRV(hash_sv)) != SVt_PVHV) {
+                    Perl_croak(aTHX_ "sasl_options requires a hash reference");
+                }
+
+                hash = (HV *)SvRV(hash_sv);
+                hv_iterinit(hash);
+                while ((value = hv_iternextsv(hash, &key, &key_length))) {
+                    if (strcaseEQ(key, "service")) {
+                        sasl_params.service = SvPV_nolen(value);
+                    }
+                    else if (strcaseEQ(key, "host")) {
+                        sasl_params.host = SvPV_nolen(value);
+                    }
+                    else if (strcaseEQ(key, "mechlist")) {
+                        sasl_params.mechlist = SvPV_nolen(value);
+                    }
+                    else if (strcaseEQ(key, "user")) {
+                        sasl_user = SvPV_nolen(value);
+                    }
+                    else if (strcaseEQ(key, "realm")) {
+                        sasl_realm = SvPV_nolen(value);
+                    }
+                    else if (strcaseEQ(key, "password_file")) {
+                        sasl_password_file = SvPV_nolen(value);
+                    }
+                }
+                use_sasl = 1;
+            }
+#endif /* HAVE_CYRUS_SASL_H */
         }
 
         Newxz(zk, 1, zk_t);
+#ifdef HAVE_CYRUS_SASL_H
+        if (use_sasl) {
+            /* KLUDGE: Leaks a reference count.  Authen::SASL::XS does
+               the same, though.  TODO(ddiederen): Fix. */
+            sasl_client_init(NULL);
+            sasl_params.callbacks = zoo_sasl_make_basic_callbacks(sasl_user,
+                sasl_realm, sasl_password_file);
+        }
 
+        zk->handle = zookeeper_init_sasl(hosts, NULL, recv_timeout,
+            client_id, NULL, 0, NULL, use_sasl ? &sasl_params : NULL);
+#else
         zk->handle = zookeeper_init(hosts, NULL, recv_timeout,
-                                    client_id, NULL, 0);
+            client_id, NULL, 0);
+#endif /* HAVE_CYRUS_SASL_H */
 
         if (!zk->handle) {
             Safefree(zk);
@@ -1203,7 +1261,7 @@ zk_add_auth(zkh, scheme, cert)
         zk->last_errno = 0;
 
         if (cert_len > PERL_INT_MAX) {
-            Perl_croak(aTHX_ "invalid certificate length: %u", cert_len);
+            Perl_croak(aTHX_ "invalid certificate length: %zu", cert_len);
         }
 
         watch = _zk_create_watch(aTHX);
@@ -1283,7 +1341,7 @@ zk_create(zkh, path, buf, ...)
         }
 
         if (buf_len > PERL_INT_MAX) {
-            Perl_croak(aTHX_ "invalid data length: %u", buf_len);
+            Perl_croak(aTHX_ "invalid data length: %zu", buf_len);
         }
 
         path_buf_len = zk->path_buf_len;
@@ -1318,7 +1376,7 @@ zk_create(zkh, path, buf, ...)
                 err = _zk_fill_acl(aTHX_ acl_arr, &acl);
 
                 if (err) {
-                    Perl_croak(aTHX_ err);
+                    Perl_croak(aTHX_ "%s", err);
                 }
             }
         }
@@ -1757,7 +1815,7 @@ zk_set(zkh, path, buf, ...)
         }
 
         if (buf_len > PERL_INT_MAX) {
-            Perl_croak(aTHX_ "invalid data length: %u", buf_len);
+            Perl_croak(aTHX_ "invalid data length: %zu", buf_len);
         }
 
         for (i = 3; i < items; i += 2) {
@@ -1920,7 +1978,7 @@ zk_set_acl(zkh, path, acl_arr, ...)
         err = _zk_fill_acl(aTHX_ acl_arr, &acl);
 
         if (err) {
-            Perl_croak(aTHX_ err);
+            Perl_croak(aTHX_ "%s", err);
         }
 
         for (i = 3; i < items; i += 2) {

zookeeper-contrib/zookeeper-contrib-zkperl/t/10_invalid.t

@@ -527,13 +527,13 @@ like($@, qr/Usage: Net::ZooKeeper::set_acl\(zkh, path, acl_arr, \.\.\.\)/,
 eval {
     $zkh->set_acl($node_path, 'foo');
 };
-like($@, qr/acl_arr is not an array reference/,
+like($@, qr/acl_arr is not an array reference/i,
      'set_acl(): invalid ACL array reference');
 
 eval {
     $zkh->set_acl($node_path, {});
 };
-like($@, qr/acl_arr is not an array reference/,
+like($@, qr/acl_arr is not an array reference/i,
      'set_acl(): invalid ACL array reference to hash');
 
 eval {

zookeeper-contrib/zookeeper-contrib-zkperl/t/30_connect.t

@@ -176,6 +176,13 @@ SKIP: {
     ## NOTE: to test re-connections with saved session IDs we create a second
     ## connection with the same ID while the first is still active;
     ## this is bad practice in normal usage
+    ##
+    ## Test disabled because it breaks with current ZooKeeper servers:
+    ## $zkh1's connection gets closed as soon as $zkh2 connects, which
+    ## causes it to reconnect, which kills $zkh2's connection, etc.
+    ## TODO: figure out a way to test this.
+    SKIP: {
+    skip 'does not work with current ZK servers', 4;
 
     my $zkh2 = Net::ZooKeeper->new($hosts,
                                   'session_id' => $session_id1,
@@ -198,5 +205,6 @@ SKIP: {
             and $session_id2 eq $session_id1),
            'FETCH(): reconnect with session ID');
     }
+    }
 }
 

zookeeper-contrib/zookeeper-contrib-zkperl/t/35_log.t

@@ -31,7 +31,7 @@ my($hosts, $root_path, $node_path) = zk_test_setup(0);
 
 my $zkh = Net::ZooKeeper->new($hosts);
 
-Net::ZooKeeper::set_log_level(ZOO_LOG_LEVEL_INFO);
+Net::ZooKeeper::set_log_level(ZOO_LOG_LEVEL_DEBUG);
 
 SKIP: {
     skip 'no valid handle', 2 unless (defined($zkh));
@@ -45,6 +45,7 @@ SKIP: {
 
                 my $old_select = select(STDERR);
                 $| = 1;
+                $/ = undef;     # slurp mode.
                 select($old_select);
             }
             else {
@@ -63,7 +64,7 @@ SKIP: {
             skip 'no seek on stderr', 1 unless (seek(STDERR, 0, 0));
 
             my $log = <STDERR>;
-            like($log, qr/ZOO_/,
+            like($log, qr/ZOO_.*exists/,
                  'exists(): generated log message');
         }
 
@@ -75,7 +76,7 @@ SKIP: {
             skip 'no seek on stderr', 1 unless (seek(STDERR, 0, 0));
 
             my $log = <STDERR>;
-            like($log, qr/ZOO_/,
+            like($log, qr/ZOO_.*close/,
                  'DESTROY(): generated log message');
         }
 

zookeeper-contrib/zookeeper-contrib-zkperl/t/50_access.t

@@ -18,6 +18,7 @@
 
 use File::Spec;
 use Test::More tests => 40;
+use Storable qw(dclone);
 
 BEGIN { use_ok('Net::ZooKeeper', qw(:all)) };
 
@@ -163,9 +164,16 @@ SKIP: {
         $! eq ''),
        'get_acl(): undef returned for non-extant node');
 
+    # The test is not running as ADMIN, which means that the server
+    # returns "redacted" ACLs (see ZOOKEEPER-1392 and OpCode.getACL in
+    # FinalRequestProcessor).  We must do the same for the comparison
+    # to succeed.
+    my $redacted_digest_acl = dclone($digest_acl);
+    $redacted_digest_acl->[1]->{id} =~ s/:.*/:x/;
+
     @acl = ('abc');
     @acl = $zkh->get_acl($acl_node_path);
-    is_deeply(\@acl, $digest_acl,
+    is_deeply(\@acl, $redacted_digest_acl,
               'get_acl(): retrieved digest ACL');
 
     my $stat = $zkh->stat();

zookeeper-contrib/zookeeper-contrib-zkperl/t/70_sasl.t

@@ -0,0 +1,110 @@
+# Net::ZooKeeper - Perl extension for Apache ZooKeeper
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+use File::Spec;
+use Test::More tests => 7;
+use JSON::PP qw(decode_json);
+
+BEGIN { use_ok('Net::ZooKeeper', qw(:all)) };
+
+
+my $test_dir;
+(undef, $test_dir, undef) = File::Spec->splitpath($0);
+require File::Spec->catfile($test_dir, 'util.pl');
+
+my($hosts, $root_path, $node_path) = zk_test_setup(0);
+
+my $sasl_options = $ENV{'ZK_TEST_SASL_OPTIONS'};
+if (defined($sasl_options)) {
+    $sasl_options = decode_json($sasl_options);
+}
+
+SKIP: {
+    skip 'no sasl_options', 6 unless defined($sasl_options);
+
+    my $zkh = Net::ZooKeeper->new($hosts,
+        'sasl_options' => $sasl_options);
+
+    my $path = $zkh->create($node_path, 'foo',
+                            'acl' => ZOO_OPEN_ACL_UNSAFE) if (defined($zkh));
+
+    skip 'no connection to ZooKeeper', 36 unless
+        (defined($path) and $path eq $node_path);
+
+    ## _zk_acl_constant()
+
+    my $acl_node_path = "$node_path/a1";
+
+    my $sasl_acl = [
+        {
+            'perms'  => ZOO_PERM_READ,
+            'scheme' => 'world',
+            'id'     => 'anyone'
+        },
+        {
+            'perms'  => ZOO_PERM_ALL,
+            'scheme' => 'sasl',
+            'id'     => $sasl_options->{user}
+        }
+    ];
+
+    $path = $zkh->create($acl_node_path, 'foo', 'acl' => $sasl_acl);
+    is($path, $acl_node_path,
+       'create(): created node with SASL ACL');
+
+
+    ## get_acl()
+
+    @acl = ('abc');
+    @acl = $zkh->get_acl($acl_node_path);
+    is_deeply(\@acl, $sasl_acl,
+              'get_acl(): retrieved SASL ACL');
+
+    SKIP: {
+        my $zkh2 = Net::ZooKeeper->new($hosts);
+
+        my $ret = $zkh->exists($root_path) if (defined($zkh));
+
+        skip 'no connection to ZooKeeper', 1 unless
+            (defined($ret) and $ret);
+
+        my $node = $zkh2->get($acl_node_path);
+        is($node, 'foo',
+           'get(): retrieved node value with world ACL');
+
+        $ret = $zkh2->set($acl_node_path, 'bar');
+        ok((!$ret and $zkh2->get_error() == ZNOAUTH and $! eq ''),
+           'set(): node value unchanged if no auth');
+    }
+
+    my $ret = $zkh->set($acl_node_path, 'bar');
+    ok($ret,
+       'set(): set node with SASL ACL');
+
+    my $node = $zkh->get($acl_node_path);
+    is($node, 'bar',
+       'get(): retrieved new node value with SASL ACL');
+
+    $ret = $zkh->delete($acl_node_path);
+    diag(sprintf('unable to delete node %s: %d, %s',
+                 $acl_node_path, $zkh->get_error(), $!)) unless ($ret);
+
+    $ret = $zkh->delete($node_path);
+    diag(sprintf('unable to delete node %s: %d, %s',
+                 $node_path, $zkh->get_error(), $!)) unless ($ret);
+}