/* SSLeay IDEA crypt-port. Thanks to Daniel Barkalow for guidelines. */
/* Copyright 1998, some rights reserved as per GNU Public License */

/*todo: fix: crypt_getc */

#include "scm.h"
#include <stdlib.h>
#include <strings.h>
#include <sys/ioctl.h>
#include <sys/time.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include "evp.h"

#define MOD "crypt:"
#define KEY_SIZE 16
#define IV_SIZE 8

#define MAX_PAD 8

/* in mak0strfrom.c */
char *mak0strfrom(SCM);

long tc16_crypt_object, tc16_in_cryptfile, tc16_out_cryptfile;

struct cf {
  SCM port;
  int we_opened;
  SCM ctx;
  unsigned char buf[MAX_PAD+1];
  int bufdex;
  int at_eof;
};

struct key {
  char iv[IV_SIZE];
  char key[KEY_SIZE];
};

#define ST_CRYPT_CTX     	1<<16
#define ST_CRYPT_KEY      	2<<16
#define ST_CRYPT_EVP	        3<<16

#define MAKE_CRYPT_OBJECT(subtype,x) (cons(tc16_crypt_object|subtype, x))
#define MAKE_CRYPT_CTX(x) MAKE_CRYPT_OBJECT(ST_CRYPT_CTX, x)
#define MAKE_CRYPT_KEY(x) MAKE_CRYPT_OBJECT(ST_CRYPT_KEY, x)
#define MAKE_CRYPT_EVP(x) MAKE_CRYPT_OBJECT(ST_CRYPT_EVP, x)

#define CRYPT_OBJECT_P(x) (NIMP(x) && (TYP16(x) == tc16_crypt_object))
#define CRYPT_CTX_P(x) (NIMP(x) \
			 && (CAR(x) == (tc16_crypt_object|ST_CRYPT_CTX)))
#define CRYPT_KEY_P(x) (NIMP(x) \
			 && (CAR(x) == (tc16_crypt_object|ST_CRYPT_KEY)))
#define CRYPT_EVP_P(x) (NIMP(x) \
			 && (CAR(x) == (tc16_crypt_object|ST_CRYPT_EVP)))

#define GET_CRYPT_OBJECT(x) CDR(x)
#define GET_CRYPT_CTX(x) ((EVP_CIPHER_CTX *)CDR(x))
#define GET_CRYPT_KEY(x) ((struct key *)CDR(x))
#define GET_CRYPT_EVP(x) (CDR(x))

#define VALID_CRYPT_OBJECT_P(x) (CRYPT_OBJECT_P(x) && CDR(x))
#define VALID_CRYPT_CTX_P(x) (CRYPT_CTX_P(x) && GET_CRYPT_CTX(x))
#define VALID_CRYPT_KEY_P(x) (CRYPT_KEY_P(x) && GET_CRYPT_KEY(x))
#define VALID_CRYPT_EVP_P(x) (CRYPT_EVP_P(x) && GET_CRYPT_EVP(x))

#define MAKE_READ_CRYPTFILE(x) cons(tc16_in_cryptfile | OPN | RDNG, x)
#define MAKE_WRITE_CRYPTFILE(x) cons(tc16_out_cryptfile | OPN | WRTNG, x)

#define IN_CRYPTFILE_P(x) (NIMP(x) && (TYP16(x) == tc16_in_cryptfile))
#define OUT_CRYPTFILE_P(x) (NIMP(x) && (TYP16(x) == tc16_out_cryptfile))
#define CRYPTFILE_P(x) (IN_CRYPTFILE_P(x) || OUT_CRYPTFILE_P(x))
#define VALID_IN_CRYPTFILE_P(x) (IN_CRYPTFILE_P(x) && (struct cf *)CDR(x))
#define VALID_OUT_CRYPTFILE_P(x) (IN_CRYPTFILE_P(x) && (struct cf *)CDR(x))
#define VALID_CRYPTFILE_P(x) (VALID_IN_CRYPTFILE_P(x) || VALID_OUT_CRYPTFILE_P(x))

#define GET_PORT(x) (((struct cf *)x)->port)
#define GET_WE_OPENED(x) (((struct cf *)x)->we_opened)
#define GET_CTX(x) (((struct cf *)x)->ctx)
#define GET_BUF(x) (((struct cf *)x)->buf)
#define GET_BUFDEX(x) (((struct cf *)x)->bufdex)
#define GET_AT_EOF(x) (((struct cf *)x)->at_eof)

