Convert-BER-XS/XS.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

// C99 required

enum {
  // ASN_TAG
  ASN_BOOLEAN           = 0x01,
  ASN_INTEGER32         = 0x02,
  ASN_BIT_STRING        = 0x03,
  ASN_OCTET_STRING      = 0x04,
  ASN_NULL              = 0x05,
  ASN_OBJECT_IDENTIFIER = 0x06,
  ASN_SEQUENCE          = 0x10,

  ASN_TAG_BER           = 0x1f,
  ASN_TAG_MASK          = 0x1f,

  // primitive/constructed
  ASN_CONSTRUCTED       = 0x20,

  // ASN_CLASS
  ASN_UNIVERSAL         = 0x00,
  ASN_APPLICATION       = 0x40,
  ASN_CONTEXT           = 0x80,
  ASN_PRIVATE           = 0xc0,

  ASN_CLASS_MASK        = 0xc0,
  ASN_CLASS_SHIFT       = 6,

  // ASN_APPLICATION
  ASN_IPADDRESS         = 0x00,
  ASN_COUNTER32         = 0x01,
  ASN_UNSIGNED32        = 0x02,
  ASN_TIMETICKS         = 0x03,
  ASN_OPAQUE            = 0x04,
  ASN_COUNTER64         = 0x06,
};

enum {
  BER_CLASS       = 0,
  BER_TAG         = 1,
  BER_CONSTRUCTED = 2,
  BER_DATA        = 3,
  BER_ARRAYSIZE
};

#define MAX_OID_STRLEN 4096

static U8 *buf, *cur;
static STRLEN len, rem;

// for "small" integers, return a readonly sv, otherwise create a new one
static SV *newSVcacheint (int val)
{
  static SV *cache[32];

  if (val < 0 || val >= sizeof (cache))
    return newSViv (val);

  if (!cache [val])
    {
      cache [val] = newSVuv (val);
      SvREADONLY_on (cache [val]);
    }

  return SvREFCNT_inc_NN (cache [val]);
}

/////////////////////////////////////////////////////////////////////////////

static void
error (const char *errmsg)
{
  croak ("%s at offset 0x%04x", errmsg, cur - buf);
}

static int
need (int count)
{
  if (count < 0 || (int)rem < count)
    {
      error ("unexpected end of message buffer");
      return 0;
    }

  return 1;
}

static U8 *
getn (int count, const U8 *errres)
{
  if (!need (count))
    return (U8 *)errres;

  U8 *res = cur;

  cur += count;
  rem -= count;

  return res;
}

static U8
get8 (void)
{
  if (rem <= 0)
    {
      error ("unexpected end of message buffer");
      return 0;
    }

  rem--;
  return *cur++;
}

static U32
getb (void)
{
  U32 res = 0;

  for (;;)
    {
      U8 c = get8 ();
      res = (res << 7) | (c & 0x7f);

      if (!(c & 0x80))
        return res;
    }
}

static U32
process_length (void)
{
  U32 res = get8 ();

  if (res & 0x80)
    {
      int cnt = res & 0x7f;
      res = 0;

      switch (cnt)
        {
          case 0:
            error ("indefinite ASN.1 lengths not supported");
            return 0;

          default:
            error ("ASN.1 length too long");
            return 0;

          case 4: res = (res << 8) | get8 ();
          case 3: res = (res << 8) | get8 ();
          case 2: res = (res << 8) | get8 ();
          case 1: res = (res << 8) | get8 ();
        }
    }

  return res;
}

static U32
process_integer32 (void)
{
  U32 length = process_length ();

  if (length <= 0)
    {
      error ("INTEGER32 length equal to zero");
      return 0;
    }

  U8 *data = getn (length, 0);

  if (!data)
    return 0;

  if (length > 5 || (length > 4 && data [0]))
    {
      error ("INTEGER32 length too long");
      return 0;
    }

  U32 res = data [0] & 0x80 ? 0xffffffff : 0;

  while (length--)
    res = (res << 8) | *data++;

  return res;
}

static SV *
process_integer32_sv (void)
{
  return newSViv ((I32)process_integer32 ());
}

