1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
5#include <openssl/ssl.h>
6#include <openssl/bn.h>
7
8#define checkOpenSslCall( result ) if( ! ( result ) ) \
9  croak( "OpenSSL error: %s", ERR_reason_error_string( ERR_get_error() ) );
10
11SV* new_obj( SV * p_proto, void* obj )
12{
13    return sv_2mortal( sv_bless( newRV_noinc( newSViv( (IV)obj ) ),
14                                 ( SvROK( p_proto )
15                                   ? SvSTASH( SvRV( p_proto ) )
16                                   : gv_stashsv( p_proto, 1 ) ) ) );
17}
18
19#define proto_obj( obj ) new_obj( ST(0), obj )
20
21BIGNUM* sv2bn( SV* sv )
22{
23    if( ! SvROK( sv ) )
24    {
25      croak( "argument is not a Crypt::OpenSSL::Bignum object" );
26    }
27    return (BIGNUM*) SvIV( SvRV( sv ) );
28}
29
30MODULE = Crypt::OpenSSL::Bignum      PACKAGE = Crypt::OpenSSL::Bignum   PREFIX=BN_
31
32BOOT:
33    ERR_load_crypto_strings();
34
35void
36_free_BN(self)
37    BIGNUM* self;
38  CODE:
39    BN_clear_free( self );
40
41BIGNUM*
42new_from_word(p_proto, p_word)
43    SV* p_proto;
44    unsigned long p_word;
45  PREINIT:
46    BIGNUM* bn;
47  CODE:
48    checkOpenSslCall( bn = BN_new() );
49    checkOpenSslCall( BN_set_word( bn, p_word ) );
50    RETVAL = bn;
51  OUTPUT:
52    RETVAL
53
54BIGNUM*
55new_from_decimal(p_proto, p_dec_string)
56    SV* p_proto;
57    char* p_dec_string;
58  PREINIT:
59    BIGNUM* bn;
60  CODE:
61    bn = NULL;
62    checkOpenSslCall( BN_dec2bn( &bn, p_dec_string ) );
63    RETVAL = bn;
64  OUTPUT:
65    RETVAL
66
67BIGNUM*
68new_from_hex(p_proto, p_hex_string)
69    SV* p_proto;
70    char* p_hex_string;
71  PREINIT:
72    BIGNUM* bn;
73  CODE:
74    bn = NULL;
75    checkOpenSslCall( BN_hex2bn( &bn, p_hex_string ) );
76    RETVAL = bn;
77  OUTPUT:
78    RETVAL
79
80BIGNUM*
81new_from_bin(p_proto, p_bin_string_SV)
82    SV* p_proto;
83    SV* p_bin_string_SV;
84  PREINIT:
85    BIGNUM* bn;
86    char* bin;
87    STRLEN bin_length;
88  CODE:
89    bin = SvPV( p_bin_string_SV, bin_length );
90    checkOpenSslCall( bn = BN_bin2bn( bin, bin_length, NULL ) );
91    RETVAL = bn;
92  OUTPUT:
93    RETVAL
94
95BIGNUM*
96zero(p_proto)
97    SV* p_proto;
98  PREINIT:
99    BIGNUM *bn;
100  CODE:
101    checkOpenSslCall( bn = BN_new() );
102    checkOpenSslCall( BN_zero( bn ) );
103    RETVAL = bn;
104  OUTPUT:
105    RETVAL
106
107BIGNUM*
108one(p_proto)
109    SV* p_proto;
110  PREINIT:
111    BIGNUM *bn;
112  CODE:
113    checkOpenSslCall( bn = BN_new() );
114    checkOpenSslCall( BN_one( bn ) );
115    RETVAL = bn;
116  OUTPUT:
117    RETVAL
118
119
120
121char*
122to_decimal(self)
123    BIGNUM* self;
124  CODE:
125    checkOpenSslCall( RETVAL = BN_bn2dec( self ) );
126  OUTPUT:
127    RETVAL
128  CLEANUP:
129    OPENSSL_free( RETVAL );
130
131
132char*
133to_hex(self)
134    BIGNUM* self;
135  CODE:
136    checkOpenSslCall( RETVAL = BN_bn2hex( self ) );
137  OUTPUT:
138    RETVAL
139  CLEANUP:
140    OPENSSL_free( RETVAL );
141
142SV*
143to_bin(self)
144    BIGNUM* self;
145  PREINIT:
146    char* bin;
147    int length;
148  CODE:
149    length = BN_num_bytes( self );
150    New( 0, bin, length, char );
151    BN_bn2bin( self, bin );
152    RETVAL = newSVpv( bin, length );
153    Safefree( bin );
154  OUTPUT:
155    RETVAL
156
157unsigned long
158BN_get_word(self)
159    BIGNUM* self;
160
161PROTOTYPES: DISABLE
162
163SV*
164add(a, b, ...)
165    BIGNUM* a;
166    BIGNUM* b;
167  PREINIT:
168    BIGNUM *bn;
169  PPCODE:
170    if( items > 3 )
171      croak( "usage: $bn->add( $bn2[, $target] )" );
172    bn = ( items < 3 ) ? BN_new() : sv2bn( ST(2) );
173    checkOpenSslCall( BN_add( bn, a, b ) );
174    ST(0) = ( (items < 3 ) ? proto_obj( bn ) : ST(2) );
175    XSRETURN(1);
176
177SV*
178sub(a, b, ...)
179    BIGNUM* a;
180    BIGNUM* b;
181  PREINIT:
182    BIGNUM *bn;
183  PPCODE:
184    if( items > 3 )
185      croak( "usage: $bn->sub( $bn2[, $target] )" );
186    bn = ( items < 3 ) ? BN_new() : sv2bn( ST(2) );
187    checkOpenSslCall( BN_sub( bn, a, b ) );
188    ST(0) = ( (items < 3 ) ? proto_obj( bn ) : ST(2) );
189    XSRETURN(1);
190
191SV*
192mul(a, b, ctx, ...)
193    BIGNUM* a;
194    BIGNUM* b;
195    BN_CTX* ctx;
196  PREINIT:
197    BIGNUM* bn;
198  PPCODE:
199    if( items > 4 )
200      croak( "usage: $bn->mul( $bn2, $ctx, [, $target] )" );
201    bn = ( items < 4 ) ? BN_new() : sv2bn( ST(3) );
202    checkOpenSslCall( BN_mul( bn, a, b, ctx ) );
203    ST(0) = ( (items < 4 ) ? proto_obj( bn ) : ST(3) );
204    XSRETURN(1);
205
206SV*
207div(a, b, ctx, ...)
208    BIGNUM* a;
209    BIGNUM* b;
210    BN_CTX* ctx;
211  PREINIT:
212    BIGNUM* quotient;
213    BIGNUM* remainder;
214  PPCODE:
215    if( items > 5 )
216      croak( "usage: $bn->add( $bn2, $ctx, [, $quotient [, $remainder ] ] )" );
217    quotient = ( items < 4 ) ? BN_new() : sv2bn( ST(3) );
218    remainder = ( items < 5 ) ? BN_new() : sv2bn( ST(4) );
219    checkOpenSslCall( BN_div( quotient, remainder, a, b, ctx ) );
220    ST(0) = ( (items < 4 ) ? proto_obj( quotient ) : ST(3) );
221    ST(1) = ( (items < 5 ) ? proto_obj( remainder ) : ST(4) );
222    XSRETURN(2);
223
224BIGNUM*
225sqr(a, ctx)
226    BIGNUM* a;
227    BN_CTX* ctx;
228  PREINIT:
229    BIGNUM* bn;
230    SV* p_proto;
231  CODE:
232    p_proto = ST(0);
233    bn = BN_new();
234    checkOpenSslCall( BN_sqr( bn, a, ctx ) );
235    RETVAL = bn;
236  OUTPUT:
237    RETVAL
238
239SV*
240mod(a, b, ctx, ...)
241    BIGNUM* a;
242    BIGNUM* b;
243    BN_CTX* ctx;
244  PREINIT:
245    BIGNUM* bn;
246  PPCODE:
247    if( items > 4 )
248      croak( "usage: $bn->add( $bn2, $ctx, [, $target] )" );
249    bn = ( items < 4 ) ? BN_new() : sv2bn( ST(3) );
250    checkOpenSslCall( BN_mod( bn, a, b, ctx ) );
251    ST(0) = ( (items < 4 ) ? proto_obj( bn ) : ST(3) );
252    XSRETURN(1);
253
254BIGNUM*
255mod_mul(a, b, m, ctx)
256    BIGNUM* a;
257    BIGNUM* b;
258    BIGNUM* m;
259    BN_CTX* ctx;
260  PREINIT:
261    BIGNUM* bn;
262    SV* p_proto;
263  CODE:
264    p_proto = ST(0);
265    bn = BN_new();
266    checkOpenSslCall( BN_mod_mul( bn, a, b, m, ctx ) );
267    RETVAL = bn;
268  OUTPUT:
269    RETVAL
270
271BIGNUM*
272exp(a, p, ctx)
273    BIGNUM* a;
274    BIGNUM* p;
275    BN_CTX* ctx;
276  PREINIT:
277    BIGNUM* bn;
278    SV* p_proto;
279  CODE:
280    p_proto = ST(0);
281    bn = BN_new();
282    checkOpenSslCall( BN_exp( bn, a, p, ctx ) );
283    RETVAL = bn;
284  OUTPUT:
285    RETVAL
286
287BIGNUM*
288mod_exp(a, p, m, ctx)
289    BIGNUM* a;
290    BIGNUM* p;
291    BIGNUM* m;
292    BN_CTX* ctx;
293  PREINIT:
294    BIGNUM* bn;
295    SV* p_proto;
296  CODE:
297    p_proto = ST(0);
298    bn = BN_new();
299    checkOpenSslCall( BN_mod_exp( bn, a, p, m, ctx ) );
300    RETVAL = bn;
301  OUTPUT:
302    RETVAL
303
304BIGNUM*
305mod_inverse(a, n, ctx)
306    BIGNUM* a;
307    BIGNUM* n;
308    BN_CTX* ctx;
309  PREINIT:
310    BIGNUM* bn;
311    SV* p_proto;
312  CODE:
313    p_proto = ST(0);
314    bn = BN_new();
315    checkOpenSslCall( BN_mod_inverse( bn, a, n, ctx ) );
316    RETVAL = bn;
317  OUTPUT:
318    RETVAL
319
320BIGNUM*
321gcd(a, b, ctx)
322    BIGNUM* a;
323    BIGNUM* b;
324    BN_CTX* ctx;
325  PREINIT:
326    BIGNUM* bn;
327    SV* p_proto;
328  CODE:
329    p_proto = ST(0);
330    bn = BN_new();
331    checkOpenSslCall( BN_gcd( bn, a, b, ctx ) );
332    RETVAL = bn;
333  OUTPUT:
334    RETVAL
335
336int
337BN_cmp(a, b)
338    BIGNUM* a;
339    BIGNUM* b;
340
341int
342BN_is_zero(a)
343    BIGNUM* a;
344
345int
346BN_is_one(a)
347    BIGNUM* a;
348
349int
350BN_is_odd(a)
351    BIGNUM* a;
352
353BIGNUM*
354copy(a)
355    BIGNUM* a;
356  PREINIT:
357    SV* p_proto;
358  CODE:
359    p_proto = ST(0);
360    checkOpenSslCall( RETVAL = BN_dup(a) );
361  OUTPUT:
362    RETVAL
363
364IV
365pointer_copy(a)
366    BIGNUM* a;
367  PREINIT:
368  CODE:
369    checkOpenSslCall( RETVAL = (IV) BN_dup(a) );
370  OUTPUT:
371    RETVAL
372
373MODULE = Crypt::OpenSSL::Bignum  PACKAGE = Crypt::OpenSSL::Bignum::CTX PREFIX=BN_CTX_
374
375BN_CTX*
376BN_CTX_new(p_proto)
377    SV* p_proto;
378  C_ARGS:
379
380void
381_free_BN_CTX(self)
382    BN_CTX* self;
383  CODE:
384    BN_CTX_free( self );
385