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