sexp.c 19.8 KB
Newer Older
Niels Möller's avatar
Niels Möller committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* sexp.c
 *
 * An implementation of Ron Rivest's S-expressions, used in spki.
 *
 * $Id$ */

/* lsh, an implementation of the ssh protocol
 *
 * Copyright (C) 1998 Niels Mller
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License as
 * published by the Free Software Foundation; either version 2 of the
 * License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
J.H.M. Dassen's avatar
J.H.M. Dassen committed
23
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
Niels Möller's avatar
Niels Möller committed
24
25
26
27
 */

#include "sexp.h"

28
#include "format.h"
Niels Möller's avatar
Niels Möller committed
29
#include "queue.h"
30
#include "werror.h"
Niels Möller's avatar
Niels Möller committed
31
32
#include "xalloc.h"

33
34
#include <assert.h>
#include <stdarg.h>
35
#include <string.h>
36

37
#define GABA_DEFINE
38
#include "sexp.h.x"
39
#undef GABA_DEFINE
Niels Möller's avatar
Niels Möller committed
40

Niels Möller's avatar
Niels Möller committed
41
/* Defines int sexp_char_classes[0x100] */
Niels Möller's avatar
Niels Möller committed
42
#define CHAR_CLASSES_TABLE sexp_char_classes
43
#include "sexp_table.h"
Niels Möller's avatar
Niels Möller committed
44
#undef CHAR_CLASSES_TABLE
45

46
47
#include "sexp.c.x"

48
/* GABA:
49
50
51
52
53
54
55
56
   (class
     (name sexp_string)
     (super sexp)
     (vars
       (display string)
       (contents string)))
*/

57
/* For advanced format */
58
59
60
61
static struct lsh_string *
do_format_simple_string(struct lsh_string *s,
			int style,
			unsigned indent)
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
{
  int quote_friendly = ( (~CHAR_control & ~CHAR_international)
			 | CHAR_escapable);
  
  switch(style)
    {
    case SEXP_TRANSPORT:
      fatal("Internal error!\n");
    case SEXP_CANONICAL:
      return ssh_format("%dS", s);
    case SEXP_INTERNATIONAL:
      quote_friendly |= CHAR_international;
      /* Fall through */
    case SEXP_ADVANCED:
      {
	int c;
	unsigned i;

	if (!s->length)
	  return ssh_format("\"\"");

	/* Compute the set of all character classes represented in the string */
	for (c = 0, i = 0; i < s->length; i++)
Niels Möller's avatar
Niels Möller committed
85
	  c |= sexp_char_classes[s->data[i]];
86

Niels Möller's avatar
Niels Möller committed
87
	if (! ( (sexp_char_classes[s->data[0]] & CHAR_digit)
88
89
90
91
92
93
94
95
96
97
98
99
100
		|| (c & ~(CHAR_alpha | CHAR_digit | CHAR_punctuation))))
	  /* Output token, without any quoting at all */
	  return lsh_string_dup(s);

	if (! (c & ~quote_friendly))
	  {
	    /* Count the number of characters needing escape */
	    unsigned length = s->length;
	    unsigned i;
	    struct lsh_string *res;
	    UINT8 *dst;
	    
	    for (i = 0; i<s->length; i++)
Niels Möller's avatar
Niels Möller committed
101
	      if (sexp_char_classes[s->data[i]] & CHAR_escapable)
102
103
104
105
		length++;

	    res = ssh_format("\"%lr\"", length, &dst);
	    for (i=0; i<s->length; i++)
Niels Möller's avatar
Niels Möller committed
106
	      if (sexp_char_classes[s->data[i]] & CHAR_escapable)
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
		{
		  *dst++ = '\\';
		  switch(s->data[i])
		    {
		    case '\b':
		      *dst++ = 'b';
		      break;
		    case '\t':
		      *dst++ = 't';
		      break;
		    case '\v':
		      *dst++ = 'v';
		      break;
		    case '\n':
		      *dst++ = 'n';
		      break;
		    case '\f':
		      *dst++ = 'f';
		      break;
		    case '\r':
		      *dst++ = 'r';
		      break;
		    case '\"':
		      *dst++ = '\"';
		      break;
		    case '\\':
		      *dst++ = '\\';
		      break;
		    default:
		      fatal("Internal error!\n");
		    }
		}
	      else
		*dst++ = s->data[i];

	    assert(dst == (res->data + 1 + length));

	    return res;
	  }
	/* Base 64 string */
147
	return encode_base64(s, "||", indent + 1, 0);
148
149
150
151
152
153
      }
    default:
      fatal("do_format_sexp_string: Unknown output style.\n");
    }
}
  
154
155
156
static struct lsh_string *
do_format_sexp_string(struct sexp *s,
		      int style, unsigned indent)
Niels Möller's avatar
Niels Möller committed
157
158
159
160
161
{
  CAST(sexp_string, self, s);

  switch(style)
    {
162
163
    case SEXP_TRANSPORT:
      fatal("Internal error!\n");
Niels Möller's avatar
Niels Möller committed
164
    case SEXP_ADVANCED:
165
    case SEXP_INTERNATIONAL:
Niels Möller's avatar
Niels Möller committed
166
167
    case SEXP_CANONICAL:
      if (self->display)
168
	return ssh_format("[%lfS]%lfS",
169
170
			  do_format_simple_string(self->display, style, indent + 1),
			  do_format_simple_string(self->contents, style, indent));
Niels Möller's avatar
Niels Möller committed
171
      else
172
	return ssh_format("%lfS",
173
			  do_format_simple_string(self->contents, style, indent));
Niels Möller's avatar
Niels Möller committed
174
175
176
177
178
    default:
      fatal("do_format_sexp_string: Unknown output style.\n");
    }
}

179
/* Consumes its args (display may be NULL) */
180
181
struct sexp *
sexp_s(struct lsh_string *d, struct lsh_string *c)
182
183
{
  NEW(sexp_string, s);
184
185
  assert(c);
  
186
  s->super.format = do_format_sexp_string;
187
  s->super.iter = NULL;
188
189
190
191
192
193
194
  
  s->display = d;
  s->contents = c;
  
  return &s->super;
}

195
196
struct lsh_string *
sexp_contents(const struct sexp *e)
197
198
199
200
201
{
  CAST(sexp_string, self, e);
  return self->contents;
}

202
203
struct lsh_string *
sexp_display(const struct sexp *e)
204
205
206
207
{
  CAST(sexp_string, self, e);
  return self->display;
}
208

209
static struct lsh_string *
210
211
do_format_sexp_nil(struct sexp *ignored UNUSED, int style UNUSED,
		   unsigned indent UNUSED)
212
213
214
215
{
  return ssh_format("()");
}

216
217
218

/* For assoc */
struct sexp_iterator *
219
220
sexp_check_type_l(struct sexp *e, UINT32 length,
		  const UINT8 *name)
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
{
  if (!sexp_atomp(e))
    {
      struct sexp_iterator *i = SEXP_ITER(e);

      if (sexp_eq(SEXP_GET(i), length, name))
	{
	  SEXP_NEXT(i);
	  return i;
	}
      else
	KILL(i);
    }  
  return NULL;
}

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
/* Returns 1 if the type matches.
 *
 * FIXME: Do we relly need this interface, that allows res == NULL? */
int
sexp_check_type(struct sexp *e, int type, struct sexp_iterator **res)
{
  struct sexp_iterator *i =
    sexp_check_type_l(e, get_atom_length(type), get_atom_name(type));

  if (i)
    {
      if (res)
	*res = i;
      else
	KILL(i);
      return 1;
    }
  return 0;
}

257
/* Forward declaration */
258
259
static struct sexp_iterator *
make_iter_cons(struct sexp *s);
260

261
struct sexp_cons sexp_nil =
262
263
{ { STATIC_HEADER, make_iter_cons, do_format_sexp_nil },
  &sexp_nil.super, &sexp_nil };
264
265
266

#define SEXP_NIL (&sexp_nil.super)

267
/* GABA:
268
269
   (class
     (name sexp_iter_cons)
270
     (super sexp_iterator)
271
272
273
274
     (vars
       (p object sexp_cons)))
*/

275
276
static struct sexp *
do_cons_get(struct sexp_iterator *c)
277
{
278
  CAST(sexp_iter_cons, i, c);
279
  return (i->p == &sexp_nil) ? NULL : i->p->car;
280
281
}

282
283
static void
do_cons_set(struct sexp_iterator *c, struct sexp *e)
284
285
286
287
288
289
290
{
  CAST(sexp_iter_cons, i, c);
  assert (i->p != &sexp_nil);

  i->p->car = e;
}

291
292
293
294
295
296
297
298
299
static struct sexp *
do_cons_assoc(struct sexp_iterator *s, UINT32 length,
	      const UINT8 *name, struct sexp_iterator **i)
{
  CAST(sexp_iter_cons, self, s);
  struct sexp_cons *p;

  for (p = self->p; p != &sexp_nil; p = p->cdr)
    {
300
      struct sexp_iterator *inner = sexp_check_type_l(p->car, length, name);
301
302
303
304
305
306
307
308
309
310
311
      if (inner)
	{
	  if (i)
	    *i = inner;

	  return p->car;
	}
    }
  return NULL;
}

312
313
static unsigned
do_cons_left(struct sexp_iterator *i)
314
315
316
317
318
319
320
321
322
323
324
{
  CAST(sexp_iter_cons, self, i);
  struct sexp_cons *p;
  unsigned k;

  for (p = self->p, k = 0; p != &sexp_nil; p = p->cdr, k++)
    ;

  return k;
}

325
326
static void
do_cons_next(struct sexp_iterator *c)
327
328
329
330
331
{
  CAST(sexp_iter_cons, i, c);
  i->p = i->p->cdr;
}

332
333
static struct sexp_iterator *
make_iter_cons(struct sexp *s)
334
335
336
337
338
339
{
  CAST(sexp_cons, c, s);
  NEW(sexp_iter_cons, iter);

  iter->super.get = do_cons_get;
  iter->super.set = do_cons_set;
340
341
  iter->super.assoc = do_cons_assoc;
  iter->super.left = do_cons_left;
342
343
  iter->super.next = do_cons_next;
  iter->p = c;
344
345
  
  return &iter->super;
346
347
}

348
349
350
static struct lsh_string *
do_format_sexp_tail(struct sexp_cons *c,
		    int style, unsigned indent)
351
{
352
353
354
  int use_space = 0;
  
  if (c == &sexp_nil)
355
356
357
358
359
360
361
    return ssh_format(")");

  switch(style)
    {
    case SEXP_TRANSPORT:
      fatal("Internal error!\n");
    case SEXP_ADVANCED:
362
363
364
    case SEXP_INTERNATIONAL:
      use_space = 1;
      /* Fall through */
365
    case SEXP_CANONICAL:
366
      return ssh_format(use_space ? " %ls%ls" : "%ls%ls",
367
368
			sexp_format(c->car, style, indent),
			do_format_sexp_tail(c->cdr, style, indent));
369
370
371
372
373
    default:
      fatal("do_format_sexp_tail: Unknown output style.\n");
    }
}

374
#if 0
375
376
static int
is_short(struct lsh_string *s)
377
378
379
380
381
382
{
  return ( (s->length < 15)
	   && !memchr(s->data, '\n', s->length); )
}
#endif

383
384
385
static struct lsh_string *
do_format_sexp_cons(struct sexp *s,
		    int style, unsigned indent)
386
387
388
389
390
391
392
393
{
  CAST(sexp_cons, self, s);

  switch(style)
    {
    case SEXP_TRANSPORT:
      fatal("Internal error!\n");
    case SEXP_ADVANCED:
394
    case SEXP_INTERNATIONAL:
395
396
397
398
399
400
401
402
403
404
405
406
407
408
#if 0
      {
	struct lsh_string *head = format_sexp(self->car, style, indent + 1);

	if (is_short(head))
	  return ssh_format("(%lfS%lfS",
			    head, do_format_sexp_tail(self->cdr, style,
						      indent + 2 + head->length));
	else
	  return ssh_format("(%lfS\n", do_format_sexp_tail(self->cdr, style,
							 indent + 1));
      }
#endif
      /* Fall through */
409
    case SEXP_CANONICAL:
410
      return ssh_format("(%ls", do_format_sexp_tail(self, style, indent));
411
412
413
414
415
    default:
      fatal("do_format_sexp_tail: Unknown output style.\n");
    }
}

416
417
struct sexp *
sexp_c(struct sexp *car, struct sexp_cons *cdr)
418
419
420
421
{
  NEW(sexp_cons, c);

  c->super.format = do_format_sexp_cons;
422
  c->super.iter = make_iter_cons;
423
424
425
426
427
428
429
  
  c->car = car;
  c->cdr = cdr;

  return &c->super;
}

430
/* GABA:
431
432
433
434
435
436
437
438
439
   (class
     (name sexp_vector)
     (super sexp)
     (vars
       ; FIXME: With better var-array support, this
       ; could use an embedded var-array instead.
       (elements object object_list)))
*/

440
/* GABA:
441
442
   (class
     (name sexp_iter_vector)
443
     (super sexp_iterator)
444
     (vars
445
       (l object object_list)
446
447
448
       (i . unsigned)))
*/

449
450
static struct sexp *
do_vector_get(struct sexp_iterator *c)
451
452
453
454
{
  CAST(sexp_iter_vector, i, c);
  if (i->i < LIST_LENGTH(i->l))
    {
455
      CAST_SUBTYPE(sexp, res, LIST(i->l)[i->i]);
456
457
458
459
460
      return res;
    }
  return NULL;
}

461
462
static void
do_vector_set(struct sexp_iterator *c, struct sexp *e)
463
464
465
466
467
468
469
{
  CAST(sexp_iter_vector, i, c);
  assert(i->i < LIST_LENGTH(i->l));

  LIST(i->l)[i->i] = &e->super;
}

470
471
472
473
474
475
476
477
478
479
static struct sexp *
do_vector_assoc(struct sexp_iterator *s, UINT32 length,
		const UINT8 *name, struct sexp_iterator **i)
{
  CAST(sexp_iter_vector, self, s);
  unsigned j;
  
  for (j = self->i; j < LIST_LENGTH(self->l); j++)
    {
      CAST_SUBTYPE(sexp, e, LIST(self->l)[j]);
480
      struct sexp_iterator *inner = sexp_check_type_l(e, length, name);
481
482
483
484
485
486
487
488
489
490
491
492
      
      if (inner)
	{
	  if (i)
	    *i = inner;

	  return e;
	}
    }
  return NULL;
}

493
494
static unsigned
do_vector_left(struct sexp_iterator *s)
495
496
497
498
499
{
  CAST(sexp_iter_vector, i, s);
  return LIST_LENGTH(i->l) - i->i;
}

500
501
static void
do_vector_next(struct sexp_iterator *c)
502
503
504
505
506
507
{
  CAST(sexp_iter_vector, i, c);
  if (i->i < LIST_LENGTH(i->l))
    i->i++;
}

508
509
static struct sexp_iterator *
make_iter_vector(struct sexp *s)
510
511
512
513
514
{
  CAST(sexp_vector, v, s);
  NEW(sexp_iter_vector, iter);

  iter->super.get = do_vector_get;
515
516
517
  iter->super.set = do_vector_set;
  iter->super.assoc = do_vector_assoc;
  iter->super.left = do_vector_left;
518
  iter->super.next = do_vector_next;
519

520
  iter->l = v->elements;
521
  iter->i = 0;
522
523

  return &iter->super;
524
525
}

526
527
528
static struct lsh_string *
do_format_sexp_vector(struct sexp *e,
		      int style, unsigned indent)
529
530
531
532
533
{
  CAST(sexp_vector, v, e);

  unsigned i;
  UINT32 size;
534
  int use_space = 0;
535
536
537
538
539
540
541
542
543
  
  struct lsh_string **elements = alloca(LIST_LENGTH(v->elements)
					* sizeof(struct lsh_string *) );
  
  switch(style)
    {
    case SEXP_TRANSPORT:
      fatal("Internal error!\n");
    case SEXP_ADVANCED:
544
545
546
    case SEXP_INTERNATIONAL:
      use_space = 1;
      /* Fall through */
547
548
549
550
551
552
    case SEXP_CANONICAL:
      {
	struct lsh_string *res;
	UINT8 *dst;
	
	assert(LIST_LENGTH(v->elements));
553
	for (i = 0, size = 2; i<LIST_LENGTH(v->elements); i++)
554
555
556
	  {
	    CAST_SUBTYPE(sexp, o, LIST(v->elements)[i]);
	    
557
	    elements[i] = sexp_format(o, style, indent + 1);
558
559
	    size += elements[i]->length;
	  }
560
561
562

	if (use_space)
	  size += LIST_LENGTH(v->elements) - 1;
563
	
564
	res = lsh_string_alloc(size);
565
566
567
568
569
	dst = res->data;
	
	*dst++ = '(';
	for (i = 0; i<LIST_LENGTH(v->elements); i++)
	  {
570
571
572
	    if (i && use_space)
	      *dst++ = ' ';
	    
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
	    memcpy(dst, elements[i]->data, elements[i]->length);
	    dst += elements[i]->length;
	    
	    lsh_string_free(elements[i]);
	  }
	*dst++ = ')';
	
	assert(dst == (res->data + res->length));
	
	return res;
      }
    default:
      fatal("do_format_sexp_vector: Unknown output style.\n");
    }
}

589
590
struct sexp *
sexp_v(struct object_list *l)
Niels Möller's avatar
Niels Möller committed
591
{
592
593
594
595
596
597
598
599
600
601
602
603
604
  if (LIST_LENGTH(l))
    {
      NEW(sexp_vector, v);
      
      v->super.format = do_format_sexp_vector;
      v->super.iter = make_iter_vector;
      
      v->elements = l;
      
      return &v->super;
    }
  else
    return SEXP_NIL;
Niels Möller's avatar
Niels Möller committed
605
606
}

607
608
struct sexp *
sexp_l(unsigned n, ...)
609
610
611
612
613
614
615
616
617
{
  va_list args;

  va_start(args, n);

  if (!n)
    {
      assert(va_arg(args, int) == -1);
      va_end(args);
618
      return SEXP_NIL;
619
620
621
    }
  else
    {
Niels Möller's avatar
Niels Möller committed
622
      struct sexp *v = sexp_v(make_object_listv(n, args));
623
      
624
625
      va_end(args);

Niels Möller's avatar
Niels Möller committed
626
      return v;
627
628
629
    }
}

630
631
struct sexp *
sexp_a(const int a)
632
{
633
  return sexp_s(NULL, ssh_format("%la", a));
634
635
}

636
637
struct sexp *
sexp_z(const char *s)
638
{
639
  return sexp_s(NULL, ssh_format("%lz", s));
640
641
642
}

/* mpz->atom */
643
644
struct sexp *
sexp_un(const mpz_t n)
645
{
646
647
648
649
650
651
652
653
  struct lsh_string *s;
  UINT32 l = bignum_format_u_length(n);

  s = lsh_string_alloc(l);
  l -= bignum_format_u(n, s->data);

  assert(!l);
  
654
  return sexp_s(NULL, s);
655
656
}

657
658
struct sexp *
sexp_sn(const mpz_t n)
659
{
660
661
662
663
664
665
666
667
  struct lsh_string *s;
  UINT32 l = bignum_format_s_length(n);

  s = lsh_string_alloc(l);
  l -= bignum_format_s(n, s->data);

  assert(!l);
  
668
  return sexp_s(NULL, s);
669
670
}
    
671
672
struct lsh_string *
sexp_format(struct sexp *e, int style, unsigned indent)
673
674
675
676
{
  switch(style)
    {
    case SEXP_TRANSPORT:
677
      return encode_base64(sexp_format(e, SEXP_CANONICAL, 0), "{}", indent, 1);
678
    case SEXP_CANONICAL:
679
680
681
    case SEXP_ADVANCED:
    case SEXP_INTERNATIONAL:
      /* NOTE: Check for NULL here? I don't think so. */
682
      return SEXP_FORMAT(e, style, indent);
683
684
685
686
687
    default:
      fatal("sexp_format: Unknown output style.\n");
    }
}

688
689
static void
encode_base64_group(UINT32 n, UINT8 *dest)
690
691
692
693
694
695
696
697
698
699
700
701
702
{
  static const UINT8 digits[64] =
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdef"
    "ghijklmnopqrstuvwxyz0123456789+/";
  unsigned i;

  for (i = 0; i<4; i++)
    {
      dest[3 - i] = digits[n & 0x3f];
      n >>= 6;
    }
}

703
704
struct lsh_string *
encode_base64(struct lsh_string *s,
705
706
707
	      const char *delimiters,
	      unsigned indent UNUSED,
	      int free)				 
708
709
710
{
  UINT32 full_groups = (s->length) / 3;
  unsigned last = (s->length) % 3;
711
  unsigned length =  (full_groups + !!last) * 4;
712
  UINT8 *src = s->data;
713
714
715
716
717
718
719
  UINT8 *dst;
    
  struct lsh_string *res
    = (delimiters
       ? ssh_format("%c%lr%c", delimiters[0], length, &dst, delimiters[1])
       : ssh_format("%lr", length, &dst));
  
720
721
722
  if (full_groups)
    {
      unsigned i;
Niels Möller's avatar
Niels Möller committed
723
      
724
      /* Loop over all but the last group. */
725
      for (i=0; i<full_groups; dst += 4, src += 3, i++)
726
	{
727
728
729
	  encode_base64_group( (src[0] << 16)
			       | (src[1] << 8)
			       | src[2], dst);
730
731
732
733
734
735
736
737
	}
    }
  switch(last)
    {
    case 0:
      /* Finished */
      break;
    case 1:
738
      encode_base64_group( src[0] << 16, dst);
739
740
741
742
743
      dst += 2;
      *dst++ = '=';
      *dst++ = '=';
      break;
    case 2:
744
745
      encode_base64_group( (src[0] << 16)
			   | (src[1] << 8), dst);
746
747
748
749
750
751
752
      dst += 3;
      *dst++ = '=';
      break;
    default:
      fatal("encode_base64: Internal error!\n");
    }

753
  assert( (dst + !!delimiters) == (res->data + res->length));
754
755
756
757
758
759

  if (free)
    lsh_string_free(s);
  
  return res;
}
760

761
762
int
sexp_nullp(const struct sexp *e)
763
764
765
766
{
  return (e == SEXP_NIL);
}

767
768
int
sexp_atomp(const struct sexp *e)
769
770
771
772
{
  return !e->iter;
}

773
774
775
776
/* Checks that the sexp is a simple string (i.e. no display part) */
struct lsh_string *
sexp2string(struct sexp *e)
{
777
  return ( (e && sexp_atomp(e) && !sexp_display(e))
778
779
780
781
	   ? sexp_contents(e) : NULL);
}
  

782
int
783
784
785
786
787
788
sexp2atom(struct sexp *e)
{
  struct lsh_string *s = sexp2string(e);
  return s ? lookup_atom(s->length, s->data) : 0;
}

789
790
791
792
793
794
795
796
797
798
799
800
801
802
int
sexp2bignum_u(struct sexp *e, mpz_t n)
{
  struct lsh_string *s = sexp2string(e);

  if (s)
    {
      bignum_parse_u(n, s->length, s->data);
      return 1;
    }
  else
    return 0;
}

803
804
int
sexp_eq(struct sexp *e, UINT32 length, const UINT8 *name)
805
806
807
808
809
{
  struct lsh_string *c = sexp2string(e);

  return c && lsh_string_eq_l(c, length, name);
}
810

811
812
813
814
815
816
817
818
819
820
/* NOTE: sexp_atom_eq() compares an sexp to a given atom, while
 *       sexp_atoms_eq() compares two atomic sexps.
 *
 * This naming seems a little confusing. */
int
sexp_atom_eq(struct sexp *e, int atom)
{
  return sexp_eq(e, get_atom_length(atom), get_atom_name(atom));
}

821
/* Assumes that both expressions are atoms */
822
int
823
sexp_atoms_eq(struct sexp *a, struct sexp *b)
824
{
825
826
827
828
  struct lsh_string *ac = sexp_contents(a);
  struct lsh_string *ad = sexp_display(a);
  struct lsh_string *bc = sexp_contents(b);
  struct lsh_string *bd = sexp_display(b);
829
830
831
832
833

  return lsh_string_eq(ac, bc)
    && (ad ? (bd && lsh_string_eq(ad, bd))
	: !bd);
}
834
835

#if 0
836
837
int
sexp_eqz(const struct sexp *e, const char *s)
838
839
840
841
842
{
  struct lsh_string *c;

  if (!sexp_atomp(e) || sexp_display(e))
    return 0;
843

844
  c = sexp_contents(e);
845

846
847
848
  return !strncmp(s, c->data, c->length);
}

849
int
850
851
sexp_check_type_z(struct sexp *e, const char *type,
		  struct sexp_iterator **res)
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
{
  struct sexp_iterator *i;
  
  if (sexp_atomp(e) || sexp_nullp(e))
    return 0;

  i = SEXP_ITER(e);

  if (sexp_eqz(SEXP_GET(i), type))
    {
      if (res)
	{
	  SEXP_NEXT(i);
	  *res = i;
	}
      return 1;
    }

  KILL(i);
  return 0;
}
873
874

/* Check that the next element is a pair (name value), and return value */
875
876
struct sexp *
sexp_assz(struct sexp_iterator *i, const char *name)
877
878
879
880
881
{
  struct sexp *l = SEXP_GET(i);
  struct sexp_iterator *inner;
  struct sexp *e;
  
882
  if (!l || !(sexp_check_type_z(l, name, &inner)))
883
884
885
886
887
888
889
890
891
    return 0;

  e = SEXP_GET(inner);

  if (e)
    {
      SEXP_NEXT(inner);
      if (SEXP_GET(inner))
	/* Too many elements */
892
	e = NULL;
893
894
895
896
897
898
      else 
	SEXP_NEXT(i);
    }
  KILL(inner);
  return e;
}
899
#endif
900

901
902
struct sexp *
sexp_assq(struct sexp_iterator *i, int atom)
903
{
904
  struct sexp_iterator *inner;
905
  if (SEXP_ASSOC(i, get_atom_length(atom), get_atom_name(atom), &inner)
906
      && (SEXP_LEFT(inner) == 1))
907
908
    {
      struct sexp *value = SEXP_GET(inner);
909
910
      assert(value);
      
911
912
913
914
915
916
      KILL(inner);
      return value;
    }
  else
    return NULL;
}
917

918
919
int
sexp_get_un(struct sexp_iterator *i, int atom, mpz_t n)
920
{
921
  return sexp2bignum_u(sexp_assq(i, atom), n);
922
923
}

924
925
926
927
928
929
930
/* Command line options */
struct sexp_format
{
  char *name;
  int id;
};

931
932
933
static const struct sexp_format
sexp_formats[] =
{
934
935
936
937
938
939
940
941
  { "transport", SEXP_TRANSPORT },
  { "canonical", SEXP_CANONICAL },
  { "advanced", SEXP_ADVANCED },
  { "international", SEXP_INTERNATIONAL },
  { NULL, 0 }
};

#if 0
942
943
static void
list_formats(void)
944
945
946
947
948
949
950
951
952
{
  int i;

  werror("Available formats are:\n");
  for (i = 0; sexp_formats[i].name; i++)
    werror("  %z\n", sexp_formats[i].name);
}
#endif

953
954
static int
lookup_sexp_format(const char *name)
955
956
957
958
959
{
  int i;

  for (i = 0; sexp_formats[i].name; i++)
    {
960
      if (strcmp(sexp_formats[i].name, name) == 0)
961
962
963
964
965
966
	return sexp_formats[i].id;
    }
  return -1;
}

static const struct argp_option
967
sexp_input_options[] =
968
{
969
970
  { NULL, 0, NULL, 0, "Valid sexp-formats are transport, canonical, "
    "advanced and international.", 0 },
971
  { "input-format", 'i', "format", 0,
972
973
974
975
976
977
978
979
980
    "Variant of the s-expression syntax to accept.", 0},
  { NULL, 0, NULL, 0, NULL, 0 }
};

static const struct argp_option
sexp_output_options[] =
{
  { NULL, 0, NULL, 0, "Valid sexp-formats are transport, canonical, "
    "advanced and international.", 0 },
981
  { "output-format", 'f', "format", 0,
982
    "Variant of the s-expression syntax to generate.", 0},
983
984
985
986
987
988
989
990
991
992
  { NULL, 0, NULL, 0, NULL, 0 }
};

static error_t
sexp_argp_parser(int key, char *arg, struct argp_state *state)
{
  switch(key)
    {
    default:
      return ARGP_ERR_UNKNOWN;
993
    case 'f':
994
    case 'i':
995
996
997
998
999
      {
	int format = lookup_sexp_format(arg);
	if (format < 0)
	  argp_error(state, "Unknown s-expression format '%s'", arg);
	else
1000
	  *(sexp_argp_state *) (state->input) = format;