procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from trunk.

Browse source
This commit is contained in:
Paul Eggert 2011-06-22 09:01:00 -07:00
commit 510005210a
40 changed files with 2520 additions and 650 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
ChangeLog
View file

@ -1,3 +1,18 @@
2011-06-21 Leo Liu <sdl.web@gmail.com>
* m4/sha256.m4:
* m4/sha512.m4:
* m4/gl-comp.m4:
* lib/u64.h:
* lib/sha256.c:
* lib/sha256.h:
* lib/sha512.c:
* lib/sha512.h:
* lib/makefile.w32-in (GNULIBOBJS):
* lib/gnulib.mk:
* Makefile.in (GNULIB_MODULES): Add crypto/sha256 and
crypto/sha512 modules from gnulib.
2011-06-19 Paul Eggert <eggert@cs.ucla.edu>
* lib/unistd.in.h, m4/getloadavg.m4: Merge from gnulib.

4
Makefile.in
View file

@ -332,8 +332,8 @@ DOS_gnulib_comp.m4 = gl-comp.m4
# $(gnulib_srcdir) (relative to $(srcdir) and should have build tools
# as per $(gnulib_srcdir)/DEPENDENCIES.
GNULIB_MODULES = \
careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg \
getopt-gnu ignore-value intprops lstat mktime readlink \
careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr \
filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink \
socklen stdarg stdio strftime strtoumax symlink sys_stat
GNULIB_TOOL_FLAGS = \
--conditional-dependencies --import --no-changelog --no-vc-files \

34
autogen/Makefile.in
View file

@ -24,7 +24,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
@ -59,7 +59,8 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \
$(top_srcdir)/m4/longlong.m4 $(top_srcdir)/m4/lstat.m4 \
$(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/mktime.m4 \
$(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/readlink.m4 \
$(top_srcdir)/m4/sha1.m4 $(top_srcdir)/m4/socklen.m4 \
$(top_srcdir)/m4/sha1.m4 $(top_srcdir)/m4/sha256.m4 \
$(top_srcdir)/m4/sha512.m4 $(top_srcdir)/m4/socklen.m4 \
$(top_srcdir)/m4/ssize_t.m4 $(top_srcdir)/m4/st_dm_mode.m4 \
$(top_srcdir)/m4/stat.m4 $(top_srcdir)/m4/stdarg.m4 \
$(top_srcdir)/m4/stdbool.m4 $(top_srcdir)/m4/stddef_h.m4 \
@ -82,11 +83,12 @@ ARFLAGS = cru
libgnu_a_AR = $(AR) $(ARFLAGS)
am__DEPENDENCIES_1 =
am__libgnu_a_SOURCES_DIST = allocator.c careadlinkat.c md5.c sha1.c \
dtoastr.c filemode.c gettext.h strftime.c
sha256.c sha512.c dtoastr.c filemode.c gettext.h strftime.c
am__objects_1 =
am_libgnu_a_OBJECTS = allocator.$(OBJEXT) careadlinkat.$(OBJEXT) \
md5.$(OBJEXT) sha1.$(OBJEXT) dtoastr.$(OBJEXT) \
filemode.$(OBJEXT) $(am__objects_1) strftime.$(OBJEXT)
md5.$(OBJEXT) sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \
dtoastr.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \
strftime.$(OBJEXT)
libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS)
depcomp = $(SHELL) $(top_srcdir)/depcomp
am__depfiles_maybe = depfiles
@ -734,14 +736,14 @@ BUILT_SOURCES = arg-nonnull.h c++defs.h $(GETOPT_H) inttypes.h \
$(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \
stdlib.h sys/stat.h time.h unistd.h warn-on-use.h
EXTRA_DIST = allocator.h $(top_srcdir)/./arg-nonnull.h \
$(top_srcdir)/./c++defs.h careadlinkat.h md5.h sha1.h \
dosname.h ftoastr.c ftoastr.h filemode.h getloadavg.c getopt.c \
getopt.in.h getopt1.c getopt_int.h ignore-value.h intprops.h \
inttypes.in.h lstat.c mktime-internal.h mktime.c readlink.c \
stat.c stdarg.in.h stdbool.in.h stddef.in.h stdint.in.h \
stdio.in.h stdlib.in.h strftime.h strtol.c strtoul.c \
strtoull.c strtoimax.c strtoumax.c symlink.c sys_stat.in.h \
time.in.h time_r.c unistd.in.h verify.h \
$(top_srcdir)/./c++defs.h careadlinkat.h md5.h sha1.h sha256.h \
sha512.h dosname.h ftoastr.c ftoastr.h filemode.h getloadavg.c \
getopt.c getopt.in.h getopt1.c getopt_int.h ignore-value.h \
intprops.h inttypes.in.h lstat.c mktime-internal.h mktime.c \
readlink.c stat.c stdarg.in.h stdbool.in.h stddef.in.h \
stdint.in.h stdio.in.h stdlib.in.h strftime.h strtol.c \
strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \
sys_stat.in.h time.in.h time_r.c u64.h unistd.in.h verify.h \
$(top_srcdir)/./warn-on-use.h
MOSTLYCLEANDIRS = sys
MOSTLYCLEANFILES = core *.stackdump arg-nonnull.h arg-nonnull.h-t \
@ -752,8 +754,8 @@ MOSTLYCLEANFILES = core *.stackdump arg-nonnull.h arg-nonnull.h-t \
unistd.h unistd.h-t warn-on-use.h warn-on-use.h-t
noinst_LIBRARIES = libgnu.a
DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src
libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c dtoastr.c \
filemode.c $(am__append_1) strftime.c
libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c sha256.c \
sha512.c dtoastr.c filemode.c $(am__append_1) strftime.c
libgnu_a_LIBADD = $(gl_LIBOBJS)
libgnu_a_DEPENDENCIES = $(gl_LIBOBJS)
EXTRA_libgnu_a_SOURCES = ftoastr.c getloadavg.c getopt.c getopt1.c \
@ -824,6 +826,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/readlink.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha1.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha256.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha512.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strftime.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoimax.Po@am__quote@

2
autogen/aclocal.m4 vendored
View file

@ -1001,6 +1001,8 @@ m4_include([m4/mktime.m4])
m4_include([m4/multiarch.m4])
m4_include([m4/readlink.m4])
m4_include([m4/sha1.m4])
m4_include([m4/sha256.m4])
m4_include([m4/sha512.m4])
m4_include([m4/socklen.m4])
m4_include([m4/ssize_t.m4])
m4_include([m4/st_dm_mode.m4])

12
autogen/configure vendored
View file

@ -6541,6 +6541,8 @@ esac
# Code from module careadlinkat:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module dosname:
# Code from module dtoastr:
# Code from module extensions:
@ -6575,6 +6577,7 @@ esac
# Code from module sys_stat:
# Code from module time:
# Code from module time_r:
# Code from module u64:
# Code from module unistd:
# Code from module verify:
# Code from module warn-on-use:
@ -16695,6 +16698,14 @@ fi
# Persuade glibc <stdlib.h> to declare getloadavg().
@ -18575,6 +18586,7 @@ fi
if test $gl_cv_have_include_next = yes; then
gl_cv_next_unistd_h='<'unistd.h'>'
else

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2011-06-21 Leo Liu <sdl.web@gmail.com>
* NEWS: Mention the new primtive secure-hash.
2011-06-14 Chong Yidong <cyd@stupidchicken.com>
* themes/dichromacy-theme.el: New theme.

28
etc/NEWS
View file

@ -109,6 +109,26 @@ and pops down the *Completions* buffer accordingly.
** auto-mode-case-fold is now enabled by default.
** smtpmail changes
** smtpmail has been largely rewritten to upgrade to STARTTLS if
possible, and uses the auth-source framework for getting credentials.
The rewrite should be largely compatible with previous versions of
smtpmail, but there are two major incompatibilities:
** `smtpmail-auth-credentials' no longer exists. That variable could
be either ~/.authinfo (in which case you're fine -- you won't see any
difference), but if it were a direct list of user names and passwords,
you will be prompted for the user name and the password instead, and
they will then be saved to ~/.authinfo.
** Similarly, if you had `smtpmail-starttls-credentials' set, then
then you need to put
machine smtp.whatever.foo port 25 key "~/.my_smtp_tls.key" cert "~/.my_smtp_tls.cert"
in your ~/.authinfo file instead.
** Internationalization changes
+++
@ -305,10 +325,16 @@ 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.
** Menu-bar changes
*** `menu-bar-select-buffer-function' lets you choose another operation
instead of `switch-to-buffer' when selecting an item in the Buffers menu.
* Editing Changes in Emacs 24.1

25
lib/gnulib.mk
View file

@ -9,7 +9,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat
MOSTLYCLEANFILES += core *.stackdump
@ -101,6 +101,22 @@ EXTRA_DIST += sha1.h
## end gnulib module crypto/sha1
## begin gnulib module crypto/sha256
libgnu_a_SOURCES += sha256.c
EXTRA_DIST += sha256.h
## end gnulib module crypto/sha256
## begin gnulib module crypto/sha512
libgnu_a_SOURCES += sha512.c
EXTRA_DIST += sha512.h
## end gnulib module crypto/sha512
## begin gnulib module dosname
if gl_GNULIB_ENABLED_dosname
@ -759,6 +775,13 @@ EXTRA_libgnu_a_SOURCES += time_r.c
## end gnulib module time_r
## begin gnulib module u64
EXTRA_DIST += u64.h
## end gnulib module u64
## begin gnulib module unistd
BUILT_SOURCES += unistd.h

20
lib/makefile.w32-in
View file

@ -30,6 +30,8 @@ GNULIBOBJS = $(BLD)/dtoastr.$(O) \
$(BLD)/time_r.$(O) \
$(BLD)/md5.$(O) \
$(BLD)/sha1.$(O) \
$(BLD)/sha256.$(O) \
$(BLD)/sha512.$(O) \
$(BLD)/filemode.$(O)
#
@ -120,6 +122,24 @@ $(BLD)/sha1.$(O) : \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h
$(BLD)/sha256.$(O) : \
$(SRC)/sha256.c \
$(SRC)/sha256.h \
$(EMACS_ROOT)/nt/inc/stdint.h \
$(EMACS_ROOT)/nt/inc/sys/stat.h \
$(EMACS_ROOT)/src/s/ms-w32.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h
$(BLD)/sha512.$(O) : \
$(SRC)/sha512.c \
$(SRC)/sha512.h \
$(EMACS_ROOT)/nt/inc/stdint.h \
$(EMACS_ROOT)/nt/inc/sys/stat.h \
$(EMACS_ROOT)/src/s/ms-w32.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h
$(BLD)/filemode.$(O) : \
$(SRC)/filemode.c \
$(SRC)/filemode.h \

569
lib/sha256.c Normal file
View file

@ -0,0 +1,569 @@
/* sha256.c - Functions to compute SHA256 and SHA224 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
This program 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 3 of the License, or
(at your option) any later version.
This program 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 this program. If not, see <http://www.gnu.org/licenses/>. */
/* Written by David Madore, considerably copypasting from
Scott G. Miller's sha1.c
*/
#include <config.h>
#include "sha256.h"
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
#if USE_UNLOCKED_IO
# include "unlocked-io.h"
#endif
#ifdef WORDS_BIGENDIAN
# define SWAP(n) (n)
#else
# define SWAP(n) \
(((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24))
#endif
#define BLOCKSIZE 32768
#if BLOCKSIZE % 64 != 0
# error "invalid BLOCKSIZE"
#endif
/* This array contains the bytes used to pad the buffer to the next
64-byte boundary. */
static const unsigned char fillbuf[64] = { 0x80, 0 /* , 0, 0, ... */ };
/*
Takes a pointer to a 256 bit block of data (eight 32 bit ints) and
intializes it to the start constants of the SHA256 algorithm. This
must be called before using hash in the call to sha256_hash
*/
void
sha256_init_ctx (struct sha256_ctx *ctx)
{
ctx->state[0] = 0x6a09e667UL;
ctx->state[1] = 0xbb67ae85UL;
ctx->state[2] = 0x3c6ef372UL;
ctx->state[3] = 0xa54ff53aUL;
ctx->state[4] = 0x510e527fUL;
ctx->state[5] = 0x9b05688cUL;
ctx->state[6] = 0x1f83d9abUL;
ctx->state[7] = 0x5be0cd19UL;
ctx->total[0] = ctx->total[1] = 0;
ctx->buflen = 0;
}
void
sha224_init_ctx (struct sha256_ctx *ctx)
{
ctx->state[0] = 0xc1059ed8UL;
ctx->state[1] = 0x367cd507UL;
ctx->state[2] = 0x3070dd17UL;
ctx->state[3] = 0xf70e5939UL;
ctx->state[4] = 0xffc00b31UL;
ctx->state[5] = 0x68581511UL;
ctx->state[6] = 0x64f98fa7UL;
ctx->state[7] = 0xbefa4fa4UL;
ctx->total[0] = ctx->total[1] = 0;
ctx->buflen = 0;
}
/* Copy the value from v into the memory location pointed to by *cp,
If your architecture allows unaligned access this is equivalent to
* (uint32_t *) cp = v */
static inline void
set_uint32 (char *cp, uint32_t v)
{
memcpy (cp, &v, sizeof v);
}
/* Put result from CTX in first 32 bytes following RESBUF. The result
must be in little endian byte order. */
void *
sha256_read_ctx (const struct sha256_ctx *ctx, void *resbuf)
{
int i;
char *r = resbuf;
for (i = 0; i < 8; i++)
set_uint32 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
return resbuf;
}
void *
sha224_read_ctx (const struct sha256_ctx *ctx, void *resbuf)
{
int i;
char *r = resbuf;
for (i = 0; i < 7; i++)
set_uint32 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
return resbuf;
}
/* Process the remaining bytes in the internal buffer and the usual
prolog according to the standard and write the result to RESBUF. */
static void
sha256_conclude_ctx (struct sha256_ctx *ctx)
{
/* Take yet unprocessed bytes into account. */
size_t bytes = ctx->buflen;
size_t size = (bytes < 56) ? 64 / 4 : 64 * 2 / 4;
/* Now count remaining bytes. */
ctx->total[0] += bytes;
if (ctx->total[0] < bytes)
++ctx->total[1];
/* Put the 64-bit file length in *bits* at the end of the buffer.
Use set_uint32 rather than a simple assignment, to avoid risk of
unaligned access. */
set_uint32 ((char *) &ctx->buffer[size - 2],
SWAP ((ctx->total[1] << 3) | (ctx->total[0] >> 29)));
set_uint32 ((char *) &ctx->buffer[size - 1],
SWAP (ctx->total[0] << 3));
memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 4 - bytes);
/* Process last bytes. */
sha256_process_block (ctx->buffer, size * 4, ctx);
}
void *
sha256_finish_ctx (struct sha256_ctx *ctx, void *resbuf)
{
sha256_conclude_ctx (ctx);
return sha256_read_ctx (ctx, resbuf);
}
void *
sha224_finish_ctx (struct sha256_ctx *ctx, void *resbuf)
{
sha256_conclude_ctx (ctx);
return sha224_read_ctx (ctx, resbuf);
}
/* Compute SHA256 message digest for bytes read from STREAM. The
resulting message digest number will be written into the 32 bytes
beginning at RESBLOCK. */
int
sha256_stream (FILE *stream, void *resblock)
{
struct sha256_ctx ctx;
size_t sum;
char *buffer = malloc (BLOCKSIZE + 72);
if (!buffer)
return 1;
/* Initialize the computation context. */
sha256_init_ctx (&ctx);
/* Iterate over full file contents. */
while (1)
{
/* We read the file in blocks of BLOCKSIZE bytes. One call of the
computation function processes the whole buffer so that with the
next round of the loop another block can be read. */
size_t n;
sum = 0;
/* Read block. Take care for partial reads. */
while (1)
{
n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
sum += n;
if (sum == BLOCKSIZE)
break;
if (n == 0)
{
/* Check for the error flag IFF N == 0, so that we don't
exit the loop after a partial read due to e.g., EAGAIN
or EWOULDBLOCK. */
if (ferror (stream))
{
free (buffer);
return 1;
}
goto process_partial_block;
}
/* We've read at least one byte, so ignore errors. But always
check for EOF, since feof may be true even though N > 0.
Otherwise, we could end up calling fread after EOF. */
if (feof (stream))
goto process_partial_block;
}
/* Process buffer with BLOCKSIZE bytes. Note that
BLOCKSIZE % 64 == 0
*/
sha256_process_block (buffer, BLOCKSIZE, &ctx);
}
process_partial_block:;
/* Process any remaining bytes. */
if (sum > 0)
sha256_process_bytes (buffer, sum, &ctx);
/* Construct result in desired memory. */
sha256_finish_ctx (&ctx, resblock);
free (buffer);
return 0;
}
/* FIXME: Avoid code duplication */
int
sha224_stream (FILE *stream, void *resblock)
{
struct sha256_ctx ctx;
size_t sum;
char *buffer = malloc (BLOCKSIZE + 72);
if (!buffer)
return 1;
/* Initialize the computation context. */
sha224_init_ctx (&ctx);
/* Iterate over full file contents. */
while (1)
{
/* We read the file in blocks of BLOCKSIZE bytes. One call of the
computation function processes the whole buffer so that with the
next round of the loop another block can be read. */
size_t n;
sum = 0;
/* Read block. Take care for partial reads. */
while (1)
{
n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
sum += n;
if (sum == BLOCKSIZE)
break;
if (n == 0)
{
/* Check for the error flag IFF N == 0, so that we don't
exit the loop after a partial read due to e.g., EAGAIN
or EWOULDBLOCK. */
if (ferror (stream))
{
free (buffer);
return 1;
}
goto process_partial_block;
}
/* We've read at least one byte, so ignore errors. But always
check for EOF, since feof may be true even though N > 0.
Otherwise, we could end up calling fread after EOF. */
if (feof (stream))
goto process_partial_block;
}
/* Process buffer with BLOCKSIZE bytes. Note that
BLOCKSIZE % 64 == 0
*/
sha256_process_block (buffer, BLOCKSIZE, &ctx);
}
process_partial_block:;
/* Process any remaining bytes. */
if (sum > 0)
sha256_process_bytes (buffer, sum, &ctx);
/* Construct result in desired memory. */
sha224_finish_ctx (&ctx, resblock);
free (buffer);
return 0;
}
/* Compute SHA512 message digest for LEN bytes beginning at BUFFER. The
result is always in little endian byte order, so that a byte-wise
output yields to the wanted ASCII representation of the message
digest. */
void *
sha256_buffer (const char *buffer, size_t len, void *resblock)
{
struct sha256_ctx ctx;
/* Initialize the computation context. */
sha256_init_ctx (&ctx);
/* Process whole buffer but last len % 64 bytes. */
sha256_process_bytes (buffer, len, &ctx);
/* Put result in desired memory area. */
return sha256_finish_ctx (&ctx, resblock);
}
void *
sha224_buffer (const char *buffer, size_t len, void *resblock)
{
struct sha256_ctx ctx;
/* Initialize the computation context. */
sha224_init_ctx (&ctx);
/* Process whole buffer but last len % 64 bytes. */
sha256_process_bytes (buffer, len, &ctx);
/* Put result in desired memory area. */
return sha224_finish_ctx (&ctx, resblock);
}
void
sha256_process_bytes (const void *buffer, size_t len, struct sha256_ctx *ctx)
{
/* When we already have some bits in our internal buffer concatenate
both inputs first. */
if (ctx->buflen != 0)
{
size_t left_over = ctx->buflen;
size_t add = 128 - left_over > len ? len : 128 - left_over;
memcpy (&((char *) ctx->buffer)[left_over], buffer, add);
ctx->buflen += add;
if (ctx->buflen > 64)
{
sha256_process_block (ctx->buffer, ctx->buflen & ~63, ctx);
ctx->buflen &= 63;
/* The regions in the following copy operation cannot overlap. */
memcpy (ctx->buffer,
&((char *) ctx->buffer)[(left_over + add) & ~63],
ctx->buflen);
}
buffer = (const char *) buffer + add;
len -= add;
}
/* Process available complete blocks. */
if (len >= 64)
{
#if !_STRING_ARCH_unaligned
# define alignof(type) offsetof (struct { char c; type x; }, x)
# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0)
if (UNALIGNED_P (buffer))
while (len > 64)
{
sha256_process_block (memcpy (ctx->buffer, buffer, 64), 64, ctx);
buffer = (const char *) buffer + 64;
len -= 64;
}
else
#endif
{
sha256_process_block (buffer, len & ~63, ctx);
buffer = (const char *) buffer + (len & ~63);
len &= 63;
}
}
/* Move remaining bytes in internal buffer. */
if (len > 0)
{
size_t left_over = ctx->buflen;
memcpy (&((char *) ctx->buffer)[left_over], buffer, len);
left_over += len;
if (left_over >= 64)
{
sha256_process_block (ctx->buffer, 64, ctx);
left_over -= 64;
memcpy (ctx->buffer, &ctx->buffer[16], left_over);
}
ctx->buflen = left_over;
}
}
/* --- Code below is the primary difference between sha1.c and sha256.c --- */
/* SHA256 round constants */
#define K(I) sha256_round_constants[I]
static const uint32_t sha256_round_constants[64] = {
0x428a2f98UL, 0x71374491UL, 0xb5c0fbcfUL, 0xe9b5dba5UL,
0x3956c25bUL, 0x59f111f1UL, 0x923f82a4UL, 0xab1c5ed5UL,
0xd807aa98UL, 0x12835b01UL, 0x243185beUL, 0x550c7dc3UL,
0x72be5d74UL, 0x80deb1feUL, 0x9bdc06a7UL, 0xc19bf174UL,
0xe49b69c1UL, 0xefbe4786UL, 0x0fc19dc6UL, 0x240ca1ccUL,
0x2de92c6fUL, 0x4a7484aaUL, 0x5cb0a9dcUL, 0x76f988daUL,
0x983e5152UL, 0xa831c66dUL, 0xb00327c8UL, 0xbf597fc7UL,
0xc6e00bf3UL, 0xd5a79147UL, 0x06ca6351UL, 0x14292967UL,
0x27b70a85UL, 0x2e1b2138UL, 0x4d2c6dfcUL, 0x53380d13UL,
0x650a7354UL, 0x766a0abbUL, 0x81c2c92eUL, 0x92722c85UL,
0xa2bfe8a1UL, 0xa81a664bUL, 0xc24b8b70UL, 0xc76c51a3UL,
0xd192e819UL, 0xd6990624UL, 0xf40e3585UL, 0x106aa070UL,
0x19a4c116UL, 0x1e376c08UL, 0x2748774cUL, 0x34b0bcb5UL,
0x391c0cb3UL, 0x4ed8aa4aUL, 0x5b9cca4fUL, 0x682e6ff3UL,
0x748f82eeUL, 0x78a5636fUL, 0x84c87814UL, 0x8cc70208UL,
0x90befffaUL, 0xa4506cebUL, 0xbef9a3f7UL, 0xc67178f2UL,
};
/* Round functions. */
#define F2(A,B,C) ( ( A & B ) | ( C & ( A | B ) ) )
#define F1(E,F,G) ( G ^ ( E & ( F ^ G ) ) )
/* Process LEN bytes of BUFFER, accumulating context into CTX.
It is assumed that LEN % 64 == 0.
Most of this code comes from GnuPG's cipher/sha1.c. */
void
sha256_process_block (const void *buffer, size_t len, struct sha256_ctx *ctx)
{
const uint32_t *words = buffer;
size_t nwords = len / sizeof (uint32_t);
const uint32_t *endp = words + nwords;
uint32_t x[16];
uint32_t a = ctx->state[0];
uint32_t b = ctx->state[1];
uint32_t c = ctx->state[2];
uint32_t d = ctx->state[3];
uint32_t e = ctx->state[4];
uint32_t f = ctx->state[5];
uint32_t g = ctx->state[6];
uint32_t h = ctx->state[7];
/* First increment the byte count. FIPS PUB 180-2 specifies the possible
length of the file up to 2^64 bits. Here we only compute the
number of bytes. Do a double word increment. */
ctx->total[0] += len;
if (ctx->total[0] < len)
++ctx->total[1];
#define rol(x, n) (((x) << (n)) | ((x) >> (32 - (n))))
#define S0(x) (rol(x,25)^rol(x,14)^(x>>3))
#define S1(x) (rol(x,15)^rol(x,13)^(x>>10))
#define SS0(x) (rol(x,30)^rol(x,19)^rol(x,10))
#define SS1(x) (rol(x,26)^rol(x,21)^rol(x,7))
#define M(I) ( tm = S1(x[(I-2)&0x0f]) + x[(I-7)&0x0f] \
+ S0(x[(I-15)&0x0f]) + x[I&0x0f] \
, x[I&0x0f] = tm )
#define R(A,B,C,D,E,F,G,H,K,M) do { t0 = SS0(A) + F2(A,B,C); \
t1 = H + SS1(E) \
+ F1(E,F,G) \
+ K \
+ M; \
D += t1; H = t0 + t1; \
} while(0)
while (words < endp)
{
uint32_t tm;
uint32_t t0, t1;
int t;
/* FIXME: see sha1.c for a better implementation. */
for (t = 0; t < 16; t++)
{
x[t] = SWAP (*words);
words++;
}
R( a, b, c, d, e, f, g, h, K( 0), x[ 0] );
R( h, a, b, c, d, e, f, g, K( 1), x[ 1] );
R( g, h, a, b, c, d, e, f, K( 2), x[ 2] );
R( f, g, h, a, b, c, d, e, K( 3), x[ 3] );
R( e, f, g, h, a, b, c, d, K( 4), x[ 4] );
R( d, e, f, g, h, a, b, c, K( 5), x[ 5] );
R( c, d, e, f, g, h, a, b, K( 6), x[ 6] );
R( b, c, d, e, f, g, h, a, K( 7), x[ 7] );
R( a, b, c, d, e, f, g, h, K( 8), x[ 8] );
R( h, a, b, c, d, e, f, g, K( 9), x[ 9] );
R( g, h, a, b, c, d, e, f, K(10), x[10] );
R( f, g, h, a, b, c, d, e, K(11), x[11] );
R( e, f, g, h, a, b, c, d, K(12), x[12] );
R( d, e, f, g, h, a, b, c, K(13), x[13] );
R( c, d, e, f, g, h, a, b, K(14), x[14] );
R( b, c, d, e, f, g, h, a, K(15), x[15] );
R( a, b, c, d, e, f, g, h, K(16), M(16) );
R( h, a, b, c, d, e, f, g, K(17), M(17) );
R( g, h, a, b, c, d, e, f, K(18), M(18) );
R( f, g, h, a, b, c, d, e, K(19), M(19) );
R( e, f, g, h, a, b, c, d, K(20), M(20) );
R( d, e, f, g, h, a, b, c, K(21), M(21) );
R( c, d, e, f, g, h, a, b, K(22), M(22) );
R( b, c, d, e, f, g, h, a, K(23), M(23) );
R( a, b, c, d, e, f, g, h, K(24), M(24) );
R( h, a, b, c, d, e, f, g, K(25), M(25) );
R( g, h, a, b, c, d, e, f, K(26), M(26) );
R( f, g, h, a, b, c, d, e, K(27), M(27) );
R( e, f, g, h, a, b, c, d, K(28), M(28) );
R( d, e, f, g, h, a, b, c, K(29), M(29) );
R( c, d, e, f, g, h, a, b, K(30), M(30) );
R( b, c, d, e, f, g, h, a, K(31), M(31) );
R( a, b, c, d, e, f, g, h, K(32), M(32) );
R( h, a, b, c, d, e, f, g, K(33), M(33) );
R( g, h, a, b, c, d, e, f, K(34), M(34) );
R( f, g, h, a, b, c, d, e, K(35), M(35) );
R( e, f, g, h, a, b, c, d, K(36), M(36) );
R( d, e, f, g, h, a, b, c, K(37), M(37) );
R( c, d, e, f, g, h, a, b, K(38), M(38) );
R( b, c, d, e, f, g, h, a, K(39), M(39) );
R( a, b, c, d, e, f, g, h, K(40), M(40) );
R( h, a, b, c, d, e, f, g, K(41), M(41) );
R( g, h, a, b, c, d, e, f, K(42), M(42) );
R( f, g, h, a, b, c, d, e, K(43), M(43) );
R( e, f, g, h, a, b, c, d, K(44), M(44) );
R( d, e, f, g, h, a, b, c, K(45), M(45) );
R( c, d, e, f, g, h, a, b, K(46), M(46) );
R( b, c, d, e, f, g, h, a, K(47), M(47) );
R( a, b, c, d, e, f, g, h, K(48), M(48) );
R( h, a, b, c, d, e, f, g, K(49), M(49) );
R( g, h, a, b, c, d, e, f, K(50), M(50) );
R( f, g, h, a, b, c, d, e, K(51), M(51) );
R( e, f, g, h, a, b, c, d, K(52), M(52) );
R( d, e, f, g, h, a, b, c, K(53), M(53) );
R( c, d, e, f, g, h, a, b, K(54), M(54) );
R( b, c, d, e, f, g, h, a, K(55), M(55) );
R( a, b, c, d, e, f, g, h, K(56), M(56) );
R( h, a, b, c, d, e, f, g, K(57), M(57) );
R( g, h, a, b, c, d, e, f, K(58), M(58) );
R( f, g, h, a, b, c, d, e, K(59), M(59) );
R( e, f, g, h, a, b, c, d, K(60), M(60) );
R( d, e, f, g, h, a, b, c, K(61), M(61) );
R( c, d, e, f, g, h, a, b, K(62), M(62) );
R( b, c, d, e, f, g, h, a, K(63), M(63) );
a = ctx->state[0] += a;
b = ctx->state[1] += b;
c = ctx->state[2] += c;
d = ctx->state[3] += d;
e = ctx->state[4] += e;
f = ctx->state[5] += f;
g = ctx->state[6] += g;
h = ctx->state[7] += h;
}
}

