diff --git a/Makefile b/Makefile index 4aa56ad0..04d16776 100644 --- a/Makefile +++ b/Makefile @@ -23,12 +23,14 @@ CHIBI_COMPILED_LIBS = lib/chibi/filesystem$(SO) lib/chibi/process$(SO) \ lib/chibi/time$(SO) lib/chibi/system$(SO) lib/chibi/stty$(SO) \ lib/chibi/weak$(SO) lib/chibi/heap-stats$(SO) lib/chibi/disasm$(SO) \ lib/chibi/net$(SO) lib/chibi/ast$(SO) lib/chibi/emscripten$(SO) +CHIBI_CRYPTO_COMPILED_LIBS = lib/chibi/crypto/crypto$(SO) CHIBI_IO_COMPILED_LIBS = lib/chibi/io/io$(SO) CHIBI_OPT_COMPILED_LIBS = lib/chibi/optimize/rest$(SO) \ lib/chibi/optimize/profile$(SO) EXTRA_COMPILED_LIBS ?= COMPILED_LIBS = $(CHIBI_COMPILED_LIBS) $(CHIBI_IO_COMPILED_LIBS) \ - $(CHIBI_OPT_COMPILED_LIBS) $(EXTRA_COMPILED_LIBS) \ + $(CHIBI_OPT_COMPILED_LIBS) $(CHIBI_CRYPTO_COMPILED_LIBS) \ + $(EXTRA_COMPILED_LIBS) \ lib/srfi/18/threads$(SO) lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \ lib/srfi/39/param$(SO) lib/srfi/69/hash$(SO) lib/srfi/95/qsort$(SO) \ lib/srfi/98/env$(SO) lib/scheme/time$(SO) @@ -284,11 +286,13 @@ install: all $(INSTALL) -m0644 lib/srfi/95/*.scm $(DESTDIR)$(MODDIR)/srfi/95/ $(INSTALL) -m0644 lib/srfi/99/*.sld $(DESTDIR)$(MODDIR)/srfi/99/ $(INSTALL) -m0644 lib/srfi/99/records/*.sld lib/srfi/99/records/*.scm $(DESTDIR)$(MODDIR)/srfi/99/records/ + $(MKDIR) $(DESTDIR)$(BINMODDIR)/chibi/crypto/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/chibi/io/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/chibi/optimize/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/scheme/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/srfi/18 $(DESTDIR)$(BINMODDIR)/srfi/27 $(DESTDIR)$(BINMODDIR)/srfi/33 $(DESTDIR)$(BINMODDIR)/srfi/39 $(DESTDIR)$(BINMODDIR)/srfi/69 $(DESTDIR)$(BINMODDIR)/srfi/95 $(DESTDIR)$(BINMODDIR)/srfi/98 $(INSTALL) -m0755 $(CHIBI_COMPILED_LIBS) $(DESTDIR)$(BINMODDIR)/chibi/ + $(INSTALL) -m0755 $(CHIBI_CRYPTO_COMPILED_LIBS) $(DESTDIR)$(BINMODDIR)/chibi/crypto/ $(INSTALL) -m0755 $(CHIBI_IO_COMPILED_LIBS) $(DESTDIR)$(BINMODDIR)/chibi/io/ $(INSTALL) -m0755 $(CHIBI_OPT_COMPILED_LIBS) $(DESTDIR)$(BINMODDIR)/chibi/optimize/ $(INSTALL) -m0755 lib/scheme/time$(SO) $(DESTDIR)$(BINMODDIR)/scheme/ diff --git a/lib/chibi/crypto/crypto.stub b/lib/chibi/crypto/crypto.stub new file mode 100644 index 00000000..6bb9f3bf --- /dev/null +++ b/lib/chibi/crypto/crypto.stub @@ -0,0 +1,39 @@ +(c-include-verbatim "sha2.c") + +;; \procedure{(start-sha type)} +;; +;; Allocates a new opaque computation context for a SHA-\var{type} +;; digest, where \var{type} can be one of the following constants: +;; \scheme{type-sha-224}, \scheme{type-sha-256}. + +(define-c-struct sha_context) + +(define-c sexp (start-sha "sexp_start_sha") + ((value ctx sexp) (value self sexp) unsigned-int (value NULL sha_context))) + +(define-c-const unsigned-int (type-sha-224 "SHA_TYPE_224")) +(define-c-const unsigned-int (type-sha-256 "SHA_TYPE_256")) + +;; \procedure{(add-sha-data! sha-context data)} +;; +;; Adds a new piece of data into the given context. \var{data} can be +;; a bytevector or a string. Bytevectors are added as sequences bytes. +;; Strings are added as sequences of byte representations of their +;; chars (which is either UTF-8 or ASCII code point sequence, depending +;; on whether Chibi was compiled with Unicode support). +;; +;; It is an error to add more data into a context that was finalized +;; by \scheme{get-sha}. This procedure returns an unspecified value. + +(define-c sexp (add-sha-data! "sexp_add_sha_data") + ((value ctx sexp) (value self sexp) sha_context sexp)) + +;; \procedure{(get-sha sha-context)} +;; +;; Finalizes computation and returns resulting SHA-2 digest as a hex +;; string (in lowercase). It is not possible to add more data with +;; \scheme{add-sha-data!} after this call. Though, digest string can +;; be retrieved multiple times from the same computation context. + +(define-c sexp (get-sha "sexp_get_sha") + ((value ctx sexp) (value self sexp) sha_context)) diff --git a/lib/chibi/crypto/integers.h b/lib/chibi/crypto/integers.h new file mode 100644 index 00000000..191bd0f4 --- /dev/null +++ b/lib/chibi/crypto/integers.h @@ -0,0 +1,28 @@ +#ifndef CHIBI_CRYPTO_INTEGERS_H +#define CHIBI_CRYPTO_INTEGERS_H + +#if __STDC_VERSION__ >= 199901L /* C99 */ +# include + typedef uint32_t sexp_uint32_t; + typedef uint8_t sexp_uint8_t; +#else +# include +# +# if UCHAR_MAX == 255 + typedef unsigned char sexp_uint8_t; +# else +# error Could not find 8-bit type +# endif +# +# if UINT_MAX == 4294967295U + typedef unsigned int sexp_uint32_t; +# elif ULONG_MAX == 4294967295UL + typedef unsigned long sexp_uint32_t; +# elif USHRT_MAX == 4294967295U + typedef unsigned short sexp_uint32_t; +# else +# error Could not find 32-bit type +# endif +#endif + +#endif /* CHIBI_CRYPTO_INTEGERS_H */ diff --git a/lib/chibi/crypto/sha2-native.scm b/lib/chibi/crypto/sha2-native.scm new file mode 100644 index 00000000..b3e94032 --- /dev/null +++ b/lib/chibi/crypto/sha2-native.scm @@ -0,0 +1,24 @@ +;; sha2-native.scm -- SHA-2 digest algorithms native interface +;; Copyright (c) 2015 Alexei Lozovsky. All rights reserved. +;; BSD-style license: http://synthcode.com/license.txt + +(define (procees-sha-data! context src) + (cond ((or (bytevector? src) (string? src)) + (add-sha-data! context src)) + ((input-port? src) + (let lp ((chunk (read-bytevector 1024 src))) + (unless (eof-object? chunk) + (add-sha-data! context chunk) + (lp (read-bytevector 1024 src))))) + (else + (error "unknown digest source: " src)))) + +(define (sha-224 src) + (let ((context (start-sha type-sha-224))) + (procees-sha-data! context src) + (get-sha context))) + +(define (sha-256 src) + (let ((context (start-sha type-sha-256))) + (procees-sha-data! context src) + (get-sha context))) diff --git a/lib/chibi/crypto/sha2.c b/lib/chibi/crypto/sha2.c new file mode 100644 index 00000000..f29c7047 --- /dev/null +++ b/lib/chibi/crypto/sha2.c @@ -0,0 +1,258 @@ +/* sha2.c -- SHA-2 digest algorithms native implementations */ +/* Copyright (c) 2015 Alexei Lozovsky. All rights reserved. */ +/* BSD-style license: http://synthcode.com/license.txt */ + +#include "integers.h" + +/* + * SHA-2 algorithms are described in RFC 6234: + * + * http://tools.ietf.org/html/rfc6234 + */ + +/* Initial hash vector for SHA-224 */ +static const sexp_uint32_t h224[8] = { + 0xC1059ED8UL, 0x367CD507UL, 0x3070DD17UL, 0xF70E5939UL, + 0xFFC00B31UL, 0x68581511UL, 0x64F98FA7UL, 0xBEFA4FA4UL, +}; + +/* Initial hash vector for SHA-256 */ +static const sexp_uint32_t h256[8] = { + 0x6A09E667UL, 0xBB67AE85UL, 0x3C6EF372UL, 0xA54FF53AUL, + 0x510E527FUL, 0x9B05688CUL, 0x1F83D9ABUL, 0x5BE0CD19UL, +}; + +/* Round constants for SHA-224/256 */ +static const sexp_uint32_t k256[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, +}; + +/* Supported digest types */ +enum sha_type { + SHA_TYPE_224, + SHA_TYPE_256, + SHA_TYPE_MAX +}; + +/* Intermediate digest computation state */ +struct sha_context { + enum sha_type type; + char sealed; + sexp_uint_t len; + union _sha_data { + struct _sha_256 { + sexp_uint8_t buffer[64]; + sexp_uint32_t hash[8]; + } sha_256; + } data; +}; + +#define sha_256_buffer(c) ((c)->data.sha_256.buffer) +#define sha_256_hash(c) ((c)->data.sha_256.hash) + +/* = SHA-224/256 implementation ===================================== */ + +#define ror32(v, a) (((v) >> (a)) | ((v) << (32 - (a)))) + +static void sha_224_256_round (const sexp_uint8_t chunk[64], + sexp_uint32_t hash[8]) { + int i; + sexp_uint32_t w[64]; + sexp_uint32_t tmp1, tmp2; + sexp_uint32_t a, b, c, d, e, f, g, h; + /* Initialize schedule array */ + for (i = 0; i < 16; i++) { + w[i] = (chunk[4*i + 0] << 24) + | (chunk[4*i + 1] << 16) + | (chunk[4*i + 2] << 8) + | (chunk[4*i + 3] << 0); + } + for (i = 16; i < 64; i++) { + w[i] = w[i - 16] + + (ror32(w[i-15], 7) ^ ror32(w[i-15], 18) ^ (w[i-15] >> 3)) + + w[i - 7] + + (ror32(w[i-2], 17) ^ ror32(w[i-2], 19) ^ (w[i-2] >> 10)); + } + /* Initialize working variables */ + a = hash[0]; b = hash[1]; c = hash[2]; d = hash[3]; + e = hash[4]; f = hash[5]; g = hash[6]; h = hash[7]; + /* Main loop */ + for (i = 0; i < 64; i++) { + tmp1 = h + + (ror32(e, 6) ^ ror32(e, 11) ^ ror32(e, 25)) + + ((e & f) ^ ((~e) & g)) + + k256[i] + + w[i]; + tmp2 = (ror32(a, 2) ^ ror32(a, 13) ^ ror32(a, 22)) + + ((a & b) ^ (a & c) ^ (b & c)); + h = g; g = f; f = e; e = d + tmp1; + d = c; c = b; b = a; a = tmp1 + tmp2; + } + /* Update hash values */ + hash[0] += a; hash[1] += b; hash[2] += c; hash[3] += d; + hash[4] += e; hash[5] += f; hash[6] += g; hash[7] += h; +} + +static void sha_224_256_remainder (sexp_uint8_t chunk[64], sexp_uint_t offset, + sexp_uint_t len_bits, sexp_uint32_t hash[8]) { + int i; + /* Pad with '1' bit and zeros */ + chunk[offset] = 0x80; + memset(chunk + offset + 1, 0, 64 - offset - 1); + /* If we can't fit the length, use an additional chunk */ + if (offset >= 56) { + sha_224_256_round(chunk, hash); + memset(chunk, 0, 64); + } + /* Append the message length in bits as big-endian 64-bit integer */ + for (i = 63; i >= 56; i--) { + chunk[i] = len_bits & 0xFF; + len_bits >>= 8; + } + sha_224_256_round(chunk, hash); +} + +/* = Allocating computation context ================================= */ + +sexp sexp_start_sha (sexp ctx, sexp self, unsigned type, struct sha_context* v) { + sexp res; + struct sha_context *sha; + sexp_uint_t sha_context_tag; + if (type >= SHA_TYPE_MAX) + return sexp_xtype_exception(ctx, self, "SHA-2 digest type not supported", + sexp_make_fixnum(type)); + (void)v; /* We receive this phony argument to access the type tag of + sha_context and still be able to return an error with Chibi FFI */ + sha_context_tag = sexp_unbox_fixnum(sexp_vector_ref(sexp_opcode_argn_type(self), SEXP_ZERO)); + res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), sha_context_tag); + if (sexp_exceptionp(res)) + return res; + sha = calloc(1, sizeof(*sha)); + sha->type = type; + switch (type) { + case SHA_TYPE_224: + memcpy(sha_256_hash(sha), h224, sizeof(h224)); + break; + case SHA_TYPE_256: + memcpy(sha_256_hash(sha), h256, sizeof(h256)); + break; + default: + break; + } + sexp_cpointer_value(res) = sha; + sexp_freep(res) = 1; + return res; +} + +/* = Processing incoming data ======================================= */ + +static sexp sha_224_256_add_bytes (struct sha_context *sha, + const sexp_uint8_t *src, sexp_uint_t len) { + sexp_uint_t src_offset, buf_offset; + /* Realign (src + src_offset) to 64 bytes */ + src_offset = 0; + buf_offset = sha->len % 64; + sha->len += len; + if (buf_offset) { + while ((buf_offset < 64) && (src_offset < len)) + sha_256_buffer(sha)[buf_offset++] = src[src_offset++]; + if (buf_offset == 64) + sha_224_256_round(sha_256_buffer(sha), sha_256_hash(sha)); + else + return SEXP_VOID; + } + /* Process whole chunks without copying them */ + if (len >= 64) { + for ( ; src_offset <= (len - 64); src_offset += 64) + sha_224_256_round(src + src_offset, sha_256_hash(sha)); + } + /* Copy the remainder into the buffer */ + if (src_offset < len) + memcpy(sha_256_buffer(sha) + buf_offset, src + src_offset, len - src_offset); + return SEXP_VOID; +} + +static sexp sha_add_bytes (sexp ctx, sexp self, struct sha_context *sha, + const char* data, sexp_uint_t len) { + switch (sha->type) { + case SHA_TYPE_224: + case SHA_TYPE_256: + return sha_224_256_add_bytes(sha, (const sexp_uint8_t*) data, len); + default: + return sexp_xtype_exception(ctx, self, "unexpected context type", + sexp_make_fixnum(sha->type)); + } +} + +sexp sexp_add_sha_data (sexp ctx, sexp self, struct sha_context *sha, sexp data) { + if (sha->sealed) + return sexp_xtype_exception(ctx, self, "cannot add to sealed context", data); + if (sexp_bytesp(data)) + return sha_add_bytes(ctx, self, sha, sexp_bytes_data(data), sexp_bytes_length(data)); + if (sexp_stringp(data)) + return sha_add_bytes(ctx, self, sha, sexp_string_data(data), sexp_string_size(data)); + return sexp_xtype_exception(ctx, self, "data type not supported", data); +} + +/* = Extracting computed digest ===================================== */ + +static const char *hex = "0123456789abcdef"; + +static sexp sha_224_256_hash_string (sexp ctx, sexp self, + const sexp_uint32_t hash[8], int count) { + sexp res; + int i, j; + sexp_uint32_t next_word; + /* Allocate a string of target length */ + res = sexp_make_string(ctx, sexp_make_fixnum(count * 8), SEXP_VOID); + if (sexp_exceptionp(res)) + return res; + /* Write 32-bit words as nibbles in big-endian order */ + for (i = 0; i < count; i++) { + next_word = hash[i]; + for (j = 7; j >= 0; j--) { + sexp_string_data(res)[8*i + j] = hex[next_word & 0xF]; + next_word >>= 4; + } + } + return res; +} + +sexp sexp_get_sha (sexp ctx, sexp self, struct sha_context *sha) { + if (!sha->sealed) { + sha->sealed = 1; + switch (sha->type) { + case SHA_TYPE_224: + case SHA_TYPE_256: + sha_224_256_remainder(sha_256_buffer(sha), sha->len % 64, + sha->len * 8, sha_256_hash(sha)); + break; + default: + break; + } + } + switch (sha->type) { + case SHA_TYPE_224: + return sha_224_256_hash_string(ctx, self, sha_256_hash(sha), 7); + case SHA_TYPE_256: + return sha_224_256_hash_string(ctx, self, sha_256_hash(sha), 8); + default: + return sexp_xtype_exception(ctx, self, "unexpected context type", + sexp_make_fixnum(sha->type)); + } +}