The Random.Org folks http:://www.random.org have some nice cgi-bin scripts that return truly random numbers based on atmospheric noise. Below is a TCL interface to that site.
Possible uses:
Enjoy! BBH
# -----------------------------------------------------------------
#
# Tcl interface to random.org random number generator
#
# -----------------------------------------------------------------
#
# author: Bruce Hartweg
#
# -----------------------------------------------------------------
#
# This creates a namespace called RandomOrg which exports 6 procs
#
# configProxy - allows configuration of HTTP proxy data
# configCache - allows setting parameters for internal cacheing
#
# These 3 procs provide direct acces to cgi scripts at random.org
# they will block until data is complete
#
# getIntList min max howMany - return a list of random numbers in range
# getSequence min max - return a random order list of non-duplicating numbers
# getBytes format numBytes - get random bytes in specified format
# formats:
# raw - binary data
# hexadecimal, decimal, octal, binary - list of ascii format numbers in each base
#
# getNumber min max - uses internal buffer of random bytes to calculate number in range
# each call doesn't need to requery random.org site usefull if requested ranges
# are not the same each time
#
# -----------------------------------------------------------------
namespace eval RandomOrg {
variable baseURL "www.random.org/random.org/cgi-bin/"
variable limits
array set limits {
maxNum 10000
intMin -1000000000
intMax 1000000000
maxBytes 16384
seqRange 10000
seqMin -1000000000
seqMax 1000000000
}
variable proxy
array set proxy {
host ""
port 8080
user ""
pw ""
haveBase64 1
}
variable formats
array set formats {
raw f
hexadecimal h
decimal d
octal o
binary b
}
variable cache
array set cache {
maxSize 1024
minSize 128
data ""
timeout 120000
token ""
}
namespace export configProxy
namespace export configCache
namespace export getIntList
namespace export getSequence
namespace export getBytes
namespace export getNumber
}
package require http
if {[catch {package require base64}]} {
set ::RandomOrg::proxy(haveBase64) 0
}
proc ::RandomOrg::configProxy {{host ""} {port 8080} {user ""} {pw ""}} {
variable proxy
foreach v {host port user pw} {
set proxy($v) [set $v]
}
if {[string length $user] > 0 && ! $proxy(haveBase64)} {
set proxy(user) ""
error "Cannot use proxy authentication - base64 package not found!"
}
}
proc ::RandomOrg::configCache {{minVal 128} {maxVal 1024} {timeout 120}} {
variable cache
# check args
if {![string is int -strict $minVal]} {
error "minVal must be an integer"
}
if {![string is int -strict $maxVal]} {
error "maxVal must be an integer"
}
if {$maxVal <= $minVal} {
error "maxVal must be greater than minVal"
}
if {$minVal < 0} {
errpr "minVal cannot be negative"
}
if {![string is int -strict $timeout] || $timeout < 1} {
error "timeout must be a positive integer"
}
set cache(minSize) $minVal
set cache(maxSize) $maxVal
set cahce(timeout) [expr {$timeout * 1000}]
if {[string length $cache(data)] < $minVal} {
_extendCache
}
return ""
}
proc ::RandomOrg::getIntList {minVal maxVal numItems} {
# check args
variable limits
if {![string is int -strict $minVal] ||
$minVal < $limits(intMin)} {
error "minVal must be an integer no less than $limits(intMin)"
}
if {![string is int -strict $maxVal] ||
$maxVal > $limits(intMax)} {
error "maxVal must be an integer no greater than $limits(intMax)"
}
if {![string is int -strict $numItems] ||
$numItems < 1 || $numItems > $limits(maxNum)} {
error "numItems must be an integer from1 to $limits(maxNum)"
}
if {$maxVal <= $minVal} {
error "maxVal must be greater than minVal"
}
# build URL string
set url "randnum?num=$numItems&min=$minVal&max=$maxVal&col=1"
if {[catch { _getData $url } ret]} {
error "Failed to get random numbers: $ret"
}
return [string map {"\n" " "} $ret]
}
proc ::RandomOrg::getSequence {minVal maxVal} {
# check args
variable limits
if {![string is int -strict $minVal] ||
$minVal < $limits(seqMin)} {
error "minVal must be an integer no less than $limits(seqMin)"
}
if {![string is int -strict $maxVal] ||
$maxVal > $limits(seqMax)} {
error "maxVal must be an integer no greater than $limits(seqMax)"
}
if {$maxVal <= $minVal} {
error "maxVal must be greater than minVal"
}
if {($maxVal - $minVal) > $limits(seqRange)} {
error "sequence range must not exceed $limits(seqRange)"
}
# build URL string
set url "randseq?min=$minVal&max=$maxVal"
if {[catch { _getData $url } ret]} {
error "Failed to get random sequence: $ret"
}
return [string map {"\n" " "} $ret]
}
proc ::RandomOrg::getBytes {format numBytes} {
variable limits
variable formats
# check args
if {![string is int -strict $numBytes] ||
$numBytes < 1 || $numBytes > $limits(maxBytes)} {
error "numBytes must be an integer from1 to $limits(maxBytes)"
}
set key [array names formats $format*]
if {[llength $key] != 1} {
error "format must be one of [array names formats]"
}
set fmt $formats($key)
# build URL string
set url "randbyte?nbytes=$numBytes&format=$fmt"
if {[catch { _getData $url } ret]} {
error "Failed to get random sequence: $ret"
}
if {[string compare $fmt f]} {
regsub -all {\s+} [string trim $ret] " " ret
}
return $ret
}
proc ::RandomOrg::getNumber {minVal maxVal} {
variable cache
# check args
if {![string is int -strict $minVal]} {
error "minVal must be an integer"
}
if {![string is int -strict $maxVal]} {
error "maxVal must be an integer"
}
if {$maxVal <= $minVal} {
error "maxVal must be greater than minVal"
}
if {[string length $cache(data)] < 4} {
_extendCache
set id [after $cache(timeout) set cache(data) Timeout]
vwait [namespace which -variable cache](data)
after cancel $id
if {[string equal $cache(data) Timeout]} {
set cache(data) ""
error "Timeout while trying to get data"
}
}
set chunk [string range $cache(data) 0 3]
set cache(data) [string range $cache(data) 4 end]
if {[string length $cache(data)] < $cache(minSize)} {
_extendCache
}
# convert to int
binary scan $chunk I num
# clear sign bit
set val [expr {$num & 0x7FFFFFFF}]
# return number in specified range
return [expr {round((($maxVal-$minVal)*($val / double(0x7FFFFFFF))) + $minVal)}]
}
# internal helper procs -----------------------------------------------------
proc ::RandomOrg::_getData {url} {
variable baseURL
variable proxy
set cmd [list ::http::geturl $baseURL$url]
# if proxy is set - configure it
if {[string length $proxy(host)] > 0} {
::http::config -proxyhost $proxy(host) -proxyport $proxy(port)
# see if proxy needs authentication
if {[string length $proxy(user)] > 0} {
set enc [base64::encode $proxy(user):$Proxy(pw)]
set auth [list "Proxy-Authorization" [concat "Basic" $enc]]
lappend cmd -headers $auth
}
}
if {[catch $cmd tok]} {
error "HTTP Request failed: $tok"
}
if {[::http::ncode $tok] != 200} {
set msg "[::http::status $tok] : [::http::error $tok]"
::http::cleanup $tok
error $msg
}
set ret [::http::data $tok]
::http::cleanup $tok
return $ret
}
proc ::RandomOrg::_extendCache {} {
variable baseURL
variable proxy
variable cache
if {[string length $cache(token)] > 0} {
# current request pending - don't send another
return
}
set cmd [list ::http::geturl ${baseURL}randbyte?nbytes=$cache(maxSize)&format=f]
# if proxy is set - configure it
if {[string length $proxy(host)] > 0} {
::http::config -proxyhost $proxy(host) -proxyport $proxy(port)
# see if proxy needs authentication
if {[string length $proxy(user)] > 0} {
set enc [base64::encode $proxy(user):$Proxy(pw)]
set auth [list "Proxy-Authorization" [concat "Basic" $enc]]
lappend cmd -headers $auth
}
}
lappend cmd -handler [namespace which -command _addToCache]
lappend cmd -command [namespace which -command _cacheComplete]
if {[catch $cmd tok]} {
error "Failed HTTP call : $tok"
}
set cache(token) $tok
}
proc ::RandomOrg::_addToCache {sock tok} {
variable cache
set chunk [read $sock]
if {[set sz [string length $chunk]] > 0} {
append cache(data) $chunk
}
return $sz
}
proc ::RandomOrg::_cacheComplete {tok} {
variable cache
::http::cleanup $tok
set cache(token) ""
if {[string length $cache(data)] < $cache(minSize)} {
_extendCache
}
}