;;;; ripemd.scm
;;;; Kon Lovett, Jan '06
;;;; Kon Lovett, Aug '10

(module ripemd

  (;export
    ripemd128-primitive
    ripemd160-primitive)

  (import scheme chicken foreign)
  (use message-digest-primitive)

#>
typedef void (*initializef)( uint32_t * );
typedef void (*compressf)( uint32_t *, uint32_t * );
typedef void (*finishf)( uint32_t *, uint8_t *, uint32_t, uint32_t );

typedef struct {
  uint8_t rembuf[16 * sizeof(uint32_t)];
  uint32_t length[2];
  uint32_t MDbuf[0];
} ripemdctx;

static void
ripemdX_init( initializef init, ripemdctx *ctx )
{
  memset( ctx->rembuf, 0, sizeof(ctx->rembuf) );
  ctx->length[0] = ctx->length[1] = 0;
  (*init)( ctx->MDbuf );
}

static void
ripemdX_update( compressf compress, ripemdctx *ctx, uint8_t *data, size_t nbytes )
{
# define BYTES_TO_DWORD( strptr ) \
    (((uint32_t) *((strptr)+3) << 24) | \
     ((uint32_t) *((strptr)+2) << 16) | \
     ((uint32_t) *((strptr)+1) <<  8) | \
     ((uint32_t) *(strptr)))

  uint32_t X[16];
  unsigned int i, j;

  /* process all complete 16-uint32_t blocks */
  for( i = nbytes; i > 63; i -= 64 ) {
     for( j = 0; j < 16; j++ ) {
        X[j] = BYTES_TO_DWORD( data );
        data += sizeof(uint32_t);
      }
     (*compress)( ctx->MDbuf, X );
  }

  /* update length[] */
  if( ctx->length[0] + nbytes < ctx->length[0] )
     ctx->length[1]++;      /* overflow to msb of length */
  ctx->length[0] += nbytes;

  /* remaining bytes? */
  /* MUST only occur on the last call to update */
  if( i ) {
    memcpy( ctx->rembuf, data, i );
  }

# undef BYTES_TO_DWORD
}

static
void ripemdX_final( finishf finish, uint8_t *str, ripemdctx *ctx, size_t mdlen )
{
  int i;

  (*finish)( ctx->MDbuf, ctx->rembuf, ctx->length[0], ctx->length[1] );

  for( i = 0; i < mdlen; i += sizeof(uint32_t) ) {
    str[i]   =  ctx->MDbuf[i>>2];
    str[i+1] = (ctx->MDbuf[i>>2] >>  8);
    str[i+2] = (ctx->MDbuf[i>>2] >> 16);
    str[i+3] = (ctx->MDbuf[i>>2] >> 24);
  }
}

#define C_VISIBILITY static

#define dword uint32_t
#define byte uint8_t

#include "rmd160.c"
#define RMD160hshsiz (160/8)
#define RMD160ctxsiz (sizeof(ripemdctx) + sizeof(uint32_t)*(160/32))
#undef BYTES_TO_DWORD
#undef ROL
#undef F
#undef G
#undef H
#undef I
#undef J
#undef FF
#undef GG
#undef HH
#undef II
#undef JJ
#undef FFF
#undef GGG
#undef HHH
#undef III
#undef JJJ

#include "rmd128.c"
#define RMD128hshsiz (128/8)
#define RMD128ctxsiz (sizeof(ripemdctx) + sizeof(uint32_t)*(128/32))
#undef BYTES_TO_DWORD
#undef ROL
#undef F
#undef G
#undef H
#undef I
#undef FF
#undef GG
#undef HH
#undef II
#undef FFF
#undef GGG
#undef HHH
#undef III

#undef dword
#undef byte

#undef C_VISIBILITY
<#

;;

(define-foreign-variable context-size128 int "RMD128ctxsiz")
(define-foreign-variable context-size160 int "RMD160ctxsiz")

(define init128
  (foreign-lambda* void ((c-pointer ctx)) "ripemdX_init( &MDinit128, ctx );"))
(define update128
  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer obj) (int len))
    "ripemdX_update( &compress128, ctx, obj, len );"))
(define final128
  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer result))
    "ripemdX_final( &MDfinish128, result, ctx, RMD128hshsiz );"))

(define init160
  (foreign-lambda* void ((c-pointer ctx))
    "ripemdX_init( &MDinit160, ctx );"))
(define update160
  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer obj) (int len))
    "ripemdX_update( &compress160, ctx, obj, len );"))
(define final160
  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer result))
    "ripemdX_final( &MDfinish160, result, ctx, RMD160hshsiz );"))

(define-foreign-variable digest-length128 int "RMD128hshsiz")
(define-foreign-variable digest-length160 int "RMD160hshsiz")

;;

(define ripemd128-primitive
  (let ((the-prim #f))
    (lambda ()
      (or the-prim
          (begin
            (set! the-prim
                  (make-message-digest-primitive
                    context-size128 digest-length128
                    init128 update128 final128
                    'ripemd128-primitive))
            the-prim ) ) ) ) )

(define ripemd160-primitive
  (let ((the-prim #f))
    (lambda ()
      (or the-prim
          (begin
            (set! the-prim
                  (make-message-digest-primitive
                    context-size160 digest-length160
                    init160 update160 final160
                    'ripemd160-primitive))
            the-prim ) ) ) ) )

) ;module ripemd