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