1 /*
2 * Copyright (C) 2012, Parrot Foundation.
3 * Copyright (C) 2006, 2007 Steven M. Schweda.
4 */
5
6 /*
7
8 =head1 NAME
9
10 src/platform/vms/entropy.c
11
12 =head1 DESCRIPTION
13
14 Get some entropy from the system, VMS version.
15
16 =head2 Functions
17
18 =over 4
19
20 =cut
21
22 */
23
24 #include "parrot/parrot.h"
25
26 static int vms_get_entropy(char *result, size_t length);
27
28 /* HEADERIZER HFILE: none */
29
30 /*
31
32 =item C<INTVAL Parrot_get_entropy(PARROT_INTERP)>
33
34 Get one INTVAL worth of entropy from the system.
35
36 =cut
37
38 */
39
Parrot_get_entropy(PARROT_INTERP)40 INTVAL Parrot_get_entropy(PARROT_INTERP) {
41 INTVAL entropy;
42 int sts;
43
44 sts = vms_get_entropy((char *)&entropy, sizeof (INTVAL));
45 if (sts != 0) {
46 const char *msg = "Couldn't gather random bytes.";
47 /* This function is called during interp init, so use the GC registry
48 * as a way to figure out interp's initializedness.
49 */
50 if (interp->gc_registry)
51 Parrot_ex_throw_from_c_args(interp, NULL, 1, msg);
52 else
53 PANIC(interp, msg);
54 }
55 return entropy;
56 }
57
58 /****************************************************************************
59 * *
60 * *
61 * VMS Randomness-Gathering Code *
62 * *
63 * *
64 ****************************************************************************/
65
66 /* Slightly modified from the GnuPG for VMS source file [.cipher]rndvms.c .
67 See http://antinode.info/dec/sw/gnupg.html
68 New file by Steven M. Schweda:
69 gnupg-1_4_9a_vms/cipher/rndvms.c VMS-specific "entropy gathering" code.
70 Licensed under the GNU GPL v3
71
72 We see no code here which could be based on cryptlib.
73 */
74
75 /* General includes */
76
77 #include <errno.h>
78 #include <fcntl.h>
79 #include <stdio.h>
80 #include <stdlib.h>
81 #include <string.h>
82 #include <unistd.h>
83
84 #define __NEW_STARLET
85 #include <cmbdef.h>
86 #include <descrip.h>
87 #include <lib$routines.h>
88 #include <psldef.h>
89 #include <starlet.h>
90 #include <stsdef.h>
91
92 #include <clidef.h>
93 #ifndef CLI$M_NOWAIT
94 # define CLI$M_NOWAIT 0x1
95 #endif
96
97 /* The structure containing information on random-data sources. Each
98 * record contains the source and a relative estimate of its usefulness
99 * (weighting) which is used to scale the number of kB of output from the
100 * source (total = data_bytes / usefulness). Usually the weighting is in the
101 * range 1-3 (or 0 for especially useless sources), resulting in a usefulness
102 * rating of 1...3 for each kB of source output (or 0 for the useless
103 * sources).
104 *
105 * If the source is constantly changing (certain types of network statistics
106 * have this characteristic) but the amount of output is small, the weighting
107 * is given as a negative value to indicate that the output should be treated
108 * as if a minimum of 1K of output had been obtained. If the source produces
109 * a lot of output then the scale factor is fractional, resulting in a
110 * usefulness rating of < 1 for each kB of source output.
111 *
112 * In order to provide enough randomness to satisfy the requirements for a
113 * slow poll, we need to accumulate at least 20 points of usefulness (a
114 * typical system should get about 30 points).
115 *
116 *
117 * In order to maximise use of the buffer, the code performs a form of run-
118 * length compression on its input where a repeated sequence of bytes is
119 * replaced by the occurrence count mod 256. Some commands output an awful
120 * lot of whitespace, this measure greatly increases the amount of data we
121 * can fit in the buffer.
122 *
123 * When we scale the weighting using the SC() macro, some preprocessors may
124 * give a division by zero warning for the most obvious expression
125 * 'weight ? 1024 / weight : 0' (and gcc 2.7.2.2 dies with a division by zero
126 * trap), so we define a value SC_0 which evaluates to zero when fed to
127 * '1024 / SC_0' */
128
129 #define SC( weight ) ( 1024 / weight ) /* Scale factor */
130 #define SC_0 16384 /* SC( SC_0 ) evalutes to 0 */
131
132
133 #define G_BUFSIZE 32767 /* Size of command-output buffer. */
134
135
136 static struct RI {
137 const char *cmd; /* Command */
138 const int usefulness; /* Usefulness of source */
139 int length; /* Quantity of output produced */
140 } dataSources[] = {
141
142 { "show system", SC(1), 0 },
143 { "show device /full d", SC(1), 0 },
144 { "show network /full", SC(2), 0 },
145 { NULL, 0, 0 }
146 };
147
148 /* Buffer for gathering "random" noise. */
149
150 static char g_buffer[ G_BUFSIZE+ 1024];
151 static int g_byte_count = 0;
152 static int g_byte_used_count = 0;
153
154 static int src_ndx = 0; /* Next command to spawn. */
155 static int spwn_pid;
156 static char lnm_mbx[ 32];
157 static struct dsc$descriptor_s cmd_dscr =
158 { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, (char *) NULL };
159
160 static $DESCRIPTOR(lnm_mbx_dscr, lnm_mbx);
161 static $DESCRIPTOR(nla0_dscr, "NLA0:");
162
163
164 static unsigned short chan_mbx = 0;
165 static int fd_mbx = -1;
166 static char *dbgfn;
167 static FILE *dbgfp = NULL;
168
169 #define GR_MIN(a, b) (((a) > (b)) ? (b) : (a))
170
171
172 #define MBX_BASE_NAME "MBX_PARROT_ENTROPY_"
173
174 /*
175
176 =item C<static int rndvms_gather_random(char *buffer, size_t length, int level)>
177
178 buffer buffer to copy into
179
180 length: bytes requested
181
182 level: source code. (See random.c: add_randomness().)
183 0 - used ony for initialization
184 1 - fast random poll function
185 2 - normal poll function
186 3 - used when level 2 random quality has been requested
187 to do an extra pool seed. (unused)
188
189 =cut
190
191 */
192
193 static int
rndvms_gather_random(char * buffer,size_t length,int level)194 rndvms_gather_random(char *buffer, size_t length, int level)
195 {
196 char *gbp1;
197 char *gbp2;
198 char *gbpe;
199 char gbc;
200 int gbc_count;
201 int n;
202 int sts;
203 int spwn_flgs = CLI$M_NOWAIT;
204
205 /****************
206 * Using a level of 0 should never block and better add nothing
207 * to the pool. So this is just a dummy for this gatherer.
208 */
209 if (level == 0)
210 return 0;
211
212
213 /* Create the mailbox (once for the process). */
214 if (chan_mbx == 0)
215 {
216 /* Open debug file, if specified. */
217 dbgfn = getenv("PARROT_RND_DEBUG");
218 if (dbgfn != NULL)
219 {
220 if (strcmp(dbgfn, "-") == 0)
221 {
222 dbgfp = stdout;
223 }
224 else
225 {
226 dbgfp = fopen(dbgfn, "w");
227 if (dbgfp == NULL)
228 {
229 fprintf(stderr,
230 "rndvms() Can't open (write) rnd debug file \"%s\".\n %s\n",
231 dbgfn, strerror(errno));
232 }
233 }
234 }
235
236 /* Form the (process-unique) mailbox logical name. */
237 sprintf(lnm_mbx, "%s%08x", MBX_BASE_NAME, getpid());
238 lnm_mbx_dscr.dsc$w_length = sizeof MBX_BASE_NAME - 1 + 8;
239
240 /* If target mailbox already exists (left-over), read/waste any
241 pending data, and close and delete the old mailbox.
242 */
243 fd_mbx = open(lnm_mbx, O_RDONLY, 0);
244 if (fd_mbx >= 0)
245 {
246 if (dbgfp)
247 {
248 fprintf(dbgfp,
249 "rndvms() Process mailbox (%s) unexpectedly exists.\n",
250 lnm_mbx);
251 fprintf(dbgfp, "rndvms() Wasting data ...");
252 fflush(dbgfp);
253 }
254
255 while (read(fd_mbx, g_buffer, 1024));
256 close(fd_mbx);
257 if (dbgfp)
258 {
259 fprintf(dbgfp, " done.\n");
260 fflush(dbgfp);
261 }
262 }
263
264 sts = sys$crembx(0, /* Temporary mailbox. */
265 &chan_mbx, /* Channel. */
266 0, /* Max msg size (default). */
267 0, /* Msg buf quota (default). */
268 0x00f0, /* Prot = O:LPWR. */
269 PSL$C_USER, /* Access mode, */
270 &lnm_mbx_dscr, /* Logical name. */
271 CMB$M_READONLY, /* Flags. */
272 0); /* Reserved. */
273
274 if (dbgfp)
275 {
276 fprintf(dbgfp,
277 "rndvms() Create process mailbox (%s). sts = %%x%08x .\n",
278 lnm_mbx, sts);
279 fflush(dbgfp);
280 }
281
282 if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
283 {
284 errno = EVMSERR;
285 vaxc$errno = sts;
286 return -1;
287 }
288 }
289
290 if (dbgfp)
291 {
292 fprintf(dbgfp,
293 "rndvms() len = %d, lev = %d. Bytes avail = %d\n",
294 length, level, (g_byte_count- g_byte_used_count));
295 fflush(dbgfp);
296 }
297
298 /* While more data remain to be supplied, supply them. */
299 while (length > 0)
300 {
301 if (g_byte_count > g_byte_used_count)
302 {
303 /* Data are available (left-over?). Use them (first). */
304 n = GR_MIN(length, (g_byte_count- g_byte_used_count));
305
306 /* Call the consumer's buffer-stuffer. */
307 if (dbgfp)
308 {
309 fprintf(dbgfp,
310 "rndvms() Adding %d \"random\" bytes.\n", n);
311 fflush(dbgfp);
312 }
313
314 memcpy(buffer, &g_buffer[ g_byte_used_count], n);
315
316 g_byte_used_count += n;
317 length -= n;
318 buffer += n;
319 }
320 else
321 {
322 /* Need more data. Reset byte counts and buffer pointer. */
323 g_byte_count = 0;
324 g_byte_used_count = 0;
325 gbp1 = g_buffer;
326
327 if (fd_mbx > 0)
328 {
329 /* Mailbox still open. Re-stock the gather buffer. */
330 while ((fd_mbx > 0) && (g_byte_count < G_BUFSIZE))
331 {
332 /* Read data while there are more data to read,
333 and space is available in the buffer.
334 */
335 while (((sts = read(fd_mbx,
336 &g_buffer[ g_byte_count], /* gbp1 */
337 (G_BUFSIZE- g_byte_count))) > 0) &&
338 (G_BUFSIZE- g_byte_count > 0))
339 {
340 gbc_count = sts;
341 /* Strip off the terminal newline character. */
342 if (g_buffer[ g_byte_count+ gbc_count- 1] == '\n')
343 {
344 gbc_count--;
345 }
346
347 /* Collapse repeated characters to a byte count
348 (mod 256). gbp1 = dest, gbp2 = source.
349 */
350 gbp2 = gbp1;
351 gbpe = gbp2+ gbc_count;
352 while (gbp2 < gbpe)
353 {
354 gbc = *gbp2;
355 if (gbc != *(gbp2+ 1))
356 {
357 /* Next byte differs. Use this one. */
358 *(gbp1++) = *(gbp2++);
359 }
360 else
361 {
362 gbc_count = 0;
363 while ((*gbp2 == gbc) && (gbp2 < gbpe))
364 {
365 gbc_count++;
366 gbp2++;
367 }
368 *(gbp1++) = gbc_count;
369 }
370 }
371 g_byte_count = gbp1- g_buffer;
372 }
373 /* If the current data source is exhausted,
374 close the mailbox.
375 */
376 if (sts <= 0)
377 {
378 sts = close(fd_mbx);
379 fd_mbx = 0;
380 }
381 }
382 }
383 else
384 {
385 /* Mailbox closed. Set the command descriptor to the
386 next command.
387 */
388 cmd_dscr.dsc$a_pointer = (char *) dataSources[ src_ndx].cmd;
389 cmd_dscr.dsc$w_length = strlen(cmd_dscr.dsc$a_pointer);
390
391
392 /* Run the next command, and open the mailbox. */
393 if (dbgfp)
394 {
395 fprintf(dbgfp,
396 "rndvms() Spawning: %.*s\n",
397 cmd_dscr.dsc$w_length, cmd_dscr.dsc$a_pointer);
398 fflush(dbgfp);
399 }
400
401 sts = lib$spawn(&cmd_dscr, /* Command. */
402 &nla0_dscr, /* SYS$INPUT */
403 &lnm_mbx_dscr, /* SYS$OUTPUT */
404 &spwn_flgs, /* Flags. 1 = NOWAIT. */
405 0, /* Process name */
406 &spwn_pid, /* Process ID */
407 0, /* Completion status */
408 0, /* Event flag */
409 0, /* AST address */
410 0, /* AST argument */
411 0, /* Prompt string */
412 0, /* CLI */
413 0); /* command table */
414
415 if ((sts& STS$M_SEVERITY) == STS$K_SUCCESS)
416 {
417 fd_mbx = open(lnm_mbx, O_RDONLY, 0);
418 if (fd_mbx < 0)
419 {
420 return -1;
421 }
422 src_ndx++;
423 if (dataSources[ src_ndx].cmd == NULL)
424 {
425 /* Command list exhausted. Start over. */
426 src_ndx = 0;
427 }
428 }
429 else
430 {
431 errno = EVMSERR;
432 vaxc$errno = sts;
433 return -1;
434 }
435 }
436 }
437 }
438 return 0;
439 }
440
441 /*
442
443 =item C<static int vms_get_entropy(char *result, size_t length)>
444
445 Call I<rndvms_gather_random()> until the entropy buffer
446 has size length.
447
448 =cut
449
450 */
451
452 static int
vms_get_entropy(char * result,size_t length)453 vms_get_entropy(char *result, size_t length)
454 {
455 char buffer [ 1 << 12 ];
456 int sts, sz, i;
457
458 if (length > sizeof (buffer))
459 return -1;
460
461 sts = rndvms_gather_random(buffer, sizeof (buffer) -1, 3);
462 if (sts != 0)
463 return sts;
464
465 for (sz = sizeof (buffer) >> 1; sz > length; sz >>= 1)
466 {
467 for (i = 0; i < sz; ++i)
468 buffer[i] ^= buffer[sz+i];
469 }
470 memcpy(result, buffer, length);
471
472 return 0;
473 }
474
475 #ifdef TEST_RNDVMS
476
477 # include <stdlib.h>
478
479 /*
480
481 =item C<int main(int argc, char **argv, char **envp)>
482
483 Compile with /Define=TEST_RNDVMS
484
485 =back
486
487 =cut
488
489 */
490
491 int
main(int argc,char ** argv,char ** envp)492 main(int argc, char **argv, char **envp)
493 {
494 INTVAL entropy;
495 int sts;
496
497 sts = vms_get_entropy((char *)&entropy, sizeof (INTVAL));
498 if (sts != 0)
499 return EXIT_FAILURE;
500
501 printf("%o\n", entropy);
502 return EXIT_SUCCESS;
503 }
504 #endif
505
506 /*
507 * Local variables:
508 * c-file-style: "parrot"
509 * End:
510 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
511 */
512