static SV *
process_unsigned32_sv (void)
{
  return newSVuv ((U32)process_integer32 ());
}

#if IVSIZE >= 8

static U64TYPE
process_integer64 (void)
{
  U32 length = process_length ();

  if (length <= 0)
    {
      error ("INTEGER64 length equal to zero");
      return 0;
    }

  U8 *data = getn (length, 0);

  if (!data)
    return 0;

  if (length > 9 || (length > 8 && data [0]))
    {
      error ("INTEGER64 length too long");
      return 0;
    }

  U64TYPE res = data [0] & 0x80 ? 0xffffffffffffffff : 0;

  while (length--)
    res = (res << 8) | *data++;

  return res;
}

static SV *
process_integer64_sv (void)
{
  return newSViv ((I64TYPE)process_integer64 ());
}

static SV *
process_unsigned64_sv (void)
{
  return newSVuv ((U64TYPE)process_integer64 ());
}

#endif

static SV *
process_octet_string_sv (void)
{
  U32 length = process_length ();

  U8 *data = getn (length, 0);
  if (!data)
    {
      error ("OCTET STRING too long");
      return &PL_sv_undef;
    }

  return newSVpvn (data, length);
}

static char *
write_uv (char *buf, U32 u)
{
  // the one-digit case is absolutely predominant, so this pays off (hopefully)
  if (u < 10)
    *buf++ = u + '0';
  else
    {
      char *beg = buf;

      do
        {
          *buf++ = u % 10 + '0';
          u /= 10;
        }
      while (u);

      // reverse digits
      for (char *ptr = buf; --ptr != beg; ++beg)
        {
          char c = *ptr;
          *ptr = *beg;
          *beg = c;
        }
    }

  return buf;
}

static SV *
process_object_identifier_sv (void)
{
  U32 length = process_length ();

  if (length <= 0)
    {
      error ("OBJECT IDENTIFIER length equal to zero");
      return &PL_sv_undef;
    }

  U8 *end = cur + length;
  U32 w = getb ();

  static char oid[MAX_OID_STRLEN]; // must be static
  char *app = oid;

  app = write_uv (app, (U8)w / 40);
  *app++ = '.';
  app = write_uv (app, (U8)w % 40);

  // we assume an oid component is never > 64 bytes
  while (cur < end && oid + sizeof (oid) - app > 64)
    {
      w = getb ();
      *app++ = '.';
      app = write_uv (app, w);
    }

  return newSVpvn (oid, app - oid);
}

static SV *
ber_decode ()
{
  int identifier = get8 ();

  SV *res;

  int constructed = identifier & ASN_CONSTRUCTED;
  int klass       = identifier & ASN_CLASS_MASK;
  int tag         = identifier & ASN_TAG_MASK;

  if (tag == ASN_TAG_BER)
    tag = getb ();

  if (tag == ASN_TAG_BER)
    tag = getb ();

  if (constructed)
    {
      U32 len = process_length ();
      U32 seqend = (cur - buf) + len;
      AV *av = (AV *)sv_2mortal ((SV *)newAV ());

      while (cur < buf + seqend)
        av_push (av, ber_decode ());

      if (cur > buf + seqend)
        croak ("constructed type %02x overflow (%x %x)\n", identifier, cur - buf, seqend);

      res = newRV_inc ((SV *)av);
    }
  else
    switch (identifier)
      {
        case ASN_NULL:
          res = &PL_sv_undef;
          break;

        case ASN_OBJECT_IDENTIFIER:
          res = process_object_identifier_sv ();
          break;

        case ASN_INTEGER32:
          res = process_integer32_sv ();
          break;

        case ASN_APPLICATION | ASN_UNSIGNED32:
        case ASN_APPLICATION | ASN_COUNTER32:
        case ASN_APPLICATION | ASN_TIMETICKS:
          res = process_unsigned32_sv ();
          break;

#if 0 // handled by default case
        case ASN_OCTET_STRING:
        case ASN_APPLICATION | ASN_IPADDRESS:
        case ASN_APPLICATION | ASN_OPAQUE:
          res = process_octet_string_sv ();
          break;
#endif

        case ASN_APPLICATION | ASN_COUNTER64:
          res = process_integer64_sv ();
          break;

        default:
          res = process_octet_string_sv ();
          break;
      }

  AV *av = newAV ();
  av_fill (av, BER_ARRAYSIZE - 1);
  AvARRAY (av)[BER_CLASS      ] = newSVcacheint (klass >> ASN_CLASS_SHIFT);
  AvARRAY (av)[BER_TAG        ] = newSVcacheint (tag);
  AvARRAY (av)[BER_CONSTRUCTED] = newSVcacheint (constructed ? 1 : 0);
  AvARRAY (av)[BER_DATA       ] = res;

  return newRV_noinc ((SV *)av);
}

