File Coverage

blib/lib/Auth/Kokolores/Protocol/CyrusSaslauthd.pm
Criterion Covered Total %
statement 6 26 23.0
branch 0 4 0.0
condition n/a
subroutine 2 5 40.0
pod 0 2 0.0
total 8 37 21.6


line stmt bran cond sub pod time code
1             package Auth::Kokolores::Protocol::CyrusSaslauthd;
2              
3 1     1   3 use Moose;
  1         1  
  1         6  
4             extends 'Auth::Kokolores::Protocol';
5              
6             # ABSTRACT: saslauthd protocol implementation for kokolores
7             our $VERSION = '1.01'; # VERSION
8              
9 1     1   4124 use Auth::Kokolores::Request;
  1         1  
  1         235  
10              
11             sub _read_sasl_string {
12 0     0     my ( $conn ) = @_;
13 0           my $buf;
14 0           $conn->read($buf, 2);
15 0           my $size = unpack('n', $buf);
16 0 0         if( ! defined $size ) {
17 0           die('protocol error: could not read size of next string');
18             }
19 0           $conn->read($buf, $size);
20 0           return unpack("A$size", $buf);
21             }
22              
23             sub read_request {
24 0     0 0   my $self = shift;
25 0           my %opts;
26              
27 0           foreach my $field ('username', 'password', 'service', 'realm') {
28 0           $opts{$field} = _read_sasl_string( $self->handle );
29             }
30              
31             return Auth::Kokolores::Request->new(
32             username => $opts{'username'},
33             password => $opts{'password'},
34             parameters => {
35             service => $opts{'service'},
36 0           realm => $opts{'realm'},
37             },
38             server => $self->server,
39             );
40             }
41              
42             sub write_response {
43 0     0 0   my ( $self, $response ) = @_;
44 0           my $message = 'NO';
45              
46 0 0         if( $response->success ) {
47 0           $message = 'OK';
48             }
49              
50 0           my $size = length($message) + 1;
51 0           $self->handle->print( pack("nA$size", $size, $message."\0") );
52              
53              
54 0           return;
55             }
56              
57             __END__
58              
59             =pod
60              
61             =encoding UTF-8
62              
63             =head1 NAME
64              
65             Auth::Kokolores::Protocol::CyrusSaslauthd - saslauthd protocol implementation for kokolores
66              
67             =head1 VERSION
68              
69             version 1.01
70              
71             =head1 AUTHOR
72              
73             Markus Benning <ich@markusbenning.de>
74              
75             =head1 COPYRIGHT AND LICENSE
76              
77             This software is Copyright (c) 2016 by Markus Benning <ich@markusbenning.de>.
78              
79             This is free software, licensed under:
80              
81             The GNU General Public License, Version 2, June 1991
82              
83             =cut