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_REAL              = 0x09, //X
  ASN_ENUMERATED        = 0x0a, //X
  ASN_SEQUENCE          = 0x10,
  ASN_SET               = 0x11, //X
  ASN_UTC_TIME          = 0x17, //X
  ASN_GENERAL_TIME      = 0x18, //X

  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 SNMP
  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;
}

// get_* functions fetch something from the buffer
// decode_* functions use get_* fun ctions to decode ber values

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

  U8 *res = cur;

  cur += count;
  rem -= count;

  return res;
}

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

  rem--;
  return *cur++;
}

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

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

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

static U32
get_length (void)
{
  U32 res = get_u8 ();

  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) | get_u8 ();
          case 3: res = (res << 8) | get_u8 ();
          case 2: res = (res << 8) | get_u8 ();
          case 1: res = (res << 8) | get_u8 ();
        }
    }

  return res;
}

static U32
get_integer32 (void)
{
  U32 length = get_length ();

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

  U8 *data = get_n (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 *
decode_integer32 (void)
{
  return newSViv ((I32)get_integer32 ());
}

static SV *
decode_unsigned32 (void)
{
  return newSVuv ((U32)get_integer32 ());
}

#if IVSIZE >= 8

static U64TYPE
get_integer64 (void)
{
  U32 length = get_length ();

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

  U8 *data = get_n (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 *
decode_integer64 (void)
{
  return newSViv ((I64TYPE)get_integer64 ());
}

static SV *
decode_unsigned64 (void)
{
  return newSVuv ((U64TYPE)get_integer64 ());
}

#endif

static SV *
decode_octet_string (void)
{
  U32 length = get_length ();

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

  return newSVpvn (data, length);
}

// gelper for decode_object_identifier
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 *
decode_object_identifier (void)
{
  U32 length = get_length ();

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

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

  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 = get_ber ();
      *app++ = '.';
      app = write_uv (app, w);
    }

  return newSVpvn (oid, app - oid);
}

static SV *
decode_ber ()
{
  int identifier = get_u8 ();

  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 = get_ber ();

  if (tag == ASN_TAG_BER)
    tag = get_ber ();

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

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

      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 = decode_object_identifier ();
          break;

        case ASN_INTEGER32:
          res = decode_integer32 ();
          break;

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

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

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

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