File: common.pl

package info (click to toggle)
libauthen-sasl-perl 2.1900-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 328 kB
  • sloc: perl: 2,249; makefile: 7
file content (34 lines) | stat: -rw-r--r-- 930 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
use strict;
use warnings;

use Authen::SASL ('Perl');

sub negotiate {
    my ($c, $s, $do) = @_;

    my $client_sasl = Authen::SASL->new( %{ $c->{sasl} } );
    my $server_sasl = Authen::SASL->new( %{ $s->{sasl} } );

    my $client = $client_sasl->client_new(@$c{qw/service host security/});
    my $server = $server_sasl->server_new(@$s{qw/service host/});

    my $start     = $client->client_start();

    my $challenge;
    my $next_cb = sub { $challenge = shift };
    $server->server_start($start, $next_cb);

    my $response;
    ## note: this wouldn't work in a real async environment
    while ($client->need_step || $server->need_step) {
        $response = $client->client_step($challenge)
            if $client->need_step;
        last if $client->error;
        $server->server_step($response, $next_cb)
            if $server->need_step;
        last if $server->error;
    }
    $do->($client, $server);
}

1;