# ######################################################################
# Procedimiento: aleatorio
#   Devuelve un número aleatorio (biginteger) utilizando el dispositivo
#   `/dev/random` de Unix (Esto no funcionará en güindón)
# Parámetros:
#   `nbytes` determina el número de bytes que se leen del dispositivo
#   y, por tanto, el tamaño del número devuelto
# Devuelve:
#   Un número, entero, aleatorio dentro del rango establecido
#
proc aleatorio {{nbytes 8}} {
    set cadena ""
    # Leo `nbytes` del dispositivo `/dev/random`
    set f [open /dev/random rb]
    for {set b 0} {$b < $nbytes} {incr b} {
        set byte [read $f 1]
        # cada byte se convierte a una cadena hexadecimal y se
        #      concatena en `cadena`
        set cadena $cadena[binary encode hex $byte]
    }
    close $f
    # convierto la cadena hexadecimal en un número decimal (big %ll)
    set n [format %lld 0x$cadena]
    return $n
}

# ######################################################################
# Procedimiento: entero-entre
#   Devuelve un entero aleatorio entre los valores mínimo y máximo. El
#   número aleatorio, devuelto por [aleatorio 8] al ser de 8 bytes,
#   tendrá un rango entre 0 y 18446744073709551615
# Parámetros:
#   `min` El valor mínimo que debe devolver
#   `max` El valor máximo que debe devolver
# Devuelve:
#   Un entero `n` tal que 'min <= n <= max'
#
proc entero-entre {min max} {
    set dec [aleatorio 8]
    # el número máximo que se puede obetener aleatoriamente por el
    # código anterior es 18446744073709551615
    return round([expr {(($dec/18446744073709551615.0) * ($max - $min)) + $min}])
}

# Paquete que proporciona el archivo
package provide rsa 1.0

# Creamos un `namespace` para evitar choques de nombre
namespace eval ::rsa {

    # Rutinas que se exportan para trabajar con ellas
    namespace export num-bits es-primo generar-primo exp-rapida

    # ######################################################################
    # Procedimiento: num-bits
    #   Devuelve el número de bits empleados para representar un número entero
    # Parámetros:
    #   `valor` representa el número del que queremos saber el tamaño
    # Devuelve:
    #   La cantidad de bits empleados en la representación del número
    #
    proc num-bits valor {
        set bits -1
        set p 0
        while {$valor >= $p} {
            set p [expr {(1 << [incr bits])}]
        }
        return $bits
    }

    # ######################################################################
    # Procedimiento: exp-rapida
    #   Calcula el resultado de una exponenciación.
    # Parámetros:
    #   `base` la base del cálculo
    #   `exp` el exponente del cálculo
    # Devuelve:
    #   El resultado de la operación
    #
    proc exp-rapida {base exp} {
        set res 1
        for {set i 1} {$i <= $exp} {incr 1} {
            set res [expr {$res * $exp}]
        }
        return $res
    }

    # ######################################################################
    # Procedimiento: lucas-lehmer
    #   Realiza el tests de primalidad con el algoritmo Lucas-Lehmer
    # Parámetros:
    #   `num` El número que debe ser probado
    # Devuelve:
    #   `0` significa que `num` es compuesto
    #   `1` significa que `num` es primo
    #
    proc lucas-lehmer num {
        set s 4
        set m [expr {[exp-rapida 2 $num] - 1}]
        for {set j 2} {$j <= ($num - 1)} {incr j} {
            set sj $s
            set s [expr {(($sj ** 2) - 2) % $m}]
            if {$sj == 0} {return 1}
        }
        return 0
    }

    # ######################################################################
    # Procedimiento: aleatorio
    #   Devuelve un número aleatorio (biginteger) utilizando el dispositivo
    #   `/dev/random` de Unix (Esto no funcionará en güindón)
    # Parámetros:
    #   `nbytes` determina el número de bytes que se leen del dispositivo
    #   y, por tanto, el tamaño del número devuelto
    # Devuelve:
    #   Un número, entero, aleatorio dentro del rango establecido
    #
    proc aleatorio {{nbytes 8}} {
        set cadena ""
        # Leo `nbytes` del dispositivo `/dev/random`
        set f [open /dev/random rb]
        for {set b 0} {$b < $nbytes} {incr b} {
            set byte [read $f 1]
            # cada byte se convierte a una cadena hexadecimal y se
            #      concatena en `cadena`
            set cadena $cadena[binary encode hex $byte]
        }
        close $f
        # convierto la cadena hexadecimal en un número decimal (big %ll)
        set n [format %lld 0x$cadena]
        return $n
    }

