1 /*
2 * random.c --
3 *
4 * Implementation of a random Tcl file channel
5 *
6 * The PRNG in use here is the ISAAC PRNG. See
7 * http://www.burtleburtle.net/bob/rand/isaacafa.html
8 * for details. This generator _is_ suitable for cryptographic use
9 *
10 * Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
11 *
12 * Permission is hereby granted, without written agreement and without
13 * license or royalty fees, to use, copy, modify, and distribute this
14 * software and its documentation for any purpose, provided that the
15 * above copyright notice and the following two paragraphs appear in
16 * all copies of this software.
17 *
18 * IN NO EVENT SHALL I BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL,
19 * INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS
20 * SOFTWARE AND ITS DOCUMENTATION, EVEN IF I HAVE BEEN ADVISED OF THE
21 * POSSIBILITY OF SUCH DAMAGE.
22 *
23 * I SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
24 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25 * PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
26 * I HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
27 * ENHANCEMENTS, OR MODIFICATIONS.
28 *
29 * CVS: $Id: random.c,v 1.5 2004/11/10 00:07:01 patthoyts Exp $
30 */
31
32
33 #include "memchanInt.h"
34 #include "../isaac/rand.h"
35 #include <time.h>
36 /*
37 * Forward declarations of internal procedures.
38 */
39
40 static int Close _ANSI_ARGS_((ClientData instanceData,
41 Tcl_Interp *interp));
42
43 static int Input _ANSI_ARGS_((ClientData instanceData,
44 char *buf, int toRead, int *errorCodePtr));
45
46 static int Output _ANSI_ARGS_((ClientData instanceData,
47 CONST84 char *buf, int toWrite, int *errorCodePtr));
48
49 static void WatchChannel _ANSI_ARGS_((ClientData instanceData, int mask));
50 static void ChannelReady _ANSI_ARGS_((ClientData instanceData));
51 static int GetFile _ANSI_ARGS_((ClientData instanceData,
52 int direction,
53 ClientData* handlePtr));
54
55 static int BlockMode _ANSI_ARGS_((ClientData instanceData,
56 int mode));
57
58 static int GetOption _ANSI_ARGS_((ClientData instanceData,
59 Tcl_Interp* interp,
60 CONST84 char *optionName,
61 Tcl_DString *dsPtr));
62
63 static int SetOption _ANSI_ARGS_((ClientData instanceData,
64 Tcl_Interp* interp,
65 CONST char *optionName,
66 CONST char *newValue));
67 /*
68 * This structure describes the channel type structure for random channels:
69 * random channels are not seekable. They have no options.
70 */
71
72 static Tcl_ChannelType channelType = {
73 "random", /* Type name. */
74 (Tcl_ChannelTypeVersion)BlockMode, /* Set blocking behaviour. */
75 Close, /* Close channel, clean instance data */
76 Input, /* Handle read request */
77 Output, /* Handle write request */
78 NULL, /* Move location of access point. NULL'able */
79 SetOption, /* Set options. NULL'able */
80 GetOption, /* Get options. NULL'able */
81 WatchChannel, /* Initialize notifier */
82 #if GT81
83 GetFile, /* Get OS handle from the channel. */
84 NULL /* Close2Proc, not available, no partial close
85 * possible */
86 #else
87 GetFile /* Get OS handle from the channel. */
88 #endif
89 };
90
91
92 /*
93 * This structure describes the per-instance state of a in-memory random channel.
94 */
95
96 typedef struct ChannelInstance {
97 Tcl_Channel chan; /* Backreference to generic channel information */
98 Tcl_TimerToken timer; /* Timer used to link the channel into the
99 * notifier. */
100 struct randctx state; /* PRNG state */
101 int delay; /* fileevent notification interval (in ms) */
102 } ChannelInstance;
103
104 /*
105 *----------------------------------------------------------------------
106 *
107 * BlockMode --
108 *
109 * Helper procedure to set blocking and nonblocking modes on a
110 * memory channel. Invoked by generic IO level code.
111 *
112 * Results:
113 * 0 if successful, errno when failed.
114 *
115 * Side effects:
116 * Sets the device into blocking or non-blocking mode.
117 *
118 *----------------------------------------------------------------------
119 */
120
121 static int
BlockMode(instanceData,mode)122 BlockMode (instanceData, mode)
123 ClientData instanceData;
124 int mode;
125 {
126 return 0;
127 }
128
129 /*
130 *------------------------------------------------------*
131 *
132 * Close --
133 *
134 * ------------------------------------------------*
135 * This procedure is called from the generic IO
136 * level to perform channel-type-specific cleanup
137 * when an in-memory random channel is closed.
138 * ------------------------------------------------*
139 *
140 * Sideeffects:
141 * Closes the device of the channel.
142 *
143 * Result:
144 * 0 if successful, errno if failed.
145 *
146 *------------------------------------------------------*
147 */
148 /* ARGSUSED */
149 static int
Close(instanceData,interp)150 Close (instanceData, interp)
151 ClientData instanceData; /* The instance information of the channel to
152 * close */
153 Tcl_Interp* interp; /* unused */
154 {
155 ChannelInstance* chan;
156
157 chan = (ChannelInstance*) instanceData;
158
159 if (chan->timer != (Tcl_TimerToken) NULL) {
160 Tcl_DeleteTimerHandler (chan->timer);
161 }
162
163 Tcl_Free ((char*) chan);
164
165 return 0;
166 }
167
168 /*
169 *------------------------------------------------------*
170 *
171 * Input --
172 *
173 * ------------------------------------------------*
174 * This procedure is invoked from the generic IO
175 * level to read input from an in-memory random channel.
176 * ------------------------------------------------*
177 *
178 * Sideeffects:
179 * Reads input from the input device of the
180 * channel.
181 *
182 * Result:
183 * The number of bytes read is returned or
184 * -1 on error. An output argument contains
185 * a POSIX error code if an error occurs, or
186 * zero.
187 *
188 *------------------------------------------------------*
189 */
190
191 static int
Input(instanceData,buf,toRead,errorCodePtr)192 Input (instanceData, buf, toRead, errorCodePtr)
193 ClientData instanceData; /* The channel to read from */
194 char* buf; /* Buffer to fill */
195 int toRead; /* Requested number of bytes */
196 int* errorCodePtr; /* Location of error flag */
197 {
198 ChannelInstance *chan = (ChannelInstance *)instanceData;
199 size_t n = 0, i = sizeof(unsigned long);
200 unsigned long rnd;
201
202 for (n = 0; toRead - n > i; n += i) {
203 rnd = rand(&chan->state);
204 memcpy(&buf[n], (char *)&rnd, i);
205 }
206 if (toRead - n > 0) {
207 rnd = rand(&chan->state);
208 memcpy(&buf[n], (char *)&rnd, toRead-n);
209 n += (toRead-n);
210 }
211
212 return n;
213 }
214
215 /*
216 *------------------------------------------------------*
217 *
218 * Output --
219 *
220 * ------------------------------------------------*
221 * This procedure is invoked from the generic IO
222 * level to write output to a file channel.
223 * ------------------------------------------------*
224 *
225 * Sideeffects:
226 * Writes output on the output device of
227 * the channel.
228 *
229 * Result:
230 * The number of bytes written is returned
231 * or -1 on error. An output argument
232 * contains a POSIX error code if an error
233 * occurred, or zero.
234 *
235 *------------------------------------------------------*
236 */
237
238 static int
Output(instanceData,buf,toWrite,errorCodePtr)239 Output (instanceData, buf, toWrite, errorCodePtr)
240 ClientData instanceData; /* The channel to write to */
241 CONST84 char* buf; /* Data to be stored. */
242 int toWrite; /* Number of bytes to write. */
243 int* errorCodePtr; /* Location of error flag. */
244 {
245 ChannelInstance *chan = (ChannelInstance *)instanceData;
246 ub4 rnd, n = 0;
247 ub4 *s = (ub4 *)buf;
248 ub4 *p = chan->state.randrsl;
249
250 while (n < RANDSIZ && n < (ub4)(toWrite/4)) {
251 p[n] ^= s[n]; n++;
252 }
253 /* mix the state */
254 rnd = rand(&chan->state);
255
256 /*
257 * If we filled the state with data, there is no advantage to
258 * adding in additional data. So lets save time.
259 */
260 return toWrite;
261 }
262
263 /*
264 *------------------------------------------------------*
265 *
266 * WatchChannel --
267 *
268 * ------------------------------------------------*
269 * Initialize the notifier to watch Tcl_Files from
270 * this channel.
271 * ------------------------------------------------*
272 *
273 * Sideeffects:
274 * Sets up the notifier so that a future
275 * event on the channel will be seen by Tcl.
276 *
277 * Result:
278 * None.
279 *
280 *------------------------------------------------------*
281 */
282 /* ARGSUSED */
283 static void
WatchChannel(instanceData,mask)284 WatchChannel (instanceData, mask)
285 ClientData instanceData; /* Channel to watch */
286 int mask; /* Events of interest */
287 {
288 /*
289 * random channels are not based on files.
290 * They are always writable, and always readable.
291 * We could call Tcl_NotifyChannel immediately, but this
292 * would starve other sources, so a timer is set up instead.
293 */
294
295 ChannelInstance* chan = (ChannelInstance*) instanceData;
296
297 if (mask) {
298 if (chan->timer == (Tcl_TimerToken) NULL) {
299 chan->timer = Tcl_CreateTimerHandler(chan->delay, ChannelReady,
300 instanceData);
301 }
302 } else {
303 Tcl_DeleteTimerHandler (chan->timer);
304 chan->timer = (Tcl_TimerToken) NULL;
305 }
306 }
307
308 /*
309 *------------------------------------------------------*
310 *
311 * ChannelReady --
312 *
313 * ------------------------------------------------*
314 * Called by the notifier (-> timer) to check whether
315 * the channel is readable or writable.
316 * ------------------------------------------------*
317 *
318 * Sideeffects:
319 * As of 'Tcl_NotifyChannel'.
320 *
321 * Result:
322 * None.
323 *
324 *------------------------------------------------------*
325 */
326
327 static void
ChannelReady(instanceData)328 ChannelReady (instanceData)
329 ClientData instanceData; /* Channel to query */
330 {
331 /*
332 * In-memory random channels are always writable (fileevent
333 * writable) and they are also always readable.
334 */
335
336 ChannelInstance* chan = (ChannelInstance*) instanceData;
337 int mask = TCL_READABLE | TCL_WRITABLE;
338
339 /*
340 * Timer fired, our token is useless now.
341 */
342
343 chan->timer = (Tcl_TimerToken) NULL;
344
345 /* Tell Tcl about the possible events.
346 * This will regenerate the timer too, via 'WatchChannel'.
347 */
348
349 Tcl_NotifyChannel (chan->chan, mask);
350 }
351
352 /*
353 *------------------------------------------------------*
354 *
355 * GetFile --
356 *
357 * ------------------------------------------------*
358 * Called from Tcl_GetChannelHandle to retrieve
359 * OS handles from inside a in-memory random channel.
360 * ------------------------------------------------*
361 *
362 * Sideeffects:
363 * None.
364 *
365 * Result:
366 * The appropriate OS handle or NULL if not
367 * present.
368 *
369 *------------------------------------------------------*
370 */
371 static int
GetFile(instanceData,direction,handlePtr)372 GetFile (instanceData, direction, handlePtr)
373 ClientData instanceData; /* Channel to query */
374 int direction; /* Direction of interest */
375 ClientData* handlePtr; /* Space to the handle into */
376 {
377 /*
378 * In-memory random channels are not based on files.
379 */
380
381 /* *handlePtr = (ClientData) NULL; */
382 return TCL_ERROR;
383 }
384
385 /*
386 *------------------------------------------------------*
387 *
388 * SetOption --
389 *
390 * ------------------------------------------------*
391 * Set a channel option
392 * ------------------------------------------------*
393 *
394 * Sideeffects:
395 * Channel parameters may be modified.
396 *
397 * Result:
398 * A standard Tcl result. The new value of the
399 * specified option is returned as the interpeter
400 * result
401 *
402 *------------------------------------------------------*
403 */
404
405 static int
SetOption(instanceData,interp,optionName,newValue)406 SetOption (instanceData, interp, optionName, newValue)
407 ClientData instanceData; /* Channel to query */
408 Tcl_Interp *interp; /* Interpreter to leave error messages in */
409 CONST char *optionName; /* Name of requested option */
410 CONST char *newValue; /* The new value */
411 {
412 ChannelInstance *chan = (ChannelInstance*) instanceData;
413 CONST char *options = "delay";
414 int result = TCL_OK;
415
416 if (!strcmp("-delay", optionName)) {
417 int delay = DELAY;
418 result = Tcl_GetInt(interp, (CONST84 char *)newValue, &delay);
419 if (result == TCL_OK) {
420 chan->delay = delay;
421 Tcl_SetObjResult(interp, Tcl_NewIntObj(delay));
422 }
423 } else {
424 result = Tcl_BadChannelOption(interp,
425 (CONST84 char *)optionName, (CONST84 char *)options);
426 }
427 return result;
428 }
429
430 /*
431 *------------------------------------------------------*
432 *
433 * GetOption --
434 *
435 * ------------------------------------------------*
436 * Computes an option value for a zero
437 * channel, or a list of all options and their values.
438 * ------------------------------------------------*
439 *
440 * Sideeffects:
441 * None.
442 *
443 * Result:
444 * A standard Tcl result. The value of the
445 * specified option or a list of all options
446 * and their values is returned in the
447 * supplied DString.
448 *
449 *------------------------------------------------------*
450 */
451
452 static int
GetOption(instanceData,interp,optionName,dsPtr)453 GetOption (instanceData, interp, optionName, dsPtr)
454 ClientData instanceData; /* Channel to query */
455 Tcl_Interp* interp; /* Interpreter to leave error messages in */
456 CONST84 char* optionName; /* Name of reuqested option */
457 Tcl_DString* dsPtr; /* String to place the result into */
458 {
459 ChannelInstance *chan = (ChannelInstance*) instanceData;
460 char buffer [50];
461
462 /* Known options:
463 * -delay: Number of milliseconds between readable fileevents.
464 */
465
466 if ((optionName != (char*) NULL) &&
467 (0 != strcmp (optionName, "-delay"))) {
468 Tcl_SetErrno (EINVAL);
469 return Tcl_BadChannelOption (interp, optionName, "delay");
470 }
471
472 if (optionName == (char*) NULL) {
473 /*
474 * optionName == NULL
475 * => a list of options and their values was requested,
476 * so append the optionName before the retrieved value.
477 */
478 Tcl_DStringAppendElement (dsPtr, "-delay");
479 LTOA (chan->delay, buffer);
480 Tcl_DStringAppendElement (dsPtr, buffer);
481
482 } else if (0 == strcmp (optionName, "-delay")) {
483 LTOA (chan->delay, buffer);
484 Tcl_DStringAppendElement (dsPtr, buffer);
485 }
486
487 return TCL_OK;
488 }
489
490 /*
491 *------------------------------------------------------
492 *
493 * Memchan_CreateRandomChannel -
494 *
495 * Mint a new 'random' channel.
496 *
497 * Result:
498 * Returns the new channel.
499 *
500 *------------------------------------------------------
501 */
502
503 Tcl_Channel
Memchan_CreateRandomChannel(interp)504 Memchan_CreateRandomChannel(interp)
505 Tcl_Interp *interp; /* current interpreter */
506 {
507 Tcl_Channel chan;
508 Tcl_Obj *channelHandle;
509 ChannelInstance *instance;
510 unsigned long seed;
511
512 instance = (ChannelInstance*) Tcl_Alloc (sizeof (ChannelInstance));
513 channelHandle = MemchanGenHandle ("random");
514
515 chan = Tcl_CreateChannel (&channelType,
516 Tcl_GetStringFromObj (channelHandle, NULL),
517 (ClientData) instance,
518 TCL_READABLE | TCL_WRITABLE);
519
520 instance->chan = chan;
521 instance->timer = (Tcl_TimerToken) NULL;
522 instance->delay = DELAY;
523
524 /*
525 * Basic initialization of the PRNG state
526 */
527 seed = time(NULL) + ((long)Tcl_GetCurrentThread() << 12);
528 memcpy(&instance->state.randrsl, &seed, sizeof(seed));
529 randinit(&instance->state);
530
531 Tcl_RegisterChannel (interp, chan);
532 Tcl_SetChannelOption (interp, chan, "-buffering", "none");
533 Tcl_SetChannelOption (interp, chan, "-blocking", "0");
534
535 return chan;
536 }
537
538 /*
539 *------------------------------------------------------*
540 *
541 * MemchanRandomCmd --
542 *
543 * ------------------------------------------------*
544 * This procedure realizes the 'random' command.
545 * See the manpages for details on what it does.
546 * ------------------------------------------------*
547 *
548 * Sideeffects:
549 * See the user documentation.
550 *
551 * Result:
552 * A standard Tcl result.
553 *
554 *------------------------------------------------------*
555 */
556 /* ARGSUSED */
557 int
MemchanRandomCmd(notUsed,interp,objc,objv)558 MemchanRandomCmd (notUsed, interp, objc, objv)
559 ClientData notUsed; /* Not used. */
560 Tcl_Interp* interp; /* Current interpreter. */
561 int objc; /* Number of arguments. */
562 Tcl_Obj*CONST objv[]; /* Argument objects. */
563 {
564 Tcl_Channel chan;
565
566 if (objc != 1) {
567 Tcl_AppendResult (interp, "wrong # args: should be \"fifo\"",
568 (char*) NULL);
569 return TCL_ERROR;
570 }
571
572 chan = Memchan_CreateRandomChannel(interp);
573 Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *)NULL);
574 return TCL_OK;
575 }
576