X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/6346d30171fa8047e292076a2407fedee64479da..7b3747f94c02ea17912b8872e0d468cbc760a9fe:/src/fns.c
diff --git a/src/fns.c b/src/fns.c
index 987d5a6564..8cccd7485d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -23,6 +23,8 @@ along with GNU Emacs. If not, see . */
#include
#include
+#include
+
#include "lisp.h"
#include "commands.h"
#include "character.h"
@@ -51,6 +53,8 @@ Lisp_Object Qcursor_in_echo_area;
static Lisp_Object Qwidget_type;
static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
+static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
+
static int internal_equal (Lisp_Object , Lisp_Object, int, int);
#ifndef HAVE_UNISTD_H
@@ -168,7 +172,7 @@ which is at least the number of distinct elements. */)
uintmax_t lolen = 1;
if (! CONSP (list))
- return 0;
+ return make_number (0);
/* halftail is used to detect circular lists. */
for (tail = halftail = list; ; )
@@ -436,7 +440,7 @@ with the original. */)
if (BOOL_VECTOR_P (arg))
{
Lisp_Object val;
- int size_in_chars
+ ptrdiff_t size_in_chars
= ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
@@ -565,8 +569,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
}
result_len += len;
- if (result_len < 0)
- error ("String overflow");
+ if (STRING_BYTES_BOUND < result_len)
+ string_overflow ();
}
if (! some_multibyte)
@@ -2139,7 +2143,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
(Lisp_Object array, Lisp_Object item)
{
register EMACS_INT size, idx;
- int charval;
if (VECTORP (array))
{
@@ -2159,27 +2162,21 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
else if (STRINGP (array))
{
register unsigned char *p = SDATA (array);
- CHECK_NUMBER (item);
- charval = XINT (item);
+ int charval;
+ CHECK_CHARACTER (item);
+ charval = XFASTINT (item);
size = SCHARS (array);
if (STRING_MULTIBYTE (array))
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
EMACS_INT size_byte = SBYTES (array);
- unsigned char *p1 = p, *endp = p + size_byte;
- int i;
- if (size != size_byte)
- while (p1 < endp)
- {
- int this_len = BYTES_BY_CHAR_HEAD (*p1);
- if (len != this_len)
- error ("Attempt to change byte length of a string");
- p1 += this_len;
- }
- for (i = 0; i < size_byte; i++)
- *p++ = str[i % len];
+ if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
+ || SCHARS (array) * len != size_byte)
+ error ("Attempt to change byte length of a string");
+ for (idx = 0; idx < size_byte; idx++)
+ *p++ = str[idx % len];
}
else
for (idx = 0; idx < size; idx++)
@@ -2188,19 +2185,18 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
else if (BOOL_VECTOR_P (array))
{
register unsigned char *p = XBOOL_VECTOR (array)->data;
- int size_in_chars
- = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ EMACS_INT size_in_chars;
+ size = XBOOL_VECTOR (array)->size;
+ size_in_chars
+ = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
- charval = (! NILP (item) ? -1 : 0);
- for (idx = 0; idx < size_in_chars - 1; idx++)
- p[idx] = charval;
- if (idx < size_in_chars)
+ if (size_in_chars)
{
- /* Mask out bits beyond the vector size. */
- if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
- charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
- p[idx] = charval;
+ memset (p, ! NILP (item) ? -1 : 0, size_in_chars);
+
+ /* Clear any extraneous bits in the last byte. */
+ p[size_in_chars - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
}
}
else
@@ -2314,7 +2310,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
for (i = 0; i < leni; i++)
{
- int byte;
+ unsigned char byte;
byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil;
dummy = call1 (fn, dummy);
@@ -2542,8 +2538,8 @@ advisable. */)
while (loads-- > 0)
{
- Lisp_Object load = (NILP (use_floats) ?
- make_number ((int) (100.0 * load_ave[loads]))
+ Lisp_Object load = (NILP (use_floats)
+ ? make_number (100.0 * load_ave[loads])
: make_float (load_ave[loads]));
ret = Fcons (load, ret);
}
@@ -2617,6 +2613,8 @@ is not loaded; so load the file FILENAME.
If FILENAME is omitted, the printname of FEATURE is used as the file name,
and `load' will try to load this name appended with the suffix `.elc' or
`.el', in that order. The name without appended suffix will not be used.
+If your system supports it, `.elc.gz' and `.el.gz' files will also be
+considered. See `get-load-suffixes' for the complete list of suffixes.
If the optional third argument NOERROR is non-nil,
then return nil if the file is not found instead of signaling an error.
Normally the return value is FEATURE.
@@ -4550,21 +4548,18 @@ including negative integers. */)
/************************************************************************
- MD5 and SHA1
+ MD5, SHA-1, and SHA-2
************************************************************************/
#include "md5.h"
#include "sha1.h"
+#include "sha256.h"
+#include "sha512.h"
-/* Convert a possibly-signed character to an unsigned character. This is
- a bit safer than casting to unsigned char, since it catches some type
- errors that the cast doesn't. */
-static inline unsigned char to_uchar (char ch) { return ch; }
-
-/* TYPE: 0 for md5, 1 for sha1. */
+/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
static Lisp_Object
-crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary)
+secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary)
{
int i;
EMACS_INT size;
@@ -4574,7 +4569,11 @@ crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Obje
register EMACS_INT b, e;
register struct buffer *bp;
EMACS_INT temp;
- Lisp_Object res=Qnil;
+ int digest_size;
+ void *(*hash_func) (const char *, size_t, void *);
+ Lisp_Object digest;
+
+ CHECK_SYMBOL (algorithm);
if (STRINGP (object))
{
@@ -4745,47 +4744,61 @@ crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Obje
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
}
- switch (type)
+ if (EQ (algorithm, Qmd5))
{
- case 0: /* MD5 */
- {
- char digest[16];
- md5_buffer (SSDATA (object) + start_byte,
- SBYTES (object) - (size_byte - end_byte),
- digest);
+ digest_size = MD5_DIGEST_SIZE;
+ hash_func = md5_buffer;
+ }
+ else if (EQ (algorithm, Qsha1))
+ {
+ digest_size = SHA1_DIGEST_SIZE;
+ hash_func = sha1_buffer;
+ }
+ else if (EQ (algorithm, Qsha224))
+ {
+ digest_size = SHA224_DIGEST_SIZE;
+ hash_func = sha224_buffer;
+ }
+ else if (EQ (algorithm, Qsha256))
+ {
+ digest_size = SHA256_DIGEST_SIZE;
+ hash_func = sha256_buffer;
+ }
+ else if (EQ (algorithm, Qsha384))
+ {
+ digest_size = SHA384_DIGEST_SIZE;
+ hash_func = sha384_buffer;
+ }
+ else if (EQ (algorithm, Qsha512))
+ {
+ digest_size = SHA512_DIGEST_SIZE;
+ hash_func = sha512_buffer;
+ }
+ else
+ error ("Invalid algorithm arg: %s", SDATA (Fsymbol_name (algorithm)));
- if (NILP (binary))
- {
- char value[33];
- for (i = 0; i < 16; i++)
- sprintf (&value[2 * i], "%02x", to_uchar (digest[i]));
- res = make_string (value, 32);
- }
- else
- res = make_string (digest, 16);
- break;
- }
+ /* allocate 2 x digest_size so that it can be re-used to hold the
+ hexified value */
+ digest = make_uninit_string (digest_size * 2);
- case 1: /* SHA1 */
- {
- char digest[20];
- sha1_buffer (SSDATA (object) + start_byte,
- SBYTES (object) - (size_byte - end_byte),
- digest);
- if (NILP (binary))
- {
- char value[41];
- for (i = 0; i < 20; i++)
- sprintf (&value[2 * i], "%02x", to_uchar (digest[i]));
- res = make_string (value, 40);
- }
- else
- res = make_string (digest, 20);
- break;
- }
- }
+ hash_func (SSDATA (object) + start_byte,
+ SBYTES (object) - (size_byte - end_byte),
+ SSDATA (digest));
- return res;
+ if (NILP (binary))
+ {
+ unsigned char *p = SDATA (digest);
+ for (i = digest_size - 1; i >= 0; i--)
+ {
+ static char const hexdigit[16] = "0123456789abcdef";
+ int p_i = p[i];
+ p[2 * i] = hexdigit[p_i >> 4];
+ p[2 * i + 1] = hexdigit[p_i & 0xf];
+ }
+ return digest;
+ }
+ else
+ return make_unibyte_string (SSDATA (digest), digest_size);
}
DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
@@ -4817,54 +4830,46 @@ If NOERROR is non-nil, silently assume the `raw-text' coding if the
guesswork fails. Normally, an error is signaled in such case. */)
(Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror)
{
- return crypto_hash_function (0, object, start, end, coding_system, noerror, Qnil);
+ return secure_hash (Qmd5, object, start, end, coding_system, noerror, Qnil);
}
-DEFUN ("sha1", Fsha1, Ssha1, 1, 4, 0,
- doc: /* Return the SHA-1 (Secure Hash Algorithm) of an OBJECT.
-
-OBJECT is either a string or a buffer. Optional arguments START and
-END are character positions specifying which portion of OBJECT for
-computing the hash. If BINARY is non-nil, return a string in binary
-form. */)
- (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
+DEFUN ("secure-hash", Fsecure_hash, Ssecure_hash, 2, 5, 0,
+ doc: /* Return the secure hash of an OBJECT.
+ALGORITHM is a symbol: md5, sha1, sha224, sha256, sha384 or sha512.
+OBJECT is either a string or a buffer.
+Optional arguments START and END are character positions specifying
+which portion of OBJECT for computing the hash. If BINARY is non-nil,
+return a string in binary form. */)
+ (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
{
- return crypto_hash_function (1, object, start, end, Qnil, Qnil, binary);
+ return secure_hash (algorithm, object, start, end, Qnil, Qnil, binary);
}
-
void
syms_of_fns (void)
{
+ DEFSYM (Qmd5, "md5");
+ DEFSYM (Qsha1, "sha1");
+ DEFSYM (Qsha224, "sha224");
+ DEFSYM (Qsha256, "sha256");
+ DEFSYM (Qsha384, "sha384");
+ DEFSYM (Qsha512, "sha512");
+
/* Hash table stuff. */
- Qhash_table_p = intern_c_string ("hash-table-p");
- staticpro (&Qhash_table_p);
- Qeq = intern_c_string ("eq");
- staticpro (&Qeq);
- Qeql = intern_c_string ("eql");
- staticpro (&Qeql);
- Qequal = intern_c_string ("equal");
- staticpro (&Qequal);
- QCtest = intern_c_string (":test");
- staticpro (&QCtest);
- QCsize = intern_c_string (":size");
- staticpro (&QCsize);
- QCrehash_size = intern_c_string (":rehash-size");
- staticpro (&QCrehash_size);
- QCrehash_threshold = intern_c_string (":rehash-threshold");
- staticpro (&QCrehash_threshold);
- QCweakness = intern_c_string (":weakness");
- staticpro (&QCweakness);
- Qkey = intern_c_string ("key");
- staticpro (&Qkey);
- Qvalue = intern_c_string ("value");
- staticpro (&Qvalue);
- Qhash_table_test = intern_c_string ("hash-table-test");
- staticpro (&Qhash_table_test);
- Qkey_or_value = intern_c_string ("key-or-value");
- staticpro (&Qkey_or_value);
- Qkey_and_value = intern_c_string ("key-and-value");
- staticpro (&Qkey_and_value);
+ DEFSYM (Qhash_table_p, "hash-table-p");
+ DEFSYM (Qeq, "eq");
+ DEFSYM (Qeql, "eql");
+ DEFSYM (Qequal, "equal");
+ DEFSYM (QCtest, ":test");
+ DEFSYM (QCsize, ":size");
+ DEFSYM (QCrehash_size, ":rehash-size");
+ DEFSYM (QCrehash_threshold, ":rehash-threshold");
+ DEFSYM (QCweakness, ":weakness");
+ DEFSYM (Qkey, "key");
+ DEFSYM (Qvalue, "value");
+ DEFSYM (Qhash_table_test, "hash-table-test");
+ DEFSYM (Qkey_or_value, "key-or-value");
+ DEFSYM (Qkey_and_value, "key-and-value");
defsubr (&Ssxhash);
defsubr (&Smake_hash_table);
@@ -4883,18 +4888,12 @@ syms_of_fns (void)
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
- Qstring_lessp = intern_c_string ("string-lessp");
- staticpro (&Qstring_lessp);
- Qprovide = intern_c_string ("provide");
- staticpro (&Qprovide);
- Qrequire = intern_c_string ("require");
- staticpro (&Qrequire);
- Qyes_or_no_p_history = intern_c_string ("yes-or-no-p-history");
- staticpro (&Qyes_or_no_p_history);
- Qcursor_in_echo_area = intern_c_string ("cursor-in-echo-area");
- staticpro (&Qcursor_in_echo_area);
- Qwidget_type = intern_c_string ("widget-type");
- staticpro (&Qwidget_type);
+ DEFSYM (Qstring_lessp, "string-lessp");
+ DEFSYM (Qprovide, "provide");
+ DEFSYM (Qrequire, "require");
+ DEFSYM (Qyes_or_no_p_history, "yes-or-no-p-history");
+ DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area");
+ DEFSYM (Qwidget_type, "widget-type");
staticpro (&string_char_byte_cache_string);
string_char_byte_cache_string = Qnil;
@@ -4908,18 +4907,13 @@ syms_of_fns (void)
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
- Qsubfeatures = intern_c_string ("subfeatures");
- staticpro (&Qsubfeatures);
+ DEFSYM (Qsubfeatures, "subfeatures");
#ifdef HAVE_LANGINFO_CODESET
- Qcodeset = intern_c_string ("codeset");
- staticpro (&Qcodeset);
- Qdays = intern_c_string ("days");
- staticpro (&Qdays);
- Qmonths = intern_c_string ("months");
- staticpro (&Qmonths);
- Qpaper = intern_c_string ("paper");
- staticpro (&Qpaper);
+ DEFSYM (Qcodeset, "codeset");
+ DEFSYM (Qdays, "days");
+ DEFSYM (Qmonths, "months");
+ DEFSYM (Qpaper, "paper");
#endif /* HAVE_LANGINFO_CODESET */
DEFVAR_BOOL ("use-dialog-box", use_dialog_box,
@@ -5004,7 +4998,7 @@ this variable. */);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
- defsubr (&Ssha1);
+ defsubr (&Ssecure_hash);
defsubr (&Slocale_info);
}