MODULE = Convert::BER::XS               PACKAGE = Convert::BER::XS

PROTOTYPES: ENABLE

BOOT:
{
  HV *stash = gv_stashpv ("Convert::BER::XS", 1);

  static const struct {
    const char *name;
    IV iv;
  } *civ, const_iv[] = {
    { "ASN_BOOLEAN",           ASN_BOOLEAN           },
    { "ASN_INTEGER32",         ASN_INTEGER32         },
    { "ASN_BIT_STRING",        ASN_BIT_STRING        },
    { "ASN_OCTET_STRING",      ASN_OCTET_STRING      },
    { "ASN_NULL",              ASN_NULL              },
    { "ASN_OBJECT_IDENTIFIER", ASN_OBJECT_IDENTIFIER },
    { "ASN_TAG_BER",           ASN_TAG_BER           },
    { "ASN_TAG_MASK",          ASN_TAG_MASK          },
    { "ASN_CONSTRUCTED",       ASN_CONSTRUCTED       },
    { "ASN_UNIVERSAL",         ASN_UNIVERSAL   >> ASN_CLASS_SHIFT },
    { "ASN_APPLICATION",       ASN_APPLICATION >> ASN_CLASS_SHIFT },
    { "ASN_CONTEXT",           ASN_CONTEXT     >> ASN_CLASS_SHIFT },
    { "ASN_PRIVATE",           ASN_PRIVATE     >> ASN_CLASS_SHIFT },
    { "ASN_CLASS_MASK",        ASN_CLASS_MASK        },
    { "ASN_CLASS_SHIFT",       ASN_CLASS_SHIFT       },
    { "ASN_SEQUENCE",          ASN_SEQUENCE          },
    { "ASN_IPADDRESS",         ASN_IPADDRESS         },
    { "ASN_COUNTER32",         ASN_COUNTER32         },
    { "ASN_UNSIGNED32",        ASN_UNSIGNED32        },
    { "ASN_TIMETICKS",         ASN_TIMETICKS         },
    { "ASN_OPAQUE",            ASN_OPAQUE            },
    { "ASN_COUNTER64",         ASN_COUNTER64         },

    { "BER_CLASS"      , BER_CLASS       },
    { "BER_TAG"        , BER_TAG         },
    { "BER_CONSTRUCTED", BER_CONSTRUCTED },
    { "BER_DATA"       , BER_DATA        },
  };

  for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ > const_iv; civ--)
    newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
}

SV *
ber_decode (SV *ber)
        CODE:
{
        buf = SvPVbyte (ber, len);
        cur = buf;
        rem = len;

        RETVAL = ber_decode ();
}
        OUTPUT: RETVAL

void
ber_is (SV *tuple, SV *klass = &PL_sv_undef, SV *tag = &PL_sv_undef, SV *constructed = &PL_sv_undef, SV *data = &PL_sv_undef)
        PROTOTYPE: $;$$$
        PPCODE:
{
        if (!SvOK (tuple))
          XSRETURN_NO;

        if (!SvROK (tuple) || SvTYPE (SvRV (tuple)) != SVt_PVAV)
          croak ("ber_seq: tuple must be ber tuple (array-ref)");

        AV *av = (AV *)SvRV (tuple);

        XPUSHs (
             (!SvOK (klass)       || SvIV  (AvARRAY (av)[BER_CLASS      ]) == SvIV (klass))
          && (!SvOK (tag)         || SvIV  (AvARRAY (av)[BER_TAG        ]) == SvIV (tag))
          && (!SvOK (constructed) || !SvIV (AvARRAY (av)[BER_CONSTRUCTED]) == !SvIV (constructed))
          && (!SvOK (data)        || sv_eq (AvARRAY (av)[BER_DATA       ], data))
          ? &PL_sv_yes : &PL_sv_no);
}