91
lib/sha256.h Normal file
View file

@ -0,0 +1,91 @@
/* Declarations of functions and data types used for SHA256 and SHA224 sum
library functions.
Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
This program 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 3 of the License, or
(at your option) any later version.
This program 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 this program. If not, see <http://www.gnu.org/licenses/>. */
#ifndef SHA256_H
# define SHA256_H 1
# include <stdio.h>
# include <stdint.h>
# ifdef __cplusplus
extern "C" {
# endif
/* Structure to save state of computation between the single steps. */
struct sha256_ctx
{
uint32_t state[8];
uint32_t total[2];
size_t buflen;
uint32_t buffer[32];
};
enum { SHA224_DIGEST_SIZE = 224 / 8 };
enum { SHA256_DIGEST_SIZE = 256 / 8 };
/* Initialize structure containing state of computation. */
extern void sha256_init_ctx (struct sha256_ctx *ctx);
extern void sha224_init_ctx (struct sha256_ctx *ctx);
/* Starting with the result of former calls of this function (or the
initialization function update the context for the next LEN bytes
starting at BUFFER.
It is necessary that LEN is a multiple of 64!!! */
extern void sha256_process_block (const void *buffer, size_t len,
struct sha256_ctx *ctx);
/* Starting with the result of former calls of this function (or the
initialization function update the context for the next LEN bytes
starting at BUFFER.
It is NOT required that LEN is a multiple of 64. */
extern void sha256_process_bytes (const void *buffer, size_t len,
struct sha256_ctx *ctx);
/* Process the remaining bytes in the buffer and put result from CTX
in first 32 (28) bytes following RESBUF. The result is always in little
endian byte order, so that a byte-wise output yields to the wanted
ASCII representation of the message digest. */
extern void *sha256_finish_ctx (struct sha256_ctx *ctx, void *resbuf);
extern void *sha224_finish_ctx (struct sha256_ctx *ctx, void *resbuf);
/* Put result from CTX in first 32 (28) bytes following RESBUF. The result is
always in little endian byte order, so that a byte-wise output yields
to the wanted ASCII representation of the message digest. */
extern void *sha256_read_ctx (const struct sha256_ctx *ctx, void *resbuf);
extern void *sha224_read_ctx (const struct sha256_ctx *ctx, void *resbuf);
/* Compute SHA256 (SHA224) message digest for bytes read from STREAM. The
resulting message digest number will be written into the 32 (28) bytes
beginning at RESBLOCK. */
extern int sha256_stream (FILE *stream, void *resblock);
extern int sha224_stream (FILE *stream, void *resblock);
/* Compute SHA256 (SHA224) message digest for LEN bytes beginning at BUFFER. The
result is always in little endian byte order, so that a byte-wise
output yields to the wanted ASCII representation of the message
digest. */
extern void *sha256_buffer (const char *buffer, size_t len, void *resblock);
extern void *sha224_buffer (const char *buffer, size_t len, void *resblock);
# ifdef __cplusplus
}
# endif
#endif

