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.32 by root, Tue Apr 23 21:20:25 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.
… …
102 104
103#if PERL_VERSION < 18 105#if PERL_VERSION < 18
104# 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)
105#endif 107#endif
106 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)
114#endif
115
107#if __GNUC__ >= 3 116#if __GNUC__ >= 3
108# define expect(expr,value) __builtin_expect ((expr), (value)) 117# define expect(expr,value) __builtin_expect ((expr), (value))
109# define INLINE static inline 118# define INLINE static inline
110#else 119#else
111# define expect(expr,value) (expr) 120# define expect(expr,value) (expr)
… …
258{ 267{
259 UV res = 0; 268 UV res = 0;
260 U8 c = get_u8 (); 269 U8 c = get_u8 ();
261 270
262 if (expect_false (c == 0x80)) 271 if (expect_false (c == 0x80))
263 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)");
264 273
265 for (;;) 274 for (;;)
266 { 275 {
267 if (expect_false (res >> UVSIZE * 8 - 7)) 276 if (expect_false (res >> UVSIZE * 8 - 7))
268 error ("BER variable length integer overflow"); 277 error ("BER variable length integer overflow");
… …
288 // this genewrates quite ugly code, but the overhead 297 // this genewrates quite ugly code, but the overhead
289 // of copying the bytes for these lengths is probably so high 298 // of copying the bytes for these lengths is probably so high
290 // that a slightly inefficient get_length won't matter. 299 // that a slightly inefficient get_length won't matter.
291 300
292 if (expect_false (cnt == 0)) 301 if (expect_false (cnt == 0))
293 error ("illegal use of indefinite BER length form in primitive encoding (X.690 8.1.3.2)"); 302 error ("invalid use of indefinite BER length form in primitive encoding (X.690 8.1.3.2)");
294 303
295 if (expect_false (cnt > UVSIZE)) 304 if (expect_false (cnt > UVSIZE))
296 error ("BER value length too long (must fit into UV) or BER reserved value in length (X.690 8.1.3.5)"); 305 error ("BER value length too long (must fit into UV) or BER reserved value in length (X.690 8.1.3.5)");
297 306
298 want (cnt); 307 want (cnt);
… …
317 if (expect_false (len > 1)) 326 if (expect_false (len > 1))
318 { 327 {
319 U16 mask = (data [0] << 8) | data [1] & 0xff80; 328 U16 mask = (data [0] << 8) | data [1] & 0xff80;
320 329
321 if (expect_false (mask == 0xff80 || mask == 0x0000)) 330 if (expect_false (mask == 0xff80 || mask == 0x0000))
322 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)");
323 } 332 }
324 333
325 int negative = data [0] & 0x80; 334 int negative = data [0] & 0x80;
326 335
327 UV val = negative ? -1 : 0; // copy signbit to all bits 336 UV val = negative ? -1 : 0; // copy signbit to all bits
… …
420 } 429 }
421 430
422 return newSVpvn (oid, app - oid); 431 return newSVpvn (oid, app - oid);
423} 432}
424 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
425// TODO: this is unacceptably slow 514// TODO: this is unacceptably slow
426static SV * 515static SV *
427decode_ucs (UV len, int chrsize) 516decode_ucs (UV len, int chrsize)
428{ 517{
429 if (len & (chrsize - 1)) 518 if (len & (chrsize - 1))
… …
564 case BER_TYPE_UCS4: 653 case BER_TYPE_UCS4:
565 res = decode_ucs (len, 4); 654 res = decode_ucs (len, 4);
566 break; 655 break;
567 656
568 case BER_TYPE_REAL: 657 case BER_TYPE_REAL:
569 error ("BER_TYPE_REAL not implemented"); 658 res = decode_real (len);
659 break;
570 660
571 case BER_TYPE_CROAK: 661 case BER_TYPE_CROAK:
572 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);
573 663
574 default: 664 default:
… …
858 } 948 }
859 949
860 len_fixup (mark); 950 len_fixup (mark);
861} 951}
862 952
863// check whether an SV is a BER tuple and returns its AV * 953static void
864static AV * 954encode_real (SV *data)
865ber_tuple (SV *tuple)
866{ 955{
867 SV *rv; 956 NV nv = SvNV (data);
868 957
869 if (expect_false (!SvROK (tuple) || SvTYPE ((rv = SvRV (tuple))) != SVt_PVAV)) 958 if (expect_false (nv == (NV)0.))
870 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;
871 1001
872 if (expect_false (SvRMAGICAL (rv))) 1002 SV *sv = POPs;
873 croak ("BER tuple must not be tied"); 1003 STRLEN l;
1004 char *f = SvPV (sv, l);
874 1005
875 if (expect_false (AvFILL ((AV *)rv) != BER_ARRAYSIZE - 1)) 1006 put_length (l);
876 croak ("BER tuple must contain exactly %d elements, not %d", BER_ARRAYSIZE, AvFILL ((AV *)rv) + 1); 1007 memcpy (cur, f, l);
1008 cur += l;
877 1009
878 return (AV *)rv; 1010 PUTBACK;
1011 FREETMPS;
1012 }
879} 1013}
880 1014
881static void 1015static void
882encode_ucs (SV *data, int chrsize) 1016encode_ucs (SV *data, int chrsize)
883{ 1017{
… …
903 1037
904 *cur++ = uchr >> 8; 1038 *cur++ = uchr >> 8;
905 *cur++ = uchr; 1039 *cur++ = uchr;
906 } 1040 }
907} 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
908static void 1061static void
909encode_ber (SV *tuple) 1062encode_ber (SV *tuple)
910{ 1063{
911 AV *av = ber_tuple (tuple); 1064 AV *av = ber_tuple (tuple);
912 1065
… …
1002 case BER_TYPE_UCS4: 1155 case BER_TYPE_UCS4:
1003 encode_ucs (data, 4); 1156 encode_ucs (data, 4);
1004 break; 1157 break;
1005 1158
1006 case BER_TYPE_REAL: 1159 case BER_TYPE_REAL:
1007 croak ("BER_TYPE_REAL not implemented"); 1160 encode_real (data);
1161 break;
1008 1162
1009 case BER_TYPE_CROAK: 1163 case BER_TYPE_CROAK:
1010 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);
1011 1165
1012 default: 1166 default:
… …
1111 STRLEN len; 1265 STRLEN len;
1112 buf = (U8 *)SvPVbyte (ber, len); 1266 buf = (U8 *)SvPVbyte (ber, len);
1113 cur = buf; 1267 cur = buf;
1114 end = buf + len; 1268 end = buf + len;
1115 1269
1270 PUTBACK;
1116 SV *tuple = decode_ber (); 1271 SV *tuple = decode_ber ();
1272 SPAGAIN;
1117 1273
1118 EXTEND (SP, 2); 1274 EXTEND (SP, 2);
1119 PUSHs (sv_2mortal (tuple)); 1275 PUSHs (sv_2mortal (tuple));
1120 1276
1121 if (ix) 1277 if (ix)
… …
1206 cur_profile = SvPROFILE (profile); 1362 cur_profile = SvPROFILE (profile);
1207 buf_sv = sv_2mortal (NEWSV (0, 256)); 1363 buf_sv = sv_2mortal (NEWSV (0, 256));
1208 SvPOK_only (buf_sv); 1364 SvPOK_only (buf_sv);
1209 set_buf (buf_sv); 1365 set_buf (buf_sv);
1210 1366
1367 PUTBACK;
1211 encode_ber (tuple); 1368 encode_ber (tuple);
1369 SPAGAIN;
1212 1370
1213 SvCUR_set (buf_sv, cur - buf); 1371 SvCUR_set (buf_sv, cur - buf);
1214 XPUSHs (buf_sv); 1372 XPUSHs (buf_sv);
1215} 1373}
1216 1374

Diff Legend

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