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
40static int	Close _ANSI_ARGS_((ClientData instanceData,
41                    Tcl_Interp *interp));
42
43static int	Input _ANSI_ARGS_((ClientData instanceData,
44		    char *buf, int toRead, int *errorCodePtr));
45
46static int	Output _ANSI_ARGS_((ClientData instanceData,
47	            CONST84 char *buf, int toWrite, int *errorCodePtr));
48
49static void	WatchChannel _ANSI_ARGS_((ClientData instanceData, int mask));
50static void	ChannelReady _ANSI_ARGS_((ClientData instanceData));
51static int      GetFile      _ANSI_ARGS_((ClientData instanceData,
52					  int direction,
53					  ClientData* handlePtr));
54
55static int	BlockMode _ANSI_ARGS_((ClientData instanceData,
56				       int mode));
57
58static int	GetOption _ANSI_ARGS_((ClientData instanceData,
59				       Tcl_Interp* interp,
60				       CONST84 char *optionName,
61				       Tcl_DString *dsPtr));
62
63static 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
72static 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
96typedef 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
121static int
122BlockMode (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 */
149static int
150Close (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
191static int
192Input (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
238static int
239Output (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 */
283static void
284WatchChannel (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
327static void
328ChannelReady (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 */
371static int
372GetFile (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
405static int
406SetOption (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
452static int
453GetOption (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
503Tcl_Channel
504Memchan_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 */
557int
558MemchanRandomCmd (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