+++ /dev/null
-/* -*-C-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
- 2017 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-*/
-
-/* Interface to mhash library */
-
-#include "scheme.h"
-#include "prims.h"
-#include "usrdef.h"
-#include "os.h"
-
-/* If mhash.h unavailable, ignore it. This helps
- "makegen/makegen.scm" work properly on systems lacking this
- library. */
-#ifdef HAVE_MHASH_H
-# include <mhash.h>
-#endif
-
-#define UNARY_OPERATION(name, get_arg, cvt_val) \
-{ \
- PRIMITIVE_HEADER (1); \
- PRIMITIVE_RETURN (cvt_val (name (get_arg (1)))); \
-}
-
-static SCHEME_OBJECT
-cp2s (void * cp)
-{
- if (cp == 0)
- return (SHARP_F);
- else
- {
- SCHEME_OBJECT s = (char_pointer_to_string (cp));
- free (cp);
- return (s);
- }
-}
-\f
-typedef struct
-{
- MHASH context;
- hashid id;
-} context_entry;
-
-static size_t context_table_length = 0;
-static context_entry * context_table = 0;
-
-static size_t
-search_context_table (MHASH context)
-{
- size_t i;
- for (i = 0; (i < context_table_length); i += 1)
- if (((context_table[i]) . context) == context)
- break;
- return (i);
-}
-
-static size_t
-allocate_context_entry (void)
-{
- size_t i = (search_context_table (0));
- if (i < context_table_length)
- return (i);
- if (i == 0)
- {
- context_table_length = 256;
- context_table
- = (OS_malloc ((sizeof (context_entry)) * context_table_length));
- }
- else
- {
- context_table_length *= 2;
- context_table
- = (OS_realloc (context_table,
- ((sizeof (context_entry)) * context_table_length)));
- }
- {
- size_t j;
- for (j = i; (j < context_table_length); j += 1)
- ((context_table[j]) . context) = 0;
- }
- return (i);
-}
-
-static SCHEME_OBJECT
-store_context (MHASH context, hashid id)
-{
- if (context == MHASH_FAILED)
- return (SHARP_F);
- {
- size_t i = (allocate_context_entry ());
- ((context_table[i]) . context) = context;
- ((context_table[i]) . id) = id;
- return (ulong_to_integer (i));
- }
-}
-
-static void
-forget_context (size_t index)
-{
- ((context_table[index]) . context) = 0;
-}
-
-static size_t
-arg_context_index (unsigned int arg)
-{
- unsigned long n = (arg_ulong_index_integer (arg, context_table_length));
- if (((context_table[n]) . context) == 0)
- error_bad_range_arg (arg);
- return (n);
-}
-
-static MHASH
-arg_context (unsigned int arg)
-{
- return ((context_table [arg_context_index (arg)]) . context);
-}
-\f
-static size_t hashid_count;
-static hashid * hashid_map = 0;
-
-static void
-initialize_hashid_map (void)
-{
- if (hashid_map == 0)
- {
- size_t i = 0;
- size_t j = 0;
- hashid_count = (mhash_count ());
- hashid_map = (OS_malloc ((sizeof (hashid)) * hashid_count));
- while (i <= hashid_count)
- {
- if ((mhash_get_block_size (i)) != 0)
- (hashid_map[j++]) = ((hashid) i);
- i += 1;
- }
- }
-}
-
-static hashid
-arg_hashid (unsigned int arg)
-{
- initialize_hashid_map ();
- return (hashid_map [arg_ulong_index_integer (arg, hashid_count)]);
-}
-
-DEFINE_PRIMITIVE ("MHASH_COUNT", Prim_mhash_count, 0, 0, 0)
-{
- PRIMITIVE_HEADER (0);
- initialize_hashid_map ();
- PRIMITIVE_RETURN (ulong_to_integer (hashid_count));
-}
-
-DEFINE_PRIMITIVE ("MHASH_GET_BLOCK_SIZE", Prim_mhash_get_block_size, 1, 1, 0)
- UNARY_OPERATION (mhash_get_block_size, arg_hashid, ulong_to_integer)
-DEFINE_PRIMITIVE ("MHASH_GET_HASH_PBLOCK", Prim_mhash_get_hash_pblock, 1, 1, 0)
- UNARY_OPERATION (mhash_get_hash_pblock, arg_hashid, ulong_to_integer)
-DEFINE_PRIMITIVE ("MHASH_GET_HASH_NAME", Prim_mhash_get_hash_name, 1, 1, 0)
- UNARY_OPERATION (mhash_get_hash_name, arg_hashid, cp2s)
-\f
-DEFINE_PRIMITIVE ("MHASH_INIT", Prim_mhash_init, 1, 1, 0)
-{
- PRIMITIVE_HEADER (1);
- {
- hashid id = (arg_hashid (1));
- PRIMITIVE_RETURN (store_context ((mhash_init (id)), id));
- }
-}
-
-DEFINE_PRIMITIVE ("MHASH_HMAC_INIT", Prim_mhash_hmac_init, 3, 3, 0)
-{
- PRIMITIVE_HEADER (3);
- CHECK_ARG (2, STRING_P);
- {
- hashid id = (arg_hashid (1));
- SCHEME_OBJECT key = (ARG_REF (2));
- PRIMITIVE_RETURN
- (store_context ((mhash_hmac_init (id,
- (STRING_POINTER (key)),
- (STRING_LENGTH (key)),
- (arg_ulong_integer (3)))),
- id));
- }
-}
-
-DEFINE_PRIMITIVE ("MHASH", Prim_mhash, 4, 4, 0)
-{
- PRIMITIVE_HEADER (4);
- CHECK_ARG (2, STRING_P);
- {
- SCHEME_OBJECT string = (ARG_REF (2));
- unsigned long end
- = (arg_ulong_index_integer (4, ((STRING_LENGTH (string)) + 1)));
- unsigned long start = (arg_ulong_index_integer (3, (end + 1)));
- mhash ((arg_context (1)), (STRING_LOC (string, start)), (end - start));
- }
- PRIMITIVE_RETURN (UNSPECIFIC);
-}
-
-DEFINE_PRIMITIVE ("MHASH_END", Prim_mhash_end, 1, 1, 0)
-{
- PRIMITIVE_HEADER (1);
- {
- size_t index = (arg_context_index (1));
- MHASH context = ((context_table[index]) . context);
- hashid id = ((context_table[index]) . id);
- size_t block_size = (mhash_get_block_size (id));
- /* Must allocate string _before_ calling mhash_end. */
- SCHEME_OBJECT sd = (allocate_string (block_size));
- void * digest = (mhash_end (context));
- forget_context (index);
- memcpy ((STRING_POINTER (sd)), digest, block_size);
- free (digest);
- PRIMITIVE_RETURN (sd);
- }
-}
-
-DEFINE_PRIMITIVE ("MHASH_HMAC_END", Prim_mhash_hmac_end, 1, 1, 0)
-{
- PRIMITIVE_HEADER (1);
- {
- size_t index = (arg_context_index (1));
- MHASH context = ((context_table[index]) . context);
- hashid id = ((context_table[index]) . id);
- size_t block_size = (mhash_get_block_size (id));
- /* Must allocate string _before_ calling mhash_hmac_end. */
- SCHEME_OBJECT sd = (allocate_string (block_size));
- void * digest = (mhash_hmac_end (context));
- forget_context (index);
- memcpy ((STRING_POINTER (sd)), digest, block_size);
- free (digest);
- PRIMITIVE_RETURN (sd);
- }
-}
-\f
-static size_t keygenid_count;
-static keygenid * keygenid_map = 0;
-
-static void
-initialize_keygenid_map (void)
-{
- if (keygenid_map == 0)
- {
- size_t i = 0;
- size_t j = 0;
- keygenid_count = (mhash_keygen_count ());
- keygenid_map = (OS_malloc ((sizeof (keygenid)) * keygenid_count));
- while (j < keygenid_count)
- {
- void * name = (mhash_get_keygen_name (i));
- if (name != 0)
- {
- (keygenid_map[j++]) = ((keygenid) i);
- free (name);
- }
- i += 1;
- }
- }
-}
-
-static keygenid
-arg_keygenid (unsigned int arg)
-{
- initialize_keygenid_map ();
- return (keygenid_map [arg_ulong_index_integer (arg, keygenid_count)]);
-}
-
-DEFINE_PRIMITIVE ("MHASH_KEYGEN_COUNT", Prim_mhash_keygen_count, 0, 0, 0)
-{
- PRIMITIVE_HEADER (0);
- initialize_keygenid_map ();
- PRIMITIVE_RETURN (ulong_to_integer (keygenid_count));
-}
-
-DEFINE_PRIMITIVE ("MHASH_GET_KEYGEN_NAME", Prim_mhash_get_keygen_name, 1, 1, 0)
- UNARY_OPERATION (mhash_get_keygen_name, arg_keygenid, cp2s)
-DEFINE_PRIMITIVE ("MHASH_KEYGEN_USES_SALT", Prim_mhash_keygen_uses_salt, 1, 1, 0)
- UNARY_OPERATION (mhash_keygen_uses_salt, arg_keygenid, BOOLEAN_TO_OBJECT)
-DEFINE_PRIMITIVE ("MHASH_KEYGEN_USES_COUNT", Prim_mhash_keygen_uses_count, 1, 1, 0)
- UNARY_OPERATION (mhash_keygen_uses_count, arg_keygenid, BOOLEAN_TO_OBJECT)
-DEFINE_PRIMITIVE ("MHASH_KEYGEN_USES_HASH_ALGORITHM", Prim_mhash_keygen_uses_hash_algorithm, 1, 1, 0)
- UNARY_OPERATION (mhash_keygen_uses_hash_algorithm, arg_keygenid, long_to_integer)
-DEFINE_PRIMITIVE ("MHASH_GET_KEYGEN_SALT_SIZE", Prim_mhash_get_keygen_salt_size, 1, 1, 0)
- UNARY_OPERATION (mhash_get_keygen_salt_size, arg_keygenid, ulong_to_integer)
-DEFINE_PRIMITIVE ("MHASH_GET_KEYGEN_MAX_KEY_SIZE", Prim_mhash_get_keygen_max_key_size, 1, 1, 0)
- UNARY_OPERATION (mhash_get_keygen_max_key_size, arg_keygenid, ulong_to_integer)
-\f
-DEFINE_PRIMITIVE ("MHASH_KEYGEN", Prim_mhash_keygen, 4, 4, 0)
-{
- /* keygen-id #(salt count hashid ...) keyword passphrase */
- PRIMITIVE_HEADER (4);
- CHECK_ARG (2, VECTOR_P);
- CHECK_ARG (3, STRING_P);
- CHECK_ARG (4, STRING_P);
- {
- keygenid id = (arg_keygenid (1));
- SCHEME_OBJECT parameters = (ARG_REF (2));
- SCHEME_OBJECT keyword = (ARG_REF (3));
- SCHEME_OBJECT passphrase = (ARG_REF (4));
- unsigned int n_algs = (mhash_keygen_uses_hash_algorithm (id));
- SCHEME_OBJECT salt;
- SCHEME_OBJECT count;
- KEYGEN cparms;
- {
- size_t max_key_size = (mhash_get_keygen_max_key_size (id));
- if ((max_key_size != 0) && ((STRING_LENGTH (keyword)) > max_key_size))
- error_bad_range_arg (4);
- }
- if ((VECTOR_LENGTH (parameters)) != (2 + n_algs))
- error_bad_range_arg (2);
- salt = (VECTOR_REF (parameters, 0));
- count = (VECTOR_REF (parameters, 1));
- if (mhash_keygen_uses_salt (id))
- {
- if (!STRING_P (salt))
- error_bad_range_arg (2);
- {
- size_t salt_size = (mhash_get_keygen_salt_size (id));
- if ((salt_size != 0) && ((STRING_LENGTH (salt)) != salt_size))
- error_bad_range_arg (2);
- }
- (cparms . salt) = (STRING_BYTE_PTR (salt));
- (cparms . salt_size) = (STRING_LENGTH (salt));
- }
- else if (salt != SHARP_F)
- error_bad_range_arg (2);
- if (mhash_keygen_uses_count (id))
- {
- if (!integer_to_ulong_p (count))
- error_bad_range_arg (2);
- (cparms . count) = (integer_to_ulong (count));
- }
- else if (count != SHARP_F)
- error_bad_range_arg (2);
- {
- unsigned int i;
- initialize_hashid_map ();
- for (i = 0; (i < n_algs); i += 1)
- {
- SCHEME_OBJECT a = (VECTOR_REF (parameters, (2 + i)));
- if (!integer_to_ulong_p (a))
- error_bad_range_arg (2);
- {
- unsigned long ia = (integer_to_ulong (a));
- if (ia < hashid_count)
- ((cparms . hash_algorithm) [i]) = (hashid_map[ia]);
- else
- error_bad_range_arg (2);
- }
- }
- }
- PRIMITIVE_RETURN
- (BOOLEAN_TO_OBJECT
- ((mhash_keygen_ext (id, cparms,
- (STRING_POINTER (keyword)),
- (STRING_LENGTH (keyword)),
- (STRING_BYTE_PTR (passphrase)),
- (STRING_LENGTH (passphrase))))
- == 0));
- }
-}
-
-#ifdef COMPILE_AS_MODULE
-
-char *
-dload_initialize_file (void)
-{
- declare_primitive
- ("MHASH_COUNT", Prim_mhash_count, 0, 0, 0);
- declare_primitive
- ("MHASH_GET_BLOCK_SIZE", Prim_mhash_get_block_size, 1, 1, 0);
- declare_primitive
- ("MHASH_GET_HASH_PBLOCK", Prim_mhash_get_hash_pblock, 1, 1, 0);
- declare_primitive
- ("MHASH_GET_HASH_NAME", Prim_mhash_get_hash_name, 1, 1, 0);
- declare_primitive
- ("MHASH_INIT", Prim_mhash_init, 1, 1, 0);
- declare_primitive
- ("MHASH_HMAC_INIT", Prim_mhash_hmac_init, 3, 3, 0);
- declare_primitive
- ("MHASH", Prim_mhash, 4, 4, 0);
- declare_primitive
- ("MHASH_END", Prim_mhash_end, 1, 1, 0);
- declare_primitive
- ("MHASH_HMAC_END", Prim_mhash_hmac_end, 1, 1, 0);
- declare_primitive
- ("MHASH_KEYGEN_COUNT", Prim_mhash_keygen_count, 0, 0, 0);
- declare_primitive
- ("MHASH_GET_KEYGEN_NAME", Prim_mhash_get_keygen_name, 1, 1, 0);
- declare_primitive
- ("MHASH_KEYGEN_USES_SALT", Prim_mhash_keygen_uses_salt, 1, 1, 0);
- declare_primitive
- ("MHASH_KEYGEN_USES_COUNT", Prim_mhash_keygen_uses_count, 1, 1, 0);
- declare_primitive
- ("MHASH_KEYGEN_USES_HASH_ALGORITHM", Prim_mhash_keygen_uses_hash_algorithm, 1, 1, 0);
- declare_primitive
- ("MHASH_GET_KEYGEN_SALT_SIZE", Prim_mhash_get_keygen_salt_size, 1, 1, 0);
- declare_primitive
- ("MHASH_GET_KEYGEN_MAX_KEY_SIZE", Prim_mhash_get_keygen_max_key_size, 1, 1, 0);
- declare_primitive
- ("MHASH_KEYGEN", Prim_mhash_keygen, 4, 4, 0);
- return "#prmd5";
-}
-
-#endif /* COMPILE_AS_MODULE */
(declare (usual-integrations))
\f
-;;;; The mhash library
-
-(define mhash-initialized?)
-(define mhash-algorithm-names)
-(define mhash-contexts)
-(define mhash-hmac-contexts)
-
-(define (mhash-name->id name procedure)
- (let ((n (vector-length mhash-algorithm-names)))
- (let loop ((i 0))
- (cond ((fix:= i n) (error:bad-range-argument name procedure))
- ((eq? name (vector-ref mhash-algorithm-names i)) i)
- (else (loop (fix:+ i 1)))))))
-
-(define-structure mhash-context index)
-(define-structure mhash-hmac-context index)
-
-(define (guarantee-mhash-context object caller)
- (if (not (mhash-context? object))
- (error:wrong-type-argument object "mhash context" caller))
- (if (not (mhash-context-index object))
- (error:bad-range-argument object caller)))
-
-(define (guarantee-mhash-hmac-context object caller)
- (if (not (mhash-hmac-context? object))
- (error:wrong-type-argument object "mhash HMAC context" caller))
- (if (not (mhash-hmac-context-index object))
- (error:bad-range-argument object caller)))
-
-(define (mhash-type-names)
- (names-vector->list mhash-algorithm-names))
-
-(define (mhash-get-block-size name)
- ((ucode-primitive mhash_get_block_size 1)
- (mhash-name->id name 'mhash-get-block-size)))
-
-(define (mhash-init name)
- (let ((id (mhash-name->id name 'mhash-init)))
- (without-interruption
- (lambda ()
- (let ((index ((ucode-primitive mhash_init 1) id)))
- (if (not index)
- (error "Unable to allocate mhash context:" name))
- (add-to-gc-finalizer! mhash-contexts (make-mhash-context index)))))))
-
-(define (mhash-update context bytes start end)
- (guarantee-mhash-context context 'mhash-update)
- ((ucode-primitive mhash 4) (mhash-context-index context) bytes start end))
-
-(define (mhash-end context)
- (remove-from-gc-finalizer! mhash-contexts context))
-
-(define (mhash-hmac-init name key)
- (let* ((id (mhash-name->id name 'mhash-init))
- (pblock ((ucode-primitive mhash_get_hash_pblock 1) id)))
- (without-interruption
- (lambda ()
- (let ((index ((ucode-primitive mhash_hmac_init 3) id key pblock)))
- (if (not index)
- (error "Unable to allocate mhash HMAC context:" name))
- (add-to-gc-finalizer! mhash-hmac-contexts
- (make-mhash-hmac-context index)))))))
-
-(define (mhash-hmac-update context bytes start end)
- (guarantee-mhash-hmac-context context 'mhash-hmac-update)
- ((ucode-primitive mhash 4) (mhash-hmac-context-index context)
- bytes start end))
-
-(define (mhash-hmac-end context)
- (remove-from-gc-finalizer! mhash-hmac-contexts context))
-\f
-(define mhash-keygen-names)
-
-(define (keygen-name->id name caller)
- (let ((n (vector-length mhash-keygen-names)))
- (let loop ((i 0))
- (cond ((fix:= i n) (error:bad-range-argument name caller))
- ((eq? name (vector-ref mhash-keygen-names i)) i)
- (else (loop (fix:+ i 1)))))))
-
-(define (mhash-keygen-type-names)
- (names-vector->list mhash-keygen-names))
-
-(define (mhash-keygen-uses-salt? name)
- ((ucode-primitive mhash_keygen_uses_salt 1)
- (keygen-name->id name 'mhash-keygen-uses-salt?)))
-
-(define (mhash-keygen-uses-count? name)
- ((ucode-primitive mhash_keygen_uses_count 1)
- (keygen-name->id name 'mhash-keygen-uses-count?)))
-
-(define (mhash-keygen-uses-hash-algorithm name)
- ((ucode-primitive mhash_keygen_uses_hash_algorithm 1)
- (keygen-name->id name 'mhash-keygen-uses-hash-algorithm)))
-
-(define (mhash-keygen-salt-size name)
- ((ucode-primitive mhash_get_keygen_salt_size 1)
- (keygen-name->id name 'mhash-keygen-salt-size)))
-
-(define (mhash-keygen-max-key-size name)
- ((ucode-primitive mhash_get_keygen_max_key_size 1)
- (keygen-name->id name 'mhash-keygen-max-key-size)))
-
-(define (mhash-keygen type passphrase #!optional salt)
- (if (not (mhash-keygen-type? type))
- (error:wrong-type-argument type "mhash type" 'mhash-keygen))
- (let ((id (mhash-keygen-type-id type))
- (keyword (make-bytevector (mhash-keygen-type-key-length type)))
- (v (mhash-keygen-type-parameter-vector type)))
- (if (not ((ucode-primitive mhash_keygen 4)
- id
- (if ((ucode-primitive mhash_keygen_uses_salt 1) id)
- (begin
- (if (or (default-object? salt) (not salt))
- (error "Salt required:"
- (vector-ref mhash-keygen-names id)))
- (let ((n
- ((ucode-primitive mhash_get_keygen_salt_size 1)
- id)))
- (if (not (or (= n 0)
- (= n (bytevector-length salt))))
- (error "Salt size incorrect:"
- (bytevector-length salt)
- (error-irritant/noise "; should be:")
- n)))
- (let ((v (vector-copy v)))
- (vector-set! v 0 salt)
- v))
- v)
- keyword
- passphrase))
- (error "Error signalled by mhash_keygen."))
- keyword))
-\f
-(define-structure (mhash-keygen-type (constructor %make-mhash-keygen-type))
- (id #f read-only #t)
- (key-length #f read-only #t)
- (parameter-vector #f read-only #t))
-
-(define (make-mhash-keygen-type name key-length hash-names #!optional count)
- (guarantee index-fixnum? key-length 'make-mhash-keygen-type)
- (if (not (let ((m (mhash-keygen-max-key-size name)))
- (or (= m 0)
- (<= key-length m))))
- (error:bad-range-argument key-length 'make-mhash-keygen-type))
- (%make-mhash-keygen-type
- (keygen-name->id name 'make-mhash-keygen-type)
- key-length
- (let ((n-algorithms (mhash-keygen-uses-hash-algorithm name))
- (hash-names
- (if (list? hash-names) hash-names (list hash-names))))
- (let ((m (length hash-names)))
- (if (not (= n-algorithms m))
- (error "Wrong number of hash types supplied:"
- m
- (error-irritant/noise "; should be:")
- n-algorithms)))
- (let ((n (+ 2 n-algorithms)))
- (let ((v (make-vector n)))
- (vector-set! v 0 #f)
- (vector-set!
- v 1
- (and (mhash-keygen-uses-count? name)
- (begin
- (if (or (default-object? count) (not count))
- (error "Iteration count required:" name))
- (if (not (and (exact-integer? count)
- (positive? count)))
- (error:bad-range-argument count 'make-mhash-keygen-type))
- count)))
- (do ((i 2 (fix:+ i 1))
- (names hash-names (cdr names)))
- ((fix:= i n))
- (vector-set! v i
- (mhash-name->id (car names) 'make-mhash-keygen-type)))
- v)))))
-\f
-(define (mhash-available?)
- (load-library-object-file "prmhash" #f)
- (and (implemented-primitive-procedure? (ucode-primitive mhash 4))
- (begin
- (if (not mhash-initialized?)
- (begin
- (set! mhash-algorithm-names
- (make-names-vector
- (ucode-primitive mhash_count 0)
- (ucode-primitive mhash_get_hash_name 1)))
- (set! mhash-contexts
- (make-gc-finalizer (ucode-primitive mhash_end 1)
- mhash-context?
- mhash-context-index
- set-mhash-context-index!))
- (set! mhash-hmac-contexts
- (make-gc-finalizer (ucode-primitive mhash_hmac_end 1)
- mhash-hmac-context?
- mhash-hmac-context-index
- set-mhash-hmac-context-index!))
- (set! mhash-keygen-names
- (make-names-vector
- (ucode-primitive mhash_keygen_count 0)
- (ucode-primitive mhash_get_keygen_name 1)))
- (set! mhash-initialized? #t)))
- #t)))
-
-(define (reset-mhash-variables!)
- (set! mhash-initialized? #f)
- unspecific)
-
-(define (mhash-file hash-type filename)
- (call-with-binary-input-file filename
- (port-consumer (lambda () (mhash-init hash-type))
- mhash-update
- mhash-end)))
-
-(define (mhash-string hash-type string #!optional start end)
- (mhash-bytevector hash-type (string->utf8 string start end)))
-
-(define (mhash-bytevector hash-type bytes #!optional start end)
- (let* ((end (fix:end-index end (bytevector-length bytes) 'mhash-bytevector))
- (start (fix:start-index start end 'mhash-bytevector))
- (context (mhash-init hash-type)))
- (mhash-update context bytes start end)
- (mhash-end context)))
-\f
;;;; MD5
(define (md5-available?)
;;;; Package initialization
(define (initialize-package!)
- (reset-mhash-variables!)
- (add-event-receiver! event:after-restart reset-mhash-variables!)
(reset-mcrypt-variables!)
(add-event-receiver! event:after-restart reset-mcrypt-variables!))
projects / mit-scheme.git / commitdiff