ycl

Artifact [02be28fc27]
Login

Artifact [02be28fc27]

Check-ins Using Download Hex

Artifact 02be28fc27dabfc3cf3ed9abedbea19bb4638aa5:

#! /bin/env tclsh

package require {ycl proc}


proc chooserandbytes {} {
	foreach cmd {randbytes_udev randbytes_sqlite randbytes_flip} {
		try {
			set res [$cmd 1]
			break
		} on error {cres copts} {
			lappend errors $cmd $cres
		}
	}
	if {[info exists res]} {
		rename randbytes {}
		[yclprefix] proc alias randbytes $cmd
		return $res
	} else {
		return -options $copts $errors 
	}
}


variable doc::flip {
	description {
		Assume that there is jitter inherent in the system, and use it as an
		entropy source by capturing variations in time at the edge of a click.
	}
}
coroutine flip ::apply [list {} {
	yield
	set repeat 1
	set diffs {}

	# test output for characteristics of randomness before changing this
	# $count 
	set count 25
	set half [expr {entier($count / 2)}]
	set mindiffs [expr {entier(sqrt($count))}]

	while 1 {
		while 1 {
			set c1 [clock clicks]
			time {expr {cos($repeat)}} $repeat
			set c2 [clock clicks]
			set diff [expr {$c2 - $c1}]
			if {[dict exists $diffs $diff]} {
				incr repeat
			} else {
				incr repeat -1
				dict incr diffs $diff 

				# Select and whiten
				if {[llength [dict keys $diffs]] >= $mindiffs && [
					::tcl::mathfunc::max {*}[dict values $diffs]] <= $half} {
					# The calculations took place at the edge of a click , reflecting
					# jitter , or at some other point when the system is unstable .
					break
				}
			}
		}
		set diffs {}
		yield [expr {$diff % 2}]
	}
} [namespace current]]


proc randasciialnum count {
	set res {}
	set length 0
	while 1 {
		set bytes [randbytes $count]
		regsub -all {[^a-zA-Z0-9]} $bytes[set bytes {}] {} bytes
		append res $bytes
		incr length [string length $bytes] 
		if {$length >= $count} break
	}
	return [string range $res 0 [expr {$count-1}]]
}


proc randbytes {{count 256}} {
	chooserandbytes
	randbytes $count
}


proc randbytes1 {datavar size args} {
	upvar $datavar data
	set data {}
	set count 0
	set seed $size
	set needed $size
	while {[llength $args]} {
		take args $arg
		optswitch $arg {
			seed {
				take args seed
			}
		}
	}
	set num [expr {entier(abs(cos($seed * 2 **10)) * 10000000000000000)}]
	while {$needed > 0} {
		set hex [format %x $num]
		set new [binary format H* $hex]
		#set new $num
		set newsize [string length $new]
		if {$needed < $newsize} {
			set new [string range new 0 $needed-1]
			set newsize [string length $new]
		}
		incr needed -$newsize
		append data $new
		set num [expr {entier(abs(cos($needed + $num)) * 10000000000000000)}]
	}
	return
}


variable doc::randbytes_flip {
	description {
		Produce random bytes .
	}
}
proc randbytes_flip {{count 256}} {
	set res {}
	while {[string length $res] < $count} {
		set num 0
		set diff 0
		for {set i 0} {$i < 9} {incr i} {
			set num [expr {($num << 1) | [flip]}]
		}
		append res [binary format c [expr {$num & 255}]]
	}
	return $res
}


proc randbytes_udev {{count 256}} {
	set res {}
	if {[file exists /dev/urandom]} {
		set chan [open /dev/urandom rb]
		chan configure $chan -blocking 1
		append res [read $chan $count]
		close $chan
	} else {
		#todo: accomodate more methods
		return -code error [list {no entropy source}]
		package require platform 
	}
	return $res
}


proc randbytes_sqlite {{count 256}} {
	package require sqlite3
	sqlite3 db :memory:
	proc randbytes_sqlite {{count 256}} {
		db eval onecolumn {select randomblob($count)}
	}
}


proc rand ceiling {
	package require {ycl math rng}
	namespace import [yclprefix]::math::rng
	proc rand ceiling {
		set needed [expr {entier(ceil(log($ceiling)/log(2)/8))}]
		set data [rng take $needed]
		binary scan $data H* hex
		scan $hex %llx res
		return [expr {$res % $ceiling}]
	}
	tailcall rand $ceiling
}


variable doc::randprint_script {
	description  {
		Creates a script that produces random strings of printable characters.
		By default, it produces a command that produces a string that, when
		interpreted as an integer in base-68 occupies approximately, but no
		more than 256 bits.
	}
	args {
		randscript {
			description {
				A script that evaluates to a random mumber between 0 and 67 ,
				inclusive .
			}

			count {
				The size of the string to produce, in characters
			}
		}
		
	}
}
proc randprint_script args {
	dict update args randscript randscript count count {}
	if {![info exists randscript]} {
		set randscript {expr {entier(rand() * 68)}}
	}
	if {![info exists count]} {
		set count 42
	}
	
	return "lindex [string repeat "\[lindex {
		# @ + - ^ = 
		0 1 2 3 4 5 6 7 8 9
		A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
		a b c d e f g h i j k l m n o p q r s t u v w x y z
	} \[$randscript]]" $count]"
}

proc randprint_256 {} {
	namespace eval private {
		package require {ycl math rng}
		namespace import [yclprefix]::math::rng
	}
	proc randprint_256 {} [randprint_script randscript [namespace code {
		apply [list args {
			binary scan [private::rng take 8] H* data
			set res [expr int(.[string reverse [expr 0x$data]] * 68)]
		} [namespace current]]
	}]]
	tailcall randprint_256
}


proc randprint_256_bitcoin args {
	namespace eval private {
		package require {ycl math rng}
		namespace import [yclprefix]::math::rng
		package require {ycl proc}
		[yclprefix] proc alias [yclprefix]::proc::alias
		[yclprefix] proc alias aliases [yclprefix] proc aliases
		aliases {
			{ycl string} {
				{base encode 58 bitcoin}
			}
		}
	}
	proc randprint_256_bitcoin args {
		set data [private::rng take 32]
		{private::base encode 58 bitcoin} data
		return $data
	}
	tailcall randprint_256_bitcoin {*}$args
}