ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-BER-XS/XS.xs
(Generate patch)

Comparing Convert-BER-XS/XS.xs (file contents):
Revision 1.27 by root, Mon Apr 22 11:01:49 2019 UTC vs.
Revision 1.33 by root, Thu Apr 25 22:30:21 2019 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.h" 3#include "XSUB.h"
4
5#include <math.h>
4 6
5// C99 required! 7// C99 required!
6// this is not just for comments, but also for 8// this is not just for comments, but also for
7// integer constant semantics, 9// integer constant semantics,
8// sscanf format modifiers and more. 10// sscanf format modifiers and more.
… …
65 SNMP_TIMETICKS = 0x03, 67 SNMP_TIMETICKS = 0x03,
66 SNMP_OPAQUE = 0x04, 68 SNMP_OPAQUE = 0x04,
67 SNMP_COUNTER64 = 0x06, 69 SNMP_COUNTER64 = 0x06,
68}; 70};
69 71
72// tlow-level types this module can ecode the above (and more) into
70enum { 73enum {
71 BER_TYPE_BYTES, 74 BER_TYPE_BYTES,
72 BER_TYPE_UTF8, 75 BER_TYPE_UTF8,
73 BER_TYPE_UCS2, 76 BER_TYPE_UCS2,
74 BER_TYPE_UCS4, 77 BER_TYPE_UCS4,
… …
80 BER_TYPE_REAL, 83 BER_TYPE_REAL,
81 BER_TYPE_IPADDRESS, 84 BER_TYPE_IPADDRESS,
82 BER_TYPE_CROAK, 85 BER_TYPE_CROAK,
83}; 86};
84 87
88// tuple array indices
85enum { 89enum {
86 BER_CLASS = 0, 90 BER_CLASS = 0,
87 BER_TAG = 1, 91 BER_TAG = 1,
88 BER_FLAGS = 2, 92 BER_FLAGS = 2,
89 BER_DATA = 3, 93 BER_DATA = 3,
… …
98static SV *buf_sv; // encoding buffer 102static SV *buf_sv; // encoding buffer
99static U8 *buf, *cur, *end; // buffer start, current, end 103static U8 *buf, *cur, *end; // buffer start, current, end
100 104
101#if PERL_VERSION < 18 105#if PERL_VERSION < 18
102# define utf8_to_uvchr_buf(s,e,l) utf8_to_uvchr (s, l) 106# define utf8_to_uvchr_buf(s,e,l) utf8_to_uvchr (s, l)
107#endif
108
109#ifndef SvREFCNT_inc_NN
110#define SvREFCNT_inc_NN(x) SvREFCNT_inc (x)
111#endif
112#ifndef SvREFCNT_dec_NN
113#define SvREFCNT_dec_NN(x) SvREFCNT_dec (x)
103#endif 114#endif
104 115
105#if __GNUC__ >= 3 116#if __GNUC__ >= 3
106# define expect(expr,value) __builtin_expect ((expr), (value)) 117# define expect(expr,value) __builtin_expect ((expr), (value))
107# define INLINE static inline 118# define INLINE static inline
… …
256{ 267{
257 UV res = 0; 268 UV res = 0;
258 U8 c = get_u8 (); 269 U8 c = get_u8 ();
259 270
260 if (expect_false (c == 0x80)) 271 if (expect_false (c == 0x80))
261 error ("illegal BER padding (X.690 8.1.2.4.2, 8.19.2)"); 272 error ("invalid BER padding (X.690 8.1.2.4.2, 8.19.2)");
262 273
263 for (;;) 274 for (;;)
264 { 275 {
265 if (expect_false (res >> UVSIZE * 8 - 7)) 276 if (expect_false (res >> UVSIZE * 8 - 7))
266 error ("BER variable length integer overflow"); 277 error ("BER variable length integer overflow");
267 278
268 res = (res << 7) | (c & 0x7f); 279 res = (res << 7) | (c & 0x7f);
269 280
270 if (!(c & 0x80)) 281 if (expect_true (!(c & 0x80)))
271 return res; 282 return res;
272 283
273 c = get_u8 (); 284 c = get_u8 ();
274 } 285 }
275} 286}
… …
277static UV 288static UV
278get_length (void) 289get_length (void)
279{ 290{
280 UV res = get_u8 (); 291 UV res = get_u8 ();
281 292
282 if (res & 0x80) 293 if (expect_false (res & 0x80))
283 { 294 {
284 int cnt = res & 0x7f; 295 U8 cnt = res & 0x7f;
296
297 // this genewrates quite ugly code, but the overhead
298 // of copying the bytes for these lengths is probably so high
299 // that a slightly inefficient get_length won't matter.
300
301 if (expect_false (cnt == 0))
302 error ("invalid use of indefinite BER length form in primitive encoding (X.690 8.1.3.2)");
303
304 if (expect_false (cnt > UVSIZE))
305 error ("BER value length too long (must fit into UV) or BER reserved value in length (X.690 8.1.3.5)");
306
307 want (cnt);
308
285 res = 0; 309 res = 0;
286 310 do
287 switch (cnt) 311 res = (res << 8) | *cur++;
288 { 312 while (--cnt);
289 case 0:
290 error ("indefinite BER value lengths not supported");
291
292 case 0x7f:
293 error ("BER reserved value in length (X.690 8.1.3.5)");
294
295 default:
296 error ("BER value length too long (must fit into UV)");
297
298#if UVSIZE > 4
299 case 8: res = (res << 8) | get_u8 ();
300 case 7: res = (res << 8) | get_u8 ();
301 case 6: res = (res << 8) | get_u8 ();
302 case 5: res = (res << 8) | get_u8 ();
303#endif
304 case 4: res = (res << 8) | get_u8 ();
305 case 3: res = (res << 8) | get_u8 ();
306 case 2: res = (res << 8) | get_u8 ();
307 case 1: res = (res << 8) | get_u8 ();
308 }
309 } 313 }
310 314
311 return res; 315 return res;
312} 316}
313 317
314static SV * 318static SV *
315decode_int (void) 319decode_int (UV len)
316{ 320{
317 UV len = get_length ();
318
319 if (!len) 321 if (!len)
320 error ("invalid BER_TYPE_INT length zero (X.690 8.3.1)"); 322 error ("invalid BER_TYPE_INT length zero (X.690 8.3.1)");
321 323
322 U8 *data = get_n (len); 324 U8 *data = get_n (len);
323 325
324 if (expect_false (len > 1)) 326 if (expect_false (len > 1))
325 { 327 {
326 U16 mask = (data [0] << 8) | data [1] & 0xff80; 328 U16 mask = (data [0] << 8) | data [1] & 0xff80;
327 329
328 if (expect_false (mask == 0xff80 || mask == 0x0000)) 330 if (expect_false (mask == 0xff80 || mask == 0x0000))
329 error ("illegal padding in BER_TYPE_INT (X.690 8.3.2)"); 331 error ("invalid padding in BER_TYPE_INT (X.690 8.3.2)");
330 } 332 }
331 333
332 int negative = data [0] & 0x80; 334 int negative = data [0] & 0x80;
333 335
334 UV val = negative ? -1 : 0; // copy signbit to all bits 336 UV val = negative ? -1 : 0; // copy signbit to all bits
… …
344 // but that's ok, as perl relies on it as well. 346 // but that's ok, as perl relies on it as well.
345 return negative ? newSViv ((IV)val) : newSVuv (val); 347 return negative ? newSViv ((IV)val) : newSVuv (val);
346} 348}
347 349
348static SV * 350static SV *
349decode_data (void) 351decode_data (UV len)
350{ 352{
351 UV len = get_length ();
352 return newSVpvn ((char *)get_n (len), len); 353 return newSVpvn ((char *)get_n (len), len);
353} 354}
354 355
355// helper for decode_object_identifier 356// helper for decode_object_identifier
356static char * 357static char *
… …
384 385
385 return buf; 386 return buf;
386} 387}
387 388
388static SV * 389static SV *
389decode_oid (int relative) 390decode_oid (UV len, int relative)
390{ 391{
391 UV len = get_length ();
392
393 if (len <= 0) 392 if (len <= 0)
394 { 393 {
395 error ("BER_TYPE_OID length must not be zero"); 394 error ("BER_TYPE_OID length must not be zero");
396 return &PL_sv_undef; 395 return &PL_sv_undef;
397 } 396 }
… …
430 } 429 }
431 430
432 return newSVpvn (oid, app - oid); 431 return newSVpvn (oid, app - oid);
433} 432}
434 433
434// oh my, this is a total mess
435static SV *
436decode_real (UV len)
437{
438 SV *res;
439 U8 *beg = cur;
440
441 if (len == 0)
442 res = newSVnv (0.);
443 else
444 {
445 U8 info = get_u8 ();
446
447 if (info & 0x80)
448 {
449 // binary
450 static const U8 base[] = { 2, 8, 16, 0 };
451 NV S = info & 0x40 ? -1 : 1; // sign
452 NV B = base [(info >> 4) & 3]; // base
453 NV F = 1 << ((info >> 2) & 3); // scale factor ("shift")
454 int L = info & 3; // exponent length
455
456 if (!B)
457 croak ("BER_TYPE_REAL binary encoding uses invalid base (0x%02x)", info);
458
459 SAVETMPS;
460
461 SV *E = sv_2mortal (decode_int (L == 3 ? get_u8 () : L + 1));
462 SV *M = sv_2mortal (decode_int (len - (cur - beg)));
463
464 res = newSVnv (S * SvNV (M) * F * Perl_pow (B, SvNV (E)));
465
466 FREETMPS;
467 }
468 else if (info & 0x40)
469 {
470 // SpecialRealValue
471 U8 special = get_u8 ();
472 NV val;
473
474 switch (special)
475 {
476 case 0x40: val = NV_INF; break;
477 case 0x41: val = -NV_INF; break;
478 case 0x42: val = NV_NAN; break;
479 case 0x43: val = -(NV)0.; break;
480
481 default:
482 croak ("BER_TYPE_REAL SpecialRealValues invalid encoding 0x%02x (X.690 8.5.9)", special);
483 }
484
485 res = newSVnv (val);
486 }
487 else
488 {
489 // decimal
490 dSP;
491 SAVETMPS;
492 PUSHMARK (SP);
493 EXTEND (SP, 2);
494 PUSHs (sv_2mortal (newSVcacheint (info & 0x3f)));
495 PUSHs (sv_2mortal (newSVpvn (get_n (len - 1), len - 1)));
496 PUTBACK;
497 call_pv ("Convert::BER::XS::_decode_real_decimal", G_SCALAR);
498 SPAGAIN;
499 res = SvREFCNT_inc_NN (POPs);
500 PUTBACK;
501 FREETMPS;
502 }
503 }
504
505 if (cur - beg != len)
506 {
507 SvREFCNT_dec_NN (res);
508 croak ("BER_TYPE_REAL invalid content length (X.690 8,5)");
509 }
510
511 return res;
512}
513
435// TODO: this is unacceptably slow 514// TODO: this is unacceptably slow
436static SV * 515static SV *
437decode_ucs (int chrsize) 516decode_ucs (UV len, int chrsize)
438{ 517{
439 SV *res = NEWSV (0, 0);
440
441 UV len = get_length ();
442
443 if (len & (chrsize - 1)) 518 if (len & (chrsize - 1))
444 croak ("BER_TYPE_UCS has an invalid number of octets (%d)", len); 519 croak ("BER_TYPE_UCS has an invalid number of octets (%d)", len);
520
521 SV *res = NEWSV (0, 0);
445 522
446 while (len) 523 while (len)
447 { 524 {
448 U8 b1 = get_u8 (); 525 U8 b1 = get_u8 ();
449 U8 b2 = get_u8 (); 526 U8 b2 = get_u8 ();
… …
482 if (tag == ASN_TAG_BER) 559 if (tag == ASN_TAG_BER)
483 tag = get_w (); 560 tag = get_w ();
484 561
485 if (constructed) 562 if (constructed)
486 { 563 {
564 want (1);
565 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
566
567 if (expect_false (*cur == 0x80))
568 {
569 // indefinite length
570 ++cur;
571
572 for (;;)
573 {
574 want (2);
575 if (!cur [0] && !cur [1])
576 {
577 cur += 2;
578 break;
579 }
580
581 av_push (av, decode_ber ());
582 }
583 }
584 else
585 {
586 UV len = get_length ();
587 UV seqend = (cur - buf) + len;
588
589 while (cur < buf + seqend)
590 av_push (av, decode_ber ());
591
592 if (expect_false (cur > buf + seqend))
593 croak ("CONSTRUCTED type %02x length overflow (0x%x 0x%x)\n", identifier, (int)(cur - buf), (int)seqend);
594 }
595
596 res = newRV_inc ((SV *)av);
597 }
598 else
599 {
487 UV len = get_length (); 600 UV len = get_length ();
488 UV seqend = (cur - buf) + len;
489 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
490 601
491 while (cur < buf + seqend)
492 av_push (av, decode_ber ());
493
494 if (cur > buf + seqend)
495 croak ("CONSTRUCTED type %02x length overflow (0x%x 0x%x)\n", identifier, (int)(cur - buf), (int)seqend);
496
497 res = newRV_inc ((SV *)av);
498 }
499 else
500 switch (profile_lookup (cur_profile, klass, tag)) 602 switch (profile_lookup (cur_profile, klass, tag))
501 { 603 {
502 case BER_TYPE_NULL: 604 case BER_TYPE_NULL:
503 { 605 if (expect_false (len))
504 UV len = get_length ();
505
506 if (len)
507 croak ("BER_TYPE_NULL value with non-zero length %d encountered (X.690 8.8.2)", len); 606 croak ("BER_TYPE_NULL value with non-zero length %d encountered (X.690 8.8.2)", len);
508 607
509 res = &PL_sv_undef; 608 res = &PL_sv_undef;
510 }
511 break; 609 break;
512 610
513 case BER_TYPE_BOOL: 611 case BER_TYPE_BOOL:
514 {
515 UV len = get_length ();
516
517 if (len != 1) 612 if (expect_false (len != 1))
518 croak ("BER_TYPE_BOOLEAN value with invalid length %d encountered (X.690 8.2.1)", len); 613 croak ("BER_TYPE_BOOLEAN value with invalid length %d encountered (X.690 8.2.1)", len);
519 614
520 res = newSVcacheint (!!get_u8 ()); 615 res = newSVcacheint (!!get_u8 ());
521 }
522 break; 616 break;
523 617
524 case BER_TYPE_OID: 618 case BER_TYPE_OID:
525 res = decode_oid (0); 619 res = decode_oid (len, 0);
526 break; 620 break;
527 621
528 case BER_TYPE_RELOID: 622 case BER_TYPE_RELOID:
529 res = decode_oid (1); 623 res = decode_oid (len, 1);
530 break; 624 break;
531 625
532 case BER_TYPE_INT: 626 case BER_TYPE_INT:
533 res = decode_int (); 627 res = decode_int (len);
534 break; 628 break;
535 629
536 case BER_TYPE_UTF8: 630 case BER_TYPE_UTF8:
537 res = decode_data (); 631 res = decode_data (len);
538 SvUTF8_on (res); 632 SvUTF8_on (res);
539 break; 633 break;
540 634
541 case BER_TYPE_BYTES: 635 case BER_TYPE_BYTES:
542 res = decode_data (); 636 res = decode_data (len);
543 break; 637 break;
544 638
545 case BER_TYPE_IPADDRESS: 639 case BER_TYPE_IPADDRESS:
546 { 640 {
547 UV len = get_length ();
548
549 if (len != 4) 641 if (len != 4)
550 croak ("BER_TYPE_IPADDRESS type with invalid length %d encountered (RFC 2578 7.1.5)", len); 642 croak ("BER_TYPE_IPADDRESS type with invalid length %d encountered (RFC 2578 7.1.5)", len);
551 643
552 U8 c1 = get_u8 (); 644 U8 *data = get_n (4);
553 U8 c2 = get_u8 (); 645 res = newSVpvf ("%d.%d.%d.%d", data [0], data [1], data [2], data [3]);
554 U8 c3 = get_u8 ();
555 U8 c4 = get_u8 ();
556
557 res = newSVpvf ("%d.%d.%d.%d", c1, c2, c3, c4);
558 } 646 }
559 break; 647 break;
560 648
561 case BER_TYPE_UCS2: 649 case BER_TYPE_UCS2:
562 res = decode_ucs (2); 650 res = decode_ucs (len, 2);
563 break; 651 break;
564 652
565 case BER_TYPE_UCS4: 653 case BER_TYPE_UCS4:
566 res = decode_ucs (4); 654 res = decode_ucs (len, 4);
567 break; 655 break;
568 656
569 case BER_TYPE_REAL: 657 case BER_TYPE_REAL:
570 error ("BER_TYPE_REAL not implemented"); 658 res = decode_real (len);
659 break;
571 660
572 case BER_TYPE_CROAK: 661 case BER_TYPE_CROAK:
573 croak ("class/tag %d/%d mapped to BER_TYPE_CROAK", klass, tag); 662 croak ("class/tag %d/%d mapped to BER_TYPE_CROAK", klass, tag);
574 663
575 default: 664 default:
576 croak ("unconfigured/unsupported class/tag %d/%d", klass, tag); 665 croak ("unconfigured/unsupported class/tag %d/%d", klass, tag);
577 } 666 }
667 }
578 668
579 AV *av = newAV (); 669 AV *av = newAV ();
580 av_fill (av, BER_ARRAYSIZE - 1); 670 av_fill (av, BER_ARRAYSIZE - 1);
581 AvARRAY (av)[BER_CLASS] = newSVcacheint (klass); 671 AvARRAY (av)[BER_CLASS] = newSVcacheint (klass);
582 AvARRAY (av)[BER_TAG ] = newSVcacheint (tag); 672 AvARRAY (av)[BER_TAG ] = newSVcacheint (tag);
… …
669} 759}
670 760
671static U8 * 761static U8 *
672put_length_at (UV val, U8 *cur) 762put_length_at (UV val, U8 *cur)
673{ 763{
674 if (val < 0x7fU) 764 if (val <= 0x7fU)
675 *cur++ = val; 765 *cur++ = val;
676 else 766 else
677 { 767 {
678 U8 *lenb = cur++; 768 U8 *lenb = cur++;
679 769
680#if UVSIZE > 4 770#if UVSIZE > 4
681 *cur = val >> 56; cur += *cur > 0; 771 *cur = val >> 56; cur += val >= ((UV)1 << (8 * 7));
682 *cur = val >> 48; cur += *cur > 0; 772 *cur = val >> 48; cur += val >= ((UV)1 << (8 * 6));
683 *cur = val >> 40; cur += *cur > 0; 773 *cur = val >> 40; cur += val >= ((UV)1 << (8 * 5));
684 *cur = val >> 32; cur += *cur > 0; 774 *cur = val >> 32; cur += val >= ((UV)1 << (8 * 4));
685#endif 775#endif
686 *cur = val >> 24; cur += *cur > 0; 776 *cur = val >> 24; cur += val >= ((UV)1 << (8 * 3));
687 *cur = val >> 16; cur += *cur > 0; 777 *cur = val >> 16; cur += val >= ((UV)1 << (8 * 2));
688 *cur = val >> 8; cur += *cur > 0; 778 *cur = val >> 8; cur += val >= ((UV)1 << (8 * 1));
689 *cur = val ; cur += 1; 779 *cur = val ; cur += 1;
690 780
691 *lenb = 0x80 + cur - lenb - 1; 781 *lenb = 0x80 + cur - lenb - 1;
692 } 782 }
693 783
… …
695} 785}
696 786
697static void 787static void
698put_length (UV val) 788put_length (UV val)
699{ 789{
700 need (5 + val); 790 need (9 + val);
701 cur = put_length_at (val, cur); 791 cur = put_length_at (val, cur);
702} 792}
703 793
704// return how many bytes the encoded length requires 794// return how many bytes the encoded length requires
705static int length_length (UV val) 795static int length_length (UV val)
706{ 796{
707 return val < 0x7fU 797 // use hashing with a DeBruin sequence, anyone?
798 return expect_true (val <= 0x7fU)
708 ? 1 799 ? 1
709 : 2 800 : 2
710 + (val > 0xffU) 801 + (val > 0x000000000000ffU)
711 + (val > 0xffffU) 802 + (val > 0x0000000000ffffU)
712 + (val > 0xffffffU) 803 + (val > 0x00000000ffffffU)
713#if UVSIZE > 4 804#if UVSIZE > 4
714 + (val > 0xffffffffU) 805 + (val > 0x000000ffffffffU)
715 + (val > 0xffffffffffU) 806 + (val > 0x0000ffffffffffU)
716 + (val > 0xffffffffffffU) 807 + (val > 0x00ffffffffffffU)
717 + (val > 0xffffffffffffffU) 808 + (val > 0xffffffffffffffU)
718#endif 809#endif
719 ; 810 ;
720} 811}
721 812
… …
857 } 948 }
858 949
859 len_fixup (mark); 950 len_fixup (mark);
860} 951}
861 952
862// check whether an SV is a BER tuple and returns its AV * 953static void
863static AV * 954encode_real (SV *data)
864ber_tuple (SV *tuple)
865{ 955{
866 SV *rv; 956 NV nv = SvNV (data);
867 957
868 if (expect_false (!SvROK (tuple) || SvTYPE ((rv = SvRV (tuple))) != SVt_PVAV)) 958 if (expect_false (nv == (NV)0.))
869 croak ("BER tuple must be array-reference"); 959 {
960 if (signbit (nv))
961 {
962 // negative zero
963 need (3);
964 *cur++ = 2;
965 *cur++ = 0x40;
966 *cur++ = 0x43;
967 }
968 else
969 {
970 // positive zero
971 need (1);
972 *cur++ = 0;
973 }
974 }
975 else if (expect_false (Perl_isinf (nv)))
976 {
977 need (3);
978 *cur++ = 2;
979 *cur++ = 0x40;
980 *cur++ = nv < (NV)0. ? 0x41 : 0x40;
981 }
982 else if (expect_false (Perl_isnan (nv)))
983 {
984 need (3);
985 *cur++ = 2;
986 *cur++ = 0x40;
987 *cur++ = 0x42;
988 }
989 else
990 {
991 // use decimal encoding
992 dSP;
993 SAVETMPS;
994 PUSHMARK (SP);
995 EXTEND (SP, 2);
996 PUSHs (data);
997 PUSHs (sv_2mortal (newSVcacheint (NV_DIG)));
998 PUTBACK;
999 call_pv ("Convert::BER::XS::_encode_real_decimal", G_SCALAR);
1000 SPAGAIN;
870 1001
871 if (expect_false (SvRMAGICAL (rv))) 1002 SV *sv = POPs;
872 croak ("BER tuple must not be tied"); 1003 STRLEN l;
1004 char *f = SvPV (sv, l);
873 1005
874 if (expect_false (AvFILL ((AV *)rv) != BER_ARRAYSIZE - 1)) 1006 put_length (l);
875 croak ("BER tuple must contain exactly %d elements, not %d", BER_ARRAYSIZE, AvFILL ((AV *)rv) + 1); 1007 memcpy (cur, f, l);
1008 cur += l;
876 1009
877 return (AV *)rv; 1010 PUTBACK;
1011 FREETMPS;
1012 }
878} 1013}
879 1014
880static void 1015static void
881encode_ucs (SV *data, int chrsize) 1016encode_ucs (SV *data, int chrsize)
882{ 1017{
… …
902 1037
903 *cur++ = uchr >> 8; 1038 *cur++ = uchr >> 8;
904 *cur++ = uchr; 1039 *cur++ = uchr;
905 } 1040 }
906} 1041}
1042
1043// check whether an SV is a BER tuple and returns its AV *
1044static AV *
1045ber_tuple (SV *tuple)
1046{
1047 SV *rv;
1048
1049 if (expect_false (!SvROK (tuple) || SvTYPE ((rv = SvRV (tuple))) != SVt_PVAV))
1050 croak ("BER tuple must be array-reference");
1051
1052 if (expect_false (SvRMAGICAL (rv)))
1053 croak ("BER tuple must not be tied");
1054
1055 if (expect_false (AvFILL ((AV *)rv) != BER_ARRAYSIZE - 1))
1056 croak ("BER tuple must contain exactly %d elements, not %d", BER_ARRAYSIZE, AvFILL ((AV *)rv) + 1);
1057
1058 return (AV *)rv;
1059}
1060
907static void 1061static void
908encode_ber (SV *tuple) 1062encode_ber (SV *tuple)
909{ 1063{
910 AV *av = ber_tuple (tuple); 1064 AV *av = ber_tuple (tuple);
911 1065
… …
1001 case BER_TYPE_UCS4: 1155 case BER_TYPE_UCS4:
1002 encode_ucs (data, 4); 1156 encode_ucs (data, 4);
1003 break; 1157 break;
1004 1158
1005 case BER_TYPE_REAL: 1159 case BER_TYPE_REAL:
1006 croak ("BER_TYPE_REAL not implemented"); 1160 encode_real (data);
1161 break;
1007 1162
1008 case BER_TYPE_CROAK: 1163 case BER_TYPE_CROAK:
1009 croak ("class/tag %d/%d mapped to BER_TYPE_CROAK", klass, tag); 1164 croak ("class/tag %d/%d mapped to BER_TYPE_CROAK", klass, tag);
1010 1165
1011 default: 1166 default:
… …
1110 STRLEN len; 1265 STRLEN len;
1111 buf = (U8 *)SvPVbyte (ber, len); 1266 buf = (U8 *)SvPVbyte (ber, len);
1112 cur = buf; 1267 cur = buf;
1113 end = buf + len; 1268 end = buf + len;
1114 1269
1270 PUTBACK;
1115 SV *tuple = decode_ber (); 1271 SV *tuple = decode_ber ();
1272 SPAGAIN;
1116 1273
1117 EXTEND (SP, 2); 1274 EXTEND (SP, 2);
1118 PUSHs (sv_2mortal (tuple)); 1275 PUSHs (sv_2mortal (tuple));
1119 1276
1120 if (ix) 1277 if (ix)
… …
1205 cur_profile = SvPROFILE (profile); 1362 cur_profile = SvPROFILE (profile);
1206 buf_sv = sv_2mortal (NEWSV (0, 256)); 1363 buf_sv = sv_2mortal (NEWSV (0, 256));
1207 SvPOK_only (buf_sv); 1364 SvPOK_only (buf_sv);
1208 set_buf (buf_sv); 1365 set_buf (buf_sv);
1209 1366
1367 PUTBACK;
1210 encode_ber (tuple); 1368 encode_ber (tuple);
1369 SPAGAIN;
1211 1370
1212 SvCUR_set (buf_sv, cur - buf); 1371 SvCUR_set (buf_sv, cur - buf);
1213 XPUSHs (buf_sv); 1372 XPUSHs (buf_sv);
1214} 1373}
1215 1374

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines