See ChangeLog: Fri Nov 19 17:15:20 CET 1999 Werner Koch
[libgcrypt.git] / src / sexp.c
1 /* sexp.c  -  S-Expression handling
2  *      Copyright (C) 1999 Free Software Foundation, Inc.
3  *
4  * This file is part of GnuPG.
5  *
6  * GnuPG is free software; you can redistribute it and/or modify
7  * it under the terms of the GNU General Public License as published by
8  * the Free Software Foundation; either version 2 of the License, or
9  * (at your option) any later version.
10  *
11  * GnuPG is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  * GNU General Public License for more details.
15  *
16  * You should have received a copy of the GNU General Public License
17  * along with this program; if not, write to the Free Software
18  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
19  */
20
21
22 /****************
23  * TODO:
24  *  - implement reference counting to defere freeing of
25  *    data and make copies of the data on demand.
26  *    --> do we really need this?
27  *
28  */
29
30 #include <config.h>
31 #include <stdio.h>
32 #include <stdlib.h>
33 #include <string.h>
34 #include <stdarg.h>
35 #include <ctype.h>
36 #include <assert.h>
37
38 #define GCRYPT_NO_MPI_MACROS 1
39 #include "g10lib.h"
40 #include "memory.h"
41
42
43 /* FIXME: We should really have the m_lib functions to allow
44  *        overriding of the default malloc functions
45  * For now use this kludge: */
46 #define m_lib_alloc        m_alloc
47 #define m_lib_alloc_clear  m_alloc_clear
48 #define m_lib_free         m_free
49
50
51
52
53 #if 0
54 struct sexp_node;
55 typedef struct sexp_node *NODE;
56
57 struct gcry_sexp {
58     int orig_format;  /* format which we used to create this object */
59     NODE sexp;        /* a NULL indicates an empty list */
60 };
61 #else
62 typedef struct gcry_sexp *NODE;
63 #endif
64
65
66 enum node_types { ntLIST, ntDATA, ntMPI };
67
68 struct gcry_sexp {
69     NODE next;
70     NODE up;        /* helper needed for faster traversal */
71     enum node_types type;
72     union {
73         NODE list;
74         GCRY_MPI mpi;
75         struct {
76             size_t len;
77             byte  d[1];
78         } data;
79     } u;
80 };
81
82
83 static void
84 dump_mpi( GCRY_MPI a )
85 {
86     char buffer[1000];
87     size_t n = 1000;
88
89     if( !a )
90         fputs("[no MPI]", stderr );
91     else if( gcry_mpi_print( GCRYMPI_FMT_HEX, buffer, &n, a ) )
92         fputs("[MPI too large to print]", stderr );
93     else
94         fputs( buffer, stderr );
95 }
96
97 static void
98 dump_string( FILE *fp, const byte *p, size_t n, int delim )
99 {
100     for( ; n; n--, p++ )
101         if( iscntrl( *p ) || *p == delim ) {
102             putc('\\', fp);
103             if( *p == '\n' )
104                 putc('n', fp);
105             else if( *p == '\r' )
106                 putc('r', fp);
107             else if( *p == '\f' )
108                 putc('f', fp);
109             else if( *p == '\v' )
110                 putc('v', fp);
111             else if( *p == '\b' )
112                 putc('b', fp);
113             else if( !*p )
114                 putc('0', fp);
115             else
116                 fprintf(fp, "x%02x", *p );
117         }
118         else
119             putc(*p, fp);
120 }
121
122 static void
123 do_dump_list( NODE node, int indent )
124 {
125     for( ; node; node = node->next ) {
126         switch( node->type ) {
127           case ntLIST:
128             if( indent )
129                 putc('\n', stderr);
130             fprintf(stderr, "%*s(", indent, "");
131             do_dump_list( node->u.list, indent+1 );
132             putc(')', stderr);
133             break;
134           case ntDATA:
135             if( !node->u.data.len )
136                 fputs("EMPTY", stderr );
137             else
138                 dump_string(stderr, node->u.data.d, node->u.data.len, ')');
139             putc(' ', stderr);
140             break;
141           case ntMPI:
142             dump_mpi( node->u.mpi );
143             putc(' ', stderr);
144             break;
145         }
146         if( !indent )
147             putc('\n', stderr);
148     }
149 }
150
151 static void
152 dump_sexp( NODE node )
153 {
154     do_dump_list( node, 0 );
155 }
156
157
158 void
159 gcry_sexp_dump( GCRY_SEXP a )
160 {
161     do_dump_list( a, 0 );
162 }
163
164
165 /****************
166  * Create a new SEXP element (data)
167  * If length is 0 it is assumed that buffer is a C string.
168  */
169 GCRY_SEXP
170 gcry_sexp_new_data( const char *buffer, size_t length )
171 {
172     NODE list, node;
173
174     if( !length )
175         length = strlen(buffer);
176     node = m_alloc_clear( sizeof *node + length );
177     node->type = ntDATA;
178     node->u.data.len = length;
179     memcpy(node->u.data.d, buffer, length );
180     list = m_alloc_clear( sizeof *list );
181     list->type = ntLIST;
182     list->u.list = node;
183     return list;
184 }
185
186 /****************
187  * Create a new SEXP element (mpi)
188  */
189 GCRY_SEXP
190 gcry_sexp_new_mpi( GCRY_MPI mpi )
191 {
192     NODE list, node;
193
194     node = m_alloc_clear( sizeof *node );
195     node->type = ntMPI;
196     node->u.mpi = gcry_mpi_copy( mpi );
197     list = m_alloc_clear( sizeof *list );
198     list->type = ntLIST;
199     list->u.list = node;
200     return list;
201 }
202
203
204 /****************
205  * Create a pair of a name and some arbitrary data.
206  */
207 GCRY_SEXP
208 gcry_sexp_new_name_data( const char *name, const char *buffer, size_t length )
209 {
210     return gcry_sexp_cons( gcry_sexp_new_data( name, 0 ),
211                            gcry_sexp_new_data( buffer, length ) );
212 }
213
214 /****************
215  * Create a pair of a name and a MPI
216  */
217 GCRY_SEXP
218 gcry_sexp_new_name_mpi( const char *name, GCRY_MPI mpi )
219 {
220     return gcry_sexp_cons( gcry_sexp_new_data( name, 0 ),
221                            gcry_sexp_new_mpi( mpi ) );
222 }
223
224
225 /****************
226  * Release resource of the given SEXP object.
227  */
228 void
229 gcry_sexp_release( GCRY_SEXP sexp )
230 {
231     /* FIXME! */
232 }
233
234
235
236
237 /****************
238  * Make a pair from lists a and b, don't use a or b later on.
239  * Special behaviour:  If one is a single element list we put the
240  * element straight into the new pair.
241  */
242 GCRY_SEXP
243 gcry_sexp_cons( GCRY_SEXP a, GCRY_SEXP b )
244 {
245     NODE head;
246
247     if( a->type != ntLIST ) {
248         fputs("sexp_cons: arg 1 is not a list\n", stderr );
249         return NULL;
250     }
251     if( b->type != ntLIST ) {
252         fputs("sexp_cons: arg 2 is not a list\n", stderr );
253         return NULL;
254     }
255
256
257     head = m_alloc_clear( sizeof *head );
258     head->type = ntLIST;
259     if( !a->u.list->next ) { /* a has only one item */
260         NODE tmp = a;
261         a = a->u.list;
262         /* fixme: release tmp here */
263     }
264     if( !b->u.list->next ) { /* b has only one item */
265         NODE tmp = b;
266         b = b->u.list;
267         /* fixme: release tmp here */
268     }
269
270     head->u.list = a;
271     a->up = head;
272     a->next = b;
273     b->up = head;
274
275     return head;
276 }
277
278
279 /****************
280  * Make a list from all items, the end of list is indicated by a NULL
281  * don't use the passed lists later on, they are void.
282  */
283 GCRY_SEXP
284 gcry_sexp_vlist( GCRY_SEXP a, ... )
285 {
286     NODE head, tail, node;
287     va_list arg_ptr ;
288
289     if( a->type != ntLIST ) {
290         fputs("sexp_vlist: arg 1 is not a list\n", stderr );
291         return NULL;
292     }
293     head = m_alloc_clear( sizeof *node );
294     head->type = ntLIST;
295     if( !a->u.list->next ) { /* a has only one item */
296         NODE tmp = a;
297         a = a->u.list;
298         /* fixme: release tmp here */
299     }
300     head->u.list = a;
301     a->up = head;
302     tail = a;
303
304     va_start( arg_ptr, a ) ;
305     while( (node = va_arg( arg_ptr, NODE )) ) {
306         if( node->type != ntLIST ) {
307             fputs("sexp_vlist: an arg is not a list\n", stderr );
308             return NULL;  /* fixme: we should release alread allocated nodes */
309         }
310         if( !node->u.list->next ) { /* node has only one item */
311             NODE tmp = node;
312             node = node->u.list;
313             /* fixme: release tmp here */
314         }
315         tail->next = node;
316         node->up = head;
317         tail = node;
318     }
319
320     va_end( arg_ptr );
321     return head;
322 }
323
324
325 /****************
326  * Append n to the list a
327  * Don't use n later on.
328  * Returns: a new ist (which maybe a)
329  */
330 GCRY_SEXP
331 gcry_sexp_append( GCRY_SEXP a, GCRY_SEXP n )
332 {
333
334     GCRY_SEXP node;
335
336     if( a->type != ntLIST ) {
337         fputs("sexp_append: a is not a list\n", stderr );
338         return a;
339     }
340
341     if( n->type != ntLIST ) {
342         fputs("sexp_append: n is not a list\n", stderr );
343         return a;
344     }
345
346     for( node = a; node->next; node = node->next )
347         ;
348
349     node->next = n;
350     return a;
351 }
352
353 GCRY_SEXP
354 gcry_sexp_prepend( GCRY_SEXP a, GCRY_SEXP n )
355 {
356
357     fputs("sexp_prepend: not impl.\n", stderr );
358     return a;
359 }
360
361
362
363 /****************
364  * Locate data in a list. Data must be the first item in the list.
365  * Returns: The sublist with that Data (don't modify it!)
366  */
367 GCRY_SEXP
368 gcry_sexp_find_token( GCRY_SEXP list, const char *tok, size_t toklen )
369 {
370     NODE node;
371
372     if( !toklen )
373         toklen = strlen(tok);
374
375     for( node=list ; node; node = node->next )
376       {
377         switch( node->type ) {
378           case ntLIST: {
379                 NODE n = gcry_sexp_find_token( node->u.list, tok, toklen );
380                 if( n )
381                     return n;
382             }
383             break;
384           case ntDATA:
385             if( node == list
386                 && node->u.data.len == toklen
387                 && !memcmp( node->u.data.d, tok, toklen ) )
388               {
389                 return node;
390               }
391             break;
392           case ntMPI:
393             break;
394         }
395       }
396
397     return NULL;
398 }
399
400
401 /****************
402  * Enumerate all objects in the list.  Ther first time you call this, pass
403  * the address of a void pointer initialized to NULL.  Then don't touch this
404  * variable anymore but pass it verbatim to the function; you will get
405  * all lists back in turn. End of lists is indicated by a returned NIL in
406  * whic case you should not continue to use this function
407  * (it would wrap around).  If you decide to cancel the operation before
408  * the final NIL you vae to release the context by calling the function
409  * with a the context but a LIST set to NULL.
410  * Note that this function returns only lists and not single objects.
411  */
412 GCRY_SEXP
413 gcry_sexp_enum( GCRY_SEXP list, void **context, int mode )
414 {
415     NODE node;
416
417     if( mode )
418         return NULL; /* mode is reserved and must be 0 */
419     if( !list ) {
420         /* we are lucky that we can hold all information in the pointer
421          * value ;-) - so there is no need to release any memory */
422         *context = NULL;
423         return NULL;
424     }
425     if( !*context )  /* start enumeration */
426         node = list;
427     else {
428         node = *context;
429         node = node->next;
430     }
431
432     for( ; node; node = node->next ) {
433         *context = node; /* store our context */
434         if( node->type == ntLIST )
435             return node->u.list;
436         return node;
437     }
438
439     /* release resources and return nil */
440     return gcry_sexp_enum( NULL, context, mode );
441 }
442
443
444
445 /****************
446  * Get the CAR
447  */
448 GCRY_SEXP
449 gcry_sexp_car( GCRY_SEXP list )
450 {
451     return list;
452 }
453
454 /****************
455  * Get data from the car
456  */
457 const char *
458 gcry_sexp_car_data( GCRY_SEXP list, size_t *datalen )
459 {
460     if( list && list->type == ntLIST && !list->next )
461         list = list->u.list;
462     if( list && list->type == ntDATA ) {
463         *datalen = list->u.data.len;
464         return list->u.data.d;
465     }
466
467     return NULL;
468 }
469
470 /****************
471  * Get a MPI from the car
472  */
473 GCRY_MPI
474 gcry_sexp_car_mpi( GCRY_SEXP list, int mpifmt )
475 {
476     if( list && list->type == ntLIST && !list->next )
477         list = list->u.list;
478     if( mpifmt && list->type == ntDATA ) {
479         MPI a;
480         size_t n = list->u.data.len;
481         if( gcry_mpi_scan( &a, mpifmt, list->u.data.d, &n ) )
482             return NULL;
483         return a;
484     }
485     else if( list->type == ntMPI )
486         return gcry_mpi_copy( list->u.mpi );
487
488     return NULL;
489 }
490
491 /****************
492  * Get the CDR
493  */
494 GCRY_SEXP
495 gcry_sexp_cdr( GCRY_SEXP list )
496 {
497     if( list && (list = list->next) )
498         return list;
499     return NULL;
500 }
501
502 /****************
503  * Get data from the cdr assuming this is a pair
504  */
505 const char *
506 gcry_sexp_cdr_data( GCRY_SEXP list, size_t *datalen )
507 {
508     if( list && (list = list->next) && list->type == ntDATA ) {
509         *datalen = list->u.data.len;
510         return list->u.data.d;
511     }
512
513     return NULL;
514 }
515
516
517 /****************
518  * cdr the mpi from the list or NULL if there is no MPI.
519  * This function tries to convert plain data to an MPI.
520  * Actually this funtion returns only the second item of the list
521  * and ignores any further arguments.
522  */
523 GCRY_MPI
524 gcry_sexp_cdr_mpi( GCRY_SEXP list, int mpifmt )
525 {
526     NODE node = list;
527
528     if( !node || !(node = node->next) || node == ntLIST )
529         return NULL;
530     if( mpifmt && node->type == ntDATA ) {
531         MPI a;
532         size_t n = node->u.data.len;
533         if( gcry_mpi_scan( &a, mpifmt, node->u.data.d, &n ) )
534             return NULL;
535         return a;
536     }
537     else if( node->type == ntMPI )
538         return gcry_mpi_copy( node->u.mpi );
539     else
540         return NULL;
541 }
542
543
544 /****************
545  * Scan the provided buffer and return the S expression in our internal
546  * format.  Returns a newly allocated expression.  If erroff is not NULL and
547  * a parsing error has occured, the offset into buffer will be returned.
548  */
549 int
550 gcry_sexp_sscan( GCRY_SEXP *retsexp, const char *buffer,
551                                      size_t length, size_t *erroff )
552 {
553     static const char tokenchars[] = "abcdefghijklmnopqrstuvwxyz"
554                                      "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
555                                      "0123456789-./_:*+=";
556     const char *p;
557     size_t n;
558     NODE head, tail, node;
559     const char *digptr=NULL;
560     const char *quoted=NULL;
561     const char *tokenp=NULL;
562     const char *hexfmt=NULL;
563     const char *base64=NULL;
564     const char *disphint=NULL;
565     int quoted_esc=0;
566     int datalen=0;
567     int first;
568
569     tail = head = NULL;
570     first = 0;
571     for(p=buffer,n=length; n; p++, n-- ) {
572         if( tokenp ) {
573             if( strchr( tokenchars, *p ) )
574                 continue;
575         }
576         if( quoted ) {
577             if( quoted_esc ) {
578                 switch( *p ) {
579                   case 'b': case 't': case 'v': case 'n': case 'f':
580                   case 'r': case '"': case '\'': case '\\':
581                     quoted_esc = 0;
582                     break;
583                   case '0': case '1': case '2': case '3': case '4':
584                   case '5': case '6': case '7':
585                     if( !(n > 2 && p[1] >= '0' && p[1] <= '7'
586                                 && p[2] >= '0' && p[2] <= '7') ) {
587                         *erroff = p - buffer;
588                         return -6;   /* invalid octal value */
589                     }
590                     p += 2; n -= 2;
591                     quoted_esc = 0;
592                     break;
593                   case 'x':
594                     if( !(n > 2 && isxdigit(p[1]) && isxdigit(p[2]) ) ) {
595                         *erroff = p - buffer;
596                         return -6;   /* invalid hex value */
597                     }
598                     p += 2; n -= 2;
599                     quoted_esc = 0;
600                     break;
601                   case '\r':  /* ignore CR[,LF] */
602                     if( n && p[1] == '\n' ) {
603                         p++; n--;
604                     }
605                     quoted_esc = 0;
606                     break;
607                   case '\n':  /* ignore LF[,CR] */
608                     if( n && p[1] == '\r' ) {
609                         p++; n--;
610                     }
611                     quoted_esc = 0;
612                     break;
613                   default:
614                     *erroff = p - buffer;
615                     return -6;   /* invalid quoted string escape */
616                 }
617             }
618             else if( *p == '\\' )
619                 quoted_esc = 1;
620             else if( *p == '\"' ) {
621                 /* fixme: add item */
622                 quoted = NULL;
623             }
624         }
625         else if( hexfmt ) {
626             if( *p == '#' )
627                hexfmt = NULL;
628         }
629         else if( base64 ) {
630             if( *p == '|' )
631                base64 = NULL;
632         }
633         else if( digptr ) {
634             if( isdigit(*p) )
635                 ;
636             else if( *p == ':' ) {
637                 if( !head ) {
638                     *erroff = 0;
639                     return -4;   /* not a list */
640                 }
641                 datalen = atoi( digptr ); /* fixme: check for overflow */
642                 digptr = NULL;
643                 if( datalen > n-1 ) {
644                     *erroff = p - buffer;
645                     return -2; /* buffer too short */
646                 }
647                 /* make a new list entry */
648                 node = m_alloc_clear( sizeof *node + datalen );
649                 if( first ) { /* stuff it into the first node */
650                     first = 0;
651                     node->up = tail;
652                     tail->u.list = node;
653                 }
654                 else {
655                     node->up = tail->up;
656                     tail->next = node;
657                 }
658                 tail = node;
659                 /* and fill in the value (we store the value in the node)*/
660                 node->type = ntDATA;
661                 node->u.data.len = datalen;
662                 memcpy(node->u.data.d, p+1, datalen );
663
664                 n -= datalen;
665                 p += datalen;
666             }
667             else if( *p == '\"' ) {
668                 digptr = NULL; /* we ignore the optional length */
669                 quoted = p;
670                 quoted_esc = 0;
671             }
672             else if( *p == '#' ) {
673                 digptr = NULL; /* we ignore the optional length */
674                 hexfmt = p;
675             }
676             else if( *p == '|' ) {
677                 digptr = NULL; /* we ignore the optional length */
678                 base64 = p;
679             }
680             else {
681                 *erroff = p - buffer;
682                 return -1;
683             }
684         }
685         else if( *p == '(' ) {
686             if( disphint ) {
687                 *erroff = p - buffer;
688                 return -9; /* open display hint */
689             }
690             node = m_alloc_clear( sizeof *node );
691             if( !head )
692                 head = node;
693             else {
694                 node->up = tail->up;
695                 tail->next = node;
696             }
697             node->type = ntLIST;
698             tail = node;
699             first = 1;
700         }
701         else if( *p == ')' ) { /* walk up */
702             if( disphint ) {
703                 *erroff = p - buffer;
704                 return -9; /* open display hint */
705             }
706             if( !head ) {
707                 *erroff = 0;
708                 return -4;   /* not a list */
709             }
710             tail = tail->up;
711             if( !tail ) {
712                 *erroff = p - buffer;
713                 return -3;
714             }
715         }
716         else if( *p == '\"' ) {
717             quoted = p;
718             quoted_esc = 0;
719         }
720         else if( *p == '#' )
721             hexfmt = p;
722         else if( *p == '|' )
723             base64 = p;
724         else if( *p == '[' ) {
725             if( disphint ) {
726                 *erroff = p - buffer;
727                 return -8; /* nested display hints */
728             }
729             disphint = p;
730         }
731         else if( *p == ']' ) {
732             if( !disphint ) {
733                 *erroff = p - buffer;
734                 return -9; /* unmatched display hint close */
735             }
736             disphint = NULL;
737         }
738         else if( isdigit(*p) ) {
739             if( *p == '0' ) { /* a length may not begin with zero */
740                 *erroff = p - buffer;
741                 return -7;
742             }
743             digptr = p;
744         }
745         else if( strchr( tokenchars, *p ) )
746             tokenp = p;
747         else if( isspace(*p) )
748             ;
749         else if( *p == '{' ) {
750             /* fixme: handle rescanning:
751              * we can do this by saving our current state
752              * and start over at p+1 -- Hmmm. At this point here
753              * we are in a well defined state, so we don't need to save
754              * it.  Great.
755              */
756             *erroff = p - buffer;
757             return -10; /* unexpected reserved punctuation */
758         }
759         else if( strchr( "&\\", *p ) ) { /*reserved punctuation*/
760             *erroff = p - buffer;
761             return -10; /* unexpected reserved punctuation */
762         }
763         else { /* bad or unavailable*/
764             *erroff = p - buffer;
765             return -5;
766         }
767
768     }
769     *retsexp = head;
770     return 0;
771 }
772
773
774 /****************
775  * Print SEXP to buffer using the MODE.  Returns the length of the
776  * SEXP in buffer or 0 if the buffer is too short (We have at least an
777  * empty list consisting of 2 bytes).  If a buffer of NULL is provided,
778  * the required length is returned.
779  */
780 size_t
781 gcry_sexp_sprint( GCRY_SEXP sexp, int mode, char *buffer, size_t maxlength )
782 {
783     return 0;
784 }
785
786
787
788
789
790 #if 0
791 /***********************************************************/
792
793 const char *
794 strusage( int level )
795 {
796     return default_strusage(level);
797 }
798
799
800 static int
801 sexp_to_pk( GCRY_SEXP sexp, int want_private, MPI **retarray, int *retalgo)
802 {
803     GCRY_SEXP list, l2;
804     const char *name;
805     const char *s;
806     size_t n;
807     int i, idx;
808     int algo;
809     const char *elems1, *elems2;
810     GCRY_MPI *array;
811     static struct { const char* name; int algo;
812                     const char* common_elements;
813                     const char* public_elements;
814                     const char* secret_elements;
815                   } algos[] = {
816         {  "dsa"            , PUBKEY_ALGO_DSA       , "pqgy", "", "x"    },
817         {  "rsa"            , PUBKEY_ALGO_RSA       , "ne",   "", "dpqu" },
818         {  "openpgp-dsa"    , PUBKEY_ALGO_DSA       , "pqgy", "", "x"    },
819         {  "openpgp-rsa"    , PUBKEY_ALGO_RSA       , "pqgy", "", "x"    },
820         {  "openpgp-elg"    , PUBKEY_ALGO_ELGAMAL_E , "pgy",  "", "x"    },
821         {  "openpgp-elg-sig", PUBKEY_ALGO_ELGAMAL   , "pgy",  "", "x"    },
822         {  NULL }};
823
824     /* check that the first element is valid */
825     list = gcry_sexp_find_token( sexp, want_private? "private-key"
826                                                     :"public-key", 0 );
827     if( !list )
828         return -1; /* Does not contain a public- or private-key object */
829     list = gcry_sexp_cdr( list );
830     if( !list )
831         return -2; /* no cdr for the key object */
832     name = gcry_sexp_car_data( list, &n );
833     if( !name )
834         return -3; /* invalid structure of object */
835     fprintf(stderr, "algorithm name: `%.*s'\n", (int)n, name );
836     for(i=0; (s=algos[i].name); i++ ) {
837         if( strlen(s) == n && !memcmp( s, name, n ) )
838             break;
839     }
840     if( !s )
841         return -4; /* unknown algorithm */
842     algo = algos[i].algo;
843     elems1 = algos[i].common_elements;
844     elems2 = want_private? algos[i].secret_elements : algos[i].public_elements;
845     array = m_lib_alloc_clear( (strlen(elems1)+strlen(elems2)+1) * sizeof *array );
846     idx = 0;
847     for(s=elems1; *s; s++, idx++ ) {
848         l2 = gcry_sexp_find_token( list, s, 1 );
849         if( !l2 ) {
850             m_lib_free( array );
851             return -5; /* required parameter not found */
852         }
853         array[idx] = gcry_sexp_cdr_mpi( l2, GCRYMPI_FMT_USG );
854         if( !array[idx] ) {
855             m_lib_free( array );
856             return -6; /* required parameter is invalid */
857         }
858     }
859     for(s=elems2; *s; s++, idx++ ) {
860         l2 = gcry_sexp_find_token( list, s, 1 );
861         if( !l2 ) {
862             m_lib_free( array );
863             return -5; /* required parameter not found */
864         }
865         /* FIXME: put the MPI in secure memory when needed */
866         array[idx] = gcry_sexp_cdr_mpi( l2, GCRYMPI_FMT_USG );
867         if( !array[idx] ) {
868             m_lib_free( array );
869             return -6; /* required parameter is invalid */
870         }
871     }
872
873     *retarray = array;
874     *retalgo = algo;
875
876     return 0;
877 }
878
879
880
881 int
882 main(int argc, char **argv)
883 {
884     char buffer[5000];
885     size_t erroff;
886     int rc, n;
887     FILE *fp;
888     GCRY_SEXP s_pk, s_dsa, s_p, s_q, s_g, s_y, sexp;
889
890   #if 0
891     fp = stdin;
892     n = fread(buffer, 1, 5000, fp );
893     rc = gcry_sexp_sscan( &sexp, buffer, n, &erroff );
894     if( rc ) {
895         fprintf(stderr, "parse error %d at offset %u\n", rc, erroff );
896         exit(1);
897     }
898     fputs("We have this S-Exp:\n",stderr);
899     dump_sexp( sexp );
900   #else
901     s_pk = SEXP_NEW( "public-key", 10 );
902     fputs("pk:\n",stderr);dump_sexp( s_pk );
903     s_dsa = SEXP_NEW( "dsa", 3 );
904     s_p = SEXP_CONS( SEXP_NEW( "p", 1 ), SEXP_NEW( "PPPPPP", 6 ) );
905     fputs("p:\n",stderr);dump_sexp( s_p );
906     s_y = SEXP_CONS( SEXP_NEW( "y", 1 ), SEXP_NEW( "YYYYYYYY", 8 ) );
907     fputs("y:\n",stderr);dump_sexp( s_y );
908     s_q = gcry_sexp_new_name_data( "q", "QQQ", 3 );
909     fputs("q:\n",stderr);dump_sexp( s_q );
910     s_g = gcry_sexp_new_name_mpi( "g" , gcry_mpi_set_ui(NULL, 42) );
911     fputs("g:\n",stderr);dump_sexp( s_g );
912     sexp = SEXP_CONS( s_pk, gcry_sexp_vlist( s_dsa,
913                                              s_y,
914                                              s_p,
915                                              s_q,
916                                              s_g,
917                                              NULL ));
918     fputs("Here is what we have:\n",stderr);
919     dump_sexp( sexp );
920   #endif
921
922     /* now find something */
923     if( argc > 1 )
924       {
925         GCRY_SEXP s1;
926
927         s1 = gcry_sexp_find_token( sexp, argv[1], strlen(argv[1]) );
928         if( !s1 )
929           {
930             fprintf(stderr, "didn't found `%s'\n", argv[1] );
931           }
932         else
933           {
934             fprintf(stderr, "found `%s':\n", argv[1] );
935             dump_sexp( s1 );
936           }
937
938         #if 1
939         {  int i,rc, algo;
940            GCRY_MPI *array;
941
942            rc = sexp_to_pk( s1, 0, &array, &algo);
943            if( rc )
944               fprintf(stderr, "sexp_to_pk failed: rc=%d\n", rc );
945            else {
946                for(i=0; array[i]; i++ ) {
947                    fprintf(stderr, "MPI[%d]: ", i);
948                    dump_mpi( array[i] );
949                    fprintf(stderr, "\n");
950                }
951             }
952         }
953         #endif
954
955
956         if( argc > 2 ) /* get the MPI out of the list */
957         #if 0
958           {
959             GCRY_SEXP s2;
960             const char *p;
961             size_t n;
962
963             p = gcry_sexp_car_data( s1, &n );
964             if( !p ) {
965                 fputs("no CAR\n", stderr );
966                 exit(1);
967             }
968             fprintf(stderr, "CAR=`%.*s'\n", (int)n, p );
969
970             p = gcry_sexp_cdr_data( s1, &n );
971             if( !p ) {
972                 s2 = gcry_sexp_cdr( s1 );
973                 if( !s2 ) {
974                     fputs("no CDR at all\n", stderr );
975                     exit(1);
976                 }
977                 p = gcry_sexp_car_data( s2, &n );
978             }
979             if( !p ) {
980                 fputs("no CDR data\n", stderr );
981                 exit(1);
982             }
983             fprintf(stderr, "CDR=`%.*s'\n", (int)n, p );
984
985
986
987           }
988         #elif 1
989           {
990             GCRY_SEXP s2;
991             MPI a;
992             const char *p;
993             size_t n;
994
995             fprintf(stderr,"*********************************\n");
996             p = gcry_sexp_car_data( s1, &n );
997             if( !p ) {
998                 fputs("no CAR\n", stderr );
999                 exit(1);
1000             }
1001             fprintf(stderr, "CAR=`%.*s'\n", (int)n, p );
1002             s2 = gcry_sexp_cdr( s1 );
1003             if( !s2 ) {
1004                 fputs("no CDR\n", stderr );
1005                 exit(1);
1006
1007             }
1008             p = gcry_sexp_car_data( s2, &n );
1009             if( !p ) {
1010                 fputs("no data at CAR\n", stderr );
1011                 exit(1);
1012             }
1013             fprintf(stderr, "CAR=`%.*s'\n", (int)n, p );
1014
1015             s2 = gcry_sexp_find_token( s1, argv[2], strlen(argv[2]) );
1016             if( !s2 )
1017             {
1018                fprintf(stderr, "didn't found `%s'\n", argv[2] );
1019                exit(1);
1020             }
1021             p = gcry_sexp_car_data( s2, &n );
1022             if( !p ) {
1023                 fputs("no CAR\n", stderr );
1024                 exit(1);
1025             }
1026             fprintf(stderr, "CAR=`%.*s'\n", (int)n, p );
1027
1028             a = gcry_sexp_cdr_mpi( s2, GCRYMPI_FMT_USG );
1029             if( a ) {
1030                 fprintf(stderr, "MPI: ");
1031                 dump_mpi( a );
1032                 fprintf(stderr, "\n");
1033             }
1034             else
1035                 fprintf(stderr, "cannot cdr a mpi\n" );
1036           }
1037          #else
1038           {    /* print all MPIs */
1039             void *ctx = NULL;
1040             GCRY_SEXP s2;
1041             MPI a;
1042
1043             while( (s2 = gcry_sexp_enum( s1, &ctx, 0 )) )
1044               {
1045                 const char *car_d;
1046                 size_t car_n;
1047
1048                 car_d = gcry_sexp_car_data( s2, &car_n );
1049                 if( car_d ) {
1050                    fprintf(stderr, "CAR: %.*s=", (int)car_n, car_d );
1051                    a = gcry_sexp_cdr_mpi( s2, GCRYMPI_FMT_USG );
1052                    dump_mpi( a );
1053                    fprintf(stderr, "\n");
1054
1055                 }
1056                 else
1057                     fprintf(stderr, "no CAR\n");
1058               }
1059           }
1060          #endif
1061       }
1062     return 0;
1063 }
1064 #endif