void
ber_is_seq (SV *tuple)
        PROTOTYPE: $
        PPCODE:
{
        if (!SvOK (tuple))
          XSRETURN_UNDEF;

        if (!SvROK (tuple) || SvTYPE (SvRV (tuple)) != SVt_PVAV)
          croak ("ber_seq: tuple must be ber tuple (array-ref)");

        AV *av = (AV *)SvRV (tuple);

        XPUSHs (
             SvIV (AvARRAY (av)[BER_CLASS      ]) == ASN_UNIVERSAL
          && SvIV (AvARRAY (av)[BER_TAG        ]) == ASN_SEQUENCE
          && SvIV (AvARRAY (av)[BER_CONSTRUCTED])
          ? AvARRAY (av)[BER_DATA] : &PL_sv_undef);
}

void
ber_is_i32 (SV *tuple, IV value)
        PROTOTYPE: $$
        PPCODE:
{
        if (!SvOK (tuple))
          XSRETURN_NO;

        if (!SvROK (tuple) || SvTYPE (SvRV (tuple)) != SVt_PVAV)
          croak ("ber_seq: tuple must be ber tuple (array-ref)");

        AV *av = (AV *)SvRV (tuple);

        XPUSHs (
              SvIV (AvARRAY (av)[BER_CLASS      ]) == ASN_UNIVERSAL
          &&  SvIV (AvARRAY (av)[BER_TAG        ]) == ASN_INTEGER32
          && !SvIV (AvARRAY (av)[BER_CONSTRUCTED])
          &&  SvIV (AvARRAY (av)[BER_DATA       ]) == value
          ? &PL_sv_yes : &PL_sv_no);
}

void
ber_is_oid (SV *tuple, SV *oid)
        PROTOTYPE: $$
        PPCODE:
{
        if (!SvOK (tuple))
          XSRETURN_NO;

        if (!SvROK (tuple) || SvTYPE (SvRV (tuple)) != SVt_PVAV)
          croak ("ber_seq: tuple must be ber tuple (array-ref)");

        AV *av = (AV *)SvRV (tuple);

        XPUSHs (
              SvIV (AvARRAY (av)[BER_CLASS      ]) == ASN_UNIVERSAL
          &&  SvIV (AvARRAY (av)[BER_TAG        ]) == ASN_OBJECT_IDENTIFIER
          && !SvIV (AvARRAY (av)[BER_CONSTRUCTED])
          &&  sv_eq (AvARRAY (av)[BER_DATA], oid)
          ? &PL_sv_yes : &PL_sv_no);
}

