perl/openssl_bio.xs

   1
   2 #include "openssl.h"
   3
   4 static int p5_bio_ex_bio_ptr = 0;
   5 static int p5_bio_ex_bio_callback = 0;
   6 static int p5_bio_ex_bio_callback_data = 0;
   7
   8 static long
   9 p5_bio_callback(bio,state,parg,cmd,larg,ret)
  10   BIO  *bio;
  11   int   state;
  12   char *parg;
  13   int   cmd;
  14   long  larg;
  15   int   ret;
  16 {
  17     int i;
  18     SV *me,*cb;
  19
  20     me = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
  21     cb = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_callback);
  22     if (cb != NULL) {
  23         dSP;
  24
  25         ENTER;
  26         SAVETMPS;
  27
  28         PUSHMARK(sp);
  29         XPUSHs(sv_2mortal(newSVsv(me)));
  30         XPUSHs(sv_2mortal(newSViv(state)));
  31         XPUSHs(sv_2mortal(newSViv(cmd)));
  32         if ((state == BIO_CB_READ) || (state == BIO_CB_WRITE))
  33             XPUSHs(sv_2mortal(newSVpv(parg,larg)));
  34         else
  35             XPUSHs(&sv_undef);
  36         /* ptr one */
  37         XPUSHs(sv_2mortal(newSViv(larg)));
  38         XPUSHs(sv_2mortal(newSViv(ret)));
  39         PUTBACK;
  40
  41         i = perl_call_sv(cb,G_SCALAR);
  42
  43         SPAGAIN;
  44         if (i == 1)
  45             ret = POPi;
  46         else
  47             ret = 1;
  48         PUTBACK;
  49         FREETMPS;
  50         LEAVE;
  51     }
  52     else {
  53         croak("Internal error in p5_bio_callback");
  54     }
  55     return(ret);
  56 }
  57
  58 int
  59 boot_bio(void)
  60 {
  61     p5_bio_ex_bio_ptr = BIO_get_ex_new_index(0, "OpenSSL::BIO", ex_new, NULL, ex_cleanup);
  62     p5_bio_ex_bio_callback = BIO_get_ex_new_index(0, "bio_callback", NULL, NULL, ex_cleanup);
  63     p5_bio_ex_bio_callback_data = BIO_get_ex_new_index(0, "bio_callback_data", NULL, NULL, ex_cleanup);
  64     return(1);
  65 }
  66
  67 MODULE = OpenSSL::BIO  PACKAGE = OpenSSL::BIO  PREFIX = p5_BIO_
  68
  69 VERSIONCHECK: DISABLE
  70
  71 void
  72 p5_BIO_new_buffer_ssl_connect(...)
  73     PROTOTYPE: ;$
  74     PREINIT:
  75         SSL_CTX *ctx;
  76         BIO *bio;
  77         SV *arg;
  78     PPCODE:
  79         if (items == 1)
  80             arg = ST(0);
  81         else if (items == 2)
  82             arg = ST(1);
  83         else
  84             arg = NULL;
  85         if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX")))
  86             croak("Usage: OpenSSL::BIO::new_buffer_ssl_connect(SSL_CTX)");
  87         else {
  88             IV tmp = SvIV((SV *)SvRV(arg));
  89             ctx = (SSL_CTX *)tmp;
  90         }
  91         EXTEND(sp, 1);
  92         bio = BIO_new_buffer_ssl_connect(ctx);
  93         arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
  94         PUSHs(arg);
  95
  96 void
  97 p5_BIO_new_ssl_connect(...)
  98     PROTOTYPE: ;$
  99     PREINIT:
 100         SSL_CTX *ctx;
 101         BIO *bio;
 102         SV *arg;
 103     PPCODE:
 104         if (items == 1)
 105             arg = ST(0);
 106         else if (items == 2)
 107             arg = ST(1);
 108         else
 109             arg = NULL;
 110         if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX")))
 111             croak("Usage: OpenSSL::BIO::new_ssl_connect(SSL_CTX)");
 112         else {
 113             IV tmp = SvIV((SV *)SvRV(arg));
 114             ctx = (SSL_CTX *)tmp;
 115         }
 116         EXTEND(sp,1);
 117         bio = BIO_new_ssl_connect(ctx);
 118         arg = (SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr);
 119         PUSHs(arg);
 120
 121 void
 122 p5_BIO_new(...)
 123     PROTOTYPE: ;$
 124     PREINIT:
 125         BIO *bio;
 126         char *type;
 127         SV *arg;
 128     PPCODE:
 129         pr_name("p5_BIO_new");
 130         if ((items == 1) && SvPOK(ST(0)))
 131             type = SvPV(ST(0),na);
 132         else if ((items == 2) && SvPOK(ST(1)))
 133             type = SvPV(ST(1),na);
 134         else
 135             croak("Usage: OpenSSL::BIO::new(type)");
 136         EXTEND(sp,1);
 137         if (strcmp(type, "mem") == 0)
 138             bio=BIO_new(BIO_s_mem());
 139         else if (strcmp(type, "socket") == 0)
 140             bio=BIO_new(BIO_s_socket());
 141         else if (strcmp(type, "connect") == 0)
 142             bio=BIO_new(BIO_s_connect());
 143         else if (strcmp(type, "accept") == 0)
 144             bio=BIO_new(BIO_s_accept());
 145         else if (strcmp(type, "fd") == 0)
 146             bio=BIO_new(BIO_s_fd());
 147         else if (strcmp(type, "file") == 0)
 148             bio=BIO_new(BIO_s_file());
 149         else if (strcmp(type, "null") == 0)
 150             bio=BIO_new(BIO_s_null());
 151         else if (strcmp(type, "ssl") == 0)
 152             bio=BIO_new(BIO_f_ssl());
 153         else if (strcmp(type, "buffer") == 0)
 154             bio=BIO_new(BIO_f_buffer());
 155         else
 156             croak("unknown BIO type");
 157         arg = (SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr);
 158         PUSHs(arg);
 159
 160 int
 161 p5_BIO_hostname(bio, name)
 162     BIO *bio;
 163     char *name;
 164     PROTOTYPE: $$
 165     CODE:
 166         RETVAL = BIO_set_conn_hostname(bio, name);
 167     OUTPUT:
 168         RETVAL
 169
 170 int
 171 p5_BIO_set_accept_port(bio, str)
 172     BIO *bio;
 173     char *str;
 174     PROTOTYPE: $$
 175     CODE:
 176         RETVAL = BIO_set_accept_port(bio, str);
 177     OUTPUT:
 178         RETVAL
 179
 180 int
 181 p5_BIO_do_handshake(bio)
 182     BIO *bio;
 183     PROTOTYPE: $
 184     CODE:
 185         RETVAL = BIO_do_handshake(bio);
 186     OUTPUT:
 187         RETVAL
 188
 189 BIO *
 190 p5_BIO_push(b, bio)
 191     BIO *b;
 192     BIO *bio;
 193     PROTOTYPE: $$
 194     CODE:
 195         /* This reference will be reduced when the reference is
 196          * let go, and then when the BIO_free_all() is called
 197          * inside the OpenSSL library by the BIO with this
 198          * pushed into */
 199         bio->references++;
 200         RETVAL = BIO_push(b, bio);
 201     OUTPUT:
 202         RETVAL
 203
 204 void
 205 p5_BIO_pop(b)
 206     BIO *b
 207     PROTOTYPE: $
 208     PREINIT:
 209         BIO *bio;
 210         char *type;
 211         SV *arg;
 212     PPCODE:
 213         bio = BIO_pop(b);
 214         if (bio != NULL) {
 215             /* This BIO will either be one created in the
 216              * perl library, in which case it will have a perl
 217              * SV, otherwise it will have been created internally,
 218              * inside OpenSSL.  For the 'pushed in', it needs
 219              * the reference count decememted. */
 220             arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
 221             if (arg == NULL) {
 222                 arg = new_ref("OpenSSL::BIO",(char *)bio,0);
 223                 BIO_set_ex_data(bio, p5_bio_ex_bio_ptr, (char *)arg);
 224                 PUSHs(arg);
 225             }
 226             else {
 227                 /* it was pushed in */
 228                 SvREFCNT_inc(arg);
 229                 PUSHs(arg);
 230             }
 231         }
 232
 233 int
 234 p5_BIO_sysread(bio, in, num, ...)
 235     BIO *bio;
 236     SV *in;
 237     int num;
 238     PROTOTYPE: $$$;
 239     PREINIT:
 240         int i,n,olen;
 241         int offset;
 242         char *p;
 243     CODE:
 244         offset = 0;
 245         if (!SvPOK(in))
 246             sv_setpvn(in, "", 0);
 247         SvPV(in, olen);
 248         if (items > 3) {
 249             offset = SvIV(ST(3));
 250             if (offset < 0) {
 251                 if (-offset > olen)
 252                     croak("Offset outside string");
 253                 offset+=olen;
 254             }
 255         }
 256         if ((num+offset) > olen) {
 257             SvGROW(in, num+offset+1);
 258             p=SvPV(in, i);
 259             memset(&(p[olen]), 0, (num+offset)-olen+1);
 260         }
 261         p = SvPV(in,n);
 262         i = BIO_read(bio, p+offset, num);
 263         RETVAL = i;
 264         if (i <= 0)
 265             i = 0;
 266         SvCUR_set(in, offset+i);
 267     OUTPUT:
 268         RETVAL
 269
 270 int
 271 p5_BIO_syswrite(bio, in, ...)
 272     BIO *bio;
 273     SV *in;
 274     PROTOTYPE: $$;
 275     PREINIT:
 276         char *ptr;
 277         int len,in_len;
 278         int offset=0;
 279         int n;
 280     CODE:
 281         ptr = SvPV(in, in_len);
 282         if (items > 2) {
 283             len = SvOK(ST(2)) ? SvIV(ST(2)) : in_len;
 284             if (items > 3) {
 285                 offset = SvIV(ST(3));
 286                 if (offset < 0) {
 287                     if (-offset > in_len)
 288                         croak("Offset outside string");
 289                     offset+=in_len;
 290                 }
 291                 else if ((offset >= in_len) && (in_len > 0))
 292                     croak("Offset outside string");
 293             }
 294             if (len >= (in_len-offset))
 295                 len = in_len-offset;
 296         }
 297         else
 298             len = in_len;
 299         RETVAL = BIO_write(bio, ptr+offset, len);
 300     OUTPUT:
 301         RETVAL
 302
 303 void
 304 p5_BIO_getline(bio)
 305     BIO *bio;
 306     PROTOTYPE: $
 307     PREINIT:
 308         int i;
 309         char *p;
 310     PPCODE:
 311         pr_name("p5_BIO_gets");
 312         EXTEND(sp, 1);
 313         PUSHs(sv_newmortal());
 314         sv_setpvn(ST(0), "", 0);
 315         SvGROW(ST(0), 1024);
 316         p=SvPV(ST(0), na);
 317         i = BIO_gets(bio, p, 1024);
 318         if (i < 0)
 319             i = 0;
 320         SvCUR_set(ST(0), i);
 321
 322 int
 323 p5_BIO_flush(bio)
 324     BIO *bio;
 325     PROTOTYPE: $
 326     CODE:
 327         RETVAL = BIO_flush(bio);
 328     OUTPUT:
 329         RETVAL
 330
 331 char *
 332 p5_BIO_type(bio)
 333     BIO *bio;
 334     PROTOTYPE: $
 335     CODE:
 336         RETVAL = bio->method->name;
 337     OUTPUT:
 338         RETVAL
 339
 340 void
 341 p5_BIO_next_bio(b)
 342     BIO *b
 343     PROTOTYPE: $
 344     PREINIT:
 345         BIO *bio;
 346         char *type;
 347         SV *arg;
 348     PPCODE:
 349         bio = b->next_bio;
 350         if (bio != NULL) {
 351             arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
 352             if (arg == NULL) {
 353                 arg = new_ref("OpenSSL::BIO", (char *)bio, 0);
 354                 BIO_set_ex_data(bio, p5_bio_ex_bio_ptr, (char *)arg);
 355                 bio->references++;
 356                 PUSHs(arg);
 357             }
 358             else {
 359                 SvREFCNT_inc(arg);
 360                 PUSHs(arg);
 361             }
 362         }
 363
 364 int
 365 p5_BIO_puts(bio, in)
 366     BIO *bio;
 367     SV *in;
 368     PROTOTYPE: $$
 369     PREINIT:
 370         char *ptr;
 371     CODE:
 372         ptr = SvPV(in,na);
 373         RETVAL = BIO_puts(bio, ptr);
 374     OUTPUT:
 375         RETVAL
 376
 377 void
 378 p5_BIO_set_callback(bio, cb,...)
 379     BIO *bio;
 380     SV *cb;
 381     PROTOTYPE: $$;
 382     PREINIT:
 383         SV *arg  = NULL;
 384         SV *arg2 = NULL;
 385     CODE:
 386         if (items > 3)
 387             croak("Usage: OpenSSL::BIO::set_callback(bio,callback[,arg]");
 388         if (items == 3) {
 389             arg2 = sv_mortalcopy(ST(2));
 390             SvREFCNT_inc(arg2);
 391             BIO_set_ex_data(bio, p5_bio_ex_bio_callback_data, (char *)arg2);
 392         }
 393         arg = sv_mortalcopy(ST(1));
 394         SvREFCNT_inc(arg);
 395         BIO_set_ex_data(bio, p5_bio_ex_bio_callback, (char *)arg);
 396         /* printf("%08lx < bio_ptr\n",BIO_get_ex_data(bio,p5_bio_ex_bio_ptr)); */
 397         BIO_set_callback(bio, p5_bio_callback);
 398
 399 void
 400 p5_BIO_DESTROY(bio)
 401     BIO *bio
 402     PROTOTYPE: $
 403     PREINIT:
 404         SV *sv;
 405     PPCODE:
 406         pr_name_d("p5_BIO_DESTROY",bio->references);
 407         /* printf("p5_BIO_DESTROY <%s> %d\n",bio->method->name,bio->references); */
 408         BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,NULL);
 409         BIO_free_all(bio);
 410
 411 int
 412 p5_BIO_set_ssl(bio, ssl)
 413     BIO *bio;
 414     SSL *ssl;
 415     PROTOTYPE: $$
 416     CODE:
 417         pr_name("p5_BIO_set_ssl");
 418         ssl->references++;
 419         RETVAL = BIO_set_ssl(bio, ssl, BIO_CLOSE);
 420     OUTPUT:
 421         RETVAL
 422
 423 int
 424 p5_BIO_number_read(bio)
 425     BIO *bio;
 426     PROTOTYPE: $
 427     CODE:
 428         RETVAL = BIO_number_read(bio);
 429     OUTPUT:
 430         RETVAL
 431
 432 int
 433 p5_BIO_number_written(bio)
 434     BIO *bio;
 435     PROTOTYPE: $
 436     CODE:
 437         RETVAL = BIO_number_written(bio);
 438     OUTPUT:
 439         RETVAL
 440
 441 int
 442 p5_BIO_references(bio)
 443     BIO *bio;
 444     PROTOTYPE: $
 445     CODE:
 446         RETVAL = bio->references;
 447     OUTPUT:
 448         RETVAL
 449