File Coverage

blib/lib/Protocol/TLS/Alert.pm
Criterion Covered Total %
statement 24 29 82.7
branch 4 8 50.0
condition n/a
subroutine 7 7 100.0
pod 0 2 0.0
total 35 46 76.0


line stmt bran cond sub pod time code
1             package Protocol::TLS::Alert;
2 2     2   11 use strict;
  2         3  
  2         51  
3 2     2   11 use warnings;
  2         3  
  2         50  
4 2     2   10 use Carp;
  2         3  
  2         119  
5 2     2   10 use Protocol::TLS::Trace qw(tracer);
  2         3  
  2         97  
6 2     2   11 use Protocol::TLS::Constants qw(const_name :alert_types :alert_desc);
  2         3  
  2         1036  
7              
8             sub decode {
9 3     3 0 25 my ( $ctx, $buf_ref, $buf_offset, $length ) = @_;
10 3 50       14 return 0 if length($$buf_ref) - $buf_offset < 2;
11 3         15 my ( $alert, $desc ) = unpack "x${buf_offset}C2", $$buf_ref;
12              
13 3 50       17 if ( $alert == WARNING ) {
    50          
14 0         0 tracer->warning(
15             "warning: " . const_name( 'alert_desc', $desc ) . "\n" );
16             }
17             elsif ( $alert == FATAL ) {
18 3 50       13 if ( $desc == CLOSE_NOTIFY ) {
19 3         37 $ctx->close;
20             }
21             else {
22 0         0 tracer->error(
23             "fatal: " . const_name( 'alert_desc', $desc ) . "\n" );
24 0         0 $ctx->shutdown(1);
25             }
26             }
27             else {
28 0         0 tracer->error("unknown alert type: $alert\n");
29 0         0 return undef;
30             }
31 3         14 return 2;
32             }
33              
34             sub encode {
35 3     3 0 8 my ( $ctx, $alert, $desc ) = @_;
36 3         22 pack "C2", $alert, $desc;
37             }
38              
39             1