home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / prmhash.c < prev    next >
C/C++ Source or Header  |  2001-03-09  |  12KB  |  416 lines
  1. /* -*-C-*-
  2.  
  3. $Id: prmhash.c,v 11.3 2001/03/09 16:13:02 cph Exp $
  4.  
  5. Copyright (c) 2000-2001 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* Interface to mhash library */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "usrdef.h"
  27. #include "os.h"
  28. #include <mhash.h>
  29.  
  30. #define UNARY_OPERATION(name, get_arg, cvt_val)                \
  31. {                                    \
  32.   PRIMITIVE_HEADER (1);                            \
  33.   PRIMITIVE_RETURN (cvt_val (name (get_arg (1))));            \
  34. }
  35.  
  36. static SCHEME_OBJECT
  37. cp2s (char * cp)
  38. {
  39.   if (cp == 0)
  40.     return (SHARP_F);
  41.   else
  42.     {
  43.       SCHEME_OBJECT s = (char_pointer_to_string (cp));
  44.       free (cp);
  45.       return (s);
  46.     }
  47. }
  48.  
  49. typedef struct
  50. {
  51.   MHASH context;
  52.   hashid id;
  53. } context_entry;
  54.  
  55. static size_t context_table_length = 0;
  56. static context_entry * context_table = 0;
  57.  
  58. static size_t
  59. search_context_table (MHASH context)
  60. {
  61.   size_t i;
  62.   for (i = 0; (i < context_table_length); i += 1)
  63.     if (((context_table[i]) . context) == context)
  64.       break;
  65.   return (i);
  66. }
  67.  
  68. static size_t
  69. allocate_context_entry (void)
  70. {
  71.   size_t i = (search_context_table (0));
  72.   if (i < context_table_length)
  73.     return (i);
  74.   if (i == 0)
  75.     {
  76.       context_table_length = 256;
  77.       context_table
  78.     = (OS_malloc ((sizeof (context_entry)) * context_table_length));
  79.     }
  80.   else
  81.     {
  82.       context_table_length *= 2;
  83.       context_table
  84.     = (OS_realloc (context_table,
  85.                ((sizeof (context_entry)) * context_table_length)));
  86.     }
  87.   {
  88.     size_t j;
  89.     for (j = i; (j < context_table_length); j += 1)
  90.       ((context_table[j]) . context) = 0;
  91.   }
  92.   return (i);
  93. }
  94.  
  95. static SCHEME_OBJECT
  96. store_context (MHASH context, hashid id)
  97. {
  98.   if (context == MHASH_FAILED)
  99.     return (SHARP_F);
  100.   {
  101.     size_t i = (allocate_context_entry ());
  102.     ((context_table[i]) . context) = context;
  103.     ((context_table[i]) . id) = id;
  104.     return (ulong_to_integer (i));
  105.   }
  106. }
  107.  
  108. static void
  109. forget_context (size_t index)
  110. {
  111.   ((context_table[index]) . context) = 0;
  112. }
  113.  
  114. static size_t
  115. arg_context_index (unsigned int arg)
  116. {
  117.   unsigned long n = (arg_ulong_index_integer (arg, context_table_length));
  118.   if (((context_table[n]) . context) == 0)
  119.     error_bad_range_arg (arg);
  120.   return (n);
  121. }
  122.  
  123. static MHASH
  124. arg_context (unsigned int arg)
  125. {
  126.   return ((context_table [arg_context_index (arg)]) . context);
  127. }
  128.  
  129. static size_t hashid_count;
  130. static hashid * hashid_map = 0;
  131.  
  132. static void
  133. initialize_hashid_map (void)
  134. {
  135.   if (hashid_map == 0)
  136.     {
  137.       size_t i = 0;
  138.       size_t j = 0;
  139.       hashid_count = (mhash_count ());
  140.       hashid_map = (OS_malloc ((sizeof (hashid)) * hashid_count));
  141.       while (j < hashid_count)
  142.     {
  143.       if ((mhash_get_block_size (i)) != 0)
  144.         (hashid_map[j++]) = ((hashid) i);
  145.       i += 1;
  146.     }
  147.     }
  148. }
  149.  
  150. static hashid
  151. arg_hashid (unsigned int arg)
  152. {
  153.   initialize_hashid_map ();
  154.   return (hashid_map [arg_ulong_index_integer (arg, hashid_count)]);
  155. }
  156.  
  157. DEFINE_PRIMITIVE ("MHASH_COUNT", Prim_mhash_count, 0, 0, 0)
  158. {
  159.   PRIMITIVE_HEADER (0);
  160.   initialize_hashid_map ();
  161.   PRIMITIVE_RETURN (ulong_to_integer (hashid_count));
  162. }
  163.  
  164. DEFINE_PRIMITIVE ("MHASH_GET_BLOCK_SIZE", Prim_mhash_get_block_size, 1, 1, 0)
  165.   UNARY_OPERATION (mhash_get_block_size, arg_hashid, ulong_to_integer)
  166. DEFINE_PRIMITIVE ("MHASH_GET_HASH_PBLOCK", Prim_mhash_get_hash_pblock, 1, 1, 0)
  167.   UNARY_OPERATION (mhash_get_hash_pblock, arg_hashid, ulong_to_integer)
  168. DEFINE_PRIMITIVE ("MHASH_GET_HASH_NAME", Prim_mhash_get_hash_name, 1, 1, 0)
  169.   UNARY_OPERATION (mhash_get_hash_name, arg_hashid, cp2s)
  170.  
  171. DEFINE_PRIMITIVE ("MHASH_INIT", Prim_mhash_init, 1, 1, 0)
  172. {
  173.   PRIMITIVE_HEADER (1);
  174.   {
  175.     hashid id = (arg_hashid (1));
  176.     PRIMITIVE_RETURN (store_context ((mhash_init (id)), id));
  177.   }
  178. }
  179.  
  180. DEFINE_PRIMITIVE ("MHASH_HMAC_INIT", Prim_mhash_hmac_init, 3, 3, 0)
  181. {
  182.   PRIMITIVE_HEADER (3);
  183.   CHECK_ARG (2, STRING_P);
  184.   {
  185.     hashid id = (arg_hashid (1));
  186.     SCHEME_OBJECT key = (ARG_REF (2));
  187.     PRIMITIVE_RETURN
  188.       (store_context ((mhash_hmac_init (id,
  189.                     (STRING_LOC (key, 0)),
  190.                     (STRING_LENGTH (key)),
  191.                     (arg_ulong_integer (3)))),
  192.               id));
  193.   }
  194. }
  195.  
  196. DEFINE_PRIMITIVE ("MHASH", Prim_mhash, 4, 4, 0)
  197. {
  198.   PRIMITIVE_HEADER (4);
  199.   CHECK_ARG (2, STRING_P);
  200.   {
  201.     SCHEME_OBJECT string = (ARG_REF (2));
  202.     unsigned long l = (STRING_LENGTH (string));
  203.     unsigned long start = (arg_ulong_index_integer (3, l));
  204.     unsigned long end = (arg_integer_in_range (4, start, (l + 1)));
  205.     mhash ((arg_context (1)), (STRING_LOC (string, start)), (end - start));
  206.   }
  207.   PRIMITIVE_RETURN (UNSPECIFIC);
  208. }
  209.  
  210. DEFINE_PRIMITIVE ("MHASH_END", Prim_mhash_end, 1, 1, 0)
  211. {
  212.   PRIMITIVE_HEADER (1);
  213.   {
  214.     size_t index = (arg_context_index (1));
  215.     MHASH context = ((context_table[index]) . context);
  216.     hashid id = ((context_table[index]) . id);
  217.     size_t block_size = (mhash_get_block_size (id));
  218.     /* Must allocate string _before_ calling mhash_end.  */
  219.     SCHEME_OBJECT sd = (allocate_string (block_size));
  220.     void * digest = (mhash_end (context));
  221.     forget_context (index);
  222.     memcpy ((STRING_LOC (sd, 0)), digest, block_size);
  223.     free (digest);
  224.     PRIMITIVE_RETURN (sd);
  225.   }
  226. }
  227.  
  228. DEFINE_PRIMITIVE ("MHASH_HMAC_END", Prim_mhash_hmac_end, 1, 1, 0)
  229. {
  230.   PRIMITIVE_HEADER (1);
  231.   {
  232.     size_t index = (arg_context_index (1));
  233.     MHASH context = ((context_table[index]) . context);
  234.     hashid id = ((context_table[index]) . id);
  235.     size_t block_size = (mhash_get_block_size (id));
  236.     /* Must allocate string _before_ calling mhash_hmac_end.  */
  237.     SCHEME_OBJECT sd = (allocate_string (block_size));
  238.     void * digest = (mhash_hmac_end (context));
  239.     forget_context (index);
  240.     memcpy ((STRING_LOC (sd, 0)), digest, block_size);
  241.     free (digest);
  242.     PRIMITIVE_RETURN (sd);
  243.   }
  244. }
  245.  
  246. static size_t keygenid_count;
  247. static keygenid * keygenid_map = 0;
  248.  
  249. static void
  250. initialize_keygenid_map (void)
  251. {
  252.   if (keygenid_map == 0)
  253.     {
  254.       size_t i = 0;
  255.       size_t j = 0;
  256.       keygenid_count = (mhash_keygen_count ());
  257.       keygenid_map = (OS_malloc ((sizeof (keygenid)) * keygenid_count));
  258.       while (j < keygenid_count)
  259.     {
  260.       char * name = (mhash_get_keygen_name (i));
  261.       if (name != 0)
  262.         {
  263.           (keygenid_map[j++]) = ((keygenid) i);
  264.           free (name);
  265.         }
  266.       i += 1;
  267.     }
  268.     }
  269. }
  270.  
  271. static keygenid
  272. arg_keygenid (unsigned int arg)
  273. {
  274.   initialize_keygenid_map ();
  275.   return (keygenid_map [arg_ulong_index_integer (arg, keygenid_count)]);
  276. }
  277.  
  278. DEFINE_PRIMITIVE ("MHASH_KEYGEN_COUNT", Prim_mhash_keygen_count, 0, 0, 0)
  279. {
  280.   PRIMITIVE_HEADER (0);
  281.   initialize_keygenid_map ();
  282.   PRIMITIVE_RETURN (ulong_to_integer (keygenid_count));
  283. }
  284.  
  285. DEFINE_PRIMITIVE ("MHASH_GET_KEYGEN_NAME", Prim_mhash_get_keygen_name, 1, 1, 0)
  286.   UNARY_OPERATION (mhash_get_keygen_name, arg_keygenid, cp2s)
  287. DEFINE_PRIMITIVE ("MHASH_KEYGEN_USES_SALT", Prim_mhash_keygen_uses_salt, 1, 1, 0)
  288.   UNARY_OPERATION (mhash_keygen_uses_salt, arg_keygenid, BOOLEAN_TO_OBJECT)
  289. DEFINE_PRIMITIVE ("MHASH_KEYGEN_USES_COUNT", Prim_mhash_keygen_uses_count, 1, 1, 0)
  290.   UNARY_OPERATION (mhash_keygen_uses_count, arg_keygenid, BOOLEAN_TO_OBJECT)
  291. DEFINE_PRIMITIVE ("MHASH_KEYGEN_USES_HASH_ALGORITHM", Prim_mhash_keygen_uses_hash_algorithm, 1, 1, 0)
  292.   UNARY_OPERATION (mhash_keygen_uses_hash_algorithm, arg_keygenid, long_to_integer)
  293. DEFINE_PRIMITIVE ("MHASH_GET_KEYGEN_SALT_SIZE", Prim_mhash_get_keygen_salt_size, 1, 1, 0)
  294.   UNARY_OPERATION (mhash_get_keygen_salt_size, arg_keygenid, ulong_to_integer)
  295. DEFINE_PRIMITIVE ("MHASH_GET_KEYGEN_MAX_KEY_SIZE", Prim_mhash_get_keygen_max_key_size, 1, 1, 0)
  296.   UNARY_OPERATION (mhash_get_keygen_max_key_size, arg_keygenid, ulong_to_integer)
  297.  
  298. DEFINE_PRIMITIVE ("MHASH_KEYGEN", Prim_mhash_keygen, 4, 4, 0)
  299. {
  300.   /* keygen-id #(salt count hashid ...) keyword passphrase */
  301.   PRIMITIVE_HEADER (4);
  302.   CHECK_ARG (2, VECTOR_P);
  303.   CHECK_ARG (3, STRING_P);
  304.   CHECK_ARG (4, STRING_P);
  305.   {
  306.     keygenid id = (arg_keygenid (1));
  307.     SCHEME_OBJECT parameters = (ARG_REF (2));
  308.     SCHEME_OBJECT keyword = (ARG_REF (3));
  309.     SCHEME_OBJECT passphrase = (ARG_REF (4));
  310.     unsigned int n_algs = (mhash_keygen_uses_hash_algorithm (id));
  311.     SCHEME_OBJECT salt;
  312.     SCHEME_OBJECT count;
  313.     KEYGEN cparms;
  314.     {
  315.       size_t max_key_size = (mhash_get_keygen_max_key_size (id));
  316.       if ((max_key_size != 0) && ((STRING_LENGTH (keyword)) > max_key_size))
  317.     error_bad_range_arg (4);
  318.     }
  319.     if ((VECTOR_LENGTH (parameters)) != (2 + n_algs))
  320.       error_bad_range_arg (2);
  321.     salt = (VECTOR_REF (parameters, 0));
  322.     count = (VECTOR_REF (parameters, 1));
  323.     if (mhash_keygen_uses_salt (id))
  324.       {
  325.     if (!STRING_P (salt))
  326.       error_bad_range_arg (2);
  327.     {
  328.       size_t salt_size = (mhash_get_keygen_salt_size (id));
  329.       if ((salt_size != 0) && ((STRING_LENGTH (salt)) != salt_size))
  330.         error_bad_range_arg (2);
  331.     }
  332.     (cparms . salt) = (STRING_LOC (salt, 0));
  333.     (cparms . salt_size) = (STRING_LENGTH (salt));
  334.       }
  335.     else if (salt != SHARP_F)
  336.       error_bad_range_arg (2);
  337.     if (mhash_keygen_uses_count (id))
  338.       {
  339.     if (!integer_to_ulong_p (count))
  340.       error_bad_range_arg (2);
  341.     (cparms . count) = (integer_to_ulong (count));
  342.       }
  343.     else if (count != SHARP_F)
  344.       error_bad_range_arg (2);
  345.     {
  346.       unsigned int i;
  347.       initialize_hashid_map ();
  348.       for (i = 0; (i < n_algs); i += 1)
  349.     {
  350.       SCHEME_OBJECT a = (VECTOR_REF (parameters, (2 + i)));
  351.       if (!integer_to_ulong_p (a))
  352.         error_bad_range_arg (2);
  353.       {
  354.         unsigned long ia = (integer_to_ulong (a));
  355.         if (ia < hashid_count)
  356.           ((cparms . hash_algorithm) [i]) = (hashid_map[ia]);
  357.         else
  358.           error_bad_range_arg (2);
  359.       }
  360.     }
  361.     }
  362.     PRIMITIVE_RETURN
  363.       (BOOLEAN_TO_OBJECT
  364.        ((mhash_keygen_ext (id, cparms,
  365.                (STRING_LOC (keyword, 0)),
  366.                (STRING_LENGTH (keyword)),
  367.                (STRING_LOC (passphrase, 0)),
  368.                (STRING_LENGTH (passphrase))))
  369.     == 0));
  370.   }
  371. }
  372.  
  373. #ifdef COMPILE_AS_MODULE
  374.  
  375. char *
  376. DEFUN_VOID (dload_initialize_file)
  377. {
  378.   declare_primitive
  379.     ("MHASH_COUNT", Prim_mhash_count, 0, 0, 0);
  380.   declare_primitive
  381.     ("MHASH_GET_BLOCK_SIZE", Prim_mhash_get_block_size, 1, 1, 0);
  382.   declare_primitive
  383.     ("MHASH_GET_HASH_PBLOCK", Prim_mhash_get_hash_pblock, 1, 1, 0);
  384.   declare_primitive
  385.     ("MHASH_GET_HASH_NAME", Prim_mhash_get_hash_name, 1, 1, 0);
  386.   declare_primitive
  387.     ("MHASH_INIT", Prim_mhash_init, 1, 1, 0);
  388.   declare_primitive
  389.     ("MHASH_HMAC_INIT", Prim_mhash_hmac_init, 3, 3, 0);
  390.   declare_primitive
  391.     ("MHASH", Prim_mhash, 4, 4, 0);
  392.   declare_primitive
  393.     ("MHASH_END", Prim_mhash_end, 1, 1, 0);
  394.   declare_primitive
  395.     ("MHASH_HMAC_END", Prim_mhash_hmac_end, 1, 1, 0);
  396.   declare_primitive
  397.     ("MHASH_KEYGEN_COUNT", Prim_mhash_keygen_count, 0, 0, 0);
  398.   declare_primitive
  399.     ("MHASH_GET_KEYGEN_NAME", Prim_mhash_get_keygen_name, 1, 1, 0);
  400.   declare_primitive
  401.     ("MHASH_KEYGEN_USES_SALT", Prim_mhash_keygen_uses_salt, 1, 1, 0);
  402.   declare_primitive
  403.     ("MHASH_KEYGEN_USES_COUNT", Prim_mhash_keygen_uses_count, 1, 1, 0);
  404.   declare_primitive
  405.     ("MHASH_KEYGEN_USES_HASH_ALGORITHM", Prim_mhash_keygen_uses_hash_algorithm, 1, 1, 0);
  406.   declare_primitive
  407.     ("MHASH_GET_KEYGEN_SALT_SIZE", Prim_mhash_get_keygen_salt_size, 1, 1, 0);
  408.   declare_primitive
  409.     ("MHASH_GET_KEYGEN_MAX_KEY_SIZE", Prim_mhash_get_keygen_max_key_size, 1, 1, 0);
  410.   declare_primitive
  411.      ("MHASH_KEYGEN", Prim_mhash_keygen, 4, 4, 0);
  412.   return "#prmd5";
  413. }
  414.  
  415. #endif /* COMPILE_AS_MODULE */
  416.