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