From 7f3f739fa4e1351a5b8a2dcd290f79c2e3baba38 Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Tue, 21 Jun 2011 16:55:22 +0800 Subject: [PATCH] New primitive secure-hash supporting md5, sha-1 and sha-2 --- etc/ChangeLog | 4 ++ etc/NEWS | 3 +- lisp/ChangeLog | 4 ++ lisp/subr.el | 8 +++ src/ChangeLog | 11 +++++ src/deps.mk | 4 +- src/fns.c | 139 ++++++++++++++++++++++++++++++---------------------- src/makefile.w32-in | 2 + 8 files changed, 114 insertions(+), 61 deletions(-) diff --git a/etc/ChangeLog b/etc/ChangeLog index 109124af4ee..062edbe42a4 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2011-06-21 Leo Liu + + * NEWS: Mention the new primtive secure-hash. + 2011-06-14 Chong Yidong * themes/dichromacy-theme.el: New theme. diff --git a/etc/NEWS b/etc/NEWS index 7d32cdba0a6..f934cf75821 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -305,7 +305,8 @@ If you need it, feedmail.el ought to provide a superset of the functionality. ** The variable `focus-follows-mouse' now always defaults to nil. -** Function `sha1' is now implemented in C for speed. +** New primitive `secure-hash' that supports many secure hash algorithms +including md5, sha-1 and sha-2 (sha-224, sha-256, sha-384 and sha-512). The elisp implementation sha1.el is removed. Feature sha1 is provided by default. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0ab00336fe5..a31868f4ed1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-06-21 Leo Liu + + * subr.el (sha1): Implement sha1 using secure-hash. + 2011-06-21 Martin Rudalics * window.el (display-buffer-alist): In default value do not diff --git a/lisp/subr.el b/lisp/subr.el index b328b7e17b7..4d2f3b1808c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2600,6 +2600,14 @@ Otherwise, return nil." (get-char-property (1- (field-end pos)) 'field) raw-field))) +(defun sha1 (object &optional start end binary) + "Return the SHA1 (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." + (secure-hash 'sha1 object start end binary)) + ;;;; Support for yanking and text properties. diff --git a/src/ChangeLog b/src/ChangeLog index 5b087e8451d..279bd1be381 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2011-06-21 Leo Liu + + * deps.mk (fns.o): + * makefile.w32-in ($(BLD)/fns.$(O)): Include sha256.h and + sha512.h. + + * fns.c (secure_hash): Rename from crypto_hash_function and change + the first arg to accept symbols. + (Fsecure_hash): New primtive. + (syms_of_fns): New symbols. + 2011-06-20 Deniz Dogan * process.c (Fset_process_buffer): Clarify return value in diff --git a/src/deps.mk b/src/deps.mk index 6c677f0e6c6..080144ae1e5 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -284,8 +284,8 @@ eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \ floatfns.o: floatfns.c syssignal.h lisp.h globals.h $(config_h) fns.o: fns.c commands.h lisp.h $(config_h) frame.h buffer.h character.h \ keyboard.h keymap.h window.h $(INTERVALS_H) coding.h ../lib/md5.h \ - ../lib/sha1.h blockinput.h atimer.h systime.h xterm.h ../lib/unistd.h \ - globals.h + ../lib/sha1.h ../lib/sha256.h ../lib/sha512.h blockinput.h atimer.h \ + systime.h xterm.h ../lib/unistd.h globals.h print.o: print.c process.h frame.h window.h buffer.h keyboard.h character.h \ lisp.h globals.h $(config_h) termchar.h $(INTERVALS_H) msdos.h termhooks.h \ blockinput.h atimer.h systime.h font.h charset.h coding.h ccl.h \ diff --git a/src/fns.c b/src/fns.c index 8057e429176..96b8a4ed7d9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -51,6 +51,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 @@ -4550,21 +4552,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 +4573,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 +4748,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 (SDATA (digest), digest_size); } DEFUN ("md5", Fmd5, Smd5, 1, 5, 0, @@ -4817,25 +4834,31 @@ 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); @@ -5004,7 +5027,7 @@ this variable. */); defsubr (&Sbase64_encode_string); defsubr (&Sbase64_decode_string); defsubr (&Smd5); - defsubr (&Ssha1); + defsubr (&Ssecure_hash); defsubr (&Slocale_info); } diff --git a/src/makefile.w32-in b/src/makefile.w32-in index d4fafcfc047..173fc673955 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -867,6 +867,8 @@ $(BLD)/fns.$(O) : \ $(EMACS_ROOT)/nt/inc/sys/time.h \ $(EMACS_ROOT)/lib/md5.h \ $(EMACS_ROOT)/lib/sha1.h \ + $(EMACS_ROOT)/lib/sha256.h \ + $(EMACS_ROOT)/lib/sha512.h \ $(LISP_H) \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ -- 2.11.4.GIT