File Coverage

blib/lib/Crypt/OpenPGP/Util.pm
Criterion Covered Total %
statement 37 50 74.0
branch 12 14 85.7
condition 5 6 83.3
subroutine 10 13 76.9
pod 7 8 87.5
total 71 91 78.0


line stmt bran cond sub pod time code
1             package Crypt::OpenPGP::Util;
2 1     1   49996 use strict;
  1         4  
  1         49  
3              
4             # For some reason, FastCalc causes problems. Restrict to one of these 3 backends
5 1     1   6 use Math::BigInt only => 'Pari,GMP,Calc';
  1         2  
  1         7  
6              
7 1     1   1513 use vars qw( @EXPORT_OK @ISA );
  1         3  
  1         63  
8 1     1   7 use Exporter;
  1         3  
  1         843  
9             @EXPORT_OK = qw( bitsize bin2bigint bin2mp bigint2bin mp2bin mod_exp mod_inverse
10             dash_escape dash_unescape canonical_text );
11             @ISA = qw( Exporter );
12              
13             sub bitsize {
14 14     14 1 138 my $bigint = Math::BigInt->new($_[0]);
15 14         446 return $bigint->bfloor($bigint->blog(2)) + 1;
16             }
17              
18 8 100   8 1 142 sub bin2bigint { $_[0] ? Math::BigInt->new('0x' . unpack 'H*', $_[0]) : 0 }
19              
20             *bin2mp = \&bin2bigint;
21              
22             sub bigint2bin {
23 16     16 1 84 my($p) = @_;
24            
25 16         46 $p = _ensure_bigint($p);
26            
27 16         39 my $base = _ensure_bigint(1) << _ensure_bigint(4*8);
28 16         3070 my $res = '';
29 16         53 while ($p != 0) {
30 44         21415 my $r = $p % $base;
31 44         7977 $p = ($p-$r) / $base;
32 44         11352 my $buf = pack 'N', $r;
33 44 100       974 if ($p == 0) {
34 14 100       2108 $buf = $r >= 16777216 ? $buf :
    100          
    100          
35             $r >= 65536 ? substr($buf, -3, 3) :
36             $r >= 256 ? substr($buf, -2, 2) :
37             substr($buf, -1, 1);
38             }
39 44         7379 $res = $buf . $res;
40             }
41 16         7674 $res;
42             }
43              
44             *mp2bin = \&bigint2bin;
45              
46             sub mod_exp {
47 1     1 1 149 my($a, $exp, $n) = @_;
48            
49 1         4 $a = _ensure_bigint($a);
50            
51 1         6 $a->copy->bmodpow($exp, $n);
52             }
53              
54             sub mod_inverse {
55 1     1 1 139 my($a, $n) = @_;
56            
57 1         5 $a = _ensure_bigint($a);
58              
59 1         6 $a->copy->bmodinv($n);
60             }
61              
62             sub dash_escape {
63 0     0 1 0 my($data) = @_;
64 0         0 $data =~ s/^-/- -/mg;
65 0         0 $data;
66             }
67              
68             sub dash_unescape {
69 0     0 0 0 my($data) = @_;
70 0         0 $data =~ s/^-\s//mg;
71 0         0 $data;
72             }
73              
74             sub canonical_text {
75 0     0 1 0 my($text) = @_;
76 0         0 my @lines = split /\n/, $text, -1;
77 0         0 for my $l (@lines) {
78             ## pgp2 and pgp5 do not trim trailing whitespace from "canonical text"
79             ## signatures, only from cleartext signatures.
80             ## See:
81             ## http://cert.uni-stuttgart.de/archive/ietf-openpgp/2000/01/msg00033.html
82 0 0       0 if ($Crypt::OpenPGP::Globals::Trim_trailing_ws) {
83 0         0 $l =~ s/[ \t\r\n]*$//;
84             } else {
85 0         0 $l =~ s/[\r\n]*$//;
86             }
87             }
88 0         0 join "\r\n", @lines;
89             }
90              
91              
92             sub _ensure_bigint {
93 50     50   72 my $num = shift;
94              
95 50 100 66     250 if ($num && (! ref $num || ! $num->isa('Math::BigInt'))) {
      100        
96 39         130 $num = Math::BigInt->new($num);
97             }
98            
99 50         1684 return $num;
100             }
101              
102             1;
103             __END__