619
lib/sha512.c Normal file
View file

@ -0,0 +1,619 @@
/* sha512.c - Functions to compute SHA512 and SHA384 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
This program 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 3 of the License, or
(at your option) any later version.
This program 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 this program. If not, see <http://www.gnu.org/licenses/>. */
/* Written by David Madore, considerably copypasting from
Scott G. Miller's sha1.c
*/
#include <config.h>
#include "sha512.h"
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
#if USE_UNLOCKED_IO
# include "unlocked-io.h"
#endif
#ifdef WORDS_BIGENDIAN
# define SWAP(n) (n)
#else
# define SWAP(n) \
u64or (u64or (u64or (u64shl (n, 56), \
u64shl (u64and (n, u64lo (0x0000ff00)), 40)), \
u64or (u64shl (u64and (n, u64lo (0x00ff0000)), 24), \
u64shl (u64and (n, u64lo (0xff000000)), 8))), \
u64or (u64or (u64and (u64shr (n, 8), u64lo (0xff000000)), \
u64and (u64shr (n, 24), u64lo (0x00ff0000))), \
u64or (u64and (u64shr (n, 40), u64lo (0x0000ff00)), \
u64shr (n, 56))))
#endif
#define BLOCKSIZE 32768
#if BLOCKSIZE % 128 != 0
# error "invalid BLOCKSIZE"
#endif
/* This array contains the bytes used to pad the buffer to the next
128-byte boundary. */
static const unsigned char fillbuf[128] = { 0x80, 0 /* , 0, 0, ... */ };
/*
Takes a pointer to a 512 bit block of data (eight 64 bit ints) and
intializes it to the start constants of the SHA512 algorithm. This
must be called before using hash in the call to sha512_hash
*/
void
sha512_init_ctx (struct sha512_ctx *ctx)
{
ctx->state[0] = u64hilo (0x6a09e667, 0xf3bcc908);
ctx->state[1] = u64hilo (0xbb67ae85, 0x84caa73b);
ctx->state[2] = u64hilo (0x3c6ef372, 0xfe94f82b);
ctx->state[3] = u64hilo (0xa54ff53a, 0x5f1d36f1);
ctx->state[4] = u64hilo (0x510e527f, 0xade682d1);
ctx->state[5] = u64hilo (0x9b05688c, 0x2b3e6c1f);
ctx->state[6] = u64hilo (0x1f83d9ab, 0xfb41bd6b);
ctx->state[7] = u64hilo (0x5be0cd19, 0x137e2179);
ctx->total[0] = ctx->total[1] = u64lo (0);
ctx->buflen = 0;
}
void
sha384_init_ctx (struct sha512_ctx *ctx)
{
ctx->state[0] = u64hilo (0xcbbb9d5d, 0xc1059ed8);
ctx->state[1] = u64hilo (0x629a292a, 0x367cd507);
ctx->state[2] = u64hilo (0x9159015a, 0x3070dd17);
ctx->state[3] = u64hilo (0x152fecd8, 0xf70e5939);
ctx->state[4] = u64hilo (0x67332667, 0xffc00b31);
ctx->state[5] = u64hilo (0x8eb44a87, 0x68581511);
ctx->state[6] = u64hilo (0xdb0c2e0d, 0x64f98fa7);
ctx->state[7] = u64hilo (0x47b5481d, 0xbefa4fa4);
ctx->total[0] = ctx->total[1] = u64lo (0);
ctx->buflen = 0;
}
/* Copy the value from V into the memory location pointed to by *CP,
If your architecture allows unaligned access, this is equivalent to
* (__typeof__ (v) *) cp = v */
static inline void
set_uint64 (char *cp, u64 v)
{
memcpy (cp, &v, sizeof v);
}
/* Put result from CTX in first 64 bytes following RESBUF.
The result must be in little endian byte order. */
void *
sha512_read_ctx (const struct sha512_ctx *ctx, void *resbuf)
{
int i;
char *r = resbuf;
for (i = 0; i < 8; i++)
set_uint64 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
return resbuf;
}
void *
sha384_read_ctx (const struct sha512_ctx *ctx, void *resbuf)
{
int i;
char *r = resbuf;
for (i = 0; i < 6; i++)
set_uint64 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i]));
return resbuf;
}
/* Process the remaining bytes in the internal buffer and the usual
prolog according to the standard and write the result to RESBUF. */
static void
sha512_conclude_ctx (struct sha512_ctx *ctx)
{
/* Take yet unprocessed bytes into account. */
size_t bytes = ctx->buflen;
size_t size = (bytes < 112) ? 128 / 8 : 128 * 2 / 8;
/* Now count remaining bytes. */
ctx->total[0] = u64plus (ctx->total[0], u64lo (bytes));
if (u64lt (ctx->total[0], u64lo (bytes)))
ctx->total[1] = u64plus (ctx->total[1], u64lo (1));
/* Put the 128-bit file length in *bits* at the end of the buffer.
Use set_uint64 rather than a simple assignment, to avoid risk of
unaligned access. */
set_uint64 ((char *) &ctx->buffer[size - 2],
SWAP (u64or (u64shl (ctx->total[1], 3),
u64shr (ctx->total[0], 61))));
set_uint64 ((char *) &ctx->buffer[size - 1],
SWAP (u64shl (ctx->total[0], 3)));
memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 8 - bytes);
/* Process last bytes. */
sha512_process_block (ctx->buffer, size * 8, ctx);
}
void *
sha512_finish_ctx (struct sha512_ctx *ctx, void *resbuf)
{
sha512_conclude_ctx (ctx);
return sha512_read_ctx (ctx, resbuf);
}
void *
sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf)
{
sha512_conclude_ctx (ctx);
return sha384_read_ctx (ctx, resbuf);
}
/* Compute SHA512 message digest for bytes read from STREAM. The
resulting message digest number will be written into the 64 bytes
beginning at RESBLOCK. */
int
sha512_stream (FILE *stream, void *resblock)
{
struct sha512_ctx ctx;
size_t sum;
char *buffer = malloc (BLOCKSIZE + 72);
if (!buffer)
return 1;
/* Initialize the computation context. */
sha512_init_ctx (&ctx);
/* Iterate over full file contents. */
while (1)
{
/* We read the file in blocks of BLOCKSIZE bytes. One call of the
computation function processes the whole buffer so that with the
next round of the loop another block can be read. */
size_t n;
sum = 0;
/* Read block. Take care for partial reads. */
while (1)
{
n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
sum += n;
if (sum == BLOCKSIZE)
break;
if (n == 0)
{
/* Check for the error flag IFF N == 0, so that we don't
exit the loop after a partial read due to e.g., EAGAIN
or EWOULDBLOCK. */
if (ferror (stream))
{
free (buffer);
return 1;
}
goto process_partial_block;
}
/* We've read at least one byte, so ignore errors. But always
check for EOF, since feof may be true even though N > 0.
Otherwise, we could end up calling fread after EOF. */
if (feof (stream))
goto process_partial_block;
}
/* Process buffer with BLOCKSIZE bytes. Note that
BLOCKSIZE % 128 == 0
*/
sha512_process_block (buffer, BLOCKSIZE, &ctx);
}
process_partial_block:;
/* Process any remaining bytes. */
if (sum > 0)
sha512_process_bytes (buffer, sum, &ctx);
/* Construct result in desired memory. */
sha512_finish_ctx (&ctx, resblock);
free (buffer);
return 0;
}
/* FIXME: Avoid code duplication */
int
sha384_stream (FILE *stream, void *resblock)
{
struct sha512_ctx ctx;
size_t sum;
char *buffer = malloc (BLOCKSIZE + 72);
if (!buffer)
return 1;
/* Initialize the computation context. */
sha384_init_ctx (&ctx);
/* Iterate over full file contents. */
while (1)
{
/* We read the file in blocks of BLOCKSIZE bytes. One call of the
computation function processes the whole buffer so that with the
next round of the loop another block can be read. */
size_t n;
sum = 0;
/* Read block. Take care for partial reads. */
while (1)
{
n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream);
sum += n;
if (sum == BLOCKSIZE)
break;
if (n == 0)
{
/* Check for the error flag IFF N == 0, so that we don't
exit the loop after a partial read due to e.g., EAGAIN
or EWOULDBLOCK. */
if (ferror (stream))
{
free (buffer);
return 1;
}
goto process_partial_block;
}
/* We've read at least one byte, so ignore errors. But always
check for EOF, since feof may be true even though N > 0.
Otherwise, we could end up calling fread after EOF. */
if (feof (stream))
goto process_partial_block;
}
/* Process buffer with BLOCKSIZE bytes. Note that
BLOCKSIZE % 128 == 0
*/
sha512_process_block (buffer, BLOCKSIZE, &ctx);
}
process_partial_block:;
/* Process any remaining bytes. */
if (sum > 0)
sha512_process_bytes (buffer, sum, &ctx);
/* Construct result in desired memory. */
sha384_finish_ctx (&ctx, resblock);
free (buffer);
return 0;
}
/* Compute SHA512 message digest for LEN bytes beginning at BUFFER. The
result is always in little endian byte order, so that a byte-wise
output yields to the wanted ASCII representation of the message
digest. */
void *
sha512_buffer (const char *buffer, size_t len, void *resblock)
{
struct sha512_ctx ctx;
/* Initialize the computation context. */
sha512_init_ctx (&ctx);
/* Process whole buffer but last len % 128 bytes. */
sha512_process_bytes (buffer, len, &ctx);
/* Put result in desired memory area. */
return sha512_finish_ctx (&ctx, resblock);
}
void *
sha384_buffer (const char *buffer, size_t len, void *resblock)
{
struct sha512_ctx ctx;
/* Initialize the computation context. */
sha384_init_ctx (&ctx);
/* Process whole buffer but last len % 128 bytes. */
sha512_process_bytes (buffer, len, &ctx);
/* Put result in desired memory area. */
return sha384_finish_ctx (&ctx, resblock);
}
void
sha512_process_bytes (const void *buffer, size_t len, struct sha512_ctx *ctx)
{
/* When we already have some bits in our internal buffer concatenate
both inputs first. */
if (ctx->buflen != 0)
{
size_t left_over = ctx->buflen;
size_t add = 256 - left_over > len ? len : 256 - left_over;
memcpy (&((char *) ctx->buffer)[left_over], buffer, add);
ctx->buflen += add;
if (ctx->buflen > 128)
{
sha512_process_block (ctx->buffer, ctx->buflen & ~127, ctx);
ctx->buflen &= 127;
/* The regions in the following copy operation cannot overlap. */
memcpy (ctx->buffer,
&((char *) ctx->buffer)[(left_over + add) & ~127],
ctx->buflen);
}
buffer = (const char *) buffer + add;
len -= add;
}
/* Process available complete blocks. */
if (len >= 128)
{
#if !_STRING_ARCH_unaligned
# define alignof(type) offsetof (struct { char c; type x; }, x)
# define UNALIGNED_P(p) (((size_t) p) % alignof (u64) != 0)
if (UNALIGNED_P (buffer))
while (len > 128)
{
sha512_process_block (memcpy (ctx->buffer, buffer, 128), 128, ctx);
buffer = (const char *) buffer + 128;
len -= 128;
}
else
#endif
{
sha512_process_block (buffer, len & ~127, ctx);
buffer = (const char *) buffer + (len & ~127);
len &= 127;
}
}
/* Move remaining bytes in internal buffer. */
if (len > 0)
{
size_t left_over = ctx->buflen;
memcpy (&((char *) ctx->buffer)[left_over], buffer, len);
left_over += len;
if (left_over >= 128)
{
sha512_process_block (ctx->buffer, 128, ctx);
left_over -= 128;
memcpy (ctx->buffer, &ctx->buffer[16], left_over);
}
ctx->buflen = left_over;
}
}
/* --- Code below is the primary difference between sha1.c and sha512.c --- */
/* SHA512 round constants */
#define K(I) sha512_round_constants[I]
static u64 const sha512_round_constants[80] = {
u64init (0x428a2f98, 0xd728ae22), u64init (0x71374491, 0x23ef65cd),
u64init (0xb5c0fbcf, 0xec4d3b2f), u64init (0xe9b5dba5, 0x8189dbbc),
u64init (0x3956c25b, 0xf348b538), u64init (0x59f111f1, 0xb605d019),
u64init (0x923f82a4, 0xaf194f9b), u64init (0xab1c5ed5, 0xda6d8118),
u64init (0xd807aa98, 0xa3030242), u64init (0x12835b01, 0x45706fbe),
u64init (0x243185be, 0x4ee4b28c), u64init (0x550c7dc3, 0xd5ffb4e2),
u64init (0x72be5d74, 0xf27b896f), u64init (0x80deb1fe, 0x3b1696b1),
u64init (0x9bdc06a7, 0x25c71235), u64init (0xc19bf174, 0xcf692694),
u64init (0xe49b69c1, 0x9ef14ad2), u64init (0xefbe4786, 0x384f25e3),
u64init (0x0fc19dc6, 0x8b8cd5b5), u64init (0x240ca1cc, 0x77ac9c65),
u64init (0x2de92c6f, 0x592b0275), u64init (0x4a7484aa, 0x6ea6e483),
u64init (0x5cb0a9dc, 0xbd41fbd4), u64init (0x76f988da, 0x831153b5),
u64init (0x983e5152, 0xee66dfab), u64init (0xa831c66d, 0x2db43210),
u64init (0xb00327c8, 0x98fb213f), u64init (0xbf597fc7, 0xbeef0ee4),
u64init (0xc6e00bf3, 0x3da88fc2), u64init (0xd5a79147, 0x930aa725),
u64init (0x06ca6351, 0xe003826f), u64init (0x14292967, 0x0a0e6e70),
u64init (0x27b70a85, 0x46d22ffc), u64init (0x2e1b2138, 0x5c26c926),
u64init (0x4d2c6dfc, 0x5ac42aed), u64init (0x53380d13, 0x9d95b3df),
u64init (0x650a7354, 0x8baf63de), u64init (0x766a0abb, 0x3c77b2a8),
u64init (0x81c2c92e, 0x47edaee6), u64init (0x92722c85, 0x1482353b),
u64init (0xa2bfe8a1, 0x4cf10364), u64init (0xa81a664b, 0xbc423001),
u64init (0xc24b8b70, 0xd0f89791), u64init (0xc76c51a3, 0x0654be30),
u64init (0xd192e819, 0xd6ef5218), u64init (0xd6990624, 0x5565a910),
u64init (0xf40e3585, 0x5771202a), u64init (0x106aa070, 0x32bbd1b8),
u64init (0x19a4c116, 0xb8d2d0c8), u64init (0x1e376c08, 0x5141ab53),
u64init (0x2748774c, 0xdf8eeb99), u64init (0x34b0bcb5, 0xe19b48a8),
u64init (0x391c0cb3, 0xc5c95a63), u64init (0x4ed8aa4a, 0xe3418acb),
u64init (0x5b9cca4f, 0x7763e373), u64init (0x682e6ff3, 0xd6b2b8a3),
u64init (0x748f82ee, 0x5defb2fc), u64init (0x78a5636f, 0x43172f60),
u64init (0x84c87814, 0xa1f0ab72), u64init (0x8cc70208, 0x1a6439ec),
u64init (0x90befffa, 0x23631e28), u64init (0xa4506ceb, 0xde82bde9),
u64init (0xbef9a3f7, 0xb2c67915), u64init (0xc67178f2, 0xe372532b),
u64init (0xca273ece, 0xea26619c), u64init (0xd186b8c7, 0x21c0c207),
u64init (0xeada7dd6, 0xcde0eb1e), u64init (0xf57d4f7f, 0xee6ed178),
u64init (0x06f067aa, 0x72176fba), u64init (0x0a637dc5, 0xa2c898a6),
u64init (0x113f9804, 0xbef90dae), u64init (0x1b710b35, 0x131c471b),
u64init (0x28db77f5, 0x23047d84), u64init (0x32caab7b, 0x40c72493),
u64init (0x3c9ebe0a, 0x15c9bebc), u64init (0x431d67c4, 0x9c100d4c),
u64init (0x4cc5d4be, 0xcb3e42b6), u64init (0x597f299c, 0xfc657e2a),
u64init (0x5fcb6fab, 0x3ad6faec), u64init (0x6c44198c, 0x4a475817),
};
/* Round functions. */
#define F2(A, B, C) u64or (u64and (A, B), u64and (C, u64or (A, B)))
#define F1(E, F, G) u64xor (G, u64and (E, u64xor (F, G)))
/* Process LEN bytes of BUFFER, accumulating context into CTX.
It is assumed that LEN % 128 == 0.
Most of this code comes from GnuPG's cipher/sha1.c. */
void
sha512_process_block (const void *buffer, size_t len, struct sha512_ctx *ctx)
{
u64 const *words = buffer;
u64 const *endp = words + len / sizeof (u64);
u64 x[16];
u64 a = ctx->state[0];
u64 b = ctx->state[1];
u64 c = ctx->state[2];
u64 d = ctx->state[3];
u64 e = ctx->state[4];
u64 f = ctx->state[5];
u64 g = ctx->state[6];
u64 h = ctx->state[7];
/* First increment the byte count. FIPS PUB 180-2 specifies the possible
length of the file up to 2^128 bits. Here we only compute the
number of bytes. Do a double word increment. */
ctx->total[0] = u64plus (ctx->total[0], u64lo (len));
if (u64lt (ctx->total[0], u64lo (len)))
ctx->total[1] = u64plus (ctx->total[1], u64lo (1));
#define S0(x) u64xor (u64rol(x, 63), u64xor (u64rol (x, 56), u64shr (x, 7)))
#define S1(x) u64xor (u64rol (x, 45), u64xor (u64rol (x, 3), u64shr (x, 6)))
#define SS0(x) u64xor (u64rol (x, 36), u64xor (u64rol (x, 30), u64rol (x, 25)))
#define SS1(x) u64xor (u64rol(x, 50), u64xor (u64rol (x, 46), u64rol (x, 23)))
#define M(I) (x[(I) & 15] \
= u64plus (x[(I) & 15], \
u64plus (S1 (x[((I) - 2) & 15]), \
u64plus (x[((I) - 7) & 15], \
S0 (x[((I) - 15) & 15])))))
#define R(A, B, C, D, E, F, G, H, K, M) \
do \
{ \
u64 t0 = u64plus (SS0 (A), F2 (A, B, C)); \
u64 t1 = \
u64plus (H, u64plus (SS1 (E), \
u64plus (F1 (E, F, G), u64plus (K, M)))); \
D = u64plus (D, t1); \
H = u64plus (t0, t1); \
} \
while (0)
while (words < endp)
{
int t;
/* FIXME: see sha1.c for a better implementation. */
for (t = 0; t < 16; t++)
{
x[t] = SWAP (*words);
words++;
}
R( a, b, c, d, e, f, g, h, K( 0), x[ 0] );
R( h, a, b, c, d, e, f, g, K( 1), x[ 1] );
R( g, h, a, b, c, d, e, f, K( 2), x[ 2] );
R( f, g, h, a, b, c, d, e, K( 3), x[ 3] );
R( e, f, g, h, a, b, c, d, K( 4), x[ 4] );
R( d, e, f, g, h, a, b, c, K( 5), x[ 5] );
R( c, d, e, f, g, h, a, b, K( 6), x[ 6] );
R( b, c, d, e, f, g, h, a, K( 7), x[ 7] );
R( a, b, c, d, e, f, g, h, K( 8), x[ 8] );
R( h, a, b, c, d, e, f, g, K( 9), x[ 9] );
R( g, h, a, b, c, d, e, f, K(10), x[10] );
R( f, g, h, a, b, c, d, e, K(11), x[11] );
R( e, f, g, h, a, b, c, d, K(12), x[12] );
R( d, e, f, g, h, a, b, c, K(13), x[13] );
R( c, d, e, f, g, h, a, b, K(14), x[14] );
R( b, c, d, e, f, g, h, a, K(15), x[15] );
R( a, b, c, d, e, f, g, h, K(16), M(16) );
R( h, a, b, c, d, e, f, g, K(17), M(17) );
R( g, h, a, b, c, d, e, f, K(18), M(18) );
R( f, g, h, a, b, c, d, e, K(19), M(19) );
R( e, f, g, h, a, b, c, d, K(20), M(20) );
R( d, e, f, g, h, a, b, c, K(21), M(21) );
R( c, d, e, f, g, h, a, b, K(22), M(22) );
R( b, c, d, e, f, g, h, a, K(23), M(23) );
R( a, b, c, d, e, f, g, h, K(24), M(24) );
R( h, a, b, c, d, e, f, g, K(25), M(25) );
R( g, h, a, b, c, d, e, f, K(26), M(26) );
R( f, g, h, a, b, c, d, e, K(27), M(27) );
R( e, f, g, h, a, b, c, d, K(28), M(28) );
R( d, e, f, g, h, a, b, c, K(29), M(29) );
R( c, d, e, f, g, h, a, b, K(30), M(30) );
R( b, c, d, e, f, g, h, a, K(31), M(31) );
R( a, b, c, d, e, f, g, h, K(32), M(32) );
R( h, a, b, c, d, e, f, g, K(33), M(33) );
R( g, h, a, b, c, d, e, f, K(34), M(34) );
R( f, g, h, a, b, c, d, e, K(35), M(35) );
R( e, f, g, h, a, b, c, d, K(36), M(36) );
R( d, e, f, g, h, a, b, c, K(37), M(37) );
R( c, d, e, f, g, h, a, b, K(38), M(38) );
R( b, c, d, e, f, g, h, a, K(39), M(39) );
R( a, b, c, d, e, f, g, h, K(40), M(40) );
R( h, a, b, c, d, e, f, g, K(41), M(41) );
R( g, h, a, b, c, d, e, f, K(42), M(42) );
R( f, g, h, a, b, c, d, e, K(43), M(43) );
R( e, f, g, h, a, b, c, d, K(44), M(44) );
R( d, e, f, g, h, a, b, c, K(45), M(45) );
R( c, d, e, f, g, h, a, b, K(46), M(46) );
R( b, c, d, e, f, g, h, a, K(47), M(47) );
R( a, b, c, d, e, f, g, h, K(48), M(48) );
R( h, a, b, c, d, e, f, g, K(49), M(49) );
R( g, h, a, b, c, d, e, f, K(50), M(50) );
R( f, g, h, a, b, c, d, e, K(51), M(51) );
R( e, f, g, h, a, b, c, d, K(52), M(52) );
R( d, e, f, g, h, a, b, c, K(53), M(53) );
R( c, d, e, f, g, h, a, b, K(54), M(54) );
R( b, c, d, e, f, g, h, a, K(55), M(55) );
R( a, b, c, d, e, f, g, h, K(56), M(56) );
R( h, a, b, c, d, e, f, g, K(57), M(57) );
R( g, h, a, b, c, d, e, f, K(58), M(58) );
R( f, g, h, a, b, c, d, e, K(59), M(59) );
R( e, f, g, h, a, b, c, d, K(60), M(60) );
R( d, e, f, g, h, a, b, c, K(61), M(61) );
R( c, d, e, f, g, h, a, b, K(62), M(62) );
R( b, c, d, e, f, g, h, a, K(63), M(63) );
R( a, b, c, d, e, f, g, h, K(64), M(64) );
R( h, a, b, c, d, e, f, g, K(65), M(65) );
R( g, h, a, b, c, d, e, f, K(66), M(66) );
R( f, g, h, a, b, c, d, e, K(67), M(67) );
R( e, f, g, h, a, b, c, d, K(68), M(68) );
R( d, e, f, g, h, a, b, c, K(69), M(69) );
R( c, d, e, f, g, h, a, b, K(70), M(70) );
R( b, c, d, e, f, g, h, a, K(71), M(71) );
R( a, b, c, d, e, f, g, h, K(72), M(72) );
R( h, a, b, c, d, e, f, g, K(73), M(73) );
R( g, h, a, b, c, d, e, f, K(74), M(74) );
R( f, g, h, a, b, c, d, e, K(75), M(75) );
R( e, f, g, h, a, b, c, d, K(76), M(76) );
R( d, e, f, g, h, a, b, c, K(77), M(77) );
R( c, d, e, f, g, h, a, b, K(78), M(78) );
R( b, c, d, e, f, g, h, a, K(79), M(79) );
a = ctx->state[0] = u64plus (ctx->state[0], a);
b = ctx->state[1] = u64plus (ctx->state[1], b);
c = ctx->state[2] = u64plus (ctx->state[2], c);
d = ctx->state[3] = u64plus (ctx->state[3], d);
e = ctx->state[4] = u64plus (ctx->state[4], e);
f = ctx->state[5] = u64plus (ctx->state[5], f);
g = ctx->state[6] = u64plus (ctx->state[6], g);
h = ctx->state[7] = u64plus (ctx->state[7], h);
}
}