    # ######################################################################
    # Procedimiento: entero-entre
    #   Devuelve un entero aleatorio entre los valores mínimo y máximo. El
    #   número aleatorio, devuelto por [aleatorio 8] al ser de 8 bytes,
    #   tendrá un rango entre 0 y 18446744073709551615
    # Parámetros:
    #   `min` El valor mínimo que debe devolver
    #   `max` El valor máximo que debe devolver
    # Devuelve:
    #   Un entero `n` tal que 'min <= n <= max'
    #
    proc entero-entre {min max} {
        set dec [aleatorio 8]
        # el número máximo que se puede obetener aleatoriamente por el
        # código anterior es 18446744073709551615
        return round([expr {(($dec/18446744073709551615.0) * ($max - $min)) + $min}])
    }

    # ######################################################################
    # Procedimiento: expmod
    #   Exponenciación modular. Calcula el residuo cuando una base se eleva
    #   a un exponente y se divide por el módulo. Se utiliza para acelerar
    #   el cálculo con grandes números.
    #   (Algoritmo sacado de la wikipedia)
    # Parámetros:
    #   `base` el número base
    #   `exp`  el exponente
    #   `mod`  el módulo
    # Devuelve:
    #   El resultado de la exponenciación
    #
    proc expmod {base exp mod} {
        set x 1
        set y $base
        while {$exp > 0} {
            if {($exp % 2) == 1} {set x [expr {($x * $y) % $mod}]}
            set y [expr {($y * $y) % $mod}]
            set exp [expr {$exp >> 1}]
        }
        return [expr {$x % $mod}]
    }

    # ######################################################################
    # Procedimiento: mr-test
    #   Proc. auxiliar del test de «Miller-Rabin» sobre primalidad, sacando
    #   el bucle de dentro del bucle principal.
    # Parámetros:
    #   `d` llega como el entero inmediatamente inferior del número testado
    #   `n` el número testado
    # Devuelve:
    #   0 significa que `n` es compuesto
    #   1 significa que `n` es primo
    #
    proc mr-test {d n} {
        set a [expr 2 + [entero-entre 1 [expr {$n - 1}]]]
        set x [expmod $a $d $n]
        if {$x == 1 || $x == ($n - 1) } {return 1}
        while {$d != ($n - 1)} {
            set x [expr {($x * $x) % $n}]
            set d [expr {$d * 2}]
            if {$x == 1} {
                return 0
            } elseif {$x == ($n - 1)} {
                return 1
            }
        }
        return 0
    }

    # ######################################################################
    # Procedimiento: miller-rabin
    #   Algoritmo de primalidad probabilístico pero altamente utilizado en
    #   criptografía. Está diseñado para evitar los falsos positivos.
    #   (Algoritmo sacado de la wikipedia, aunque adaptado)
    # Parámetros:
    #   `n` El número cuya primalidad deseamos probar
    #   `k` El número de pruebas que queremos hacer
    # Devuelve:
    #   0 significa que el número `n` es compuesto
    #   1 significa que el número `n` es primo
    #
    proc miller-rabin { n k } {
        set d [expr {$n - 1}]
        while { ($d % 2) == 0 } {
            set d [expr {$d >> 1}]
        }
        for {set i 0} {$i < $k} {incr i} {
            if {[mr-test $d $n] == 0} {
                return 0
            }
        }
        return 1
    }

    # ######################################################################
    # Procedimiento: es-primo
    #   Determina si un número es primo.
    # Parámetros:
    #   `num` El número cuya primalidad será testeada
    # Devuelve:
    #   0 si el número `num` es compuesto
    #   1 si el número `num` es primo
    #
    proc es-primo num {
        # la variable `k` podría ajustarse por parámetro.
        # de momento la calculo en base a la cantidad de bits de `num`, de
        # esta manera habrá un muestreo proporcional al tamaño del número
        set k [expr {2 * [num-bits $num]}]
        if {$k < 8} {set k 8}
        # hacer la prueba `k` veces
        set primo [miller-rabin $num $k]
        return $primo
    }

    # ######################################################################
    # Procedimiento: generar-primo
    #   Devuelve un número primo del tamaño en bytes especificado
    # Parámetros:
    #   `s` es el tamaño en bytes del número deseado
    # Devuelve:
    #   Un número primo
    #
    proc generar-primo s {
        set veces 0
        while { 1 } {
            incr veces
            set p [aleatorio $s]
            if {($p % 2) == 0} {
                continue
            } else {
                # if { [lucas-lehmer $p] } 
                if { [es-primo $p] } {
                    break
                }
            }
        }
        return [list $veces $p]
    }
}