static char s_crypt_object_p[] = "crypt-object?";
static SCM p_crypt_object_p(SCM x)
{
  return (CRYPT_OBJECT_P(x) ? BOOL_T : BOOL_F);
}

static char s_crypt_ctx_p[] = "crypt-ctx?";
static SCM p_crypt_ctx_p(SCM x)
{
  return (CRYPT_CTX_P(x) ? BOOL_T : BOOL_F);
}
static char s_crypt_key_p[] = "crypt-key?";
static SCM p_crypt_key_p(SCM x)
{
  return (CRYPT_KEY_P(x) ? BOOL_T : BOOL_F);
}
static char s_crypt_evp_p[] = "crypt-evp?";
static SCM p_crypt_evp_p(SCM x)
{
  return (CRYPT_EVP_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_crypt_object_p[] = "valid-crypt-object?";
static SCM p_valid_crypt_object_p(SCM x)
{
  return (VALID_CRYPT_OBJECT_P(x) ? BOOL_T : BOOL_F);
}
static char s_valid_crypt_ctx_p[] = "valid-crypt-ctx?";
static SCM p_valid_crypt_ctx_p(SCM x)
{
  return (VALID_CRYPT_CTX_P(x) ? BOOL_T : BOOL_F);
}
static char s_valid_crypt_key_p[] = "valid-crypt-key?";
static SCM p_valid_crypt_key_p(SCM x)
{
  return (VALID_CRYPT_KEY_P(x) ? BOOL_T : BOOL_F);
}
static char s_valid_crypt_evp_p[] = "valid-crypt-evp?";
static SCM p_valid_crypt_evp_p(SCM x)
{
  return (VALID_CRYPT_EVP_P(x) ? BOOL_T : BOOL_F);
}

static int print_crypt_object(SCM exp, SCM port, int writing)
{
  if (VALID_CRYPT_OBJECT_P(exp)) {
    switch(CAR(exp) & ~tc16_crypt_object) {
    case ST_CRYPT_CTX: lputs("#<SSL:Crypt context ", port); break;
    case ST_CRYPT_KEY: lputs("#<SSL:Crypt key ", port); break;
    case ST_CRYPT_EVP: lputs("#<SSL:Crypt envelope ", port); break;
    default: lputs("#<unknown SSL:Crypt object ", port); break;
    }
    intprint(CDR(exp), 16, port);
    lputs(">", port);
  } else {
    lputs("#<invalid SSL:Crypt object>", port);
  }
  return 1;
}

static sizet freecrypt(CELLPTR c)
{
  int s = 0;
  void *p = (void *)c->cdr;
  switch (c->car & ~tc16_crypt_object) {
  case ST_CRYPT_CTX:
    s = sizeof(EVP_CIPHER_CTX);
    break;
  case ST_CRYPT_KEY:
    s = sizeof(struct key);
    break;
  }
  if (s) {
    memset(p, 0, s);
    free (p);
  }
  return s;
}

static smobfuns cryptsmob = {
  mark0,
  freecrypt,
  print_crypt_object,
  0
};


static int crypt_print(SCM exp, SCM port, int writing)
{
  prinport(exp, port, "SSL:Cryptfile");
  return 1;
}

static sizet crypt_write(char *s, sizet siz, sizet num, FILE *p)
{
  int i;
  SCM port;
  EVP_CIPHER_CTX *ctx;
  int outl;
  char *out;

  ctx = GET_CRYPT_CTX(GET_CTX(p));
  port = GET_PORT(p);
  out = (char*) malloc(siz*num + MAX_PAD);
  if (out==0) return -1;
  EVP_EncryptUpdate(ctx, out, &outl, s, siz*num);
  i=lfwrite(out, 1, outl, port);
  free(out);
  if (i == outl) {
    return num;
  } else if (i <= 0) {
    return i;
  } else { /* partial success; fake it. */
    i += siz*num - outl;
    if (i <= 0) i = 1;
    return i/siz;
  }
}

static int crypt_putc(int c0, FILE *p)
{
  char c = c0;
  return crypt_write(&c, 1, 1, p);
}

static int crypt_puts(char *s, FILE *p)
{
  return crypt_write(s, 1, strlen(s), p);
}

static int crypt_flush(FILE *p)
{
  SCM port;
  port = GET_PORT(p);
  return lflush(port);
}

static int crypt_getc(FILE *p)
{
  SCM port;
  int bufdex;
  unsigned char *buf;
  int i;
  char in;
  int toret; /*to return*/
  EVP_CIPHER_CTX *ctx;

  port = GET_PORT(p);
  buf = GET_BUF(p);
  ctx = GET_CRYPT_CTX(GET_CTX(p));
  bufdex = GET_BUFDEX(p);

  while (bufdex == 0) { /* decrypt something */
    if (GET_AT_EOF(p))
      return EOF;
    i = lgetc(port);
    if (i != EOF) {
      in = i;
      EVP_DecryptUpdate(ctx, buf, &bufdex, &in, 1);
    } else {
      GET_AT_EOF(p) = 1;
      EVP_DecryptFinal(ctx, buf, &bufdex);
    }
  }
  /* return one char and advance the buffer.*/
  toret = buf[0];
  GET_BUFDEX(p) = --bufdex;
  for (i=0; i<MAX_PAD; i++)
    buf[i]=buf[i+1];
  return toret;
}

static int in_crypt_close(FILE *p)
{
  int i;
  int retcode = 0;
  SCM port;
  EVP_CIPHER_CTX *ctx;

  ctx = GET_CRYPT_CTX(GET_CTX(p));
  port = GET_PORT(p);
  if (GET_WE_OPENED(p))
    close_port(port);
  if (i<0) retcode = -1;
  return 0;
}

static int out_crypt_close(FILE *p)
{
  int i;
  int retcode = 0;
  SCM port;
  EVP_CIPHER_CTX *ctx;
  int outl;
  char out[MAX_PAD + 1];

  ctx = GET_CRYPT_CTX(GET_CTX(p));
  port = GET_PORT(p);
  EVP_EncryptFinal(ctx, out, &outl);
  i = lfwrite(out, 1, outl, port);
  if (i<0) retcode = -1;
  if (GET_WE_OPENED(p))
    close_port(port);
  return retcode;
}

static SCM mark_cf(SCM s)
{
  mark0(s);
  gc_mark(GET_CTX(CDR(s)));
  return GET_PORT(CDR(s));
}

static int free_cf(FILE *p)
{
  memset(p, 0, sizeof(struct cf)); /* paranoia */
  free(p);
  return sizeof(struct cf);
}

static ptobfuns in_cryptptob = {
  mark_cf,
  free_cf,
  crypt_print,
  0,
  0,
  0,
  0,
  0,
  crypt_getc,
  in_crypt_close,
};

static ptobfuns out_cryptptob = {
  mark_cf,
  free_cf,
  crypt_print,
  0,
  crypt_putc,
  crypt_puts,
  crypt_write,
  crypt_flush,
  0,
  out_crypt_close,
};

static char s_in_cryptfile_p[] = "in-cryptfile?";
static SCM p_in_cryptfile_p(SCM x)
{
  return (IN_CRYPTFILE_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_in_cryptfile_p[] = "valid-in-cryptfile?";
static SCM p_valid_in_cryptfile_p(SCM x)
{
  return (VALID_IN_CRYPTFILE_P(x) ? BOOL_T : BOOL_F);
}

static char s_out_cryptfile_p[] = "out-cryptfile?";
static SCM p_out_cryptfile_p(SCM x)
{
  return (OUT_CRYPTFILE_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_out_cryptfile_p[] = "valid-out-cryptfile?";
static SCM p_valid_out_cryptfile_p(SCM x)
{
  return (VALID_OUT_CRYPTFILE_P(x) ? BOOL_T : BOOL_F);
}

static char s_cryptfile_p[] = "cryptfile?";
static SCM p_cryptfile_p(SCM x)
{
  return (CRYPTFILE_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_cryptfile_p[] = "valid-cryptfile?";
static SCM p_valid_cryptfile_p(SCM x)
{
  return (VALID_CRYPTFILE_P(x) ? BOOL_T : BOOL_F);
}

static char s_make_key[] = MOD "make-key";
static SCM p_make_key(SCM data) /*data is KEY_SIZE byte string*/
{
  int keysize;
  struct key *k;
  char *init;

  ASSERT(STRINGP(data), data, ARG1, s_make_key);

  init = CHARS(data);
  k = (struct key *)malloc(sizeof(struct key));
  keysize = EVP_BytesToKey(EVP_idea_cbc(), EVP_md5(), NULL, CHARS(data),
			   LENGTH(data), 1, k->key, k->iv);
  return MAKE_CRYPT_KEY(k);  
}

static char s_make_encrypt_context[] = MOD "make-encrypt-context";
static SCM p_make_encrypt_context(SCM data)
{
  char *key;
  char *iv;
  EVP_CIPHER_CTX *ctx;

  ASSERT(VALID_CRYPT_KEY_P(data), data, ARG1, s_make_encrypt_context);

  ctx = (EVP_CIPHER_CTX*) malloc(sizeof(EVP_CIPHER_CTX));
  if (ctx==0) return NULL;
  key = GET_CRYPT_KEY(data)->key;
  iv = GET_CRYPT_KEY(data)->iv;
  EVP_EncryptInit(ctx, EVP_idea_cbc(), key, iv);
  return MAKE_CRYPT_CTX(ctx);
}

static char s_make_decrypt_context[] = MOD "make-decrypt-context";
static SCM p_make_decrypt_context(SCM data)
{
  char *key;
  char *iv;
  EVP_CIPHER_CTX *ctx;

  ASSERT(VALID_CRYPT_KEY_P(data), data, ARG1, s_make_decrypt_context);

  ctx = (EVP_CIPHER_CTX*) malloc(sizeof(EVP_CIPHER_CTX));
  if (ctx==0) return NULL;
  key = GET_CRYPT_KEY(data)->key;
  iv = GET_CRYPT_KEY(data)->iv;
  EVP_DecryptInit(ctx, EVP_idea_cbc(), key, iv);
  return MAKE_CRYPT_CTX(ctx);
}

static char s_open_read[] = MOD "open-read";
static SCM p_open_read(SCM ctx, SCM x)
{
  struct cf *p;

  ASSERT(VALID_CRYPT_CTX_P(ctx), ctx, ARG1, s_open_read);
  ASSERT(STRINGP(x) || OPINPORTP(x), x, ARG2, s_open_read);

  p = (struct cf *)malloc(sizeof(struct cf));
  if (PORTP(x)) {
    p->we_opened = 0;
    p->port = x;
  } else {
    p->we_opened = 1;
    p->port = open_file(x, makfrom0str("r"));
  }
  p->ctx = ctx;
  p->bufdex = 0;
  p->at_eof = 0;
  return MAKE_READ_CRYPTFILE(p);
}

static char s_open_write[] = MOD "open-write";
static SCM p_open_write(SCM ctx, SCM x)
{
  struct cf *p;

  ASSERT(VALID_CRYPT_CTX_P(ctx), ctx, ARG1, s_open_write);
  ASSERT(STRINGP(x) || OPOUTPORTP(x), x, ARG2, s_open_write);

  p = (struct cf *)malloc(sizeof(struct cf));
  if (PORTP(x)) {
    p->we_opened = 0;
    p->port = x;
  } else {
    int old_umask;
    p->we_opened = 1;
    old_umask = umask(077); /* be fascist */
    p->port = open_file(x, makfrom0str("w"));
    umask(old_umask);
  }
  p->ctx = ctx;
  return MAKE_WRITE_CRYPTFILE(p);
}

#define PROCIFY(pname) {s_ ## pname, p_ ## pname},
#define DONE {0, 0} 

static iproc procs1[] = {
     PROCIFY(crypt_object_p)
     PROCIFY(crypt_key_p)
     PROCIFY(crypt_ctx_p)
     PROCIFY(crypt_evp_p)
     PROCIFY(valid_crypt_object_p)
     PROCIFY(valid_crypt_ctx_p)
     PROCIFY(valid_crypt_key_p)
     PROCIFY(valid_crypt_evp_p)
     PROCIFY(in_cryptfile_p)
     PROCIFY(valid_in_cryptfile_p)
     PROCIFY(out_cryptfile_p)
     PROCIFY(valid_out_cryptfile_p)
     PROCIFY(cryptfile_p)
     PROCIFY(valid_cryptfile_p)
     PROCIFY(make_key)
     PROCIFY(make_encrypt_context)
     PROCIFY(make_decrypt_context)
     DONE
};

static iproc procs2[] = {
     PROCIFY(open_read)
     PROCIFY(open_write)
     DONE
};

void init_cryptfile()
{
  tc16_crypt_object = newsmob(&cryptsmob);
  tc16_in_cryptfile = newptob(&in_cryptptob);
  tc16_out_cryptfile = newptob(&out_cryptptob);

  init_iprocs(procs1, tc7_subr_1);
  init_iprocs(procs2, tc7_subr_2);

  add_feature("cryptptob");
}