95
lib/sha512.h Normal file
View file

@ -0,0 +1,95 @@
/* Declarations of functions and data types used for SHA512 and SHA384 sum
library functions.
Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
This program 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 3 of the License, or
(at your option) any later version.
This program 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 this program. If not, see <http://www.gnu.org/licenses/>. */
#ifndef SHA512_H
# define SHA512_H 1
# include <stdio.h>
# include "u64.h"
# ifdef __cplusplus
extern "C" {
# endif
/* Structure to save state of computation between the single steps. */
struct sha512_ctx
{
u64 state[8];
u64 total[2];
size_t buflen;
u64 buffer[32];
};
enum { SHA384_DIGEST_SIZE = 384 / 8 };
enum { SHA512_DIGEST_SIZE = 512 / 8 };
/* Initialize structure containing state of computation. */
extern void sha512_init_ctx (struct sha512_ctx *ctx);
extern void sha384_init_ctx (struct sha512_ctx *ctx);
/* Starting with the result of former calls of this function (or the
initialization function update the context for the next LEN bytes
starting at BUFFER.
It is necessary that LEN is a multiple of 128!!! */
extern void sha512_process_block (const void *buffer, size_t len,
struct sha512_ctx *ctx);
/* Starting with the result of former calls of this function (or the
initialization function update the context for the next LEN bytes
starting at BUFFER.
It is NOT required that LEN is a multiple of 128. */
extern void sha512_process_bytes (const void *buffer, size_t len,
struct sha512_ctx *ctx);
/* Process the remaining bytes in the buffer and put result from CTX
in first 64 (48) bytes following RESBUF. The result is always in little
endian byte order, so that a byte-wise output yields to the wanted
ASCII representation of the message digest. */
extern void *sha512_finish_ctx (struct sha512_ctx *ctx, void *resbuf);
extern void *sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf);
/* Put result from CTX in first 64 (48) bytes following RESBUF. The result is
always in little endian byte order, so that a byte-wise output yields
to the wanted ASCII representation of the message digest.
IMPORTANT: On some systems it is required that RESBUF is correctly
aligned for a 32 bits value. */
extern void *sha512_read_ctx (const struct sha512_ctx *ctx, void *resbuf);
extern void *sha384_read_ctx (const struct sha512_ctx *ctx, void *resbuf);
/* Compute SHA512 (SHA384) message digest for bytes read from STREAM. The
resulting message digest number will be written into the 64 (48) bytes
beginning at RESBLOCK. */
extern int sha512_stream (FILE *stream, void *resblock);
extern int sha384_stream (FILE *stream, void *resblock);
/* Compute SHA512 (SHA384) message digest for LEN bytes beginning at BUFFER. The
result is always in little endian byte order, so that a byte-wise
output yields to the wanted ASCII representation of the message
digest. */
extern void *sha512_buffer (const char *buffer, size_t len, void *resblock);
extern void *sha384_buffer (const char *buffer, size_t len, void *resblock);
# ifdef __cplusplus
}
# endif
#endif

158
lib/u64.h Normal file
View file

@ -0,0 +1,158 @@
/* uint64_t-like operations that work even on hosts lacking uint64_t
Copyright (C) 2006, 2009-2011 Free Software Foundation, Inc.
This program 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 3 of the License, or
(at your option) any later version.
This program 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 this program. If not, see <http://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
#include <stdint.h>
/* Return X rotated left by N bits, where 0 < N < 64. */
#define u64rol(x, n) u64or (u64shl (x, n), u64shr (x, 64 - n))
#ifdef UINT64_MAX
/* Native implementations are trivial. See below for comments on what
these operations do. */
typedef uint64_t u64;
# define u64hilo(hi, lo) ((u64) (((u64) (hi) << 32) + (lo)))
# define u64init(hi, lo) u64hilo (hi, lo)
# define u64lo(x) ((u64) (x))
# define u64lt(x, y) ((x) < (y))
# define u64and(x, y) ((x) & (y))
# define u64or(x, y) ((x) | (y))
# define u64xor(x, y) ((x) ^ (y))
# define u64plus(x, y) ((x) + (y))
# define u64shl(x, n) ((x) << (n))
# define u64shr(x, n) ((x) >> (n))
#else
/* u64 is a 64-bit unsigned integer value.
u64init (HI, LO), is like u64hilo (HI, LO), but for use in
initializer contexts. */
# ifdef WORDS_BIGENDIAN
typedef struct { uint32_t hi, lo; } u64;
# define u64init(hi, lo) { hi, lo }
# else
typedef struct { uint32_t lo, hi; } u64;
# define u64init(hi, lo) { lo, hi }
# endif
/* Given the high and low-order 32-bit quantities HI and LO, return a u64
value representing (HI << 32) + LO. */
static inline u64
u64hilo (uint32_t hi, uint32_t lo)
{
u64 r;
r.hi = hi;
r.lo = lo;
return r;
}
/* Return a u64 value representing LO. */
static inline u64
u64lo (uint32_t lo)
{
u64 r;
r.hi = 0;
r.lo = lo;
return r;
}
/* Return X < Y. */
static inline int
u64lt (u64 x, u64 y)
{
return x.hi < y.hi || (x.hi == y.hi && x.lo < y.lo);
}
/* Return X & Y. */
static inline u64
u64and (u64 x, u64 y)
{
u64 r;
r.hi = x.hi & y.hi;
r.lo = x.lo & y.lo;
return r;
}
/* Return X | Y. */
static inline u64
u64or (u64 x, u64 y)
{
u64 r;
r.hi = x.hi | y.hi;
r.lo = x.lo | y.lo;
return r;
}
/* Return X ^ Y. */
static inline u64
u64xor (u64 x, u64 y)
{
u64 r;
r.hi = x.hi ^ y.hi;
r.lo = x.lo ^ y.lo;
return r;
}
/* Return X + Y. */
static inline u64
u64plus (u64 x, u64 y)
{
u64 r;
r.lo = x.lo + y.lo;
r.hi = x.hi + y.hi + (r.lo < x.lo);
return r;
}
/* Return X << N. */
static inline u64
u64shl (u64 x, int n)
{
u64 r;
if (n < 32)
{
r.hi = (x.hi << n) | (x.lo >> (32 - n));
r.lo = x.lo << n;
}
else
{
r.hi = x.lo << (n - 32);
r.lo = 0;
}
return r;
}
/* Return X >> N. */
static inline u64
u64shr (u64 x, int n)
{
u64 r;
if (n < 32)
{
r.hi = x.hi >> n;
r.lo = (x.hi << (32 - n)) | (x.lo >> n);
}
else
{
r.hi = 0;
r.lo = x.hi >> (n - 32);
}
return r;
}
#endif

123
lisp/ChangeLog
View file

