5 * Utilities for Catacomb/Perl
7 * (c) 2001 Straylight/Edgeware
10 /*----- Licensing notice --------------------------------------------------*
12 * This file is part of the Perl interface to Catacomb.
14 * Catacomb/Perl is free software; you can redistribute it and/or modify
15 * it under the terms of the GNU General Public License as published by
16 * the Free Software Foundation; either version 2 of the License, or
17 * (at your option) any later version.
19 * Catacomb/Perl is distributed in the hope that it will be useful,
20 * but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 * GNU General Public License for more details.
24 * You should have received a copy of the GNU General Public License
25 * along with Catacomb/Perl; if not, write to the Free Software Foundation,
26 * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
29 /*----- Header files ------------------------------------------------------*/
31 #include "catacomb-perl.h"
32 #include <catacomb/ec-guts.h>
33 #include <catacomb/group-guts.h>
34 #include <catacomb/field-guts.h>
35 #include <catacomb/ectab.h>
36 #include <catacomb/ptab.h>
37 #include <catacomb/bintab.h>
39 /*----- Lists of things ---------------------------------------------------*/
42 LI(list, lists[i].name, lists[i].name) \
43 LI(hash, ghashtab[i], ghashtab[i]->name) \
44 LI(prp, prptab[i], prptab[i]->name) \
45 LI(cipher, gciphertab[i], gciphertab[i]->name) \
46 LI(mac, gmactab[i], gmactab[i]->name) \
47 LI(mgfrand, mgftab[i].name, mgftab[i].name) \
48 LI(counterrand, ctrtab[i].name, ctrtab[i].name) \
49 LI(ofbrand, ofbtab[i].name, ofbtab[i].name) \
50 LI(ec, ectab[i].name, ectab[i].name) \
51 LI(prime, ptab[i].name, ptab[i].name) \
52 LI(bin, bintab[i].name, bintab[i].name)
54 #define XLISTFN(what, endp, name) \
55 static void list##what(void) \
59 for (i = 0; endp; i++) \
60 XPUSHs(sv_2mortal(newSVpv(name, 0))); \
64 #define ENTRY(what, endp, name) { #what, list##what },
71 static const struct listent lists
[];
75 static const struct listent lists
[] = {
80 void names(const char *name
)
84 for (i
= 0; lists
[i
].name
; i
++) {
85 if (strcmp(name
, lists
[i
].name
) == 0) {
90 croak("unknown list `%s'", name
);
93 /*----- Miscellaneous things ----------------------------------------------*/
95 U32
findconst(const struct consttab
*cc
, const char *pkg
, const char *name
)
98 if ((p
= strrchr(name
, ':')) != 0)
101 if (strcmp(cc
->name
, name
) == 0)
105 croak("unknown %s constant `%s'", pkg
, name
);
108 void ptrtosv(SV
**sv
, void *p
, const char *type
)
111 sv_setref_pv(*sv
, type
, (void *)p
);
116 void *ptrfromsv(SV
*sv
, const char *type
, const char *what
, ...)
118 if (!sv_derived_from(sv
, type
)) {
120 SV
*t
= sv_newmortal();
122 sv_vsetpvfn(t
, what
, strlen(what
), &ap
, 0, 0, 0);
123 croak("%s is not of type %s", SvPVX(t
), type
);
125 return (void *)SvIV((SV
*)SvRV(sv
));
128 void *ptrfromsvdflt(SV
*sv
, const char *type
, void *dflt
, const char *what
)
133 return (ptrfromsv(sv
, type
, "%s", what
));
136 /*----- Cursor reading stuff ----------------------------------------------*/
138 void c_init(cursor
*c
, SV
*sv
)
141 croak("not a reference");
143 switch (SvTYPE(sv
)) {
146 c
->u
.a
.av
= (AV
*)sv
;
154 croak("must be hash ref or array ref");
158 void c_skip(cursor
*c
)
160 if (!(c
->f
& CF_HASH
))
164 SV
*c_get(cursor
*c
, const char *tag
, unsigned f
)
169 sv
= hv_fetch(c
->u
.hv
, tag
, strlen(tag
), 0);
171 sv
= av_fetch(c
->u
.a
.av
, c
->u
.a
.i
, 0);
174 if ((f
& CF_MUST
) && !sv
)
175 croak("missing entry `%s'", tag
);
176 return (sv ?
*sv
: &PL_sv_undef
);
179 void hvput(HV
*hv
, const char *k
, SV
*val
)
181 SV
**sv
= hv_fetch(hv
, k
, strlen(k
), 1);
183 croak("couldn't set hash key %s", k
);
187 /*----- Wrapped objects ---------------------------------------------------*/
189 static SV
*firstelt(SV
*sv
, const char *what
)
195 croak("%s is not a reference", what
);
197 if (SvTYPE(sv
) != SVt_PVAV
)
198 croak("%s is not an array reference", what
);
200 svp
= av_fetch(av
, 0, 0);
202 croak("%s is empty", what
);
206 ge
*groupelt(SV
*sv
, const char *what
)
208 if (sv_derived_from(sv
, "Catacomb::Group::Elt"))
209 sv
= firstelt(sv
, what
);
210 return (ptrfromsv(sv
, "Catacomb::Group::Element", what
));
213 mp
*fieldelt(SV
*sv
, const char *what
)
215 if (sv_derived_from(sv
, "Catacomb::Field::Elt"))
216 sv
= firstelt(sv
, what
);
217 return (mp_fromsv(sv
, what
, 0, 0));
220 ec
*ecpt(SV
*sv
, const char *what
)
222 if (sv_derived_from(sv
, "Catacomb::EC::Pt"))
223 sv
= firstelt(sv
, what
);
224 return (ptrfromsv(sv
, "Catacomb::EC::Point", what
));
227 /*----- DSA contexts ------------------------------------------------------*/
229 void gdsa_privfromsv(gdsa
*g
, SV
*sv
)
234 g
->g
= C_PTR(&c
, "G", "Catacomb::Group");
235 g
->p
= C_GE(&c
, "p");
236 g
->u
= C_MP(&c
, "u");
237 g
->h
= C_PTR(&c
, "h", "Catacomb::HashClass");
238 g
->r
= C_PTRDFLT(&c
, "rng", "Catacomb::Rand", &rand_global
);
241 void gdsa_pubfromsv(gdsa
*g
, SV
*sv
)
246 g
->g
= C_PTR(&c
, "G", "Catacomb::Group");
247 g
->p
= C_GE(&c
, "p");
249 g
->h
= C_PTR(&c
, "h", "Catacomb::HashClass");
250 g
->r
= C_PTRDFLT(&c
, "rng", "Catacomb::Rand", &rand_global
);
253 /*----- RSA padding contexts ----------------------------------------------*/
255 void pkcs1_fromsv(pkcs1
*p
, SV
*sv
)
262 t
= c_get(&c
, "ep", 0);
264 p
->ep
= SvPV(t
, len
);
270 p
->r
= C_PTRDFLT(&c
, "rng", "Catacomb::Rand", &rand_global
);
273 void oaep_fromsv(oaep
*p
, SV
*sv
)
280 p
->cc
= C_PTR(&c
, "c", "Catacomb::CipherClass");
281 p
->ch
= C_PTR(&c
, "h", "Catacomb::HashClass");
282 t
= c_get(&c
, "ep", 0);
284 p
->ep
= SvPV(t
, len
);
290 p
->r
= C_PTRDFLT(&c
, "rng", "Catacomb::Rand", &rand_global
);
293 void pss_fromsv(pss
*p
, SV
*sv
)
300 p
->cc
= C_PTR(&c
, "c", "Catacomb::CipherClass");
301 p
->ch
= C_PTR(&c
, "h", "Catacomb::HashClass");
302 t
= c_get(&c
, "ssz", 0);
303 p
->ssz
= SvOK(t
) ?
SvUV(t
) : p
->ch
->hashsz
;
304 p
->r
= C_PTRDFLT(&c
, "rng", "Catacomb::Rand", &rand_global
);
307 /*----- Reconstructing various objects ------------------------------------*/
309 static SV
*collect(SV
*thing
, ...)
318 thing
= va_arg(ap
, SV
*);
321 return (newRV_noinc((SV
*)av
));
324 /* --- Somewhat unpleasant, really --- */
326 SV
*info_field(field
*f
)
328 const char *n
= F_NAME(f
);
330 if (strcmp(n
, "prime") == 0 || strcmp(n
, "niceprime") == 0 ||
331 strcmp(n
, "binpoly") == 0)
332 return (collect(newSVpv(n
, 0), MAKE_MP(MP_COPY(f
->m
)), (SV
*)0));
333 else if (strcmp(n
, "binnorm") == 0) {
334 fctx_binnorm
*fc
= (fctx_binnorm
*)f
;
335 return (collect(newSVpv(n
, 0),
336 MAKE_MP(MP_COPY(f
->m
)),
337 MAKE_MP(MP_COPY(fc
->ntop
.r
[fc
->ntop
.n
- 1])),
340 return (&PL_sv_undef
);
343 field
*copy_field(field
*f
)
345 if (strcmp(F_NAME(f
), "prime") == 0)
346 f
= field_prime(f
->m
);
347 else if (strcmp(F_NAME(f
), "niceprime") == 0)
348 f
= field_niceprime(f
->m
);
349 else if (strcmp(F_NAME(f
), "binpoly") == 0)
350 f
= field_binpoly(f
->m
);
351 else if (strcmp(F_NAME(f
), "binnorm") == 0) {
352 fctx_binnorm
*fc
= (fctx_binnorm
*)f
;
353 f
= field_binnorm(f
->m
, fc
->ntop
.r
[fc
->ntop
.n
- 1]);
359 SV
*info_curve(ec_curve
*c
)
362 const char *n
= EC_NAME(c
);
368 return (&PL_sv_undef
);
369 a
= F_OUT(f
, MP_NEW
, c
->a
);
370 b
= F_OUT(f
, MP_NEW
, c
->b
);
371 if (strcmp(n
, "prime") == 0 || strcmp(n
, "primeproj") == 0 ||
372 strcmp(n
, "bin") == 0 || strcmp(n
, "binproj") == 0)
373 return (collect(newSVpv(n
, 0), fsv
, MAKE_MP(a
), MAKE_MP(b
), (SV
*)0));
378 return (&PL_sv_undef
);
382 ec_curve
*copy_curve(ec_curve
*c
)
387 if ((f
= copy_field(c
->f
)) == 0)
389 a
= F_OUT(f
, MP_NEW
, c
->a
);
390 b
= F_OUT(f
, MP_NEW
, c
->b
);
391 if (strcmp(EC_NAME(c
), "prime") == 0)
392 c
= ec_prime(f
, a
, b
);
393 else if (strcmp(EC_NAME(c
), "primeproj") == 0)
394 c
= ec_primeproj(f
, a
, b
);
395 else if (strcmp(EC_NAME(c
), "bin") == 0)
397 else if (strcmp(EC_NAME(c
), "binproj") == 0)
398 c
= ec_binproj(f
, a
, b
);
403 if (!c
) F_DESTROY(f
);
407 SV
*info_group(group
*g
)
409 const char *n
= G_NAME(g
);
411 if (strcmp(n
, "prime") == 0) {
412 gctx_prime
*gc
= (gctx_prime
*)g
;
413 return (collect(newSVpv(n
, 0),
414 MAKE_MP(MP_COPY(gc
->mm
.m
)),
415 MAKE_MP(G_TOINT(g
, MP_NEW
, g
->g
)),
416 MAKE_MP(MP_COPY(gc
->g
.r
)),
418 } else if (strcmp(n
, "bin") == 0) {
419 gctx_bin
*gc
= (gctx_bin
*)g
;
420 return (collect(newSVpv(n
, 0),
421 MAKE_MP(MP_COPY(gc
->r
.p
)),
422 MAKE_GF(G_TOINT(g
, MP_NEW
, g
->g
)),
423 MAKE_MP(MP_COPY(gc
->g
.r
)),
425 } else if (strcmp(n
, "ec") == 0) {
426 gctx_ec
*gc
= (gctx_ec
*)g
;
427 SV
*csv
= info_curve(gc
->ei
.c
);
430 return (&PL_sv_undef
);
433 EC_COPY(gen
, &gc
->ei
.g
);
434 return (collect(newSVpv(n
, 0),
436 MAKE(gen
, "Catacomb::EC::Point"),
437 MAKE_MP(MP_COPY(gc
->ei
.r
)),
438 MAKE_MP(MP_COPY(gc
->ei
.h
)),
441 return (&PL_sv_undef
);
444 group
*copy_group(group
*g
)
446 if (strcmp(G_NAME(g
), "prime") == 0) {
447 gctx_prime
*gc
= (gctx_prime
*)g
;
449 gp
.g
= G_TOINT(g
, MP_NEW
, g
->g
);
452 g
= group_prime(&gp
);
454 } else if (strcmp(G_NAME(g
), "bin") == 0) {
455 gctx_bin
*gc
= (gctx_bin
*)g
;
457 gb
.g
= G_TOINT(g
, MP_NEW
, g
->g
);
460 g
= group_binary(&gb
);
462 } else if (strcmp(G_NAME(g
), "ec") == 0) {
463 gctx_ec
*gc
= (gctx_ec
*)g
;
465 if ((ei
.c
= copy_curve(gc
->ei
.c
)) == 0)
468 EC_COPY(&ei
.g
, &gc
->ei
.g
);
469 ei
.r
= MP_COPY(gc
->ei
.r
);
470 ei
.h
= MP_COPY(gc
->ei
.h
);
477 /*----- That's all, folks -------------------------------------------------*/