Revision:	1.1
Committed:	Fri Apr 19 16:19:36 2019 UTC (5 years, 1 month ago) by root
Branch:	MAIN
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5			// C99 required
6
7			enum {
8			// ASN_TAG
9			ASN_BOOLEAN = 0x01,
10			ASN_INTEGER32 = 0x02,
11			ASN_BIT_STRING = 0x03,
12			ASN_OCTET_STRING = 0x04,
13			ASN_NULL = 0x05,
14			ASN_OBJECT_IDENTIFIER = 0x06,
15			ASN_SEQUENCE = 0x10,
16
17			ASN_TAG_BER = 0x1f,
18			ASN_TAG_MASK = 0x1f,
19
20			// primitive/constructed
21			ASN_CONSTRUCTED = 0x20,
22
23			// ASN_CLASS
24			ASN_UNIVERSAL = 0x00,
25			ASN_APPLICATION = 0x40,
26			ASN_CONTEXT = 0x80,
27			ASN_PRIVATE = 0xc0,
28
29			ASN_CLASS_MASK = 0xc0,
30			ASN_CLASS_SHIFT = 6,
31
32			// ASN_APPLICATION
33			ASN_IPADDRESS = 0x00,
34			ASN_COUNTER32 = 0x01,
35			ASN_UNSIGNED32 = 0x02,
36			ASN_TIMETICKS = 0x03,
37			ASN_OPAQUE = 0x04,
38			ASN_COUNTER64 = 0x06,
39			};
40
41			enum {
42			BER_CLASS = 0,
43			BER_TAG = 1,
44			BER_CONSTRUCTED = 2,
45			BER_DATA = 3,
46			BER_ARRAYSIZE
47			};
48
49			#define MAX_OID_STRLEN 4096
50
51			static U8 buf, cur;
52			static STRLEN len, rem;
53
54			// for "small" integers, return a readonly sv, otherwise create a new one
55			static SV *newSVcacheint (int val)
56			{
57			static SV *cache[32];
58
59			if (val < 0 \|\| val >= sizeof (cache))
60			return newSViv (val);
61
62			if (!cache [val])
63			{
64			cache [val] = newSVuv (val);
65			SvREADONLY_on (cache [val]);
66			}
67
68			return SvREFCNT_inc_NN (cache [val]);
69			}
70
71			/////////////////////////////////////////////////////////////////////////////
72
73			static void
74			error (const char *errmsg)
75			{
76			croak ("%s at offset 0x%04x", errmsg, cur - buf);
77			}
78
79			static int
80			need (int count)
81			{
82			if (count < 0 \|\| (int)rem < count)
83			{
84			error ("unexpected end of message buffer");
85			return 0;
86			}
87
88			return 1;
89			}
90
91			static U8 *
92			getn (int count, const U8 *errres)
93			{
94			if (!need (count))
95			return (U8 *)errres;
96
97			U8 *res = cur;
98
99			cur += count;
100			rem -= count;
101
102			return res;
103			}
104
105			static U8
106			get8 (void)
107			{
108			if (rem <= 0)
109			{
110			error ("unexpected end of message buffer");
111			return 0;
112			}
113
114			rem--;
115			return *cur++;
116			}
117
118			static U32
119			getb (void)
120			{
121			U32 res = 0;
122
123			for (;;)
124			{
125			U8 c = get8 ();
126			res = (res << 7) \| (c & 0x7f);
127
128			if (!(c & 0x80))
129			return res;
130			}
131			}
132
133			static U32
134			process_length (void)
135			{
136			U32 res = get8 ();
137
138			if (res & 0x80)
139			{
140			int cnt = res & 0x7f;
141			res = 0;
142
143			switch (cnt)
144			{
145			case 0:
146			error ("indefinite ASN.1 lengths not supported");
147			return 0;
148
149			default:
150			error ("ASN.1 length too long");
151			return 0;
152
153			case 4: res = (res << 8) \| get8 ();
154			case 3: res = (res << 8) \| get8 ();
155			case 2: res = (res << 8) \| get8 ();
156			case 1: res = (res << 8) \| get8 ();
157			}
158			}
159
160			return res;
161			}
162
163			static U32
164			process_integer32 (void)
165			{
166			U32 length = process_length ();
167
168			if (length <= 0)
169			{
170			error ("INTEGER32 length equal to zero");
171			return 0;
172			}
173
174			U8 *data = getn (length, 0);
175
176			if (!data)
177			return 0;
178
179			if (length > 5 \|\| (length > 4 && data [0]))
180			{
181			error ("INTEGER32 length too long");
182			return 0;
183			}
184
185			U32 res = data [0] & 0x80 ? 0xffffffff : 0;
186
187			while (length--)
188			res = (res << 8) \| *data++;
189
190			return res;
191			}
192
193			static SV *
194			process_integer32_sv (void)
195			{
196			return newSViv ((I32)process_integer32 ());
197			}
198
199			static SV *
200			process_unsigned32_sv (void)
201			{
202			return newSVuv ((U32)process_integer32 ());
203			}
204
205			#if IVSIZE >= 8
206
207			static U64TYPE
208			process_integer64 (void)
209			{
210			U32 length = process_length ();
211
212			if (length <= 0)
213			{
214			error ("INTEGER64 length equal to zero");
215			return 0;
216			}
217
218			U8 *data = getn (length, 0);
219
220			if (!data)
221			return 0;
222
223			if (length > 9 \|\| (length > 8 && data [0]))
224			{
225			error ("INTEGER64 length too long");
226			return 0;
227			}
228
229			U64TYPE res = data [0] & 0x80 ? 0xffffffffffffffff : 0;
230
231			while (length--)
232			res = (res << 8) \| *data++;
233
234			return res;
235			}
236
237			static SV *
238			process_integer64_sv (void)
239			{
240			return newSViv ((I64TYPE)process_integer64 ());
241			}
242
243			static SV *
244			process_unsigned64_sv (void)
245			{
246			return newSVuv ((U64TYPE)process_integer64 ());
247			}
248
249			#endif
250
251			static SV *
252			process_octet_string_sv (void)
253			{
254			U32 length = process_length ();
255
256			U8 *data = getn (length, 0);
257			if (!data)
258			{
259			error ("OCTET STRING too long");
260			return &PL_sv_undef;
261			}
262
263			return newSVpvn (data, length);
264			}
265
266			static char *
267			write_uv (char *buf, U32 u)
268			{
269			// the one-digit case is absolutely predominant, so this pays off (hopefully)
270			if (u < 10)
271			*buf++ = u + '0';
272			else
273			{
274			char *beg = buf;
275
276			do
277			{
278			*buf++ = u % 10 + '0';
279			u /= 10;
280			}
281			while (u);
282
283			// reverse digits
284			for (char *ptr = buf; --ptr != beg; ++beg)
285			{
286			char c = *ptr;
287			ptr = beg;
288			*beg = c;
289			}
290			}
291
292			return buf;
293			}
294
295			static SV *
296			process_object_identifier_sv (void)
297			{
298			U32 length = process_length ();
299
300			if (length <= 0)
301			{
302			error ("OBJECT IDENTIFIER length equal to zero");
303			return &PL_sv_undef;
304			}
305
306			U8 *end = cur + length;
307			U32 w = getb ();
308
309			static char oid[MAX_OID_STRLEN]; // must be static
310			char *app = oid;
311
312			app = write_uv (app, (U8)w / 40);
313			*app++ = '.';
314			app = write_uv (app, (U8)w % 40);
315
316			// we assume an oid component is never > 64 bytes
317			while (cur < end && oid + sizeof (oid) - app > 64)
318			{
319			w = getb ();
320			*app++ = '.';
321			app = write_uv (app, w);
322			}
323
324			return newSVpvn (oid, app - oid);
325			}
326
327			static SV *
328			ber_decode ()
329			{
330			int identifier = get8 ();
331
332			SV *res;
333
334			int constructed = identifier & ASN_CONSTRUCTED;
335			int klass = identifier & ASN_CLASS_MASK;
336			int tag = identifier & ASN_TAG_MASK;
337
338			if (tag == ASN_TAG_BER)
339			tag = getb ();
340
341			if (tag == ASN_TAG_BER)
342			tag = getb ();
343
344			if (constructed)
345			{
346			U32 len = process_length ();
347			U32 seqend = (cur - buf) + len;
348			AV av = (AV )sv_2mortal ((SV *)newAV ());
349
350			while (cur < buf + seqend)
351			av_push (av, ber_decode ());
352
353			if (cur > buf + seqend)
354			croak ("constructed type %02x overflow (%x %x)\n", identifier, cur - buf, seqend);
355
356			res = newRV_inc ((SV *)av);
357			}
358			else
359			switch (identifier)
360			{
361			case ASN_NULL:
362			res = &PL_sv_undef;
363			break;
364
365			case ASN_OBJECT_IDENTIFIER:
366			res = process_object_identifier_sv ();
367			break;
368
369			case ASN_INTEGER32:
370			res = process_integer32_sv ();
371			break;
372
373			case ASN_APPLICATION \| ASN_UNSIGNED32:
374			case ASN_APPLICATION \| ASN_COUNTER32:
375			case ASN_APPLICATION \| ASN_TIMETICKS:
376			res = process_unsigned32_sv ();
377			break;
378
379			#if 0 // handled by default case
380			case ASN_OCTET_STRING:
381			case ASN_APPLICATION \| ASN_IPADDRESS:
382			case ASN_APPLICATION \| ASN_OPAQUE:
383			res = process_octet_string_sv ();
384			break;
385			#endif
386
387			case ASN_APPLICATION \| ASN_COUNTER64:
388			res = process_integer64_sv ();
389			break;
390
391			default:
392			res = process_octet_string_sv ();
393			break;
394			}
395
396			AV *av = newAV ();
397			av_fill (av, BER_ARRAYSIZE - 1);
398			AvARRAY (av)[BER_CLASS ] = newSVcacheint (klass >> ASN_CLASS_SHIFT);
399			AvARRAY (av)[BER_TAG ] = newSVcacheint (tag);
400			AvARRAY (av)[BER_CONSTRUCTED] = newSVcacheint (constructed ? 1 : 0);
401			AvARRAY (av)[BER_DATA ] = res;
402
403			return newRV_noinc ((SV *)av);
404			}
405
406			MODULE = Convert::BER::XS PACKAGE = Convert::BER::XS
407
408			PROTOTYPES: ENABLE
409
410			BOOT:
411			{
412			HV *stash = gv_stashpv ("Convert::BER::XS", 1);
413
414			static const struct {
415			const char *name;
416			IV iv;
417			} *civ, const_iv[] = {
418			{ "ASN_BOOLEAN", ASN_BOOLEAN },
419			{ "ASN_INTEGER32", ASN_INTEGER32 },
420			{ "ASN_BIT_STRING", ASN_BIT_STRING },
421			{ "ASN_OCTET_STRING", ASN_OCTET_STRING },
422			{ "ASN_NULL", ASN_NULL },
423			{ "ASN_OBJECT_IDENTIFIER", ASN_OBJECT_IDENTIFIER },
424			{ "ASN_TAG_BER", ASN_TAG_BER },
425			{ "ASN_TAG_MASK", ASN_TAG_MASK },
426			{ "ASN_CONSTRUCTED", ASN_CONSTRUCTED },
427			{ "ASN_UNIVERSAL", ASN_UNIVERSAL >> ASN_CLASS_SHIFT },
428			{ "ASN_APPLICATION", ASN_APPLICATION >> ASN_CLASS_SHIFT },
429			{ "ASN_CONTEXT", ASN_CONTEXT >> ASN_CLASS_SHIFT },
430			{ "ASN_PRIVATE", ASN_PRIVATE >> ASN_CLASS_SHIFT },
431			{ "ASN_CLASS_MASK", ASN_CLASS_MASK },
432			{ "ASN_CLASS_SHIFT", ASN_CLASS_SHIFT },
433			{ "ASN_SEQUENCE", ASN_SEQUENCE },
434			{ "ASN_IPADDRESS", ASN_IPADDRESS },
435			{ "ASN_COUNTER32", ASN_COUNTER32 },
436			{ "ASN_UNSIGNED32", ASN_UNSIGNED32 },
437			{ "ASN_TIMETICKS", ASN_TIMETICKS },
438			{ "ASN_OPAQUE", ASN_OPAQUE },
439			{ "ASN_COUNTER64", ASN_COUNTER64 },
440
441			{ "BER_CLASS" , BER_CLASS },
442			{ "BER_TAG" , BER_TAG },
443			{ "BER_CONSTRUCTED", BER_CONSTRUCTED },
444			{ "BER_DATA" , BER_DATA },
445			};
446
447			for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ > const_iv; civ--)
448			newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
449			}
450
451			SV *
452			ber_decode (SV *ber)
453			CODE:
454			{
455			buf = SvPVbyte (ber, len);
456			cur = buf;
457			rem = len;
458
459			RETVAL = ber_decode ();
460			}
461			OUTPUT: RETVAL
462
463			void
464			ber_is (SV tuple, SV klass = &PL_sv_undef, SV tag = &PL_sv_undef, SV constructed = &PL_sv_undef, SV *data = &PL_sv_undef)
465			PROTOTYPE: $;$$$
466			PPCODE:
467			{
468			if (!SvOK (tuple))
469			XSRETURN_NO;
470
471			if (!SvROK (tuple) \|\| SvTYPE (SvRV (tuple)) != SVt_PVAV)
472			croak ("ber_seq: tuple must be ber tuple (array-ref)");
473
474			AV av = (AV )SvRV (tuple);
475
476			XPUSHs (
477			(!SvOK (klass) \|\| SvIV (AvARRAY (av)[BER_CLASS ]) == SvIV (klass))
478			&& (!SvOK (tag) \|\| SvIV (AvARRAY (av)[BER_TAG ]) == SvIV (tag))
479			&& (!SvOK (constructed) \|\| !SvIV (AvARRAY (av)[BER_CONSTRUCTED]) == !SvIV (constructed))
480			&& (!SvOK (data) \|\| sv_eq (AvARRAY (av)[BER_DATA ], data))
481			? &PL_sv_yes : &PL_sv_no);
482			}
483
484			void
485			ber_is_seq (SV *tuple)
486			PROTOTYPE: $
487			PPCODE:
488			{
489			if (!SvOK (tuple))
490			XSRETURN_UNDEF;
491
492			if (!SvROK (tuple) \|\| SvTYPE (SvRV (tuple)) != SVt_PVAV)
493			croak ("ber_seq: tuple must be ber tuple (array-ref)");
494
495			AV av = (AV )SvRV (tuple);
496
497			XPUSHs (
498			SvIV (AvARRAY (av)[BER_CLASS ]) == ASN_UNIVERSAL
499			&& SvIV (AvARRAY (av)[BER_TAG ]) == ASN_SEQUENCE
500			&& SvIV (AvARRAY (av)[BER_CONSTRUCTED])
501			? AvARRAY (av)[BER_DATA] : &PL_sv_undef);
502			}
503
504			void
505			ber_is_i32 (SV *tuple, IV value)
506			PROTOTYPE: $$
507			PPCODE:
508			{
509			if (!SvOK (tuple))
510			XSRETURN_NO;
511
512			if (!SvROK (tuple) \|\| SvTYPE (SvRV (tuple)) != SVt_PVAV)
513			croak ("ber_seq: tuple must be ber tuple (array-ref)");
514
515			AV av = (AV )SvRV (tuple);
516
517			XPUSHs (
518			SvIV (AvARRAY (av)[BER_CLASS ]) == ASN_UNIVERSAL
519			&& SvIV (AvARRAY (av)[BER_TAG ]) == ASN_INTEGER32
520			&& !SvIV (AvARRAY (av)[BER_CONSTRUCTED])
521			&& SvIV (AvARRAY (av)[BER_DATA ]) == value
522			? &PL_sv_yes : &PL_sv_no);
523			}
524
525			void
526			ber_is_oid (SV tuple, SV oid)
527			PROTOTYPE: $$
528			PPCODE:
529			{
530			if (!SvOK (tuple))
531			XSRETURN_NO;
532
533			if (!SvROK (tuple) \|\| SvTYPE (SvRV (tuple)) != SVt_PVAV)
534			croak ("ber_seq: tuple must be ber tuple (array-ref)");
535
536			AV av = (AV )SvRV (tuple);
537
538			XPUSHs (
539			SvIV (AvARRAY (av)[BER_CLASS ]) == ASN_UNIVERSAL
540			&& SvIV (AvARRAY (av)[BER_TAG ]) == ASN_OBJECT_IDENTIFIER
541			&& !SvIV (AvARRAY (av)[BER_CONSTRUCTED])
542			&& sv_eq (AvARRAY (av)[BER_DATA], oid)
543			? &PL_sv_yes : &PL_sv_no);
544			}
545