@ -1,3 +1,111 @@
2011-06-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mail/smtpmail.el (smtpmail-via-smtp): Make sure we don't send
QUIT twice.
(smtpmail-try-auth-methods): Require user name and password from
auth-source.
2011-06-22 Martin Rudalics <rudalics@gmx.at>
* window.el (display-buffer-default-specifiers)
(display-buffer-alist): Remove entries for pop-up-frame-alist.
Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
(split-window): Normalize SIDE argument (Bug#8916).
* frame.el (pop-up-frame-alist, pop-up-frame-function)
(special-display-frame-alist, special-display-popup-frame):
Remove duplicate declarations. These are now in window.el.
2011-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mail/smtpmail.el (smtpmail-via-smtp): Set
:use-starttls-if-possible so that we always use STARTTLS if the
server supports it. SMTP servers that support STARTTLS commonly
require it.
* net/network-stream.el (network-stream-open-starttls): Support
upgrading to STARTTLS always, even if we don't have built-in support.
(open-network-stream): Add the :always-query-capabilies keyword.
* mail/smtpmail.el: Rewritten to do opportunistic STARTTLS
upgrades with `open-network-stream', and rely solely on
auth-source for all credentials. Big changes throughout the file,
but in particular:
(smtpmail-auth-credentials): Removed.
(smtpmail-starttls-credentials): Removed.
(smtpmail-via-smtp): Check for servers saying they want AUTH after
MAIL FROM, too.
* net/network-stream.el (network-stream-open-starttls): Provide
support for client certificates both for external and built-in
STARTTLS.
(auth-source): Require.
(open-network-stream): Document the :client-certificate keyword.
(network-stream-certificate): Change cert-cert to cert and
cert-key to key.
2011-06-21 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-cache.el (top): Don't load the persistency file when
"emacs -Q" has been called.
2011-06-21 Tim Harper <timcharper@gmail.com>
* term/ns-win.el (ns-initialize-window-system): set
application-specific `ApplePressAndHoldEnabled' system
resource to NO as it is not yet supported by the NS port.
2011-06-21 Juanma Barranquero <lekktu@gmail.com>
* misc.el (list-dynamic-libraries--refresh): Compute header here...
(list-dynamic-libraries): ...not here.
2011-06-21 Leo Liu <sdl.web@gmail.com>
* subr.el (sha1): Implement sha1 using secure-hash.
2011-06-21 Martin Rudalics <rudalics@gmx.at>
* window.el (display-buffer-alist): In default value do not
enforce searching a window on any but the selected frame.
Reported by Katsumi Yamaoka <yamaoka@jpl.org>.
(display-buffer-select-window): Remove function.
(display-buffer-in-window): When a window on another frame gets
reused, do not select it any more but just raise its frame if
necessary (Bug#8851) and (Bug#8856).
(display-buffer-normalize-options): Handle pop-up-frames related
options more faithfully.
(pop-to-buffer): Don't rely on `display-buffer' selecting the
window if it is on another frame.
(display-buffer-alist, display-buffer-default-specifiers): Don't
make new frame unsplittable by default.
(display-buffer-normalize-argument): Fix doc-string typo and use
'same-frame-other-window instead of 'other-window when associating
with display-buffer-macro-specifiers.
2011-06-21 Vincent Belaïche <vincent.b.1@hotmail.fr>
* play/5x5.el (5x5-solve-rotate-left, 5x5-solve-rotate-right):
New functions.
(5x5-mode-map, 5x5-mode-menu): Bind them.
(5x5-draw-grid): Tweak the solver's rendering.
2011-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/compile.el (compilation-error-regexp-alist-alist): Rename
`caml' to `python-tracebacks-and-caml'; allow leading tabs (bug#8585).
2011-06-21 Drew Adams <drew.adams@oracle.com>
* menu-bar.el: Use function variable instead of switch-to-buffer.
(menu-bar-select-buffer-function): New variable.
(menu-bar-update-buffers): Use it (bug#8876).
2011-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (add-to-list): Add handler to check the
variable's status.
2011-06-20 Jan Djärv <jan.h.d@swipnet.se>
* x-dnd.el (x-dnd-version-from-flags)
@ -7,15 +115,16 @@
2011-06-20 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuffer.el (completion-metadata): Prepend the alist with `metadata'.
* minibuffer.el (completion-metadata): Add `metadata' to the alist.
(completion-try-completion, completion-all-completions): Compute the
metadata argument if it's missing; make it optional (bug#8795).
* wid-edit.el: Use lexical scoping and move towards completion-at-point.
* wid-edit.el: Use lex-bind and move towards completion-at-point.
(widget-complete): Use new :completion-function property.
(widget-completions-at-point): New function.
(default): Use :completion-function instead of :complete.
(widget-default-completions): Rename from widget-default-complete, rewrite.
(widget-default-completions): Rename from widget-default-complete;
Rewrite.
(widget-string-complete, widget-file-complete, widget-color-complete):
Remove functions.
(file, symbol, function, variable, coding-system, color):
@ -51,14 +160,6 @@
* net/rcirc.el: Delete trailing whitespaces once and for all.
2011-06-20 Martin Rudalics <rudalics@gmx.at>
* window.el (get-window-with-predicate): Start scanning with
window following selected window to restore Emacs 23 behavior.
Clarify doc-string.
(get-buffer-window-list): Start scanning with selected window to
restore Emacs 23 behavior. Clarify doc-string.
2011-06-20 Daniel Colascione <dan.colascione@gmail.com>
* emacs-lisp/syntax.el (syntax-ppss): Further improve docstring.

19
lisp/emacs-lisp/bytecomp.el
View file

@ -4244,6 +4244,25 @@ binding slots have been popped."
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
(byte-defop-compiler-1 add-to-list byte-compile-add-to-list)
(defun byte-compile-add-to-list (form)
;; FIXME: This could be used for `set' as well, except that it's got
;; its own opcode, so the final `byte-compile-normal-call' needs to
;; be replaced with something else.
(pcase form
(`(,fun ',var . ,_)
(byte-compile-check-variable var 'assign)
(if (assq var byte-compile--lexical-environment)
(byte-compile-log-warning
(format "%s cannot use lexical var `%s'" fun var)
nil :error)
(unless (or (not (byte-compile-warning-enabled-p 'free-vars))
(boundp var)
(memq var byte-compile-bound-variables)
(memq var byte-compile-free-references))
(byte-compile-warn "assignment to free variable `%S'" var)
(push var byte-compile-free-references)))))
(byte-compile-normal-call form))
;;; tags

90
lisp/frame.el
View file

@ -95,96 +95,6 @@ appended when the minibuffer frame is created."
(sexp :tag "Value")))
:group 'frames)
(defcustom pop-up-frame-alist nil
"Alist of parameters for automatically generated new frames.
You can set this in your init file; for example,
(setq pop-up-frame-alist '((width . 80) (height . 20)))
If non-nil, the value you specify here is used by the default
`pop-up-frame-function' for the creation of new frames.
Since `pop-up-frame-function' is used by `display-buffer' for
making new frames, any value specified here by default affects
the automatic generation of new frames via `display-buffer' and
all functions based on it. The behavior of `make-frame' is not
affected by this variable."
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
(sexp :tag "Value")))
:group 'frames)
(defcustom pop-up-frame-function
(lambda () (make-frame pop-up-frame-alist))
"Function used by `display-buffer' for creating a new frame.
This function is called with no arguments and should return a new
frame. The default value calls `make-frame' with the argument
`pop-up-frame-alist'."
:type 'function
:group 'frames)
(defcustom special-display-frame-alist
'((height . 14) (width . 80) (unsplittable . t))
"Alist of parameters for special frames.
Special frames are used for buffers whose names are listed in
`special-display-buffer-names' and for buffers whose names match
one of the regular expressions in `special-display-regexps'.
This variable can be set in your init file, like this:
(setq special-display-frame-alist '((width . 80) (height . 20)))
These supersede the values given in `default-frame-alist'."
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
(sexp :tag "Value")))
:group 'frames)
(defun special-display-popup-frame (buffer &optional args)
"Display BUFFER and return the window chosen.
If BUFFER is already displayed in a visible or iconified frame,
raise that frame. Otherwise, display BUFFER in a new frame.
Optional argument ARGS is a list specifying additional
information.
If ARGS is an alist, use it as a list of frame parameters. If
these parameters contain \(same-window . t), display BUFFER in
the selected window. If they contain \(same-frame . t), display
BUFFER in a window of the selected frame.
If ARGS is a list whose car is a symbol, use (car ARGS) as a
function to do the work. Pass it BUFFER as first argument,
and (cdr ARGS) as second."
(if (and args (symbolp (car args)))
(apply (car args) buffer (cdr args))
(let ((window (get-buffer-window buffer 0)))
(or
;; If we have a window already, make it visible.
(when window
(let ((frame (window-frame window)))
(make-frame-visible frame)
(raise-frame frame)
window))
;; Reuse the current window if the user requested it.
(when (cdr (assq 'same-window args))
(condition-case nil
(progn (switch-to-buffer buffer) (selected-window))
(error nil)))
;; Stay on the same frame if requested.
(when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
(let* ((pop-up-windows t)
pop-up-frames
special-display-buffer-names special-display-regexps)
(display-buffer buffer)))
;; If no window yet, make one in a new frame.
(let ((frame
(with-current-buffer buffer
(make-frame (append args special-display-frame-alist)))))
(set-window-buffer (frame-selected-window frame) buffer)
(set-window-dedicated-p (frame-selected-window frame) t)
(frame-selected-window frame))))))
(defun handle-delete-frame (event)
"Handle delete-frame events from the X server."
(interactive "e")

12
lisp/gnus/ChangeLog
View file

@ -1,3 +1,15 @@
2011-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
* auth-source.el (auth-source-netrc-create): Don't print all tokens in
%S format, since that looks odd.
(auth-sources): Prefer the ~/.authinfo file over the ~/.authinfo.gpg
file, especially when saving.
2011-06-21 Andrew Cohen <cohen@andy.bu.edu>
* nnimap.el (nnimap-find-article-by-message-id): return nil when no
article found.
2011-06-18 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-source-netrc-use-gpg-tokens): Replace

19
lisp/gnus/auth-source.el
View file

@ -208,7 +208,7 @@ If the value is a function, debug messages are logged by calling
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
"List of authentication sources.
The default will get login and password information from
@ -713,7 +713,8 @@ Returns the deleted entries."
when (string-match (concat "^" auth-source-magic)
(symbol-name sym))
;; remove that key
do (password-cache-remove (symbol-name sym))))
do (password-cache-remove (symbol-name sym)))
(setq auth-source-netrc-cache nil))
(defun auth-source-remember (spec found)
"Remember FOUND search results for SPEC."
@ -1144,6 +1145,9 @@ See `auth-source-search' for details on SPEC."
;; we know (because of an assertion in auth-source-search) that the
;; :create parameter is either t or a list (which includes nil)
(create-extra (if (eq t create) nil create))
(current-data (car (auth-source-search :max 1
:host host
:port port)))
(required (append base-required create-extra))
(file (oref backend source))
(add "")
@ -1178,7 +1182,9 @@ See `auth-source-search' for details on SPEC."
(dolist (r required)
(let* ((data (aget valist r))
;; take the first element if the data is a list
(data (auth-source-netrc-element-or-first data))
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(intern (format ":%s" r) obarray))))
;; this is the default to be offered
(given-default (aget auth-source-creation-defaults r))
;; the default supplementals are simple:
@ -1281,7 +1287,7 @@ See `auth-source-search' for details on SPEC."
(let ((printer (lambda ()
;; append the key (the symbol name of r)
;; and the value in r
(format "%s%s %S"
(format "%s%s %s"
;; prepend a space
(if (zerop (length add)) "" " ")
;; remap auth-source tokens to netrc
@ -1291,8 +1297,9 @@ See `auth-source-search' for details on SPEC."
(secret "password")
(port "port") ; redundant but clearer
(t (symbol-name r)))
;; the value will be printed in %S format
data))))
(if (string-match "[\" ]" data)
(format "%S" data)
data)))))
(setq add (concat add (funcall printer)))))))
(plist-put

2
lisp/gnus/nnimap.el
View file

@ -929,7 +929,7 @@ textual parts.")
(car (setq result (nnimap-parse-response))))
;; Select the last instance of the message in the group.
(and (setq article
(car (last (assoc "SEARCH" (cdr result)))))
(car (last (cdr (assoc "SEARCH" (cdr result))))))
(string-to-number article))))))
(defun nnimap-delete-article (articles)

614
lisp/mail/smtpmail.el
View file

@ -34,16 +34,10 @@
;;
;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
;;(setq smtpmail-smtp-server "YOUR SMTP HOST")
;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-debug-info t) ; only to debug problems
;;(setq smtpmail-auth-credentials ; or use ~/.authinfo
;; '(("YOUR SMTP HOST" 25 "username" "password")))
;;(setq smtpmail-starttls-credentials
;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
;; integer or a string, just as long as they match (eq).
;; To queue mail, set `smtpmail-queue-mail' to t and use
;; `smtpmail-send-queued-mail' to send.
@ -58,17 +52,9 @@
;; Authentication by the AUTH mechanism.
;; See http://www.ietf.org/rfc/rfc2554.txt
;; Modified by Simon Josefsson <simon@josefsson.org>, 2000-10-07, to support
;; STARTTLS. Requires external program
;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz.
;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt
;;; Code:
(require 'sendmail)
(autoload 'starttls-any-program-available "starttls")
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
(autoload 'mail-strip-quoted-names "mail-utils")
(autoload 'message-make-date "message")
(autoload 'message-make-message-id "message")
@ -85,11 +71,9 @@
:group 'mail)
(defcustom smtpmail-default-smtp-server nil
(defvar smtpmail-default-smtp-server nil
"Specify default SMTP server.
This only has effect if you specify it before loading the smtpmail library."
:type '(choice (const nil) string)
:group 'smtpmail)
This only has effect if you specify it before loading the smtpmail library.")
(defcustom smtpmail-smtp-server
(or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
@ -110,6 +94,16 @@ don't define this value."
:type '(choice (const nil) string)
:group 'smtpmail)
(defcustom smtpmail-stream-type nil
"Connection type SMTP connections.
This may be either nil (plain connection) or `starttls' (use the
starttls mechanism to turn on TLS security after opening the
stream)."
:version "24.1"
:group 'smtpmail
:type '(choice (const :tag "Plain" nil)
(const starttls)))
(defcustom smtpmail-sendto-domain nil
"Local domain name without a host name.
This is appended (with an @-sign) to any specified recipients which do
@ -117,11 +111,7 @@ not include an @-sign, so that each RCPT TO address is fully qualified.
\(Some configurations of sendmail require this.)
Don't bother to set this unless you have get an error like:
Sending failed; SMTP protocol error
when sending mail, and the *trace of SMTP session to <somewhere>*
buffer includes an exchange like:
RCPT TO: <someone>
501 <someone>: recipient address must contain a domain."
Sending failed; 501 <someone>: recipient address must contain a domain."
:type '(choice (const nil) string)
:group 'smtpmail)
@ -157,39 +147,6 @@ and sent with `smtpmail-send-queued-mail'."
:type 'directory
:group 'smtpmail)
(defcustom smtpmail-auth-credentials "~/.authinfo"
"Specify username and password for servers, directly or via .netrc file.
This variable can either be a filename pointing to a file in netrc(5)
format, or list of four-element lists that contain, in order,
`servername' (a string), `port' (an integer), `user' (a string) and
`password' (a string, or nil to query the user when needed). If you
need to enter a `realm' too, add it to the user string, so that it
looks like `user@realm'."
:type '(choice file
(repeat (list (string :tag "Server")
(integer :tag "Port")
(string :tag "Username")
(choice (const :tag "Query when needed" nil)
(string :tag "Password")))))
:version "22.1"
:group 'smtpmail)
(defcustom smtpmail-starttls-credentials '(("" 25 "" ""))
"Specify STARTTLS keys and certificates for servers.
This is a list of four-element list with `servername' (a string),
`port' (an integer), `key' (a filename) and `certificate' (a
filename).
If you do not have a certificate/key pair, leave the `key' and
`certificate' fields as `nil'. A key/certificate pair is only
needed if you want to use X.509 client authenticated
connections."
:type '(repeat (list (string :tag "Server")
(integer :tag "Port")
(file :tag "Key")
(file :tag "Certificate")))
:version "21.1"
:group 'smtpmail)
(defcustom smtpmail-warn-about-unknown-extensions nil
"If set, print warnings about unknown SMTP extensions.
This is mainly useful for development purposes, to learn about
@ -230,6 +187,7 @@ The list is in preference order.")
(tembuf (generate-new-buffer " smtpmail temp"))
(case-fold-search nil)
delimline
result
(mailbuf (current-buffer))
;; Examine this variable now, so that
;; local binding in the mail buffer will take effect.
@ -373,9 +331,10 @@ The list is in preference order.")
;; Send or queue
(if (not smtpmail-queue-mail)
(if (not (null smtpmail-recipient-address-list))
(if (not (smtpmail-via-smtp
smtpmail-recipient-address-list tembuf))
(error "Sending failed; SMTP protocol error"))
(when (setq result
(smtpmail-via-smtp
smtpmail-recipient-address-list tembuf))
(error "Sending failed: %s" result))
(error "Sending failed; no recipients"))
(let* ((file-data
(expand-file-name
@ -432,7 +391,8 @@ The list is in preference order.")
;; mail, send it, etc...
(let ((file-msg "")
(qfile (expand-file-name smtpmail-queue-index-file
smtpmail-queue-dir)))
smtpmail-queue-dir))
result)
(insert-file-contents qfile)
(goto-char (point-min))
(while (not (eobp))
@ -448,17 +408,16 @@ The list is in preference order.")
(or (and mail-specify-envelope-from (mail-envelope-from))
user-mail-address)))
(if (not (null smtpmail-recipient-address-list))
(if (not (smtpmail-via-smtp smtpmail-recipient-address-list
(current-buffer)))
(error "Sending failed; SMTP protocol error"))
(when (setq result (smtpmail-via-smtp
smtpmail-recipient-address-list
(current-buffer)))
(error "Sending failed: %s" result))
(error "Sending failed; no recipients"))))
(delete-file file-msg)
(delete-file (concat file-msg ".el"))
(delete-region (point-at-bol) (point-at-bol 2)))
(write-region (point-min) (point-max) qfile))))
;; (defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
(defun smtpmail-fqdn ()
(if smtpmail-local-domain
(concat (system-name) "." smtpmail-local-domain)
@ -503,146 +462,133 @@ The list is in preference order.")
(push el2 result)))
(nreverse result)))
(defvar starttls-extra-args)
(defvar starttls-extra-arguments)
(defun smtpmail-open-stream (process-buffer host port)
(let ((cred (smtpmail-find-credentials
smtpmail-starttls-credentials host port)))
(if (null (and cred (starttls-any-program-available)))
;; The normal case.
(open-network-stream "SMTP" process-buffer host port)
(let* ((cred-key (smtpmail-cred-key cred))
(cred-cert (smtpmail-cred-cert cred))
(starttls-extra-args
(append
starttls-extra-args
(when (and (stringp cred-key) (stringp cred-cert)
(file-regular-p
(setq cred-key (expand-file-name cred-key)))
(file-regular-p
(setq cred-cert (expand-file-name cred-cert))))
(list "--key-file" cred-key "--cert-file" cred-cert))))
(starttls-extra-arguments
(append
starttls-extra-arguments
(when (and (stringp cred-key) (stringp cred-cert)
(file-regular-p
(setq cred-key (expand-file-name cred-key)))
(file-regular-p
(setq cred-cert (expand-file-name cred-cert))))
(list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
(starttls-open-stream "SMTP" process-buffer host port)))))
;; `password-read' autoloads password-cache.
(declare-function password-cache-add "password-cache" (key password))
(defun smtpmail-try-auth-methods (process supported-extensions host port)
(defun smtpmail-command-or-throw (process string &optional code)
(let (ret)
(smtpmail-send-command process string)
(unless (smtpmail-ok-p (setq ret (smtpmail-read-response process))
code)
(throw 'done (format "%s in response to %s"
(smtpmail-response-text ret)
string)))
ret))
(defun smtpmail-try-auth-methods (process supported-extensions host port
&optional ask-for-password)
(let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
(mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
(auth-info (auth-source-search :max 1
:host host
:port (or port "smtp")))
(auth-user (plist-get (nth 0 auth-info) :user))
(auth-pass (plist-get (nth 0 auth-info) :secret))
(auth-pass (if (functionp auth-pass)
(funcall auth-pass)
auth-pass))
(cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-*
(list host port auth-user auth-pass)
;; else, if auth-source didn't return them...
(if (stringp smtpmail-auth-credentials)
(let* ((netrc (netrc-parse smtpmail-auth-credentials))
(port-name (format "%s" (or port "smtp")))
(hostentry (netrc-machine netrc host port-name
port-name)))
(when hostentry
(list host port
(netrc-get hostentry "login")
(netrc-get hostentry "password"))))
;; else, try `smtpmail-find-credentials' since
;; `smtpmail-auth-credentials' is not a string
(smtpmail-find-credentials
smtpmail-auth-credentials host port))))
(prompt (when cred (format "SMTP password for %s:%s: "
(smtpmail-cred-server cred)
(smtpmail-cred-port cred))))
(passwd (when cred
(or (smtpmail-cred-passwd cred)
(password-read prompt prompt))))
(auth-source-creation-prompts
'((user . "SMTP user at %h: ")
(secret . "SMTP password for %u@%h: ")))
(auth-info (car
(auth-source-search
:max 1
:host host
:port (if port
(format "%s" port)
"smtp")
:require (and ask-for-password
'(:user :secret))
:create ask-for-password)))
(user (plist-get auth-info :user))
(password (plist-get auth-info :secret))
(save-function (and ask-for-password
(plist-get auth-info :save-function)))
ret)
(when (and cred mech)
(cond
((eq mech 'cram-md5)
(smtpmail-send-command process (upcase (format "AUTH %s" mech)))
(if (or (null (car (setq ret (smtpmail-read-response process))))
(not (integerp (car ret)))
(>= (car ret) 400))
(throw 'done nil))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
(decoded (base64-decode-string challenge))
(hash (rfc2104-hash 'md5 64 16 passwd decoded))
(response (concat (smtpmail-cred-user cred) " " hash))
;; Osamu Yamane <yamane@green.ocn.ne.jp>:
;; SMTP auth fails because the SMTP server identifies
;; only the first part of the string (delimited by
;; new line characters) as a response from the
;; client, and the rest as distinct commands.
(when (functionp password)
(setq password (funcall password)))
(cond
((or (not mech)
(not user)
(not password))
;; No mechanism, or no credentials.
mech)
((eq mech 'cram-md5)
(setq ret (smtpmail-command-or-throw process "AUTH CRAM-MD5"))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
(decoded (base64-decode-string challenge))
(hash (rfc2104-hash 'md5 64 16 password decoded))
(response (concat user " " hash))
;; Osamu Yamane <yamane@green.ocn.ne.jp>:
;; SMTP auth fails because the SMTP server identifies
;; only the first part of the string (delimited by
;; new line characters) as a response from the
;; client, and the rest as distinct commands.
;; In my case, the response string is 80 characters
;; long. Without the no-line-break option for
;; `base64-encode-string', only the first 76 characters
;; are taken as a response to the server, and the
;; authentication fails.
(encoded (base64-encode-string response t)))
(smtpmail-send-command process (format "%s" encoded))
(if (or (null (car (setq ret (smtpmail-read-response process))))
(not (integerp (car ret)))
(>= (car ret) 400))
(throw 'done nil)))))
((eq mech 'login)
(smtpmail-send-command process "AUTH LOGIN")
(if (or (null (car (setq ret (smtpmail-read-response process))))
(not (integerp (car ret)))
(>= (car ret) 400))
(throw 'done nil))
(smtpmail-send-command
process (base64-encode-string (smtpmail-cred-user cred) t))
(if (or (null (car (setq ret (smtpmail-read-response process))))
(not (integerp (car ret)))
(>= (car ret) 400))
(throw 'done nil))
(smtpmail-send-command process (base64-encode-string passwd t))
(if (or (null (car (setq ret (smtpmail-read-response process))))
(not (integerp (car ret)))
(>= (car ret) 400))
(throw 'done nil)))
((eq mech 'plain)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
;; is not sent if the server did not advertise AUTH PLAIN in
;; the EHLO response. See RFC 2554 for more info.
(smtpmail-send-command process
(concat "AUTH PLAIN "
(base64-encode-string
(concat "\0"
(smtpmail-cred-user cred)
"\0"
passwd) t)))
(if (or (null (car (setq ret (smtpmail-read-response process))))
(not (integerp (car ret)))
(not (equal (car ret) 235)))
(throw 'done nil)))
;; In my case, the response string is 80 characters
;; long. Without the no-line-break option for
;; `base64-encode-string', only the first 76 characters
;; are taken as a response to the server, and the
;; authentication fails.
(encoded (base64-encode-string response t)))
(smtpmail-command-or-throw process encoded)
(when save-function
(funcall save-function)))))
((eq mech 'login)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw
process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t))
(when save-function
(funcall save-function)))
((eq mech 'plain)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
;; is not sent if the server did not advertise AUTH PLAIN in
;; the EHLO response. See RFC 2554 for more info.
(smtpmail-command-or-throw
process
(concat "AUTH PLAIN "
(base64-encode-string (concat "\0" user "\0" password) t))
235)
(when save-function
(funcall save-function)))
(t
(error "Mechanism %s not implemented" mech)))))
(t
(error "Mechanism %s not implemented" mech)))
;; Remember the password.
(when (null (smtpmail-cred-passwd cred))
(password-cache-add prompt passwd)))))
(defun smtpmail-response-code (string)
(when string
(with-temp-buffer
(insert string)
(goto-char (point-min))
(and (re-search-forward "^\\([0-9]+\\) " nil t)
(string-to-number (match-string 1))))))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
(defun smtpmail-ok-p (response &optional code)
(and (car response)
(integerp (car response))
(< (car response) 400)
(or (null code)
(= code (car response)))))
(defun smtpmail-response-text (response)
(mapconcat 'identity (cdr response) "\n"))
(defun smtpmail-query-smtp-server ()
(let ((server (read-string "Outgoing SMTP mail server: "))
(ports '(587 "smtp"))
stream port)
(when (and smtpmail-smtp-server
(not (member smtpmail-smtp-server ports)))
(push smtpmail-smtp-server ports))
(while (and (not smtpmail-smtp-server)
(setq port (pop ports)))
(when (setq stream (ignore-errors
(open-network-stream "smtp" nil server port)))
(customize-save-variable 'smtpmail-smtp-server server)
(customize-save-variable 'smtpmail-smtp-service port)
(delete-process stream)))
(unless smtpmail-smtp-server
(error "Couldn't contact an SMTP server"))))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
&optional ask-for-password)
(unless smtpmail-smtp-server
(smtpmail-query-smtp-server))
(let ((process nil)
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
@ -654,14 +600,16 @@ The list is in preference order.")
(mail-envelope-from))
user-mail-address))
response-code
greeting
process-buffer
result
auth-mechanisms
(supported-extensions '()))
(unwind-protect
(catch 'done
;; get or create the trace buffer
(setq process-buffer
(get-buffer-create (format "*trace of SMTP session to %s*" host)))
(get-buffer-create
(format "*trace of SMTP session to %s*" host)))
;; clear the trace buffer of old output
(with-current-buffer process-buffer
@ -669,105 +617,89 @@ The list is in preference order.")
(erase-buffer))
;; open the connection to the server
(setq process (smtpmail-open-stream process-buffer host port))
(and (null process) (throw 'done nil))
(setq result
(open-network-stream
"smtpmail" process-buffer host port
:type smtpmail-stream-type
:return-list t
:capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
:end-of-command "^[0-9]+ .*\r\n"
:success "^2.*\n"
:always-query-capabilities t
:starttls-function
(lambda (capabilities)
(and (string-match "-STARTTLS" capabilities)
"STARTTLS\r\n"))
:client-certificate t
:use-starttls-if-possible t))
;; If we couldn't access the server at all, we give up.
(unless (setq process (car result))
(throw 'done "Unable to contact server"))
;; set the send-filter
(set-process-filter process 'smtpmail-process-filter)
(let* ((greeting (plist-get (cdr result) :greeting))
(code (smtpmail-response-code greeting)))
(unless code
(throw 'done (format "No greeting: %s" greeting)))
(when (>= code 400)
(throw 'done (format "Connection not allowed: %s" greeting))))
(with-current-buffer process-buffer
(set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
(make-local-variable 'smtpmail-read-point)
(setq smtpmail-read-point (point-min))
(let* ((capabilities (plist-get (cdr result) :capabilities))
(code (smtpmail-response-code capabilities)))
(if (or (null code)
(>= code 400))
;; The server didn't accept EHLO, so we fall back on HELO.
(smtpmail-command-or-throw
process (format "HELO %s" (smtpmail-fqdn)))
;; EHLO was successful, so we parse the extensions.
(dolist (line (delete
""
(split-string
(plist-get (cdr result) :capabilities)
"\r\n")))
(let ((name
(with-case-table ascii-case-table
(mapcar (lambda (s) (intern (downcase s)))
(split-string (substring line 4) "[ ]")))))
(when (= (length name) 1)
(setq name (car name)))
(when name
(cond ((memq (if (consp name) (car name) name)
'(verb xvrb 8bitmime onex xone
expn size dsn etrn
enhancedstatuscodes
help xusr
auth=login auth starttls))
(setq supported-extensions
(cons name supported-extensions)))
(smtpmail-warn-about-unknown-extensions
(message "Unknown extension %s" name))))))))
(if (or (null (car (setq greeting (smtpmail-read-response process))))
(not (integerp (car greeting)))
(>= (car greeting) 400))
(throw 'done nil))
(setq auth-mechanisms
(smtpmail-try-auth-methods
process supported-extensions host port
ask-for-password))
(let ((do-ehlo t)
(do-starttls t))
(while do-ehlo
;; EHLO
(smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn)))
(when (or (member 'onex supported-extensions)
(member 'xone supported-extensions))
(smtpmail-command-or-throw process (format "ONEX")))
(if (or (null (car (setq response-code
(smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(progn
;; HELO
(smtpmail-send-command
process (format "HELO %s" (smtpmail-fqdn)))
(if (or (null (car (setq response-code
(smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil)))
(dolist (line (cdr (cdr response-code)))
(let ((name
(with-case-table ascii-case-table
(mapcar (lambda (s) (intern (downcase s)))
(split-string (substring line 4) "[ ]")))))
(and (eq (length name) 1)
(setq name (car name)))
(and name
(cond ((memq (if (consp name) (car name) name)
'(verb xvrb 8bitmime onex xone
expn size dsn etrn
enhancedstatuscodes
help xusr
auth=login auth starttls))
(setq supported-extensions
(cons name supported-extensions)))
(smtpmail-warn-about-unknown-extensions
(message "Unknown extension %s" name)))))))
(if (and do-starttls
(smtpmail-find-credentials smtpmail-starttls-credentials host port)
(member 'starttls supported-extensions)
(numberp (process-id process)))
(progn
(smtpmail-send-command process (format "STARTTLS"))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil))
(starttls-negotiate process)
(setq do-starttls nil))
(setq do-ehlo nil))))
(smtpmail-try-auth-methods process supported-extensions host port)
(if (or (member 'onex supported-extensions)
(member 'xone supported-extensions))
(progn
(smtpmail-send-command process (format "ONEX"))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil))))
(if (and smtpmail-debug-verb
(or (member 'verb supported-extensions)
(member 'xvrb supported-extensions)))
(progn
(smtpmail-send-command process (format "VERB"))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil))))
(if (member 'xusr supported-extensions)
(progn
(smtpmail-send-command process (format "XUSR"))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil))))
(when (and smtpmail-debug-verb
(or (member 'verb supported-extensions)
(member 'xvrb supported-extensions)))
(smtpmail-command-or-throw process (format "VERB")))
(when (member 'xusr supported-extensions)
(smtpmail-command-or-throw process (format "XUSR")))
;; MAIL FROM:<sender>
(let ((size-part
(if (or (member 'size supported-extensions)
@ -797,65 +729,73 @@ The list is in preference order.")
" BODY=8BITMIME"
"")
"")))
;; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
(smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
envelope-from
size-part
body-part))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil)))
(smtpmail-send-command
process (format "MAIL FROM:<%s>%s%s"
envelope-from size-part body-part))
(cond
((smtpmail-ok-p (setq result (smtpmail-read-response process)))
;; Success.
)
((and auth-mechanisms
(not ask-for-password)
(= (car result) 530))
;; We got a "530 auth required", so we close and try
;; again, this time asking the user for a password.
(smtpmail-send-command process "QUIT")
(smtpmail-read-response process)
(delete-process process)
(setq process nil)
(throw 'done
(smtpmail-via-smtp recipient smtpmail-text-buffer t)))
(t
;; Return the error code.
(throw 'done
(smtpmail-response-text result)))))
;; RCPT TO:<recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
(smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
(setq n (1+ n))
(smtpmail-send-command
process (format "RCPT TO:<%s>"
(smtpmail-maybe-append-domain
(nth n recipient))))
(cond
((smtpmail-ok-p (setq result (smtpmail-read-response process)))
;; Success.
nil)
((and auth-mechanisms
(not ask-for-password)
(= (car result) 550))
;; We got a "550 relay not permitted", and the server
;; accepts credentials, so we try again, but ask for a
;; password first.
(smtpmail-send-command process "QUIT")
(smtpmail-read-response process)
(delete-process process)
(setq process nil)
(throw 'done
(smtpmail-via-smtp recipient smtpmail-text-buffer t)))
(t
;; Return the error code.
(throw 'done
(smtpmail-response-text result))))
(setq n (1+ n))))
(setq response-code (smtpmail-read-response process))
(if (or (null (car response-code))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil))))
;; DATA
(smtpmail-send-command process "DATA")
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil))
;; Mail contents
;; Send the contents.
(smtpmail-command-or-throw process "DATA")
(smtpmail-send-data process smtpmail-text-buffer)
;; DATA end "."
(smtpmail-send-command process ".")
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil))
;; QUIT
;; (smtpmail-send-command process "QUIT")
;; (and (null (car (smtpmail-read-response process)))
;; (throw 'done nil))
t))
(if process
(with-current-buffer (process-buffer process)
(smtpmail-send-command process "QUIT")
(smtpmail-read-response process)
;; (if (or (null (car (setq response-code (smtpmail-read-response process))))
;; (not (integerp (car response-code)))
;; (>= (car response-code) 400))
;; (throw 'done nil))
(delete-process process)
(unless smtpmail-debug-info
(kill-buffer process-buffer)))))))
(smtpmail-command-or-throw process ".")
;; Return success.
nil))
(when (and process
(buffer-live-p process-buffer))
(with-current-buffer (process-buffer process)
(smtpmail-send-command process "QUIT")
(smtpmail-read-response process)
(delete-process process)
(unless smtpmail-debug-info
(kill-buffer process-buffer)))))))
(defun smtpmail-process-filter (process output)

6
lisp/menu-bar.el
View file

@ -1977,6 +1977,10 @@ Buffers menu is regenerated."
;; Used to cache the menu entries for commands in the Buffers menu
(defvar menu-bar-buffers-menu-command-entries nil)
(defvar menu-bar-select-buffer-function 'switch-to-buffer
"Function to select the buffer chosen from the `Buffers' menu-bar menu.
It must accept a buffer as its only required argument.")
(defun menu-bar-update-buffers (&optional force)
;; If user discards the Buffers item, play along.
(and (lookup-key (current-global-map) [menu-bar buffer])
@ -2022,7 +2026,7 @@ Buffers menu is regenerated."
(cons nil nil))
`(lambda ()
(interactive)
(switch-to-buffer ,(cdr pair))))))
(funcall menu-bar-select-buffer-function ,(cdr pair))))))
(list buffers-vec))))
;; Make a Frames menu if we have more than one frame.

2
lisp/misc.el
View file

@ -151,6 +151,7 @@ Internal use only."
(vector (list "Library" (1+ max-id-len) t)
(list "Loaded from" (1+ max-name-len) t)
(list "Candidate names" 0 t))))
(tabulated-list-init-header)
(setq tabulated-list-entries nil)
(dolist (lib dynamic-library-alist)
(let* ((id (car lib))
@ -178,7 +179,6 @@ The return value is always nil."
(tabulated-list-mode)
(setq tabulated-list-sort-key (cons "Library" nil))
(add-hook 'tabulated-list-revert-hook 'list-dynamic-libraries--refresh nil t)
(tabulated-list-init-header)
(setq list-dynamic-libraries--loaded-only-p loaded-only-p)
(list-dynamic-libraries--refresh)
(tabulated-list-print))

53
lisp/net/network-stream.el
View file

@ -44,6 +44,7 @@
(require 'tls)
(require 'starttls)
(require 'auth-source)
(declare-function gnutls-negotiate "gnutls" t t) ; defun*
@ -110,10 +111,21 @@ values:
STARTTLS if the server supports STARTTLS, and nil otherwise.
:always-query-capabilies says whether to query the server for
capabilities, even if we're doing a `plain' network connection.
capabilities, even if we're doing a `plain' network connection.
:client-certificate should either be a list where the first
element is the certificate key file name, and the second
element is the certificate file name itself, or `t', which
means that `auth-source' will be queried for the key and the
certificate. This parameter will only be used when doing TLS
or STARTTLS connections.
If :use-starttls-if-possible is non-nil, do opportunistic
STARTTLS upgrades even if Emacs doesn't have built-in TLS
functionality.
:nowait is a boolean that says the connection should be made
asynchronously, if possible."
asynchronously, if possible."
(unless (featurep 'make-network-process)
(error "Emacs was compiled without networking support"))
(let ((type (plist-get parameters :type))
@ -152,6 +164,22 @@ asynchronously, if possible."
:type (nth 3 result))
(car result))))))
(defun network-stream-certificate (host service parameters)
(let ((spec (plist-get :client-certificate parameters)))
(cond
((listp spec)
;; Either nil or a list with a key/certificate pair.
spec)
((eq spec t)
(let* ((auth-info
(car (auth-source-search :max 1
:host host
:port service)))
(key (plist-get auth-info :key))
(cert (plist-get auth-info :cert)))
(and key cert
(list key cert)))))))
;;;###autoload
(defalias 'open-protocol-stream 'open-network-stream)
@ -184,7 +212,8 @@ asynchronously, if possible."
;; If we have built-in STARTTLS support, try to upgrade the
;; connection.
(when (and (or (fboundp 'open-gnutls-stream)
(and require-tls
(and (or require-tls
(plist-get parameters :use-starttls-if-possible))
(executable-find "gnutls-cli")))
capabilities success-string starttls-function
(setq starttls-command
@ -201,14 +230,28 @@ asynchronously, if possible."
starttls-extra-arguments
;; For opportunistic TLS upgrades, we don't really
;; care about the identity of the peer.
(cons "--insecure" starttls-extra-arguments))))
(cons "--insecure" starttls-extra-arguments)))
(cert (network-stream-certificate host service parameters)))
;; There are client certificates requested, so add them to
;; the command line.
(when cert
(setq starttls-extra-arguments
(nconc (list "--x509keyfile" (expand-file-name (nth 0 cert))
"--x509certfile" (expand-file-name (nth 1 cert)))
starttls-extra-arguments)))
(setq stream (starttls-open-stream name buffer host service)))
(network-stream-get-response stream start eoc))
;; Requery capabilities for protocols that require it; i.e.,
;; EHLO for SMTP.
(when (plist-get parameters :always-query-capabilities)
(network-stream-command stream capability-command eoc))
(when (string-match success-string
(network-stream-command stream starttls-command eoc))
;; The server said it was OK to begin STARTTLS negotiations.
(if (fboundp 'open-gnutls-stream)
(gnutls-negotiate :process stream :hostname host)
(let ((cert (network-stream-certificate host service parameters)))
(gnutls-negotiate :process stream :hostname host
:keylist (and cert (list cert))))
(unless (starttls-negotiate stream)
(delete-process stream)))
(if (memq (process-status stream) '(open run))

78
lisp/net/tramp-cache.el
View file

@ -177,9 +177,9 @@ Remove also properties of all files in subdirectories."
(tramp-message vec 8 "%s" directory)
(maphash
(lambda (key value)
(when (and (stringp (tramp-file-name-localname key))
(string-match directory (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
(when (and (stringp (tramp-file-name-localname key))
(string-match directory (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
tramp-cache-data)))
;; Reverting or killing a buffer should also flush file properties.
@ -200,12 +200,12 @@ Remove also properties of all files in subdirectories."
(add-hook 'kill-buffer-hook 'tramp-flush-file-function)
(add-hook 'tramp-cache-unload-hook
(lambda ()
(remove-hook 'before-revert-hook
'tramp-flush-file-function)
(remove-hook 'eshell-pre-command-hook
'tramp-flush-file-function)
(remove-hook 'kill-buffer-hook
'tramp-flush-file-function)))
(remove-hook 'before-revert-hook
'tramp-flush-file-function)
(remove-hook 'eshell-pre-command-hook
'tramp-flush-file-function)
(remove-hook 'kill-buffer-hook
'tramp-flush-file-function)))
;;; -- Properties --
@ -290,17 +290,17 @@ KEY identifies the connection, it is either a process or a vector."
(let (result)
(maphash
(lambda (key value)
(let ((tmp (format
"(%s %s)"
(if (processp key)
(prin1-to-string (prin1-to-string key))
(prin1-to-string key))
(if (hash-table-p value)
(tramp-cache-print value)
(if (bufferp value)
(prin1-to-string (prin1-to-string value))
(prin1-to-string value))))))
(setq result (if result (concat result " " tmp) tmp))))
(let ((tmp (format
"(%s %s)"
(if (processp key)
(prin1-to-string (prin1-to-string key))
(prin1-to-string key))
(if (hash-table-p value)
(tramp-cache-print value)
(if (bufferp value)
(prin1-to-string (prin1-to-string value))
(prin1-to-string value))))))
(setq result (if result (concat result " " tmp) tmp))))
table)
result)))
@ -310,8 +310,8 @@ KEY identifies the connection, it is either a process or a vector."
(let (result)
(maphash
(lambda (key value)
(when (and (vectorp key) (null (aref key 3)))
(add-to-list 'result key)))
(when (and (vectorp key) (null (aref key 3)))
(add-to-list 'result key)))
tramp-cache-data)
result))
@ -327,12 +327,12 @@ KEY identifies the connection, it is either a process or a vector."
;; Remove temporary data.
(maphash
(lambda (key value)
(if (and (vectorp key) (not (tramp-file-name-localname key)))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
(remhash "first-password-request" value))
(remhash key cache)))
(if (and (vectorp key) (not (tramp-file-name-localname key)))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
(remhash "first-password-request" value))
(remhash key cache)))
cache)
;; Dump it.
(with-temp-buffer
@ -357,8 +357,8 @@ KEY identifies the connection, it is either a process or a vector."
(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties))
(add-hook 'tramp-cache-unload-hook
(lambda ()
(remove-hook 'kill-emacs-hook
'tramp-dump-connection-properties)))
(remove-hook 'kill-emacs-hook
'tramp-dump-connection-properties)))
;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
@ -368,18 +368,22 @@ for all methods. Resulting data are derived from connection history."
(let (res)
(maphash
(lambda (key value)
(if (and (vectorp key)
(string-equal method (tramp-file-name-method key))
(not (tramp-file-name-localname key)))
(push (list (tramp-file-name-user key)
(tramp-file-name-host key))
res)))
(if (and (vectorp key)
(string-equal method (tramp-file-name-method key))
(not (tramp-file-name-localname key)))
(push (list (tramp-file-name-user key)
(tramp-file-name-host key))
res)))
tramp-cache-data)
res))
;; Read persistent connection history.
(when (and (stringp tramp-persistency-file-name)
(zerop (hash-table-count tramp-cache-data)))
(zerop (hash-table-count tramp-cache-data))
;; When "emacs -Q" has been called, both variables are nil.
;; We do not load the persistency file then, in order to
;; have a clean test environment.
(or init-file-user site-run-file))
(condition-case err
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)

97
lisp/play/5x5.el
View file

@ -144,6 +144,8 @@
(define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
(define-key map "n" #'5x5-new-game)
(define-key map "s" #'5x5-solve-suggest)
(define-key map "<" #'5x5-solve-rotate-left)
(define-key map ">" #'5x5-solve-rotate-right)
(define-key map "q" #'5x5-quit-game)
map)
"Local keymap for the 5x5 game.")
@ -174,6 +176,9 @@ GRID is the grid of positions to click.")
["Quit game" 5x5-quit-game t]
"---"
["Use Calc solver" 5x5-solve-suggest t]
["Rotate left list of Calc solutions" 5x5-solve-rotate-left t]
["Rotate right list of Calc solutions" 5x5-solve-rotate-right t]
"---"
["Crack randomly" 5x5-crack-randomly t]
["Crack mutating current" 5x5-crack-mutating-current t]
["Crack mutating best" 5x5-crack-mutating-best t]
@ -207,18 +212,21 @@ squares you must fill the grid.
5x5 keyboard bindings are:
\\<5x5-mode-map>
Flip \\[5x5-flip-current]
Move up \\[5x5-up]
Move down \\[5x5-down]
Move left \\[5x5-left]
Move right \\[5x5-right]
Start new game \\[5x5-new-game]
New game with random grid \\[5x5-randomize]
Random cracker \\[5x5-crack-randomly]
Mutate current cracker \\[5x5-crack-mutating-current]
Mutate best cracker \\[5x5-crack-mutating-best]
Mutate xor cracker \\[5x5-crack-xor-mutate]
Quit current game \\[5x5-quit-game]"
Flip \\[5x5-flip-current]
Move up \\[5x5-up]
Move down \\[5x5-down]
Move left \\[5x5-left]
Move right \\[5x5-right]
Start new game \\[5x5-new-game]
New game with random grid \\[5x5-randomize]
Random cracker \\[5x5-crack-randomly]
Mutate current cracker \\[5x5-crack-mutating-current]
Mutate best cracker \\[5x5-crack-mutating-best]
Mutate xor cracker \\[5x5-crack-xor-mutate]
Solve with Calc \\[5x5-solve-suggest]
Rotate left Calc Solutions \\[5x5-solve-rotate-left]
Rotate right Calc Solutions \\[5x5-solve-rotate-right]
Quit current game \\[5x5-quit-game]"
(interactive "P")
(setq 5x5-cracking nil)
@ -331,9 +339,14 @@ Quit current game \\[5x5-quit-game]"
(forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
(dotimes (x 5x5-grid-size)
(when (5x5-cell solution-grid y x)
(if (= 0 (mod 5x5-x-scale 2))
(progn
(insert "()")
(delete-region (point) (+ (point) 2))
(backward-char 2))
(insert-char ?O 1)
(delete-char 1)
(backward-char))
(backward-char)))
(forward-char (1+ 5x5-x-scale))))
(forward-line 5x5-y-scale))))
(setq 5x5-solver-output nil)))
@ -790,6 +803,64 @@ Argument N is ignored."
(5x5-draw-grid (list 5x5-grid))
(5x5-position-cursor))
(defun 5x5-solve-rotate-left (&optional n)
"Rotate left by N the list of solutions in 5x5-solver-output.
If N is not supplied rotate by 1, that is to say put the last
element first in the list.
The 5x5 game has in general several solutions. For grid size=5,
there are 4 possible solutions. When function
`5x5-solve-suggest' (press `\\[5x5-solve-suggest]') is called the
solution that is presented is the one that needs least number of
strokes --- other solutions can be viewed by rotating through the
list. The list of solution is ordered by number of strokes, so
rotating left just after calling `5x5-solve-suggest' will show
the the solution with second least number of strokes, while
rotating right will show the solution with greatest number of
strokes."
(interactive "P")
(let ((len (length 5x5-solver-output)))
(when (>= len 3)
(setq n (if (integerp n) n 1)
n (mod n (1- len)))
(unless (eq n 0)
(setq n (- len n 1))
(let* ((p-tail (last 5x5-solver-output (1+ n)))
(tail (cdr p-tail))
(l-tail (last tail)))
;;
;; For n = 2:
;;
;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+
;; |M | ---->|S1| ---->|S2| ---->|S3| ---->|S4| ----> nil
;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+
;; ^ ^ ^ ^
;; | | | |
;; + 5x5-solver-output | | + l-tail
;; + p-tail |
;; + tail
;;
(setcdr l-tail (cdr 5x5-solver-output))
(setcdr 5x5-solver-output tail)
(unless (eq p-tail 5x5-solver-output)
(setcdr p-tail nil)))
(5x5-draw-grid (list 5x5-grid))
(5x5-position-cursor)))))
(defun 5x5-solve-rotate-right (&optional n)
"Rotate right by N the list of solutions in 5x5-solver-output.
If N is not supplied, rotate by 1. Similar to function
`5x5-solve-rotate-left' except that rotation is right instead of
lest."
(interactive "P")
(setq n
(if (integerp n) (- n)
-1))
(5x5-solve-rotate-left n))
;; Keyboard response functions.
(defun 5x5-flip-current ()

4
lisp/progmodes/compile.el
View file

@ -155,8 +155,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
\\([a-zA-Z]?:?[^:( \t\n]+\\)\
\\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
(caml
"^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
(python-tracebacks-and-caml
"^[ \t]*File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
2 (3 . 4) (5 . 6) (7))

8
lisp/subr.el
View file

@ -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.

5
lisp/term/ns-win.el
View file

@ -916,6 +916,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
(menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
;; OS X Lion introduces PressAndHold, which is unsupported by this port.
;; See this thread for more details:
;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
(ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
(setq ns-initialized t))
(add-to-list 'handle-args-function-alist '(ns . x-handle-args))

132
lisp/window.el
View file

@ -3014,7 +3014,11 @@ new window are inherited from the window selected on WINDOW's
frame. The selected window is not changed by this function."
(interactive "i")
(setq window (normalize-any-window window))
(let* ((horizontal (not (memq side '(nil below above))))
(let* ((side (cond
((not side) 'below)
((memq side '(below above right left)) side)
(t 'right)))
(horizontal (not (memq side '(nil below above))))
(frame (window-frame window))
(parent (window-parent window))
(function (window-parameter window 'split-window))
@ -3820,8 +3824,6 @@ subwindows can get as small as `window-safe-min-height' and
(pop-up-window-min-height . 40)
(pop-up-window-min-width . 80)
(reuse-window other nil nil)
(pop-up-frame-alist
(height . 24) (width . 80) (unsplittable . t))
(reuse-window nil other visible)
(reuse-window nil nil t)
(reuse-window-even-sizes . t))
@ -3862,8 +3864,8 @@ buffer display specifiers.")
(defcustom display-buffer-alist
'((((regexp . ".*"))
;; Reuse window showing same buffer.
reuse-window (reuse-window nil same visible)
;; Reuse window showing same buffer on same frame.
reuse-window (reuse-window nil same nil)
;; Pop up window.
pop-up-window
;; Split largest or lru window.
@ -4371,9 +4373,7 @@ using the location specifiers `same-window' or `other-frame'."
(list
:tag "Pop-up frame"
:value (pop-up-frame
(pop-up-frame)
(pop-up-frame-alist
(height . 24) (width . 80) (unsplittable . t)))
(pop-up-frame))
:format "%t\n%v"
:inline t
(const :format "" pop-up-frame)
@ -4723,22 +4723,6 @@ documentation of `display-buffer-alist' for a description."
((functionp set-width)
(ignore-errors (funcall set-width window))))))
;; We have to work around the deficiency that the command loop does not
;; preserve the selected window when it is on a frame that hasn't been
;; raised or given input focus. So we have to (1) select the window
;; used for displaying a buffer and (2) raise its frame if necessary,
;; thus defeating one primary principle of `display-buffer' namely to
;; _not_ select the window chosen for displaying the buffer :-(
(defun display-buffer-select-window (window &optional norecord)
"Select WINDOW and raise its frame if necessary."
(let ((old-frame (selected-frame))
(new-frame (window-frame window)))
;; Select WINDOW _before_ raising the frame to assure that the mouse
;; cursor moves into the correct window.
(select-window window norecord)
(unless (eq old-frame new-frame)
(select-frame-set-input-focus new-frame))))
(defun display-buffer-in-window (buffer window specifiers)
"Display BUFFER in WINDOW and raise its frame if needed.
WINDOW must be a live window and defaults to the selected one.
@ -4759,8 +4743,16 @@ documentation of `display-buffer-alist' for a description."
(set-window-dedicated-p window dedicated))
(when no-other-window
(set-window-parameter window 'no-other-window t))
(unless (eq old-frame new-frame)
(display-buffer-select-window window))
(unless (or (eq old-frame new-frame)
(not (frame-visible-p new-frame))
;; Assume the selected frame is already visible enough.
(eq new-frame (selected-frame))
;; Assume the frame from which we invoked the minibuffer
;; is visible.
(and (minibuffer-window-active-p (selected-window))
(eq new-frame
(window-frame (minibuffer-selected-window)))))
(raise-frame new-frame))
;; Return window.
window))
@ -5314,7 +5306,7 @@ user preferences expressed in `display-buffer-alist'."
BUFFER-NAME is the name of the buffer that shall be displayed,
SPECIFIERS is the second argument of `display-buffer'. LABEL the
same argument of `display-buffer'. OTHER-FRAME non-nil means use
other-frame for other-windo."
other-frame for other-window."
(let (normalized entry)
(cond
((not specifiers)
@ -5329,7 +5321,7 @@ other-frame for other-windo."
;; `other-window' must be treated separately.
(let ((entry (assq (if other-frame
'other-frame
'other-window)
'same-frame-other-window)
display-buffer-macro-specifiers)))
(dolist (item (cdr entry))
(setq normalized (cons item normalized)))))
@ -5357,11 +5349,14 @@ other-frame for other-windo."
BUFFER-OR-NAME is the buffer to display. This routine provides a
compatibility layer for the now obsolete Emacs 23 buffer display
options."
(let* ((buffer (normalize-live-buffer buffer-or-name))
(buffer-name (buffer-name buffer))
specifiers)
;; Disable warnings, there are too many obsolete options here.
(with-no-warnings
(with-no-warnings
(let* ((buffer (normalize-live-buffer buffer-or-name))
(buffer-name (buffer-name buffer))
(use-pop-up-frames
(or (and (eq pop-up-frames 'graphic-only)
(display-graphic-p))
pop-up-frames))
specifiers)
;; `even-window-heights', unless nil or unset.
(unless (memq even-window-heights '(nil unset))
(setq specifiers
@ -5408,10 +5403,8 @@ options."
(cons 'largest fun) (cons 'lru fun))
specifiers))))
;; `pop-up-frame' group. Add things if `pop-up-frames' is non-nil
;; (we ignore the problem that callers usually don't care about
;; graphic-only).
(when pop-up-frames
;; `pop-up-frame' group.
(when use-pop-up-frames
;; `pop-up-frame-function'. If `pop-up-frame-function' uses the
;; now obsolete `pop-up-frame-alist' it will continue to do so.
(setq specifiers
@ -5419,7 +5412,16 @@ options."
specifiers))
;; `pop-up-frame'
(setq specifiers
(cons (list 'pop-up-frame pop-up-frames) specifiers)))
(cons (list 'pop-up-frame t) specifiers)))
;; `pop-up-windows' and `use-pop-up-frames' both nil means means
;; we are supposed to reuse any window on the same frame (unless
;; we find one showing the same buffer already).
(unless (or pop-up-windows use-pop-up-frames)
;; `reuse-window' showing any buffer on same frame.
(setq specifiers
(cons (list 'reuse-window nil nil nil)
specifiers)))
;; `special-display-p' group.
(when special-display-function
@ -5432,6 +5434,22 @@ options."
(when (listp pars) pars))
specifiers)))))
;; `pop-up-frames', `display-buffer-reuse-frames' means search for
;; a window showing the buffer on some visible or iconfied frame.
;; `last-nonminibuffer-frame' set and not the same frame means
;; search that frame.
(let ((frames (or (and (or use-pop-up-frames
display-buffer-reuse-frames
(not (last-nonminibuffer-frame)))
;; All visible or iconfied frames.
0)
;; Same frame.
(last-nonminibuffer-frame))))
(when frames
(setq specifiers
(cons (list 'reuse-window 'other 'same frames)
specifiers))))
;; `same-window-p' group.
(when (same-window-p buffer-name)
;; Try to reuse the same (selected) window.
@ -5439,25 +5457,9 @@ options."
(cons (list 'reuse-window 'same nil nil)
specifiers)))
;; `pop-up-windows' and `pop-up-frames' both nil means means we
;; are supposed to reuse any window (unless we find one showing
;; the same buffer already).
(unless (or pop-up-windows pop-up-frames)
;; `reuse-window' showing any buffer on same frame.
(setq specifiers
(cons (list 'reuse-window nil nil nil)
specifiers)))
;; `display-buffer-reuse-frames' or `pop-up-frames' non-nil means
;; we are supposed to reuse a window showing the same buffer on
;; another frame.
(when (or display-buffer-reuse-frames pop-up-frames)
;; `reuse-window' showing same buffer on visible frame.
(setq specifiers
(cons (list 'reuse-window nil 'same 0) specifiers)))
;; Prepend "reuse window on same frame if showing the buffer
;; already" specifier.
;; already" specifier. It will be overriden by the application
;; supplied 'other-window specifier.
(setq specifiers (cons (list 'reuse-window nil 'same nil)
specifiers))
@ -5761,11 +5763,21 @@ documentations of `display-buffer' and `display-buffer-alist' for
additional information."
(interactive "BPop to buffer:\nP")
(let ((buffer (normalize-buffer-to-display buffer-or-name))
window)
(old-window (selected-window))
(old-frame (selected-frame))
new-window new-frame)
(set-buffer buffer)
(when (setq window (display-buffer buffer specifiers label))
(select-window window norecord)
buffer)))
(setq new-window (display-buffer buffer specifiers label))
(unless (eq new-window old-window)
;; `display-buffer' has chosen another window, select it.
(select-window new-window norecord)
(setq new-frame (window-frame new-window))
(unless (eq new-frame old-frame)
;; `display-buffer' has chosen another frame, make sure it gets
;; input focus and is risen.
(select-frame-set-input-focus new-frame)))
buffer))
(defsubst pop-to-buffer-same-window (&optional buffer-or-name norecord label)
"Pop to buffer specified by BUFFER-OR-NAME in the selected window.

13
m4/gl-comp.m4
View file

@ -32,6 +32,8 @@ AC_DEFUN([gl_EARLY],
# Code from module careadlinkat:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module dosname:
# Code from module dtoastr:
# Code from module extensions:
@ -70,6 +72,7 @@ AC_DEFUN([gl_EARLY],
# Code from module sys_stat:
# Code from module time:
# Code from module time_r:
# Code from module u64:
# Code from module unistd:
# Code from module verify:
# Code from module warn-on-use:
@ -94,6 +97,8 @@ AC_DEFUN([gl_INIT],
AC_CHECK_FUNCS_ONCE([readlinkat])
gl_MD5
gl_SHA1
gl_SHA256
gl_SHA512
AC_REQUIRE([gl_C99_STRTOLD])
gl_FILEMODE
gl_GETLOADAVG
@ -165,6 +170,7 @@ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
gl_PREREQ_TIME_R
fi
gl_TIME_MODULE_INDICATOR([time_r])
AC_REQUIRE([AC_C_INLINE])
gl_UNISTD_H
gl_gnulib_enabled_dosname=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
@ -413,6 +419,10 @@ AC_DEFUN([gl_FILE_LIST], [
lib/readlink.c
lib/sha1.c
lib/sha1.h
lib/sha256.c
lib/sha256.h
lib/sha512.c
lib/sha512.h
lib/stat.c
lib/stdarg.in.h
lib/stdbool.in.h
@ -431,6 +441,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/sys_stat.in.h
lib/time.in.h
lib/time_r.c
lib/u64.h
lib/unistd.in.h
lib/verify.h
m4/00gnulib.m4
@ -449,6 +460,8 @@ AC_DEFUN([gl_FILE_LIST], [
m4/multiarch.m4
m4/readlink.m4
m4/sha1.m4
m4/sha256.m4
m4/sha512.m4
m4/socklen.m4
m4/ssize_t.m4
m4/st_dm_mode.m4

12
m4/sha256.m4 Normal file
View file

@ -0,0 +1,12 @@
# sha256.m4 serial 5
dnl Copyright (C) 2005, 2008-2011 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_SHA256],
[
dnl Prerequisites of lib/sha256.c.
AC_REQUIRE([gl_BIGENDIAN])
AC_REQUIRE([AC_C_INLINE])
])

12
m4/sha512.m4 Normal file
View file

@ -0,0 +1,12 @@
# sha512.m4 serial 6
dnl Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_SHA512],
[
dnl Prerequisites of lib/sha512.c.
AC_REQUIRE([gl_BIGENDIAN])
AC_REQUIRE([AC_C_INLINE])
])

27
src/ChangeLog
View file

@ -19,8 +19,6 @@
(x_allocate_bitmap_record): Check for size overflow.
* dispextern.h, lisp.h: Adjust to API changes elsewhere.
2011-06-21 Paul Eggert <eggert@cs.ucla.edu>
Use ptrdiff_t, not int, for overlay counts.
* buffer.h (overlays_at, sort_overlays, GET_OVERLAYS_AT):
* editfns.c (overlays_around, get_pos_property):
@ -199,6 +197,31 @@
(record_overlay_string): Check for size-calculation overflow.
(init_buffer_once): Check at compile-time, not run-time.
2011-06-22 Jim Meyering <meyering@redhat.com>
don't leak an XBM-image-sized buffer
* image.c (xbm_load): Free the image buffer after using it.
2011-06-21 Paul Eggert <eggert@cs.ucla.edu>
Port to Sun C.
* composite.c (find_automatic_composition): Omit needless 'return 0;'
that Sun C diagnosed.
* fns.c (secure_hash): Fix pointer signedness issue.
* intervals.c (static_offset_intervals): New function.
(offset_intervals): Use it.
2011-06-21 Leo Liu <sdl.web@gmail.com>
* 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 <deniz@dogan.se>
* process.c (Fset_process_buffer): Clarify return value in

1
src/composite.c
View file

@ -1677,7 +1677,6 @@ find_automatic_composition (EMACS_INT pos, EMACS_INT limit,
}
BACKWARD_CHAR (cur, stop);
}
return 0;
}
/* Return the adjusted point provided that point is moved from LAST_PT

4
src/deps.mk
View file

@ -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 \

141
src/fns.c
View file

@ -53,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
@ -4544,21 +4546,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;
@ -4568,7 +4567,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))
{
@ -4739,47 +4742,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);
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;
}
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;
}
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)));
return res;
/* allocate 2 x digest_size so that it can be re-used to hold the
hexified value */
digest = make_uninit_string (digest_size * 2);
hash_func (SSDATA (object) + start_byte,
SBYTES (object) - (size_byte - end_byte),
SSDATA (digest));
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,
@ -4811,25 +4828,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);
@ -4998,7 +5021,7 @@ this variable. */);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
defsubr (&Ssha1);
defsubr (&Ssecure_hash);
defsubr (&Slocale_info);
}

1
src/image.c
View file

@ -2833,6 +2833,7 @@ xbm_load (struct frame *f, struct image *img)
}
success_p = xbm_load_image (f, img, contents, contents + size);
xfree (contents);
}
else
{

17
src/intervals.c
View file

@ -1425,10 +1425,15 @@ adjust_intervals_for_deletion (struct buffer *buffer,
/* Make the adjustments necessary to the interval tree of BUFFER to
represent an addition or deletion of LENGTH characters starting
at position START. Addition or deletion is indicated by the sign
of LENGTH. */
of LENGTH.
inline void
offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
The two inline functions (one static) pacify Sun C 5.8, a pre-C99
compiler that does not allow calling a static function (here,
adjust_intervals_for_deletion) from a non-static inline function. */
static inline void
static_offset_intervals (struct buffer *buffer, EMACS_INT start,
EMACS_INT length)
{
if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
return;
@ -1441,6 +1446,12 @@ offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
adjust_intervals_for_deletion (buffer, start, -length);
}
}
inline void
offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
{
static_offset_intervals (buffer, start, length);
}
/* Merge interval I with its lexicographic successor. The resulting
interval is returned, and has the properties of the original

2
src/makefile.w32-in
View file

@ -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 \