660b443c |
1 | /* -*-c-*- |
2 | * |
a1a90aaf |
3 | * $Id$ |
660b443c |
4 | * |
5 | * Utilities for Catacomb/Perl |
6 | * |
7 | * (c) 2001 Straylight/Edgeware |
8 | */ |
9 | |
10 | /*----- Licensing notice --------------------------------------------------* |
11 | * |
12 | * This file is part of the Perl interface to Catacomb. |
13 | * |
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. |
18 | * |
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. |
23 | * |
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. |
27 | */ |
28 | |
660b443c |
29 | /*----- Header files ------------------------------------------------------*/ |
30 | |
31 | #include "catacomb-perl.h" |
f9952aec |
32 | #include <catacomb/ec-guts.h> |
33 | #include <catacomb/group-guts.h> |
34 | #include <catacomb/field-guts.h> |
fcd15e0b |
35 | #include <catacomb/ectab.h> |
36 | #include <catacomb/ptab.h> |
37 | #include <catacomb/bintab.h> |
660b443c |
38 | |
fcd15e0b |
39 | /*----- Lists of things ---------------------------------------------------*/ |
40 | |
41 | #define LISTS(LI) \ |
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) |
53 | |
54 | #define XLISTFN(what, endp, name) \ |
55 | static void list##what(void) \ |
56 | { \ |
57 | int i; \ |
58 | dSP; \ |
59 | for (i = 0; endp; i++) \ |
60 | XPUSHs(sv_2mortal(newSVpv(name, 0))); \ |
61 | PUTBACK; \ |
62 | } |
63 | |
64 | #define ENTRY(what, endp, name) { #what, list##what }, |
65 | |
66 | struct listent { |
67 | const char *name; |
68 | void (*list)(void); |
69 | }; |
70 | |
71 | static const struct listent lists[]; |
72 | |
73 | LISTS(XLISTFN) |
74 | |
75 | static const struct listent lists[] = { |
76 | LISTS(ENTRY) |
77 | { 0, 0 } |
78 | }; |
79 | |
80 | void names(const char *name) |
81 | { |
82 | int i; |
83 | |
84 | for (i = 0; lists[i].name; i++) { |
85 | if (strcmp(name, lists[i].name) == 0) { |
86 | lists[i].list(); |
87 | return; |
88 | } |
89 | } |
90 | croak("unknown list `%s'", name); |
91 | } |
92 | |
93 | /*----- Miscellaneous things ----------------------------------------------*/ |
660b443c |
94 | |
95 | U32 findconst(const struct consttab *cc, const char *pkg, const char *name) |
96 | { |
97 | const char *p; |
98 | if ((p = strrchr(name, ':')) != 0) |
99 | name = p + 1; |
100 | while (cc->name) { |
101 | if (strcmp(cc->name, name) == 0) |
102 | return (cc->val); |
103 | cc++; |
104 | } |
105 | croak("unknown %s constant `%s'", pkg, name); |
106 | } |
107 | |
a1a90aaf |
108 | void ptrtosv(SV **sv, void *p, const char *type) |
109 | { |
110 | if (p) |
111 | sv_setref_pv(*sv, type, (void *)p); |
112 | else |
113 | *sv = &PL_sv_undef; |
114 | } |
115 | |
116 | void *ptrfromsv(SV *sv, const char *type, const char *what, ...) |
117 | { |
118 | if (!sv_derived_from(sv, type)) { |
119 | va_list ap; |
120 | SV *t = sv_newmortal(); |
121 | va_start(ap, what); |
122 | sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0); |
123 | croak("%s is not of type %s", SvPVX(t), type); |
124 | } |
125 | return (void *)SvIV((SV *)SvRV(sv)); |
126 | } |
127 | |
fcd15e0b |
128 | void *ptrfromsvdflt(SV *sv, const char *type, void *dflt, const char *what) |
129 | { |
130 | if (!SvOK(sv)) |
131 | return (dflt); |
132 | else |
133 | return (ptrfromsv(sv, type, "%s", what)); |
134 | } |
135 | |
136 | /*----- Cursor reading stuff ----------------------------------------------*/ |
137 | |
138 | void c_init(cursor *c, SV *sv) |
139 | { |
140 | if (!SvROK(sv)) |
141 | croak("not a reference"); |
142 | sv = SvRV(sv); |
143 | switch (SvTYPE(sv)) { |
144 | case SVt_PVAV: |
145 | c->f = CF_ARRAY; |
146 | c->u.a.av = (AV *)sv; |
147 | c->u.a.i = 0; |
148 | break; |
149 | case SVt_PVHV: |
150 | c->f = CF_HASH; |
151 | c->u.hv = (HV *)sv; |
152 | break; |
153 | default: |
154 | croak("must be hash ref or array ref"); |
155 | } |
156 | } |
157 | |
158 | void c_skip(cursor *c) |
159 | { |
160 | if (!(c->f & CF_HASH)) |
161 | c->u.a.i++; |
162 | } |
163 | |
164 | SV *c_get(cursor *c, const char *tag, unsigned f) |
165 | { |
166 | SV **sv; |
167 | |
168 | if (c->f & CF_HASH) |
169 | sv = hv_fetch(c->u.hv, tag, strlen(tag), 0); |
170 | else { |
171 | sv = av_fetch(c->u.a.av, c->u.a.i, 0); |
172 | if (sv) c->u.a.i++; |
173 | } |
174 | if ((f & CF_MUST) && !sv) |
175 | croak("missing entry `%s'", tag); |
176 | return (sv ? *sv : &PL_sv_undef); |
177 | } |
178 | |
179 | void hvput(HV *hv, const char *k, SV *val) |
180 | { |
181 | SV **sv = hv_fetch(hv, k, strlen(k), 1); |
182 | if (!sv) |
183 | croak("couldn't set hash key %s", k); |
184 | *sv = val; |
185 | } |
186 | |
187 | /*----- Wrapped objects ---------------------------------------------------*/ |
188 | |
189 | static SV *firstelt(SV *sv, const char *what) |
190 | { |
191 | AV *av; |
192 | SV **svp; |
193 | |
194 | if (!SvROK(sv)) |
195 | croak("%s is not a reference", what); |
196 | sv = SvRV(sv); |
197 | if (SvTYPE(sv) != SVt_PVAV) |
198 | croak("%s is not an array reference", what); |
199 | av = (AV *)sv; |
200 | svp = av_fetch(av, 0, 0); |
201 | if (!svp) |
202 | croak("%s is empty", what); |
203 | return (*svp); |
204 | } |
205 | |
206 | ge *groupelt(SV *sv, const char *what) |
207 | { |
208 | if (sv_derived_from(sv, "Catacomb::Group::Elt")) |
209 | sv = firstelt(sv, what); |
210 | return (ptrfromsv(sv, "Catacomb::Group::Element", what)); |
211 | } |
212 | |
213 | mp *fieldelt(SV *sv, const char *what) |
214 | { |
215 | if (sv_derived_from(sv, "Catacomb::Field::Elt")) |
216 | sv = firstelt(sv, what); |
217 | return (mp_fromsv(sv, what, 0, 0)); |
218 | } |
219 | |
220 | ec *ecpt(SV *sv, const char *what) |
221 | { |
222 | if (sv_derived_from(sv, "Catacomb::EC::Pt")) |
223 | sv = firstelt(sv, what); |
224 | return (ptrfromsv(sv, "Catacomb::EC::Point", what)); |
225 | } |
226 | |
227 | /*----- DSA contexts ------------------------------------------------------*/ |
228 | |
229 | void gdsa_privfromsv(gdsa *g, SV *sv) |
230 | { |
231 | cursor c; |
232 | |
233 | c_init(&c, 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); |
239 | } |
240 | |
241 | void gdsa_pubfromsv(gdsa *g, SV *sv) |
242 | { |
243 | cursor c; |
244 | |
245 | c_init(&c, sv); |
246 | g->g = C_PTR(&c, "G", "Catacomb::Group"); |
247 | g->p = C_GE(&c, "p"); |
248 | c_skip(&c); |
249 | g->h = C_PTR(&c, "h", "Catacomb::HashClass"); |
250 | g->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global); |
251 | } |
252 | |
253 | /*----- RSA padding contexts ----------------------------------------------*/ |
254 | |
255 | void pkcs1_fromsv(pkcs1 *p, SV *sv) |
256 | { |
257 | cursor c; |
258 | STRLEN len; |
259 | SV *t; |
260 | |
261 | c_init(&c, sv); |
262 | t = c_get(&c, "ep", 0); |
263 | if (SvOK(t)) { |
264 | p->ep = SvPV(t, len); |
265 | p->epsz = len; |
266 | } else { |
267 | p->ep = 0; |
268 | p->epsz = 0; |
269 | } |
270 | p->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global); |
271 | } |
272 | |
273 | void oaep_fromsv(oaep *p, SV *sv) |
274 | { |
275 | cursor c; |
276 | STRLEN len; |
277 | SV *t; |
278 | |
279 | c_init(&c, 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); |
283 | if (SvOK(t)) { |
284 | p->ep = SvPV(t, len); |
285 | p->epsz = len; |
286 | } else { |
287 | p->ep = 0; |
288 | p->epsz = 0; |
289 | } |
290 | p->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global); |
291 | } |
292 | |
293 | void pss_fromsv(pss *p, SV *sv) |
294 | { |
295 | cursor c; |
296 | STRLEN len; |
297 | SV *t; |
298 | |
299 | c_init(&c, 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); |
305 | } |
306 | |
f9952aec |
307 | /*----- Reconstructing various objects ------------------------------------*/ |
308 | |
fcd15e0b |
309 | static SV *collect(SV *thing, ...) |
310 | { |
311 | va_list ap; |
312 | AV *av; |
313 | |
314 | va_start(ap, thing); |
315 | av = newAV(); |
316 | while (thing) { |
317 | av_push(av, thing); |
318 | thing = va_arg(ap, SV *); |
319 | } |
320 | va_end(ap); |
321 | return (newRV_noinc((SV *)av)); |
322 | } |
323 | |
f9952aec |
324 | /* --- Somewhat unpleasant, really --- */ |
325 | |
fcd15e0b |
326 | SV *info_field(field *f) |
327 | { |
328 | const char *n = F_NAME(f); |
329 | |
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])), |
338 | (SV *)0)); |
339 | } else |
340 | return (&PL_sv_undef); |
341 | } |
342 | |
f9952aec |
343 | field *copy_field(field *f) |
344 | { |
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]); |
354 | } else |
355 | f = 0; |
356 | return (f); |
357 | } |
358 | |
fcd15e0b |
359 | SV *info_curve(ec_curve *c) |
360 | { |
361 | field *f = c->f; |
362 | const char *n = EC_NAME(c); |
363 | SV *fsv; |
364 | mp *a, *b; |
365 | |
366 | fsv = info_field(f); |
367 | if (!SvOK(fsv)) |
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)); |
374 | else { |
375 | MP_DROP(a); |
376 | MP_DROP(b); |
377 | SvREFCNT_dec(fsv); |
378 | return (&PL_sv_undef); |
379 | } |
380 | } |
381 | |
f9952aec |
382 | ec_curve *copy_curve(ec_curve *c) |
383 | { |
384 | field *f; |
385 | mp *a, *b; |
386 | |
387 | if ((f = copy_field(c->f)) == 0) |
388 | return (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); |
fcd15e0b |
395 | else if (strcmp(EC_NAME(c), "bin") == 0) |
f9952aec |
396 | c = ec_bin(f, a, b); |
397 | else if (strcmp(EC_NAME(c), "binproj") == 0) |
398 | c = ec_binproj(f, a, b); |
399 | else |
400 | c = 0; |
401 | MP_DROP(a); |
402 | MP_DROP(b); |
403 | if (!c) F_DESTROY(f); |
404 | return (c); |
405 | } |
406 | |
fcd15e0b |
407 | SV *info_group(group *g) |
408 | { |
409 | const char *n = G_NAME(g); |
410 | |
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)), |
417 | (SV *)0)); |
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)), |
424 | (SV *)0)); |
425 | } else if (strcmp(n, "ec") == 0) { |
426 | gctx_ec *gc = (gctx_ec *)g; |
427 | SV *csv = info_curve(gc->ei.c); |
428 | ec *gen; |
429 | if (!SvOK(csv)) |
430 | return (&PL_sv_undef); |
431 | gen = CREATE(ec); |
432 | EC_CREATE(gen); |
433 | EC_COPY(gen, &gc->ei.g); |
434 | return (collect(newSVpv(n, 0), |
435 | csv, |
436 | MAKE(gen, "Catacomb::EC::Point"), |
437 | MAKE_MP(MP_COPY(gc->ei.r)), |
438 | MAKE_MP(MP_COPY(gc->ei.h)), |
439 | (SV *)0)); |
440 | } else |
441 | return (&PL_sv_undef); |
442 | } |
443 | |
f9952aec |
444 | group *copy_group(group *g) |
445 | { |
446 | if (strcmp(G_NAME(g), "prime") == 0) { |
447 | gctx_prime *gc = (gctx_prime *)g; |
448 | gprime_param gp; |
449 | gp.g = G_TOINT(g, MP_NEW, g->g); |
450 | gp.p = gc->mm.m; |
451 | gp.q = gc->g.r; |
452 | g = group_prime(&gp); |
453 | MP_DROP(gp.g); |
fcd15e0b |
454 | } else if (strcmp(G_NAME(g), "bin") == 0) { |
455 | gctx_bin *gc = (gctx_bin *)g; |
456 | gbin_param gb; |
457 | gb.g = G_TOINT(g, MP_NEW, g->g); |
458 | gb.p = gc->r.p; |
459 | gb.q = gc->g.r; |
460 | g = group_binary(&gb); |
461 | MP_DROP(gb.g); |
f9952aec |
462 | } else if (strcmp(G_NAME(g), "ec") == 0) { |
463 | gctx_ec *gc = (gctx_ec *)g; |
464 | ec_info ei; |
465 | if ((ei.c = copy_curve(gc->ei.c)) == 0) |
466 | return (0); |
467 | EC_CREATE(&ei.g); |
468 | EC_COPY(&ei.g, &gc->ei.g); |
469 | ei.r = MP_COPY(gc->ei.r); |
470 | ei.h = MP_COPY(gc->ei.h); |
471 | g = group_ec(&ei); |
472 | } else |
473 | g = 0; |
474 | return (g); |
475 | } |
476 | |
660b443c |
477 | /*----- That's all, folks -------------------------------------------------*/ |