"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/binary-sasl.t" (21 Feb 2022, 17882 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use warnings;
    5 use Cwd;
    6 use FindBin qw($Bin);
    7 use lib "$Bin/lib";
    8 use MemcachedTest;
    9 
   10 my $supports_sasl = supports_sasl();
   11 
   12 use Test::More;
   13 
   14 if (supports_sasl()) {
   15     if ($ENV{'RUN_SASL_TESTS'}) {
   16         plan tests => 34;
   17     } else {
   18         plan skip_all => 'Skipping SASL tests';
   19         exit 0;
   20     }
   21 } else {
   22     plan tests => 1;
   23     eval {
   24         my $server = new_memcached("-S");
   25     };
   26     ok($@, "Died with illegal -S args when SASL is not supported.");
   27     exit 0;
   28 }
   29 
   30 eval {
   31     my $server = new_memcached("-S -B auto");
   32 };
   33 ok($@, "SASL shouldn't be used with protocol auto negotiate");
   34 
   35 eval {
   36     my $server = new_memcached("-S -B ascii");
   37 };
   38 ok($@, "SASL isn't implemented in the ascii protocol");
   39 
   40 eval {
   41     my $server = new_memcached("-S -B binary -B ascii");
   42 };
   43 ok($@, "SASL isn't implemented in the ascii protocol");
   44 
   45 # Based almost 100% off testClient.py which is:
   46 # Copyright (c) 2007  Dustin Sallings <dustin@spy.net>
   47 
   48 # Command constants
   49 use constant CMD_GET        => 0x00;
   50 use constant CMD_SET        => 0x01;
   51 use constant CMD_ADD        => 0x02;
   52 use constant CMD_REPLACE    => 0x03;
   53 use constant CMD_DELETE     => 0x04;
   54 use constant CMD_INCR       => 0x05;
   55 use constant CMD_DECR       => 0x06;
   56 use constant CMD_QUIT       => 0x07;
   57 use constant CMD_FLUSH      => 0x08;
   58 use constant CMD_GETQ       => 0x09;
   59 use constant CMD_NOOP       => 0x0A;
   60 use constant CMD_VERSION    => 0x0B;
   61 use constant CMD_GETK       => 0x0C;
   62 use constant CMD_GETKQ      => 0x0D;
   63 use constant CMD_APPEND     => 0x0E;
   64 use constant CMD_PREPEND    => 0x0F;
   65 use constant CMD_STAT       => 0x10;
   66 use constant CMD_SETQ       => 0x11;
   67 use constant CMD_ADDQ       => 0x12;
   68 use constant CMD_REPLACEQ   => 0x13;
   69 use constant CMD_DELETEQ    => 0x14;
   70 use constant CMD_INCREMENTQ => 0x15;
   71 use constant CMD_DECREMENTQ => 0x16;
   72 use constant CMD_QUITQ      => 0x17;
   73 use constant CMD_FLUSHQ     => 0x18;
   74 use constant CMD_APPENDQ    => 0x19;
   75 use constant CMD_PREPENDQ   => 0x1A;
   76 
   77 use constant CMD_SASL_LIST_MECHS    => 0x20;
   78 use constant CMD_SASL_AUTH          => 0x21;
   79 use constant CMD_SASL_STEP          => 0x22;
   80 use constant ERR_AUTH_ERROR   => 0x20;
   81 
   82 
   83 # REQ and RES formats are divided even though they currently share
   84 # the same format, since they _could_ differ in the future.
   85 use constant REQ_PKT_FMT      => "CCnCCnNNNN";
   86 use constant RES_PKT_FMT      => "CCnCCnNNNN";
   87 use constant INCRDECR_PKT_FMT => "NNNNN";
   88 use constant MIN_RECV_BYTES   => length(pack(RES_PKT_FMT));
   89 use constant REQ_MAGIC        => 0x80;
   90 use constant RES_MAGIC        => 0x81;
   91 
   92 my $pwd=getcwd;
   93 $ENV{'SASL_CONF_PATH'} = "$pwd/t/sasl";
   94 
   95 my $server = new_memcached('-B binary -U 0 -S -l 127.0.0.1 ');
   96 
   97 my $mc = MC::Client->new;
   98 
   99 my $check = sub {
  100     my ($key, $orig_val) = @_;
  101     my ($status, $val, $cas) = $mc->get($key);
  102 
  103     if ($val =~ /^\d+$/) {
  104         cmp_ok($val,'==', $orig_val, "$val = $orig_val");
  105     }
  106     else {
  107         cmp_ok($val, 'eq', $orig_val, "$val = $orig_val");
  108     }
  109 };
  110 
  111 my $set = sub {
  112     my ($key, $orig_value, $exp) = @_;
  113     $exp = defined $exp ? $exp : 0;
  114     my ($status, $rv)= $mc->set($key, $orig_value, $exp);
  115     $check->($key, $orig_value);
  116 };
  117 
  118 my $empty = sub {
  119     my $key = shift;
  120     my ($status,$rv) =()= eval { $mc->get($key) };
  121     #if ($status == ERR_AUTH_ERROR) {
  122     #    ok($@->auth_error, "Not authorized to connect");
  123     #}
  124     #else {
  125     #    ok($@->not_found, "We got a not found error when we expected one");
  126     #}
  127     if ($status) {
  128         ok($@->not_found, "We got a not found error when we expected one");
  129     }
  130 };
  131 
  132 my $delete = sub {
  133     my ($key, $when) = @_;
  134     $mc->delete($key, $when);
  135     $empty->($key);
  136 };
  137 
  138 # BEGIN THE TEST
  139 ok($server, "started the server");
  140 
  141 my $v = $mc->version;
  142 ok(defined $v && length($v), "Proper version: $v");
  143 
  144 # list mechs
  145 my $mechs= $mc->list_mechs();
  146 Test::More::cmp_ok($mechs, 'eq', 'CRAM-MD5 PLAIN', "list_mechs $mechs");
  147 
  148 # this should fail, not authenticated
  149 {
  150     my ($status, $val)= $mc->set('x', "somevalue");
  151     ok($status, "this fails to authenticate");
  152     cmp_ok($status,'==',ERR_AUTH_ERROR, "error code matches");
  153 }
  154 $empty->('x');
  155 {
  156     my $mc = MC::Client->new;
  157     my ($status, $val) = $mc->delete('x');
  158     ok($status, "this fails to authenticate");
  159     cmp_ok($status,'==',ERR_AUTH_ERROR, "error code matches");
  160 }
  161 $empty->('x');
  162 {
  163     my $mc = MC::Client->new;
  164     my ($status, $val)= $mc->set('x', "somevalue");
  165     ok($status, "this fails to authenticate");
  166     cmp_ok($status,'==',ERR_AUTH_ERROR, "error code matches");
  167 }
  168 $empty->('x');
  169 {
  170     my $mc = MC::Client->new;
  171     my ($status, $val)=  $mc->flush('x');
  172     ok($status, "this fails to authenticate");
  173     cmp_ok($status,'==',ERR_AUTH_ERROR, "error code matches");
  174 }
  175 $empty->('x');
  176 
  177 # Build the auth DB for testing.
  178 my $sasldb = '/tmp/test-memcached.sasldb';
  179 unlink $sasldb;
  180 
  181 my $saslpasswd_path;
  182 for my $dir (split(/:/, $ENV{PATH}),
  183              "/usr/bin",
  184              "/usr/sbin",
  185              "/usr/local/bin",
  186              "/usr/local/sbin",
  187     ) {
  188     my $exe = $dir . '/saslpasswd2';
  189     if (-x $exe) {
  190         $saslpasswd_path = $exe;
  191         last;
  192     }
  193 }
  194 die "no saslpasswd2 found" unless $saslpasswd_path;
  195 
  196 my $sasl_realm = 'memcached.realm';
  197 
  198 system("echo testpass | $saslpasswd_path -a memcached -u $sasl_realm -c -p testuser");
  199 
  200 $mc = MC::Client->new;
  201 
  202 # Attempt a bad auth mech.
  203 is ($mc->authenticate('testuser', 'testpass', "X" x 40), 0x4, "bad mech");
  204 
  205 # Attempt bad authentication.
  206 is ($mc->authenticate('testuser', 'wrongpassword'), 0x20, "bad auth");
  207 
  208 # Now try good authentication and make the tests work.
  209 is ($mc->authenticate('testuser', 'testpass'), 0, "authenticated");
  210 # these should work
  211 {
  212     my ($status, $val)= $mc->set('x', "somevalue");
  213     ok(! $status);
  214 }
  215 $check->('x','somevalue');
  216 
  217 {
  218     my ($status, $val)= $mc->delete('x');
  219     ok(! $status);
  220 }
  221 $empty->('x');
  222 
  223 {
  224     my ($status, $val)= $mc->set('x', "somevalue");
  225     ok(! $status);
  226 }
  227 $check->('x','somevalue');
  228 
  229 {
  230     my ($status, $val)=  $mc->flush('x');
  231     ok(! $status);
  232 }
  233 $empty->('x');
  234 
  235 {
  236     my $mc = MC::Client->new;
  237 
  238     # Attempt bad authentication.
  239     is ($mc->authenticate('testuser', 'wrongpassword'), 0x20, "bad auth");
  240 
  241     # This should fail because $mc is not authenticated
  242     my ($status, $val)= $mc->set('x', "somevalue");
  243     ok($status, "this fails to authenticate");
  244     cmp_ok($status,'==',ERR_AUTH_ERROR, "error code matches");
  245 }
  246 $empty->('x', 'somevalue');
  247 
  248 {
  249     my $mc = MC::Client->new;
  250 
  251     # Attempt bad authentication.
  252     is ($mc->authenticate('testuser', 'wrongpassword'), 0x20, "bad auth");
  253 
  254     # Mix an authenticated connection and an unauthenticated connection to
  255     # confirm c->authenticated is not shared among connections
  256     my $mc2 = MC::Client->new;
  257     is ($mc2->authenticate('testuser', 'testpass'), 0, "authenticated");
  258     my ($status, $val)= $mc2->set('x', "somevalue");
  259     ok(! $status);
  260 
  261     # This should fail because $mc is not authenticated
  262     ($status, $val)= $mc->set('x', "somevalue");
  263     ok($status, "this fails to authenticate");
  264     cmp_ok($status,'==',ERR_AUTH_ERROR, "error code matches");
  265 }
  266 
  267 {
  268     my $mc = MC::Client->new;
  269     is ($mc->sasl_step('testuser', 'testpass'), 0x20, "sasl_step_fails_no_segfault");
  270 }
  271 
  272 # check the SASL stats, make sure they track things correctly
  273 # note: the enabled or not is presence checked in stats.t
  274 
  275 # while authenticated, get current counter
  276 #
  277 # My initial approach was going to be to get current counts, reauthenticate
  278 # and fail, followed by a reauth successfully so I'd know what happened.
  279 # Reauthentication is currently unsupported, so it doesn't work that way at the
  280 # moment.  Adding tests may break this.
  281 
  282 {
  283     my %stats = $mc->stats('');
  284     is ($stats{'auth_cmds'}, 6, "auth commands counted");
  285     is ($stats{'auth_errors'}, 4, "auth errors correct");
  286 }
  287 
  288 
  289 # Along with the assertion added to the code to verify we're staying
  290 # within bounds when we do a stats detail dump (detail turned on at
  291 # the top).
  292 # my %stats = $mc->stats('detail dump');
  293 
  294 # ######################################################################
  295 # Test ends around here.
  296 # ######################################################################
  297 
  298 package MC::Client;
  299 
  300 use strict;
  301 use warnings;
  302 use fields qw(socket);
  303 use IO::Socket::INET;
  304 
  305 use constant ERR_AUTH_ERROR   => 0x20;
  306 
  307 sub new {
  308     my $self = shift;
  309     my ($s) = @_;
  310     $s = $server unless defined $s;
  311     my $sock = $s->sock;
  312     $self = fields::new($self);
  313     $self->{socket} = $sock;
  314     return $self;
  315 }
  316 
  317 sub authenticate {
  318     my ($self, $user, $pass, $mech)= @_;
  319     $mech ||= 'PLAIN';
  320     my $buf = sprintf("%c%s@%s%c%s", 0, $user, $sasl_realm, 0, $pass);
  321     my ($status, $rv, undef) = $self->_do_command(::CMD_SASL_AUTH, $mech, $buf, '');
  322     return $status;
  323 }
  324 sub sasl_step {
  325     my ($self, $user, $pass, $mech)= @_;
  326     $mech ||= 'PLAIN';
  327     my $buf = sprintf("%c%s@%s%c%s", 0, $user, $sasl_realm, 0, $pass);
  328     my ($status, $rv, undef) = $self->_do_command(::CMD_SASL_STEP, $mech, $buf, '');
  329     return $status;
  330 }
  331 sub list_mechs {
  332     my ($self)= @_;
  333     my ($status, $rv, undef) = $self->_do_command(::CMD_SASL_LIST_MECHS, '', '', '');
  334     return join(" ", sort(split(/\s+/, $rv)));
  335 }
  336 
  337 sub build_command {
  338     my $self = shift;
  339     die "Not enough args to send_command" unless @_ >= 4;
  340     my ($cmd, $key, $val, $opaque, $extra_header, $cas) = @_;
  341 
  342     $extra_header = '' unless defined $extra_header;
  343     my $keylen    = length($key);
  344     my $vallen    = length($val);
  345     my $extralen  = length($extra_header);
  346     my $datatype  = 0;  # field for future use
  347     my $reserved  = 0;  # field for future use
  348     my $totallen  = $keylen + $vallen + $extralen;
  349     my $ident_hi  = 0;
  350     my $ident_lo  = 0;
  351 
  352     if ($cas) {
  353         $ident_hi = int($cas / 2 ** 32);
  354         $ident_lo = int($cas % 2 ** 32);
  355     }
  356 
  357     my $msg = pack(::REQ_PKT_FMT, ::REQ_MAGIC, $cmd, $keylen, $extralen,
  358                    $datatype, $reserved, $totallen, $opaque, $ident_hi,
  359                    $ident_lo);
  360     my $full_msg = $msg . $extra_header . $key . $val;
  361     return $full_msg;
  362 }
  363 
  364 sub send_command {
  365     my $self = shift;
  366     die "Not enough args to send_command" unless @_ >= 4;
  367     my ($cmd, $key, $val, $opaque, $extra_header, $cas) = @_;
  368 
  369     my $full_msg = $self->build_command($cmd, $key, $val, $opaque, $extra_header, $cas);
  370 
  371     my $sent = $self->{socket}->send($full_msg);
  372     die("Send failed:  $!") unless $sent;
  373     if($sent != length($full_msg)) {
  374         die("only sent $sent of " . length($full_msg) . " bytes");
  375     }
  376 }
  377 
  378 sub flush_socket {
  379     my $self = shift;
  380     $self->{socket}->flush;
  381 }
  382 
  383 # Send a silent command and ensure it doesn't respond.
  384 sub send_silent {
  385     my $self = shift;
  386     die "Not enough args to send_silent" unless @_ >= 4;
  387     my ($cmd, $key, $val, $opaque, $extra_header, $cas) = @_;
  388 
  389     $self->send_command($cmd, $key, $val, $opaque, $extra_header, $cas);
  390     $self->send_command(::CMD_NOOP, '', '', $opaque + 1);
  391 
  392     my ($ropaque, $status, $data) = $self->_handle_single_response;
  393     Test::More::is($ropaque, $opaque + 1);
  394 }
  395 
  396 sub silent_mutation {
  397     my $self = shift;
  398     my ($cmd, $key, $value) = @_;
  399 
  400     $empty->($key);
  401     my $extra = pack "NN", 82, 0;
  402     $mc->send_silent($cmd, $key, $value, 7278552, $extra, 0);
  403     $check->($key, $value);
  404 }
  405 
  406 sub _handle_single_response {
  407     my $self = shift;
  408     my $myopaque = shift;
  409 
  410     $self->{socket}->recv(my $response, ::MIN_RECV_BYTES);
  411 
  412     my ($magic, $cmd, $keylen, $extralen, $datatype, $status, $remaining,
  413         $opaque, $ident_hi, $ident_lo) = unpack(::RES_PKT_FMT, $response);
  414 
  415     return ($opaque, '', '', '', 0) if not defined $remaining;
  416     return ($opaque, '', '', '', 0) if ($remaining == 0);
  417 
  418     # fetch the value
  419     my $rv="";
  420     while($remaining - length($rv) > 0) {
  421         $self->{socket}->recv(my $buf, $remaining - length($rv));
  422         $rv .= $buf;
  423     }
  424     if(length($rv) != $remaining) {
  425         my $found = length($rv);
  426         die("Expected $remaining bytes, got $found");
  427     }
  428 
  429     my $cas = ($ident_hi * 2 ** 32) + $ident_lo;
  430 
  431     #if ($status) {
  432         #die MC::Error->new($status, $rv);
  433     #}
  434 
  435     return ($opaque, $status, $rv, $cas, $keylen);
  436 }
  437 
  438 sub _do_command {
  439     my $self = shift;
  440     die unless @_ >= 3;
  441     my ($cmd, $key, $val, $extra_header, $cas) = @_;
  442 
  443     $extra_header = '' unless defined $extra_header;
  444     my $opaque = int(rand(2**32));
  445     $self->send_command($cmd, $key, $val, $opaque, $extra_header, $cas);
  446     my (undef, $status, $rv, $rcas) = $self->_handle_single_response($opaque);
  447     return ($status, $rv, $rcas);
  448 }
  449 
  450 sub _incrdecr_header {
  451     my $self = shift;
  452     my ($amt, $init, $exp) = @_;
  453 
  454     my $amt_hi = int($amt / 2 ** 32);
  455     my $amt_lo = int($amt % 2 ** 32);
  456 
  457     my $init_hi = int($init / 2 ** 32);
  458     my $init_lo = int($init % 2 ** 32);
  459 
  460     my $extra_header = pack(::INCRDECR_PKT_FMT, $amt_hi, $amt_lo, $init_hi,
  461                             $init_lo, $exp);
  462 
  463     return $extra_header;
  464 }
  465 
  466 sub _incrdecr {
  467     my $self = shift;
  468     my ($cmd, $key, $amt, $init, $exp) = @_;
  469 
  470     my ($status, $data, undef) = $self->_do_command($cmd, $key, '',
  471                                            $self->_incrdecr_header($amt, $init, $exp));
  472 
  473     my $header = substr $data, 0, 8, '';
  474     my ($resp_hi, $resp_lo) = unpack "NN", $header;
  475     my $resp = ($resp_hi * 2 ** 32) + $resp_lo;
  476 
  477     return $resp;
  478 }
  479 
  480 sub silent_incrdecr {
  481     my $self = shift;
  482     my ($cmd, $key, $amt, $init, $exp) = @_;
  483     my $opaque = 8275753;
  484 
  485     $mc->send_silent($cmd, $key, '', $opaque,
  486                      $mc->_incrdecr_header($amt, $init, $exp));
  487 }
  488 
  489 sub stats {
  490     my $self = shift;
  491     my $key  = shift;
  492     my $cas = 0;
  493     my $opaque = int(rand(2**32));
  494     $self->send_command(::CMD_STAT, $key, '', $opaque, '', $cas);
  495 
  496     my %rv = ();
  497     my $found_key = '';
  498     my $found_val = '';
  499     my $status= 0;
  500     do {
  501         my ($op, $status, $data, $cas, $keylen) = $self->_handle_single_response($opaque);
  502         if ($keylen > 0) {
  503             $found_key = substr($data, 0, $keylen);
  504             $found_val = substr($data, $keylen);
  505             $rv{$found_key} = $found_val;
  506         } else {
  507             $found_key = '';
  508         }
  509     } while($found_key ne '');
  510     return %rv;
  511 }
  512 
  513 sub get {
  514     my $self = shift;
  515     my $key  = shift;
  516     my ($status, $rv, $cas) = $self->_do_command(::CMD_GET, $key, '', '');
  517 
  518     my $header = substr $rv, 0, 4, '';
  519     my $flags  = unpack("N", $header);
  520 
  521     return ($status, $rv);
  522 }
  523 
  524 sub get_multi {
  525     my $self = shift;
  526     my @keys = @_;
  527 
  528     for (my $i = 0; $i < @keys; $i++) {
  529         $self->send_command(::CMD_GETQ, $keys[$i], '', $i, '', 0);
  530     }
  531 
  532     my $terminal = @keys + 10;
  533     $self->send_command(::CMD_NOOP, '', '', $terminal);
  534 
  535     my %return;
  536     my $status = 0;
  537     while (1) {
  538         my ($opaque, $status, $data) = $self->_handle_single_response;
  539         last if $opaque == $terminal;
  540 
  541         my $header = substr $data, 0, 4, '';
  542         my $flags  = unpack("N", $header);
  543 
  544         $return{$keys[$opaque]} = [$flags, $data];
  545     }
  546 
  547     return %return if wantarray;
  548     return \%return;
  549 }
  550 
  551 sub version {
  552     my $self = shift;
  553     return $self->_do_command(::CMD_VERSION, '', '');
  554 }
  555 
  556 sub flush {
  557     my $self = shift;
  558     return $self->_do_command(::CMD_FLUSH, '', '');
  559 }
  560 
  561 sub add {
  562     my $self = shift;
  563     my ($key, $val, $flags, $expire) = @_;
  564     my $extra_header = pack "NN", $flags, $expire;
  565     my $cas = 0;
  566     return $self->_do_command(::CMD_ADD, $key, $val, $extra_header, $cas);
  567 }
  568 
  569 sub set {
  570     my $self = shift;
  571     my $flags = 0;
  572     my $cas = 0;
  573     my ($key, $val, $expire) = @_;
  574     $expire = defined $expire ? $expire : 0;
  575     my $extra_header = pack "NN", $flags, $expire;
  576     return $self->_do_command(::CMD_SET, $key, $val, $extra_header, $cas);
  577 }
  578 
  579 sub _append_prepend {
  580     my $self = shift;
  581     my ($cmd, $key, $val, $cas) = @_;
  582     return $self->_do_command($cmd, $key, $val, '', $cas);
  583 }
  584 
  585 sub replace {
  586     my $self = shift;
  587     my ($key, $val, $flags, $expire) = @_;
  588     my $extra_header = pack "NN", $flags, $expire;
  589     my $cas = 0;
  590     return $self->_do_command(::CMD_REPLACE, $key, $val, $extra_header, $cas);
  591 }
  592 
  593 sub delete {
  594     my $self = shift;
  595     my ($key) = @_;
  596     return $self->_do_command(::CMD_DELETE, $key, '');
  597 }
  598 
  599 sub incr {
  600     my $self = shift;
  601     my ($key, $amt, $init, $exp) = @_;
  602     $amt = 1 unless defined $amt;
  603     $init = 0 unless defined $init;
  604     $exp = 0 unless defined $exp;
  605 
  606     return $self->_incrdecr(::CMD_INCR, $key, $amt, $init, $exp);
  607 }
  608 
  609 sub decr {
  610     my $self = shift;
  611     my ($key, $amt, $init, $exp) = @_;
  612     $amt = 1 unless defined $amt;
  613     $init = 0 unless defined $init;
  614     $exp = 0 unless defined $exp;
  615 
  616     return $self->_incrdecr(::CMD_DECR, $key, $amt, $init, $exp);
  617 }
  618 
  619 sub noop {
  620     my $self = shift;
  621     return $self->_do_command(::CMD_NOOP, '', '');
  622 }
  623 
  624 package MC::Error;
  625 
  626 use strict;
  627 use warnings;
  628 
  629 use constant ERR_UNKNOWN_CMD  => 0x81;
  630 use constant ERR_NOT_FOUND    => 0x1;
  631 use constant ERR_EXISTS       => 0x2;
  632 use constant ERR_TOO_BIG      => 0x3;
  633 use constant ERR_EINVAL       => 0x4;
  634 use constant ERR_NOT_STORED   => 0x5;
  635 use constant ERR_DELTA_BADVAL => 0x6;
  636 use constant ERR_AUTH_ERROR   => 0x20;
  637 
  638 use overload '""' => sub {
  639     my $self = shift;
  640     return "Memcache Error ($self->[0]): $self->[1]";
  641 };
  642 
  643 sub new {
  644     my $class = shift;
  645     my $error = [@_];
  646     my $self = bless $error, (ref $class || $class);
  647 
  648     return $self;
  649 }
  650 
  651 sub not_found {
  652     my $self = shift;
  653     return $self->[0] == ERR_NOT_FOUND;
  654 }
  655 
  656 sub exists {
  657     my $self = shift;
  658     return $self->[0] == ERR_EXISTS;
  659 }
  660 
  661 sub too_big {
  662     my $self = shift;
  663     return $self->[0] == ERR_TOO_BIG;
  664 }
  665 
  666 sub delta_badval {
  667     my $self = shift;
  668     return $self->[0] == ERR_DELTA_BADVAL;
  669 }
  670 
  671 sub auth_error {
  672     my $self = shift;
  673     return $self->[0] == ERR_AUTH_ERROR;
  674 }
  675 
  676 unlink $sasldb;
  677 
  678 # vim: filetype=perl