view release on metacpan or  search on metacpan

t/client.t  view on Meta::CPAN

        "message structure"
    );
    isnt( $first, $client->first_msg, "repeat calls are different" );

    like( get_client( username => 'us,e=r' )->first_msg,
        qr{^n,,n=us=2ce=3dr}, "user name , and = encoding" );

    like(
        get_client( authorization_id => 'other,me' )->first_msg,
        qr{^n,a=other=2cme,n=user,r=.+},
        "authorization_id with encoding"
    );
};

subtest "RFC 5802 example" => sub {
    # force client nonce to match RFC5802 example
    my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" } );
    my $first = $client->first_msg();
    is( $first, "n,,n=user,r=fyko+d2lbbFgONRv9qkxdawL", "client first message" )
      or diag explain $client;

    # RFC5802 example server-first-message
    my $server_first =
      "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096";
    my $final = $client->final_msg($server_first);
    is(
        $final,
        "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts=",
        "client final message"
    ) or diag explain $client;

    ok( $client->validate("v=rmF9pqV8S7suAoZWja4dJRkFsKQ="),
        "server message validated" );

    # Repeat to check credential caching by hooking the digest method,
    # which is called to pass to 'derive'.
    {
        no warnings 'redefine';
        my $digest_called;
        my $orig = \&Authen::SCRAM::Client::digest;
        local *Authen::SCRAM::Client::digest = sub {
            $digest_called = 1;
            &$orig;
        };

        # Reuse earlier client (recall that nonce is forced constant)
        my $first = $client->first_msg();
        is( $first, "n,,n=user,r=fyko+d2lbbFgONRv9qkxdawL", "client first message" )
          or diag explain $client;

        # RFC5802 example server-first-message
        my $server_first =
          "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096";
        my $final = $client->final_msg($server_first);
        is(
            $final,
            "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts=",
            "client final message"
        ) or diag explain $client;

        ok( !$digest_called, "cached credentials used" );
    }

};

subtest "RFC 7677 example (SHA256)" => sub {
    # force client nonce to match RFC7677 example
    my $client = get_client(
        digest           => 'SHA-256',
        _nonce_generator => sub { "rOprNGfwEbeRWgbNEkqO" }
    );
    my $first = $client->first_msg();
    is( $first, "n,,n=user,r=rOprNGfwEbeRWgbNEkqO", "client first message" )
      or diag explain $client;

    # RFC7677 example server-first-message
    my $server_first =
      'r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,s=W22ZaJ0SNY7soEsUEjb6gQ==,i=4096';
    my $final = $client->final_msg($server_first);
    is(
        $final,
        'c=biws,r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,p=dHzbZapWIk4jUhN+Ute9ytag9zjfMHgsqmmiz7AndVQ=',
        "client final message"
    ) or diag explain $client;

    ok( $client->validate("v=6rriTRBi23WpRR/wtup+mMhUZUn/dB5nLTJRsjl95G4="),
        "server message validated" );

};

subtest "Unicode username" => sub {
    my $client = get_client(
        username         => "ram\N{U+00F3}n",
        password         => "p\N{U+00C5}ssword",
        _nonce_generator => sub { "cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xr" }
    );
    my $first = $client->first_msg();
    is(
        $first,
        "n,,n=ram\N{U+00F3}n,r=cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xr",
        "client first message"
    ) or diag explain $client;

    my $server_first =
      "r=cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xrB3rw8xNSLYx23V0qdkD/t7ZjoUcyDrTy,s=c2FsdA==,i=4096";
    my $final = $client->final_msg($server_first);
    is(
        $final,
        'c=biws,r=cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xrB3rw8xNSLYx23V0qdkD/t7ZjoUcyDrTy,p=lfZL47BCT5wdBisDystprtNLsbA=',
        "client final message"
    ) or diag explain $client;

    ok( $client->validate("v=etGS4QFClYMJTMeRBMs0lnWRmV8="),
        "server message validated" );

};

subtest "Minimum iteration count" => sub {
    {
        # force client nonce to match RFC5802 example
        my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" } );