#ifdef HAVE_CONFIG_H
#include "scmconfig.h"
#endif

#include "scm.h"

#include <fcntl.h>
#include <signal.h>
#include <sys/time.h>

#include <bio.h>
#include <err.h>
#include <asn1.h>
#include <evp.h>
#include <x509.h>
#include <ssl.h>
#include <rand.h>

#include "tcp.h"

/* in repl.c */
SCM cur_error_port(void);

/* in sys.c */
int noop0(FILE *);

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

/* in gsubr.c */
SCM make_gsubr(char *, int, int, int, SCM (*)());

/* in repl.c */
void lfflush(SCM);

#define MOD "ssl:"
#define BIO_TYPE_PTOB 34

/* New types. */
long tc16_ssl_object, tc16_ssl;
/* These should all be multiples of 1<<16. ST = subtype. */
#define ST_SSL_CIPHER		1<<16
#define ST_SSL_METHOD      	2<<16
#define ST_SSL_COMPRESSION	3<<16
#define ST_SSL_SESSION		4<<16
#define ST_SSL_CTX		5<<16
#define ST_X509			6<<16
#define ST_SSL_CA_STACK		7<<16
#define ST_RSA			8<<16

#define MAKE_SSL_OBJECT(subtype,x) (cons(tc16_ssl_object|subtype, x))
#ifndef EXTRA_DEBUG
#define MAKE_SSL_CIPHER(x) MAKE_SSL_OBJECT(ST_SSL_CIPHER, x)
#define MAKE_SSL_METHOD(x) MAKE_SSL_OBJECT(ST_SSL_METHOD, x)
#define MAKE_SSL_COMPRESSION(x) MAKE_SSL_OBJECT(ST_SSL_COMPRESSION, x)
#define MAKE_SSL_SESSION(x) MAKE_SSL_OBJECT(ST_SSL_SESSION, x)
#define MAKE_SSL_CTX(x) MAKE_SSL_OBJECT(ST_SSL_CTX, x)
#define MAKE_X509(x) MAKE_SSL_OBJECT(ST_X509, x)
#define MAKE_SSL_CA_STACK(x) MAKE_SSL_OBJECT(ST_SSL_CA_STACK, x)
#define MAKE_RSA(x) MAKE_SSL_OBJECT(ST_RSA, x)
#else
static SCM MAKE_SSL_CIPHER(SSL_CIPHER *x) {
  return MAKE_SSL_OBJECT(ST_SSL_CIPHER, x);
}

static SCM MAKE_SSL_METHOD(SSL_METHOD *x) {
  return MAKE_SSL_OBJECT(ST_SSL_METHOD, x);
}

static SCM MAKE_SSL_COMPRESSION(SSL_COMPRESSION *x) {
  return MAKE_SSL_OBJECT(ST_SSL_COMPRESSION, x);
}

static SCM MAKE_SSL_SESSION(SSL_SESSION *x) {
  return MAKE_SSL_OBJECT(ST_SSL_SESSION, x);
}

static SCM MAKE_SSL_CTX(SSL_CTX *x) {
  return MAKE_SSL_OBJECT(ST_SSL_CTX, x);
}

static SCM MAKE_X509(X509 *x) {
  return MAKE_SSL_OBJECT(ST_X509, x);
}

static SCM MAKE_SSL_CA_STACK(STACK *x) {
  return MAKE_SSL_OBJECT(ST_SSL_CA_STACK, x);
}

static SCM MAKE_RSA(RSA *x) {
  return MAKE_SSL_OBJECT(ST_RSA, x);
}
#endif

#define SSL_OBJECT_P(x) (NIMP(x) && (TYP16(x) == tc16_ssl_object))
#define SSL_CIPHER_P(x) (NIMP(x) \
			 && (CAR(x) == (tc16_ssl_object|ST_SSL_CIPHER)))
#define SSL_METHOD_P(x) (NIMP(x) \
			 && (CAR(x) == (tc16_ssl_object|ST_SSL_METHOD)))
#define SSL_COMPRESSION_P(x) (NIMP(x) \
			      && (CAR(x) \
				  == (tc16_ssl_object|ST_SSL_COMPRESSION)))
#define SSL_SESSION_P(x) (NIMP(x) \
			  && (CAR(x) == (tc16_ssl_object|ST_SSL_SESSION)))
#define SSL_CTX_P(x) (NIMP(x) && (CAR(x) == (tc16_ssl_object|ST_SSL_CTX)))
#define X509_P(x) (NIMP(x) && (CAR(x) == (tc16_ssl_object|ST_X509)))
#define SSL_CA_STACK_P(x) (NIMP(x) \
			   && (CAR(x) == (tc16_ssl_object|ST_SSL_CA_STACK)))
#define RSA_P(x) (NIMP(x) && (CAR(x) == (tc16_ssl_object|ST_RSA)))

#define GET_SSL_OBJECT(x) CDR(x)
#define GET_SSL_CIPHER(x) ((SSL_CIPHER *)CDR(x))
#define GET_SSL_METHOD(x) ((SSL_METHOD *)CDR(x))
#define GET_SSL_COMPRESSION(x) ((SSL_COMPRESSION *)CDR(x))
#define GET_SSL_SESSION(x) ((SSL_SESSION *)CDR(x))
#define GET_SSL_CTX(x) ((SSL_CTX *)CDR(x))
#define GET_X509(x) ((X509 *)CDR(x))
#define GET_SSL_CA_STACK(x) ((STACK *)CDR(x))
#define GET_RSA(x) ((RSA *)CDR(x))

#define VALID_SSL_OBJECT_P(x) (SSL_OBJECT_P(x) && CDR(x))
#define VALID_SSL_CIPHER_P(x) (SSL_CIPHER_P(x) && GET_SSL_CIPHER(x))
#define VALID_SSL_METHOD_P(x) (SSL_METHOD_P(x) && GET_SSL_METHOD(x))
#define VALID_SSL_COMPRESSION_P(x) (SSL_COMPRESSION_P(x) && \
				    GET_SSL_COMPRESSION(x))
#define VALID_SSL_SESSION_P(x) (SSL_SESSION_P(x) && GET_SSL_SESSION(x))
#define VALID_SSL_CTX_P(x) (SSL_CTX_P(x) && GET_SSL_CTX(x))
#define VALID_X509_P(x) (X509_P(x) && GET_X509(x))
#define VALID_SSL_CA_STACK_P(x) (SSL_CA_STACK_P(x) && GET_SSL_CA_STACK(x))
#define VALID_RSA_P(x) (RSA_P(x) && GET_RSA(x))

#define MAKE_SSL(x) cons(tc16_ssl | OPN | RDNG | WRTNG, x)
#define GET_SSL(x) ((SSL *)CDR(x))
#define SSL_P(x) (NIMP(x) && (TYP16(x) == tc16_ssl))
#define VALID_SSL_P(x) (SSL_P(x) && GET_SSL(x))
#define VALID_SSL_OR_CTX_P(x) (VALID_SSL_P(x) || VALID_SSL_CTX_P(x))

static char s_ssl_object_p[] = "ssl-object?";
static SCM p_ssl_object_p(SCM x)
{
  return (SSL_OBJECT_P(x) ? BOOL_T : BOOL_F);
}

static char s_ssl_cipher_p[] = "ssl-cipher?";
static SCM p_ssl_cipher_p(SCM x)
{
  return (SSL_CIPHER_P(x) ? BOOL_T : BOOL_F);
}

static char s_ssl_method_p[] = "ssl-method?";
static SCM p_ssl_method_p(SCM x)
{
  return (SSL_METHOD_P(x) ? BOOL_T : BOOL_F);
}

static char s_ssl_compression_p[] = "ssl-compression?";
static SCM p_ssl_compression_p(SCM x)
{
  return (SSL_COMPRESSION_P(x) ? BOOL_T : BOOL_F);
}

static char s_ssl_session_p[] = "ssl-session?";
static SCM p_ssl_session_p(SCM x)
{
  return (SSL_SESSION_P(x) ? BOOL_T : BOOL_F);
}

static char s_ssl_ctx_p[] = "ssl-ctx?";
static SCM p_ssl_ctx_p(SCM x)
{
  return (SSL_CTX_P(x) ? BOOL_T : BOOL_F);
}

static char s_x509_p[] = "x509?";
static SCM p_x509_p(SCM x)
{
  return (X509_P(x) ? BOOL_T : BOOL_F);
}

static char s_ssl_ca_stack_p[] = "ssl-ca-stack?";
static SCM p_ssl_ca_stack_p(SCM x)
{
  return (SSL_CA_STACK_P(x) ? BOOL_T : BOOL_F);
}

static char s_rsa_p[] = "rsa?";
static SCM p_rsa_p(SCM x)
{
  return (RSA_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_object_p[] = "valid-ssl-object?";
static SCM p_valid_ssl_object_p(SCM x)
{
  return (VALID_SSL_OBJECT_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_cipher_p[] = "valid-ssl-cipher?";
static SCM p_valid_ssl_cipher_p(SCM x)
{
  return (VALID_SSL_CIPHER_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_method_p[] = "valid-ssl-method?";
static SCM p_valid_ssl_method_p(SCM x)
{
  return (VALID_SSL_METHOD_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_compression_p[] = "valid-ssl-compression?";
static SCM p_valid_ssl_compression_p(SCM x)
{
  return (VALID_SSL_COMPRESSION_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_session_p[] = "valid-ssl-session?";
static SCM p_valid_ssl_session_p(SCM x)
{
  return (VALID_SSL_SESSION_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_ctx_p[] = "valid-ssl-ctx?";
static SCM p_valid_ssl_ctx_p(SCM x)
{
  return (VALID_SSL_CTX_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_x509_p[] = "valid-x509?";
static SCM p_valid_x509_p(SCM x)
{
  return (VALID_X509_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_ca_stack_p[] = "valid-ssl-ca-stack?";
static SCM p_valid_ssl_ca_stack_p(SCM x)
{
  return (VALID_SSL_CA_STACK_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_rsa_p[] = "valid-rsa?";
static SCM p_valid_rsa_p(SCM x)
{
  return (VALID_RSA_P(x) ? BOOL_T : BOOL_F);
}

static int print_ssl_object(SCM exp, SCM port, int writing)
{
  if (VALID_SSL_OBJECT_P(exp)) {
    switch(CAR(exp) & ~tc16_ssl_object) {
    case ST_SSL_CIPHER: lputs("#<SSL cipher ", port); break;
    case ST_SSL_METHOD: lputs("#<SSL method ", port); break;
    case ST_SSL_COMPRESSION: lputs("#<SSL compression ", port); break;
    case ST_SSL_SESSION: lputs("#<SSL session ", port); break;
    case ST_SSL_CTX: lputs("#<SSL context ", port); break;
    case ST_X509: lputs("#<X.509 certificate ", port); break;
    case ST_SSL_CA_STACK: lputs("#<SSL CA stack ", port); break;
    case ST_RSA: lputs("#<RSA key ", port); break;
    default: lputs("#<unknown SSL object ", port); break;
    }
    intprint(CDR(exp), 16, port);
    lputs(">", port);
  } else {
    lputs("#<invalid SSL object>", port);
  }
  return 1;
}

static smobfuns sslsmob = {
  mark0,
  free0,
  print_ssl_object,
  0
};

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

#ifdef BUGGY_DO_SSL_WRITE
static sizet ssl_write(char *s, sizet siz, sizet num, FILE *p)
{
  int i, r = 0, n = num * siz;
  SSL *ssl = (SSL *)p;
  while (n > 0) {
    i = SSL_write((SSL *)p, s + r, (n > 16384) ? 16384 : n);
    if (i < 0) {
      if (errno == EPIPE)
	SSL_set_bio(ssl, SSL_get_rbio(ssl), BIO_new(BIO_s_null()));
      return -1;
    }
    n -= i;
  }
  return r / siz;
}
#else
static sizet ssl_write(char *s, sizet siz, sizet num, FILE *p)
{
  int i;
  SSL *ssl = (SSL *)p;
  i = SSL_write((SSL *)p, s, siz*num);
  if ((i == -1) && (errno == EPIPE))
    SSL_set_bio(ssl, SSL_get_rbio(ssl), BIO_new(BIO_s_null()));
  return ((i >= 0) ? (i / siz) : -1);
}
#endif

static int ssl_putc(int c0, FILE *p)
{
  char c = c0;

  return ssl_write(&c, 1, 1, p);
}

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

static int ssl_flush(FILE *p)
{
  SSL *s = (SSL *)p;
  BIO_ctrl(SSL_get_wbio(s), BIO_CTRL_FLUSH, 0, 0);
  return 0;
}

static struct timeval tv = {0, 0}, *tvp = &tv;

static int ssl_getc(FILE *p)
{
  unsigned char c;
  int code;
  SSL *s = (SSL *)p;
  struct timeval *old_tvp = tvp;

  /* Blatant abstraction violation.  Oh well. */
  tvp = NULL;
  while ((code = SSL_read(s, &c, 1)) < 1) {
    if (s->shutdown & SSL_RECEIVED_SHUTDOWN)
      return EOF;
    else
      {
	sleep(1); /* block */
      }
  }
  tvp = old_tvp;
  
  return c;
}

static int ssl_close(FILE *p)
{
  SSL *s = (SSL *)p;
  SSL_shutdown(s);
  SSL_free(s);
  return 0;
}

static ptobfuns sslptob = {
  mark0,
  noop0, /* SSL_free? */
  ssl_print,
  0,
  ssl_putc,
  ssl_puts,
  ssl_write,
  ssl_flush,
  ssl_getc,
  ssl_close,
};

static int nb_getc(SCM ptob) {
  int fd;
  fd_set set;
  if (ITCPP(ptob) && (INUM(p_rdcount(ptob)) == 0)) {
    fd = ((tcpobj *)CDR(ptob))->fd;
    FD_ZERO(&set);
    FD_SET(fd, &set);
    select(fd + 1, &set, NULL, NULL, tvp);
  }
  if (ITCPP(ptob) && (INUM(p_rdcount(ptob)) == 0))
    return EOF;
  else
    return lgetc(ptob);
}

static int ptob_bio_write(BIO *b, char *data, int len) {
  int i;
  i = lfwrite(data, 1, len, PTR2SCM(b->ptr));
  lfflush(PTR2SCM(b->ptr));
  return i;
}

static int ptob_bio_read(BIO *b, char *data, int len) {
  int i, c;

  for (i = 0; i < len; ++i) {
    c = nb_getc(PTR2SCM(b->ptr));
    if (c == EOF)
      break;
    data[i] = c;
  }
  return i;
}

static int ptob_bio_puts(BIO *b, char *buf) {
  return ptob_bio_write(b, buf, strlen(buf));
}

static int ptob_bio_gets(BIO *b, char *buf, int len) {
  int i, c;

  for (i = 0; i < len - 1; ++i) {
    c = nb_getc(PTR2SCM(b->ptr));
    if (c == EOF)
      break;
    buf[i] = c;
    if (c == '\n') {
      ++i;
      break;
    }      
  }
  buf[i++] = 0;
  return i;
}

static long ptob_bio_ctrl(BIO *b, int cmd, long *l, char *p) {
  if (cmd == BIO_CTRL_FLUSH) {
    lfflush(PTR2SCM(b->ptr));
    return 1;
  } else
    return 0;
}

static BIO_METHOD methods_bio_ptob = {
  BIO_TYPE_SOURCE_SINK | BIO_TYPE_PTOB,
  "scm ptob",
  ptob_bio_write,
  ptob_bio_read,
  ptob_bio_puts,
  ptob_bio_gets,
  ptob_bio_ctrl,
  NULL, /* create */
  NULL, /* destroy */
};

static BIO* ptob_to_bio(SCM p)
{
  BIO *b;
  b = BIO_new(&methods_bio_ptob);
  b->init = 1;
  b->ptr = (char *)SCM2PTR(p);
  return b;
}

static char s_ssl_p[] = "ssl?";
static SCM p_ssl_p(SCM x)
{
  return (SSL_P(x) ? BOOL_T : BOOL_F);
}

static char s_valid_ssl_p[] = "valid-ssl?";
static SCM p_valid_ssl_p(SCM x)
{
  return (VALID_SSL_P(x) ? BOOL_T : BOOL_F);
}

static SCM STACK_to_list(STACK *st, SCM f(char *))
{
  SCM l = EOL;
  STACK *s2;

  s2 = sk_dup(st);
  
  while (sk_num(s2) > 0)
    l = cons(f(sk_pop(s2)), l);

  return l;
}

static SCM cp_to_X509(char *p)
{
  return MAKE_X509(p);
}

static SCM cp_to_SSL_CIPHER(char *p)
{
  return MAKE_SSL_CIPHER(p);
}

static STACK *list_to_STACK(SCM l, char *f(SCM))
{
  STACK *st;

  st = sk_new(NULL);

  if (st == NULL) 
    return NULL;

  while (l != EOL) {
    sk_push(st, f(CAR(l)));
    l = CDR(l);
  }
  return st;
}

static char* X509_to_cp(SCM x)
{
  return (char *)GET_X509(x);
}

static char* SSL_CIPHER_to_cp(SCM x)
{
  return (char *)GET_SSL_CIPHER(x);
}

static char s_init[] = MOD "initialize!";
static SCM p_init(void)
{
  SSL_load_error_strings();
  SSLeay_add_all_algorithms();
  return UNSPECIFIED;
}

static char s_RAND_seed[] = MOD "add-random-data!";
static SCM p_RAND_seed(SCM data)
{
  ASSERT(STRINGP(data), data, ARG1, s_RAND_seed);
  RAND_seed(CHARS(data), LENGTH(data));
  return UNSPECIFIED;
}

static char s_RAND_bytes[] = MOD "random-data";
static SCM p_RAND_bytes(SCM buffer_length)
{
  char *randstring;
  int l;
  SCM result;

  ASSERT(NUMBERP(buffer_length), buffer_length, ARG1, s_RAND_bytes);
  l = num2long(buffer_length);
  randstring = malloc(l);
  if (randstring == NULL) {
    wta(buffer_length, NALLOC, s_RAND_bytes);
    return BOOL_F;
  }

  RAND_bytes(randstring, l);

  result = makfromstr(randstring, l);
  free(randstring);
  return result;
}

static char s_RAND_force_entropy[] = MOD "force-entropy!";
static SCM p_RAND_force_entropy(SCM numbits, SCM keyboard_available) {
  int kb_avail;
  ASSERT(NUMBERP(numbits), numbits, ARG1, s_RAND_force_entropy);
  ASSERT(IFLAGP(keyboard_available) &&
	 (keyboard_available==BOOL_T || keyboard_available==BOOL_F),
	 keyboard_available, ARG2, s_RAND_force_entropy);
  kb_avail = (keyboard_available==BOOL_T ? 1 : 0);
  RAND_force_entropy(num2long(numbits), kb_avail);
  return UNSPECIFIED;
}

static char s_RAND_slow_poll[] = MOD "slow-poll!";
static SCM p_RAND_slow_poll() {
  RAND_slow_poll();
  return UNSPECIFIED;
}

static char s_RAND_get_randBits[] = MOD "randbits-in-pool";
static SCM p_RAND_get_randBits() {
  return ulong2num(randBits);
}

static char s_RAND_set_randBits[] = MOD "set-randbits-in-pool!";
static SCM p_RAND_set_randBits(SCM value) {		/* Must not be negative! */
  ASSERT(NUMBERP(value) && (num2ulong(value) >= 0), value, ARG1, s_RAND_set_randBits);
  randBits = num2ulong(value);
  return ulong2num(randBits);
}

static char s_RAND_eat_randBits[] = MOD "eat-randbits-in-pool!"; /* Now that I had to write set-randbits-in-pool!, this is kinda redundant... */
static SCM p_RAND_eat_randBits(SCM eaten) {		/* Must not be negative! */
  ASSERT(NUMBERP(eaten) && (num2ulong(eaten) >= 0), eaten, ARG1, s_RAND_eat_randBits);
  randBits -= num2ulong(eaten);
  return ulong2num(randBits);
}

static char s_ERR_get_errors[] = MOD "get-errors";
static SCM p_ERR_get_errors(void)
{
  BIO *b;
  char *p;
  int l;

  b = BIO_new(BIO_s_mem());
  if (b == NULL)
    wta(BOOL_F, NALLOC, s_ERR_get_errors);
  ERR_print_errors(b);
  l = BIO_ctrl(b, BIO_CTRL_INFO, 0, (char *)&p);
  /* The line below is from when this was "print-errors";
     it turns out to be -far- more useful to just return
     the string and let SCM deal with it as it sees fit.
  return display(makfromstr(p, l), cur_error_port()); */
  return makfromstr(p, l);
}

static char s_SSL_is_init_finished[] = MOD "established?";
static SCM p_SSL_is_init_finished(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_is_init_finished);
  return (SSL_is_init_finished(GET_SSL(ssl)) ? BOOL_T : BOOL_F);
}

static char s_SSL_in_accept_init[] = MOD "in-accept-init?";
static SCM p_SSL_in_accept_init(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_in_accept_init);
  return (SSL_in_accept_init(GET_SSL(ssl)) ? BOOL_T : BOOL_F);
}

static char s_ssl_accepted_p[] = MOD "accepted?";
static SCM p_ssl_accepted_p(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_ssl_accepted_p);
  switch (GET_SSL(ssl)->state) {
  case SSL_ST_ACCEPT:
  case SSL2_ST_GET_CLIENT_HELLO_A:
  case SSL3_ST_SR_CLNT_HELLO_A:
  case SSL23_ST_SR_CLNT_HELLO_A:
    return BOOL_F;
  default:
    return BOOL_T;
  }
}

static char s_ssl_connected_p[] = MOD "connected?";
static SCM p_ssl_connected_p(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_ssl_accepted_p);
  switch (GET_SSL(ssl)->state) {
  case SSL_ST_CONNECT:
  case SSL2_ST_GET_SERVER_HELLO_A:
  case SSL3_ST_CR_SRVR_HELLO_A:
    /*  case SSL3_ST_CW_CLNT_HELLO_A: */
  case SSL23_ST_CR_SRVR_HELLO_A:
    /* case SSL23_ST_CW_CLNT_HELLO_A: */
    return BOOL_F;
  default:
    return BOOL_T;
  }
}

/* packet and packet_length are supposed to be private, but we need to
get at them for our redirection to work.  Sigh. */

static char s_ssl_packet[] = MOD "packet";
static SCM p_ssl_packet(SCM ssl)
{
  SSL *s = GET_SSL(ssl);
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_ssl_packet);
  return makfromstr(s->packet, s->packet_length);
}

/* callback and mkit borrowed from SSLeay's selfsign demo */

static void rsa_callback(int p, int n)
{
  fputc(".+*\n"[p%4], stderr);
}

int mkit(X509 **x509p, EVP_PKEY **pkeyp, RSA *rsa, int serial, int days,
	 int verboze, char *identifier)
{
  X509 *x;
  EVP_PKEY *pk;
  char *s;
  X509_NAME *name=NULL;
  X509_NAME_ENTRY *ne=NULL;
  X509_EXTENSION *ex=NULL;
  ASN1_OCTET_STRING *data=NULL;
  
  
  if ((pkeyp == NULL) || (*pkeyp == NULL))
    {
      if ((pk=EVP_PKEY_new()) == NULL)
	{
	  abort(); 
	  return(0);
	}
    }
  else
    pk= *pkeyp;

  if ((x509p == NULL) || (*x509p == NULL))
    {
      if ((x=X509_new()) == NULL)
	goto err;
    }
  else
    x= *x509p;

  if (!EVP_PKEY_assign_RSA(pk,rsa))
    {
      abort();
      goto err;
    }
  rsa=NULL;

  X509_set_version(x,0);
  ASN1_INTEGER_set(X509_get_serialNumber(x),serial);
  /* Netscape 4 doesn't like brand-new certs.  Sigh. */
  X509_gmtime_adj(X509_get_notBefore(x),-60*60*24);
  X509_gmtime_adj(X509_get_notAfter(x),(long)60*60*24*days);
  X509_set_pubkey(x,pk);

  name=X509_NAME_new();

  ne=X509_NAME_ENTRY_create_by_NID(&ne,NID_organizationName,
				V_ASN1_APP_CHOOSE,identifier,-1);
  X509_NAME_add_entry(name,ne,0,0);

  X509_NAME_ENTRY_create_by_NID(&ne,NID_commonName,
				V_ASN1_APP_CHOOSE,identifier,-1);
  X509_NAME_add_entry(name,ne,1,0);

	/* finished with structure */
  X509_NAME_ENTRY_free(ne);

  X509_set_subject_name(x,name);
  X509_set_issuer_name(x,name);

  /* finished with structure */
  X509_NAME_free(name);

  /*
  data=X509v3_pack_string(NULL,V_ASN1_BIT_STRING,
			  "\377",1);
  ex=X509_EXTENSION_create_by_NID(NULL,NID_netscape_cert_type,0,data);
  X509_add_ext(x,ex,-1);

  X509v3_pack_string(&data,V_ASN1_IA5STRING,
		     "example comment extension",-1);
  X509_EXTENSION_create_by_NID(&ex,NID_netscape_comment,0,data);
  X509_add_ext(x,ex,-1);

  X509v3_pack_string(&data,V_ASN1_BIT_STRING,
		     "*",-1);
  X509_EXTENSION_create_by_NID(&ex,NID_netscape_ssl_server_name,0,data);
  X509_add_ext(x,ex,-1);
  */
	
  X509_EXTENSION_free(ex);
  ASN1_OCTET_STRING_free(data);

  if (!X509_sign(x,pk,EVP_md5()))
    goto err;

  *x509p=x;
  *pkeyp=pk;
  return(1);
err:
  return(0);
}

/* This function returns a cert, ASN.1-encoded.
 * It used to generate an rsa key, but then it only returned the private
 * key, and it didn't let us make certificates with a given rsa key pair.
 */
static char s_ssl_make_cert[] = MOD "make-cert";
static SCM p_ssl_make_cert(SCM name, SCM rsa, SCM days, SCM ser, SCM verb)
{
  EVP_PKEY *pkey = NULL;
  X509 *x = NULL;
  int certlen;
  unsigned char *certstr, *certstr2;
  SCM cert;
  int verboze = NFALSEP(verb) && !UNBNDP(verb), serial;

  ASSERT(STRINGP(name), name, ARG1, s_ssl_make_cert);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG2, s_ssl_make_cert);
  ASSERT(NUMBERP(days), days, ARG3, s_ssl_make_cert);
  if (UNBNDP(ser))
    serial = time(NULL);
  else {
    ASSERT(NUMBERP(ser), ser, ARG4, s_ssl_make_cert);
    serial = num2long(ser);
  }

  /* p_get_cryptlib_randomness(); */
  
  X509v3_add_netscape_extensions();

  mkit(&x, &pkey, GET_RSA(rsa), serial, num2long(days), verboze,
       CHARS(name));

  certlen = i2d_X509(x, NULL);
  certstr = certstr2 = malloc(certlen);
  if (certstr == NULL)
    wta(BOOL_F, NALLOC, s_ssl_make_cert);
  i2d_X509(x, &certstr2);
  cert = makfromstr(certstr, certlen);
  free(certstr);

  return cert;
}

void ssl_info_callback(SSL *s, int where, int ret)
{
  char *str;
  int w;
  SCM p = cur_error_port();

  w=where & ~SSL_ST_MASK;

  if (w & SSL_ST_CONNECT) str="SSL_connect";
  else if (w & SSL_ST_ACCEPT) str="SSL_accept";
  else str="undefined";

  if (where & SSL_CB_LOOP) {
    lputs(str, p);
    lputc(':', p);
    lputs(SSL_state_string_long(s), p);
    lputc('\n', p);
  } else if (where & SSL_CB_ALERT) {
    lputs("SSL3 alert ", p);
    if (where & SSL_CB_READ)
      lputs("read:", p);
    else
      lputs("write:", p);
    lputs(SSL_alert_type_string_long(ret), p);
    lputc(':', p);
    lputs(SSL_alert_desc_string_long(ret), p);
    lputc('\n', p);
  } else if (where & SSL_CB_EXIT) {
    if (ret <= 0) {
      lputs(str, p);
      if (ret == 0)
	lputs(":failed in ", p);
      else
	lputs(":error in ", p);
      lputs(SSL_state_string_long(s), p);
      lputc('\n', p);
    }
  }
}

static char s_ssl_ctx_trace[] = MOD "trace-ctx!";
static SCM p_ssl_ctx_trace(SCM ctx)
{
  ASSERT(VALID_SSL_CTX_P(ctx), ctx, ARG1, s_ssl_ctx_trace);
  SSL_CTX_set_info_callback(GET_SSL_CTX(ctx), ssl_info_callback);
  return UNSPECIFIED;
}

static char s_x509_md5_fingerprint[] = MOD "x509-md5-fingerprint";
static SCM p_x509_md5_fingerprint(SCM x)
{
  unsigned int i, n;
  unsigned char md[EVP_MAX_MD_SIZE];
  char s[EVP_MAX_MD_SIZE*3+1];
  ASSERT(VALID_X509_P(x), x, ARG1, s_x509_md5_fingerprint);
  if (!X509_digest(GET_X509(x), EVP_md5(), md, &n)) {
    wta(x, NALLOC, s_x509_md5_fingerprint);
    return BOOL_F;
  }
  for (i = 0; i < n; ++i)
    sprintf(s + 3*i, "%02X:", md[i]);
  return makfromstr(s, 3*n - 1);
}

static char s_d2i_X509[] = MOD "der-string->x509";
static SCM p_d2i_X509(SCM str)
{
  unsigned char *p = (unsigned char *)CHARS(str);
  ASSERT(STRINGP(str), str, ARG1, s_d2i_X509);
  return MAKE_X509(d2i_X509(NULL, &p, LENGTH(str)));
}  

/* Code needed for making and verifying RSA signatures */
static char s_RSA_generate_key[] = MOD "generate-rsa";
static SCM p_RSA_generate_key(SCM bits, SCM verboze)
{
  void (*cb)(int, int);

  ASSERT(NUMBERP(bits), bits, ARG1, s_RSA_generate_key);
  if (NFALSEP(verboze) && !UNBNDP(verboze)) 
    cb = rsa_callback;
  else
    cb = NULL;
  return MAKE_RSA(RSA_generate_key(num2long(bits), RSA_F4, cb));
}

static char s_RSA_free[] = MOD "free-rsa!";
static SCM p_RSA_free(SCM rsa)
{
  ASSERT(RSA_P(rsa), rsa, ARG1, s_RSA_free);
  RSA_free(GET_RSA(rsa));
  return UNSPECIFIED;
}

static char s_d2i_RSAPublicKey[] = MOD "der-string->rsa-public-key";
static SCM p_d2i_RSAPublicKey(SCM str)
{
  unsigned char *p = (unsigned char *)CHARS(str);
  ASSERT(STRINGP(str), str, ARG1, s_d2i_RSAPublicKey);
  return MAKE_RSA(d2i_RSAPublicKey(NULL, &p, LENGTH(str)));
}  

static char s_i2d_RSAPublicKey[] = MOD "rsa-public-key->der-string";
static SCM p_i2d_RSAPublicKey(SCM rsa)
{
  int len;
  unsigned char *p, *p2;
  SCM result;
  ASSERT(VALID_RSA_P(rsa), rsa, ARG1, s_i2d_RSAPublicKey);
  len = i2d_RSAPublicKey(GET_RSA(rsa), NULL);
  p = p2 = malloc(len);
  if (p == NULL)
    wta(BOOL_F, NALLOC, s_i2d_RSAPublicKey);
  i2d_RSAPublicKey(GET_RSA(rsa), &p2);
  result = makfromstr(p, len);
  free(p);
  return result;
}

static char s_d2i_RSAPrivateKey[] = MOD "der-string->rsa-private-key";
static SCM p_d2i_RSAPrivateKey(SCM str)
{
  unsigned char *p = (unsigned char *)CHARS(str);
  ASSERT(STRINGP(str), str, ARG1, s_d2i_RSAPrivateKey);
  return MAKE_RSA(d2i_RSAPrivateKey(NULL, &p, LENGTH(str)));
}

static char s_i2d_RSAPrivateKey[] = MOD "rsa-private-key->der-string";
static SCM p_i2d_RSAPrivateKey(SCM rsa)
{
  int len;
  unsigned char *p, *p2;
  SCM result;
  ASSERT(VALID_RSA_P(rsa), rsa, ARG1, s_i2d_RSAPrivateKey);
  len = i2d_RSAPrivateKey(GET_RSA(rsa), NULL);
  p = p2 = malloc(len);
  if (p == NULL)
    wta(BOOL_F, NALLOC, s_i2d_RSAPrivateKey);
  i2d_RSAPrivateKey(GET_RSA(rsa), &p2);
  result = makfromstr(p, len);
  free(p);
  return result;
}

static char s_x509__rsa_public_key[] = MOD "x509->rsa-public-key";
static SCM p_x509__rsa_public_key(SCM x509)
{
  X509 *x;
  X509_PUBKEY *xpk;

  ASSERT(VALID_X509_P(x509), x509, ARG1, s_x509__rsa_public_key);
  x = GET_X509(x509);
  xpk = x->cert_info->key;
  return MAKE_RSA(X509_PUBKEY_get(xpk)->pkey.rsa);
}

static char s_RSA_sign__md5[] = MOD "rsa-sign-md5-hash";
static SCM p_RSA_sign__md5(SCM msg, SCM rsa)
{
  char md[MD5_DIGEST_LENGTH], sig[1024]; /* _should_ be plenty */
  unsigned int siglen;

  ASSERT(STRINGP(msg), msg, ARG1, s_RSA_sign__md5);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG2, s_RSA_sign__md5);
  MD5(CHARS(msg), LENGTH(msg), md);
  RSA_sign(NID_md5, md, MD5_DIGEST_LENGTH, sig, &siglen, GET_RSA(rsa));
  return makfromstr(sig, siglen);
}

static char s_RSA_verify__md5[] = MOD "rsa-verify-md5-hash";
static SCM p_RSA_verify__md5(SCM msg, SCM sig, SCM rsa)
{
  char md[MD5_DIGEST_LENGTH];

  ASSERT(STRINGP(msg), msg, ARG1, s_RSA_verify__md5);
  ASSERT(STRINGP(sig), sig, ARG2, s_RSA_verify__md5);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG3, s_RSA_verify__md5);
  MD5(CHARS(msg), LENGTH(msg), md);
  if (RSA_verify(NID_md5, md, MD5_DIGEST_LENGTH, CHARS(sig), LENGTH(sig),
		 GET_RSA(rsa)) > 0)
    return BOOL_T;
  else
    return BOOL_F;
}

static char s_md5_fingerprint[] = MOD "md5-fingerprint";
static SCM p_md5_fingerprint(SCM x)
{
  unsigned int i;
  unsigned char md[MD5_DIGEST_LENGTH];
  char s[MD5_DIGEST_LENGTH*3+1];
  ASSERT(STRINGP(x), x, ARG1, s_md5_fingerprint);
  MD5(CHARS(x), LENGTH(x), md);
  for (i = 0; i < MD5_DIGEST_LENGTH; ++i)
    sprintf(s + 3*i, "%02X:", md[i]);
  return makfromstr(s, 3*MD5_DIGEST_LENGTH - 1);
}

static char s_md5_hash[] = MOD "md5-hash";
static SCM p_md5_hash(SCM str)
{
  unsigned int i;
  unsigned char md[MD5_DIGEST_LENGTH];
  char s[MD5_DIGEST_LENGTH*3+1];
  ASSERT(STRINGP(str), str, ARG1, s_md5_fingerprint);
  MD5(CHARS(str), LENGTH(str), md);
  return makfromstr(md, MD5_DIGEST_LENGTH);
}

#define SHA1_DIGEST_LENGTH SHA_DIGEST_LENGTH

static char s_RSA_sign__sha1[] = MOD "rsa-sign-sha1-hash";
static SCM p_RSA_sign__sha1(SCM msg, SCM rsa)
{
  char md[SHA1_DIGEST_LENGTH], sig[1024]; /* _should_ be plenty */
  unsigned int siglen;

  ASSERT(STRINGP(msg), msg, ARG1, s_RSA_sign__sha1);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG2, s_RSA_sign__sha1);
  SHA1(CHARS(msg), LENGTH(msg), md);
  RSA_sign(NID_sha1, md, SHA1_DIGEST_LENGTH, sig, &siglen, GET_RSA(rsa));
  return makfromstr(sig, siglen);
}

static char s_RSA_verify__sha1[] = MOD "rsa-verify-sha1-hash";
static SCM p_RSA_verify__sha1(SCM msg, SCM sig, SCM rsa)
{
  char md[SHA1_DIGEST_LENGTH];

  ASSERT(STRINGP(msg), msg, ARG1, s_RSA_verify__sha1);
  ASSERT(STRINGP(sig), sig, ARG2, s_RSA_verify__sha1);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG3, s_RSA_verify__sha1);
  SHA1(CHARS(msg), LENGTH(msg), md);
  if (RSA_verify(NID_sha1, md, SHA1_DIGEST_LENGTH, CHARS(sig), LENGTH(sig),
		 GET_RSA(rsa)) > 0)
    return BOOL_T;
  else
    return BOOL_F;
}

static char s_sha1_fingerprint[] = MOD "sha1-fingerprint";
static SCM p_sha1_fingerprint(SCM x)
{
  unsigned int i;
  unsigned char md[SHA1_DIGEST_LENGTH];
  char s[SHA1_DIGEST_LENGTH*3+1];
  ASSERT(STRINGP(x), x, ARG1, s_sha1_fingerprint);
  SHA1(CHARS(x), LENGTH(x), md);
  for (i = 0; i < SHA1_DIGEST_LENGTH; ++i)
    sprintf(s + 3*i, "%02X:", md[i]);
  return makfromstr(s, 3*SHA1_DIGEST_LENGTH - 1);
}

static char s_sha1_hash[] = MOD "sha1-hash";
static SCM p_sha1_hash(SCM str)
{
  unsigned int i;
  unsigned char md[SHA1_DIGEST_LENGTH];
  char s[SHA1_DIGEST_LENGTH*3+1];
  ASSERT(STRINGP(str), str, ARG1, s_sha1_fingerprint);
  SHA1(CHARS(str), LENGTH(str), md);
  return makfromstr(md, SHA1_DIGEST_LENGTH);
}

static char s_RSA_public_encrypt[] = MOD "rsa-public-encrypt";
static SCM p_RSA_public_encrypt(SCM data, SCM rsa)
{
  unsigned char *to;
  int tolen;
  SCM result;
  ASSERT(STRINGP(data), data, ARG1, s_RSA_public_encrypt);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG2, s_RSA_public_encrypt);
  to = malloc(RSA_size(GET_RSA(rsa)));
  if (to == NULL)
    wta(BOOL_F, NALLOC, s_RSA_public_encrypt);
  tolen = RSA_public_encrypt(LENGTH(data), UCHARS(data), to,
			     GET_RSA(rsa), RSA_PKCS1_PADDING);
  if (tolen < 0) {
    free(to);
    return BOOL_F;
  } else {
    result = makfromstr(to, tolen);
    return result;
  }
}

static char s_RSA_private_encrypt[] = MOD "rsa-private-encrypt";
static SCM p_RSA_private_encrypt(SCM data, SCM rsa)
{
  unsigned char *to;
  int tolen;
  SCM result;
  ASSERT(STRINGP(data), data, ARG1, s_RSA_private_encrypt);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG2, s_RSA_private_encrypt);
  to = malloc(RSA_size(GET_RSA(rsa)));
  if (to == NULL)
    wta(BOOL_F, NALLOC, s_RSA_private_encrypt);
  tolen = RSA_private_encrypt(LENGTH(data), UCHARS(data), to,
			     GET_RSA(rsa), RSA_PKCS1_PADDING);
  if (tolen < 0) {
    free(to);
    return BOOL_F;
  } else {
    result = makfromstr(to, tolen);
    return result;
  }
}

static char s_RSA_public_decrypt[] = MOD "rsa-public-decrypt";
static SCM p_RSA_public_decrypt(SCM data, SCM rsa)
{
  unsigned char *to;
  int tolen;
  SCM result;
  ASSERT(STRINGP(data), data, ARG1, s_RSA_public_decrypt);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG2, s_RSA_public_decrypt);
  to = malloc(RSA_size(GET_RSA(rsa)));
  if (to == NULL)
    wta(BOOL_F, NALLOC, s_RSA_public_decrypt);
  tolen = RSA_public_decrypt(LENGTH(data), UCHARS(data), to,
			     GET_RSA(rsa), RSA_PKCS1_PADDING);
  if (tolen < 0) {
    free(to);
    return BOOL_F;
  } else {
    result = makfromstr(to, tolen);
    return result;
  }
}

static char s_RSA_private_decrypt[] = MOD "rsa-private-decrypt";
static SCM p_RSA_private_decrypt(SCM data, SCM rsa)
{
  unsigned char *to;
  int tolen;
  SCM result;
  ASSERT(STRINGP(data), data, ARG1, s_RSA_private_decrypt);
  ASSERT(VALID_RSA_P(rsa), rsa, ARG2, s_RSA_private_decrypt);
  to = malloc(RSA_size(GET_RSA(rsa)));
  if (to == NULL)
    wta(BOOL_F, NALLOC, s_RSA_private_decrypt);
  tolen = RSA_private_decrypt(LENGTH(data), UCHARS(data), to,
			     GET_RSA(rsa), RSA_PKCS1_PADDING);
  if (tolen < 0) {
    free(to);
    return BOOL_F;
  } else {
    result = makfromstr(to, tolen);
    return result;
  }
}

/* ...and now the thin wrappers around ssl functions. */

static char s_SSL_CTX_new[] = MOD "make-ctx";
static SCM p_SSL_CTX_new(SCM method)
{
  SSL_CTX *ctx;
  ASSERT(VALID_SSL_METHOD_P(method), method, ARG1, s_SSL_CTX_new);
  ctx = SSL_CTX_new(GET_SSL_METHOD(method));
  /* enable bug workarounds. */
  SSL_CTX_set_options(ctx, SSL_OP_ALL);
  SSL_CTX_set_tmp_rsa(ctx, RSA_generate_key(512,RSA_F4,NULL));
  /* cache all sessions, and don't clear cache every 256 connections */
  SSL_CTX_set_session_cache_mode(ctx, (SSL_SESS_CACHE_BOTH
				       | SSL_SESS_CACHE_NO_AUTO_CLEAR));
  return MAKE_SSL_CTX(ctx);
}

static char s_SSL_CTX_free[] = MOD "free-ctx!";
static SCM p_SSL_CTX_free(SCM ctx)
{
  ASSERT(VALID_SSL_CTX_P(ctx), ctx, ARG1, s_SSL_CTX_free);
  SSL_CTX_free(GET_SSL_CTX(ctx));
  /* Mark as invalid. */
  GET_SSL_CTX(ctx) = NULL;
  return UNSPECIFIED;
}

static char s_SSL_clear[] = MOD "clear!";
static SCM p_SSL_clear(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_clear);
  SSL_clear(GET_SSL(ssl));
  return UNSPECIFIED;
}

static char s_SSL_CTX_flush_sessions[] = MOD "flush-ctx-sessions!";
static SCM p_SSL_CTX_flush_sessions(SCM ctx, SCM tm)
{
  ASSERT(VALID_SSL_CTX_P(ctx), ctx, ARG1, s_SSL_CTX_flush_sessions);
  ASSERT(NUMBERP(tm), tm, ARG2, s_SSL_CTX_flush_sessions);
  SSL_CTX_flush_sessions(GET_SSL_CTX(ctx), num2long(tm));
  return UNSPECIFIED;
}

static char s_SSL_get_current_cipher[] = MOD "current-cipher";
static SCM p_SSL_get_current_cipher(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_current_cipher);
  return MAKE_SSL_CIPHER(SSL_get_current_cipher(GET_SSL(ssl)));
}

static char s_SSL_CIPHER_get_bits[] = MOD "cipher-bits";
static SCM p_SSL_CIPHER_get_bits(SCM cipher)
{
  ASSERT(VALID_SSL_CIPHER_P(cipher), cipher, ARG1, s_SSL_CIPHER_get_bits);
  return long2num(SSL_CIPHER_get_bits(GET_SSL_CIPHER(cipher), NULL));
}

static char s_SSL_CIPHER_get_version[] = MOD "cipher-version";
static SCM p_SSL_CIPHER_get_version(SCM cipher)
{
  ASSERT(VALID_SSL_CIPHER_P(cipher), cipher, ARG1, s_SSL_CIPHER_get_version);
  return makfrom0str(SSL_CIPHER_get_version(GET_SSL_CIPHER(cipher)));
}

static char s_SSL_CIPHER_get_name[] = MOD "cipher-name";
static SCM p_SSL_CIPHER_get_name(SCM cipher)
{
  ASSERT(VALID_SSL_CIPHER_P(cipher), cipher, ARG1, s_SSL_CIPHER_get_name);
  return makfrom0str(SSL_CIPHER_get_name(GET_SSL_CIPHER(cipher)));
}

static char s_SSL_get_fd[] = MOD "stream";
static SCM p_SSL_get_fd(SCM ssl)
{
  int fd;
  FILE *fp;
  SCM pt;

  NEWCELL(pt);
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_fd);
  fd = SSL_get_fd(GET_SSL(ssl));
  fp = fdopen(fd, "r+");
  if (!fp) {
    wta(MAKINUM(fd), NALLOC, s_port_type);
  }
  CAR(pt) = tc16_fport | mode_bits("r+0");
  SETSTREAM(pt, fp);
  i_setbuf0(pt);
  return pt;
}

static char s_SSL_get_shared_ciphers[] = MOD "shared-ciphers";
static SCM p_SSL_get_shared_ciphers(SCM ssl)
{
  char buf[1024];
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_shared_ciphers);
  return makfrom0str(SSL_get_shared_ciphers(GET_SSL(ssl), buf, sizeof(buf)));
}

static char s_SSL_get_read_ahead[] = MOD "read-ahead";
static SCM p_SSL_get_read_ahead(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_read_ahead);
  return (SSL_get_read_ahead(GET_SSL(ssl)) ? BOOL_T : BOOL_F);
}

static char s_SSL_pending[] = MOD "pending";
static SCM p_SSL_pending(SCM ssl)
{
  SSL *s;
  char c;
  int n;
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_pending);
  
  s = GET_SSL(ssl);

  SSL_read(s, &c, 0); /* SSL_peek is too passive */
  n = SSL_peek(s, &c, 1);
  if (n == 1)
    return MAKINUM(1);
  if (s->shutdown & SSL_RECEIVED_SHUTDOWN) /* EOF */
    return MAKINUM(1);
  return MAKINUM(0);
}

static char s_SSL_set_cipher_list[] = MOD "set-cipher-list!";
static SCM p_SSL_set_cipher_list(SCM ssl, SCM ciphers)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_set_cipher_list);
  ASSERT(STRINGP(ciphers), ciphers, ARG2, s_SSL_set_cipher_list);

  if (SSL_P(ssl))
    b = SSL_set_cipher_list(GET_SSL(ssl), mak0strfrom(ciphers));
  else
    b = SSL_CTX_set_cipher_list(GET_SSL_CTX(ssl), mak0strfrom(ciphers));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_set_read_ahead[] = MOD "set-read-ahead!";
static SCM p_SSL_set_read_ahead(SCM ssl, SCM ra)
{
  SCM oldra;
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_set_read_ahead);
  oldra = p_SSL_get_read_ahead(ssl);
  SSL_set_read_ahead(GET_SSL(ssl), NFALSEP(ra));
  return oldra;
}

static char s_SSL_get_verify_mode[] = MOD "verification?";
static SCM p_SSL_get_verify_mode(SCM ssl)
{
  int b;

  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_get_verify_mode);
  if (SSL_P(ssl))
    b = SSL_get_verify_mode(GET_SSL(ssl));
  else
    b = SSL_CTX_get_verify_mode(GET_SSL_CTX(ssl));
  return b ? BOOL_T : BOOL_F;
}

static int stupid_verify_callback(int ok, X509_STORE_CTX *ctx)
{
  return 1;
}

static char s_SSL_set_verify[] = MOD "set-verification!";
static SCM p_SSL_set_verify(SCM ssl, SCM mode)
{
  SCM oldmode;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_set_verify);
  oldmode = p_SSL_get_verify_mode(ssl);
  if (SSL_P(ssl))
    SSL_set_verify(GET_SSL(ssl), NFALSEP(mode), &stupid_verify_callback);
  else
    SSL_CTX_set_verify(GET_SSL_CTX(ssl), NFALSEP(mode), &stupid_verify_callback);
  return oldmode;
}

static char s_SSL_use_RSAPrivateKey[] = MOD "use-rsa-private-key!";
static SCM p_SSL_use_RSAPrivateKey(SCM ssl, SCM key)
{
  int b;

  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_RSAPrivateKey);
  ASSERT(VALID_RSA_P(key), key, ARG2, s_SSL_use_RSAPrivateKey);
  if (SSL_P(ssl))
    b = SSL_use_RSAPrivateKey(GET_SSL(ssl), GET_RSA(key));
  else
    b = SSL_CTX_use_RSAPrivateKey(GET_SSL_CTX(ssl), GET_RSA(key));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_RSAPrivateKey_ASN1[] = MOD "use-rsa-private-key-from-asn1-string!";
static SCM p_SSL_use_RSAPrivateKey_ASN1(SCM ssl, SCM key)
{
  int b;

  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_RSAPrivateKey_ASN1);
  ASSERT(STRINGP(key), key, ARG2, s_SSL_use_RSAPrivateKey_ASN1);
  if (SSL_P(ssl))
    b = SSL_use_RSAPrivateKey_ASN1(GET_SSL(ssl), CHARS(key), LENGTH(key));
  else
    b = SSL_CTX_use_RSAPrivateKey_ASN1(GET_SSL_CTX(ssl), CHARS(key),
				       LENGTH(key));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_RSAPrivateKey_file__ASN1[] = MOD "use-rsa-private-key-from-asn1-file!";
static SCM p_SSL_use_RSAPrivateKey_file__ASN1(SCM ssl, SCM name)
{
  int b;

  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1,
	 s_SSL_use_RSAPrivateKey_file__ASN1);
  ASSERT(STRINGP(name), name, ARG2, s_SSL_use_RSAPrivateKey_file__ASN1);
  if (SSL_P(ssl))
    b = SSL_use_RSAPrivateKey_file(GET_SSL(ssl), mak0strfrom(name),
				    SSL_FILETYPE_ASN1);
  else
    b = SSL_CTX_use_RSAPrivateKey_file(GET_SSL_CTX(ssl), mak0strfrom(name),
					SSL_FILETYPE_ASN1);
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_PrivateKey_ASN1__DSA[] = MOD "use-dsa-private-key-from-asn1-string!";
static SCM p_SSL_use_PrivateKey_ASN1__DSA(SCM ssl, SCM key)
{
  int b; 
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_PrivateKey_ASN1__DSA);
  ASSERT(STRINGP(key), key, ARG2, s_SSL_use_PrivateKey_ASN1__DSA);
  if (SSL_P(ssl))
    b = SSL_use_PrivateKey_ASN1(EVP_PKEY_DSA, GET_SSL(ssl), CHARS(key),
				LENGTH(key));
  else
    b = SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_DSA, GET_SSL_CTX(ssl), CHARS(key),
				    LENGTH(key));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_PrKey_file__PEM[] = MOD "use-private-key-from-pem-file!";
static SCM p_SSL_use_PrKey_file__PEM(SCM ssl, SCM name)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_PrKey_file__PEM);
  ASSERT(STRINGP(name), name, ARG2, s_SSL_use_PrKey_file__PEM);
  if (SSL_P(ssl))
    b = SSL_use_PrivateKey_file(GET_SSL(ssl), mak0strfrom(name),
				SSL_FILETYPE_PEM);
  else
    b = SSL_CTX_use_PrivateKey_file(GET_SSL_CTX(ssl), mak0strfrom(name),
				SSL_FILETYPE_PEM);
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_certificate[] = MOD "use-certificate!";
static SCM p_SSL_use_certificate(SCM ssl, SCM cert)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_certificate);
  ASSERT(VALID_X509_P(cert), cert, ARG2, s_SSL_use_certificate);
  if (SSL_P(ssl))
    b = SSL_use_certificate(GET_SSL(ssl), GET_X509(cert));
  else
    b = SSL_CTX_use_certificate(GET_SSL_CTX(ssl), GET_X509(cert));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_certificate_ASN1[] = MOD "use-certificate-from-asn1-string!";
static SCM p_SSL_use_certificate_ASN1(SCM ssl, SCM cert)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_certificate_ASN1);
  ASSERT(STRINGP(cert), cert, ARG2, s_SSL_use_certificate_ASN1);
  if (SSL_P(ssl))
    b = SSL_use_certificate_ASN1(GET_SSL(ssl), LENGTH(cert), CHARS(cert));
  else
    b = SSL_CTX_use_certificate_ASN1(GET_SSL_CTX(ssl), LENGTH(cert),
				     CHARS(cert));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_cert_file__ASN1[] = MOD "use-certificate-from-asn1-file!";
static SCM p_SSL_use_cert_file__ASN1(SCM ssl, SCM name)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_cert_file__ASN1);
  ASSERT(STRINGP(name), name, ARG2, s_SSL_use_cert_file__ASN1);
  if (SSL_P(ssl))
    b = SSL_use_certificate_file(GET_SSL(ssl), mak0strfrom(name),
				 SSL_FILETYPE_ASN1);
  else 
    b = SSL_CTX_use_certificate_file(GET_SSL_CTX(ssl), mak0strfrom(name),
				     SSL_FILETYPE_ASN1);
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_use_cert_file__PEM[] = MOD "use-certificate-from-pem-file!";
static SCM p_SSL_use_cert_file__PEM(SCM ssl, SCM name)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_use_cert_file__PEM);
  ASSERT(STRINGP(name), name, ARG2, s_SSL_use_cert_file__PEM);
  if (SSL_P(ssl))
    b = SSL_use_certificate_file(GET_SSL(ssl), mak0strfrom(name),
				 SSL_FILETYPE_PEM);
  else
    b = SSL_CTX_use_certificate_file(GET_SSL_CTX(ssl), mak0strfrom(name),
				     SSL_FILETYPE_PEM);
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_state_string[] = MOD "state";
static SCM p_SSL_state_string(SCM ssl, SCM l)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_state_string);
  if (NFALSEP(l) && !UNBNDP(l))
    return makfrom0str(SSL_state_string_long(GET_SSL(ssl)));
  else
    return makfrom0str(SSL_state_string(GET_SSL(ssl)));
}

static char s_SSL_rstate_string[] = MOD "read-state";
static SCM p_SSL_rstate_string(SCM ssl, SCM l)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_rstate_string);
  if (NFALSEP(l) && !UNBNDP(l))
    return makfrom0str(SSL_rstate_string_long(GET_SSL(ssl)));
  else
    return makfrom0str(SSL_rstate_string(GET_SSL(ssl)));
}

static char s_SSL_get_time[] = MOD "time";
static SCM p_SSL_get_time(SCM session)
{
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG1, s_SSL_get_time);
  return long2num(SSL_get_time(GET_SSL_SESSION(session)));
}

static char s_SSL_set_time[] = MOD "set-time!";
static SCM p_SSL_set_time(SCM session, SCM t)
{
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG1, s_SSL_set_time);
  ASSERT(NUMBERP(t), t, ARG2, s_SSL_set_time);
  return long2num(SSL_set_time(GET_SSL_SESSION(session), num2long(t)));
}

static char s_SSL_get_timeout[] = MOD "timeout";
static SCM p_SSL_get_timeout(SCM session)
{
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG1, s_SSL_get_timeout);
  return long2num(SSL_get_timeout(GET_SSL_SESSION(session)));
}

static char s_SSL_set_timeout[] = MOD "set-timeout!";
static SCM p_SSL_set_timeout(SCM session, SCM t)
{
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG1, s_SSL_set_timeout);
  ASSERT(NUMBERP(t), t, ARG2, s_SSL_set_timeout);
  return long2num(SSL_set_timeout(GET_SSL_SESSION(session), num2long(t)));
}

static char s_SSL_copy_session_id[] = MOD "copy-session-id!";
static SCM p_SSL_copy_session_id(SCM to, SCM from)
{
  ASSERT(VALID_SSL_P(to), to, ARG1, s_SSL_copy_session_id);
  ASSERT(VALID_SSL_P(from), from, ARG2, s_SSL_copy_session_id);
  SSL_copy_session_id(GET_SSL(to), GET_SSL(from));
  return UNSPECIFIED;
}

static char s_SSL_SESSION_new[] = MOD "make-session";
static SCM p_SSL_SESSION_new(void)
{
  return MAKE_SSL_SESSION(SSL_SESSION_new());
}

static char s_SSL_SESSION_print[] = MOD "print-session-information";
static SCM p_SSL_SESSION_print(SCM session)
{
  BIO *b;
  char *p;
  int l;

  ASSERT(VALID_SSL_SESSION_P(session), session, ARG1, s_SSL_SESSION_print);
  b = BIO_new(BIO_s_mem());
  if (b == NULL)
    wta(BOOL_F, NALLOC, s_SSL_SESSION_print);
  SSL_SESSION_print(b, GET_SSL_SESSION(session));
  l = BIO_ctrl(b, BIO_CTRL_INFO, 0, (char *)&p);
  return display(makfromstr(p, l), cur_output_port());
}

static char s_SSL_SESSION_free[] = MOD "free-session!";
static SCM p_SSL_SESSION_free(SCM session)
{
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG1, s_SSL_SESSION_free);
  SSL_SESSION_free(GET_SSL_SESSION(session));
  /* mark as invalid. */
  GET_SSL_SESSION(session) = NULL;
  return UNSPECIFIED;
}

static char s_i2d_SSL_SESSION[] = MOD "session->der-string";
static SCM p_i2d_SSL_SESSION(SCM session)
{
  int len;
  unsigned char *p, *p2;
  SCM result;
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG1, s_i2d_SSL_SESSION);
  len = i2d_SSL_SESSION(GET_SSL_SESSION(session), NULL);
  p = p2 = malloc(len);
  if (p == NULL)
    wta(BOOL_F, NALLOC, s_i2d_SSL_SESSION);
  i2d_SSL_SESSION(GET_SSL_SESSION(session), &p2);
  result = makfromstr(p, len);
  free(p);
  return result;
}

static char s_SSL_set_session[] = MOD "set-session!";
static SCM p_SSL_set_session(SCM to, SCM session)
{
  ASSERT(VALID_SSL_P(to), to, ARG1, s_SSL_set_session);
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG2, s_SSL_set_session);
  return (SSL_set_session(GET_SSL(to), GET_SSL_SESSION(session))
	  ? BOOL_T : BOOL_F);
}

static char s_SSL_CTX_add_session[] = MOD "add-session-to-context!";
static SCM p_SSL_CTX_add_session(SCM ctx, SCM session)
{
  ASSERT(VALID_SSL_CTX_P(ctx), ctx, ARG1, s_SSL_CTX_add_session);
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG2, s_SSL_CTX_add_session);
  return (SSL_CTX_add_session(GET_SSL_CTX(ctx), GET_SSL_SESSION(session))
	  ? BOOL_T : BOOL_F);
}

static char s_SSL_CTX_remove_session[] = MOD "remove-session-from-context!";
static SCM p_SSL_CTX_remove_session(SCM ctx, SCM session)
{
  ASSERT(VALID_SSL_CTX_P(ctx), ctx, ARG1, s_SSL_CTX_remove_session);
  ASSERT(VALID_SSL_SESSION_P(session), session, ARG2,
	 s_SSL_CTX_remove_session);
  return (SSL_CTX_remove_session(GET_SSL_CTX(ctx), GET_SSL_SESSION(session))
	  ? BOOL_T : BOOL_F);
}

static char s_d2i_SSL_SESSION[] = MOD "der-string->session";
static SCM p_d2i_SSL_SESSION(SCM str)
{
  unsigned char *p = (unsigned char *)CHARS(str);
  ASSERT(STRINGP(str), str, ARG1, s_d2i_SSL_SESSION);
  return MAKE_SSL_SESSION(d2i_SSL_SESSION(NULL, &p, LENGTH(str)));
}  

static char s_SSL_get_peer_certificate[] = MOD "peer-certificate";
static SCM p_SSL_get_peer_certificate(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_peer_certificate);
  return MAKE_X509(SSL_get_peer_certificate(GET_SSL(ssl)));
}

static char s_SSL_get_peer_cert_chain[] = MOD "peer-certificate-chain";
static SCM p_SSL_get_peer_cert_chain(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_peer_cert_chain);
  return STACK_to_list(SSL_get_peer_cert_chain(GET_SSL(ssl)), cp_to_X509);
}

static char s_SSL_check_private_key[] = MOD "check-private-key";
static SCM p_SSL_check_private_key(SCM ssl)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_check_private_key);
  if (SSL_P(ssl))
    b = SSL_check_private_key(GET_SSL(ssl));
  else
    b = SSL_CTX_check_private_key(GET_SSL_CTX(ssl));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_new[] = MOD "make";
#if 1
static SCM p_SSL_new(SCM ctx, SCM ptob)
{
  SSL *ssl;
  BIO *b;
  ASSERT(VALID_SSL_CTX_P(ctx), ctx, ARG1, s_SSL_new);
  ASSERT(PORTP(ptob), ptob, ARG2, s_SSL_new);
  ssl = SSL_new(GET_SSL_CTX(ctx));
  b = ptob_to_bio(ptob);
  if (ssl != NULL)
    SSL_set_bio(ssl, b, b);
  return MAKE_SSL(ssl);
}
#else
static SCM p_SSL_new(SCM ctx, SCM ptob)
{
  SSL *ssl;
  ASSERT(VALID_SSL_CTX_P(ctx), ctx, ARG1, s_SSL_new);
  ASSERT(ITCPP(ptob), ptob, ARG2, s_SSL_new);
  ssl = SSL_new(GET_SSL_CTX(ctx));
  if (ssl != NULL)
    SSL_set_fd(ssl, ((tcpobj *)CDR(ptob))->fd);
  return MAKE_SSL(ssl);
}
#endif

static char s_SSL_free[] = MOD "free!";
static SCM p_SSL_free(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_free);
  SSL_free(GET_SSL(ssl));
  GET_SSL(ssl) = NULL;
  return UNSPECIFIED;
}

#if 1
static SCM p_SSL_accept_or_connect(SCM ssl, SCM timeout, int (*func)(SSL *),
				   char *name)
{
  int r;
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, name);
  ASSERT(UNBNDP(timeout)||NUMBERP(timeout), timeout, ARG2, name);

  if (NUMBERP(timeout)) {
    tv.tv_sec = num2long(timeout);
    tv.tv_usec = 0;
    tvp = &tv;
  } else {
    tvp = NULL;
  }
  r = func(GET_SSL(ssl));
  tv.tv_sec = tv.tv_usec = 0;
  tvp = &tv;
  return ((r >= 0) ? BOOL_T : BOOL_F);
}
#else
#ifdef SIGALRM
static int alarmsockfd = -1;

static RETSIGTYPE alarmhandler(int n) {
  /* This isn't strictly kosher, but I don't see a better alternative. */
  if (alarmsockfd >= 0) {
    fcntl(alarmsockfd, F_SETFL, fcntl(alarmsockfd, F_GETFL) | O_NONBLOCK);
  }
}
#endif

static SCM p_SSL_accept_or_connect(SCM ssl, SCM timeout, int (*func)(SSL *),
				   char *name)
{
#ifdef SIGALRM
#ifdef HAVE_SIGACTION
  struct sigaction act, oldact;
  sigset_t s;
#else
  RETSIGTYPE (*oldhandler)(int);
#endif
#endif

  long oldflags;
  int r, t, fd = -1;
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, name);
  ASSERT(UNBNDP(timeout)||NUMBERP(timeout), timeout, ARG2, name);

  if (NUMBERP(timeout)) {
    /* This is *really* gross, but SSLeay deals poorly with non-blocking
       I/O in this case. :-( */
    if ((SSL_get_rbio(GET_SSL(ssl))->method == &methods_bio_ptob)
	&& ITCPP(SSL_get_rbio(GET_SSL(ssl))->num))
      fd = ((tcpobj *)CDR(SSL_get_rbio(GET_SSL(ssl))->num))->fd;
    else
      fd = SSL_get_fd(GET_SSL(ssl));
  }
  if (fd > 0) {
    oldflags = fcntl(fd, F_GETFL);
    fcntl(fd, F_SETFL, oldflags & ~O_NONBLOCK);
#ifdef SIGALRM
    t = num2long(timeout);
    if (t > 0) {
      alarmsockfd = fd;
#ifdef HAVE_SIGACTION
      memset(&act, 0, sizeof(struct sigaction));
      act.sa_handler = alarmhandler;
      sigfillset(&s);
      act.sa_mask = s;
#ifdef SA_ONESHOT
      act.sa_flags = SA_ONESHOT;
#endif
      sigaction(SIGALRM, &act, &oldact);
#else
      oldhandler = signal(SIGALRM, alarmhandler);
#endif /* !HAVE_SIGACTION */
      alarm(t);
    }
#endif /* SIGALRM */
  }
  r = func(GET_SSL(ssl));
#ifdef SIGALRM
  alarm(0);
  alarmsockfd = -1;
#ifdef HAVE_SIGACTION
  sigaction(SIGALRM, &oldact, NULL);
#else
  signal(SIGALRM, oldhandler);
#endif
#endif
  if (fd > 0)
    fcntl(fd, F_SETFL, oldflags);
  return ((r >= 0) ? BOOL_T : BOOL_F);
}
#endif

static char s_SSL_accept[] = MOD "accept";
static SCM p_SSL_accept(SCM ssl, SCM timeout)
{
  return p_SSL_accept_or_connect(ssl, timeout, SSL_accept, s_SSL_accept);
}

static char s_SSL_connect[] = MOD "connect";
static SCM p_SSL_connect(SCM ssl, SCM timeout)
{
  return p_SSL_accept_or_connect(ssl, timeout, SSL_connect, s_SSL_connect);
}


static char s_SSL_peek[] = MOD "peek";
static SCM p_SSL_peek(SCM ssl, SCM n)
{
  char *s, i;
  SCM result;
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_peek);
  ASSERT(NUMBERP(n), n, ARG2, s_SSL_peek);
  s = malloc(n+1);
  if (s == NULL)
    wta(n, NALLOC, s_SSL_peek);
  i = SSL_peek(GET_SSL(ssl), s, n);
  if (i > 0) {
    result = makfromstr(s, i);
    free(s);
    return result;
  } else {
    free(s);
    return BOOL_F;
  }
}

/* SSL_ctrl ??? */

static char s_SSL_get_version[] = MOD "version";
static SCM p_SSL_get_version(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_version);
  return makfrom0str(SSL_get_version(GET_SSL(ssl)));
}



static char s_SSLv2_method[] = MOD "v2-method";
static SCM p_SSLv2_method(void) 
{
  return MAKE_SSL_METHOD(SSLv2_method());
}

static char s_SSLv2_server_method[] = MOD "v2-server-method";
static SCM p_SSLv2_server_method(void) 
{
  return MAKE_SSL_METHOD(SSLv2_server_method());
}

static char s_SSLv2_client_method[] = MOD "v2-client-method";
static SCM p_SSLv2_client_method(void) 
{
  return MAKE_SSL_METHOD(SSLv2_client_method());
}

static char s_SSLv3_method[] = MOD "v3-method";
static SCM p_SSLv3_method(void) 
{
  return MAKE_SSL_METHOD(SSLv3_method());
}

static char s_SSLv3_server_method[] = MOD "v3-server-method";
static SCM p_SSLv3_server_method(void) 
{
  return MAKE_SSL_METHOD(SSLv3_server_method());
}

static char s_SSLv3_client_method[] = MOD "v3-client-method";
static SCM p_SSLv3_client_method(void) 
{
  return MAKE_SSL_METHOD(SSLv3_client_method());
}

static char s_SSLv23_method[] = MOD "v23-method";
static SCM p_SSLv23_method(void) 
{
  return MAKE_SSL_METHOD(SSLv23_method());
}

static char s_SSLv23_server_method[] = MOD "v23-server-method";
static SCM p_SSLv23_server_method(void) 
{
  return MAKE_SSL_METHOD(SSLv23_server_method());
}

static char s_SSLv23_client_method[] = MOD "v23-client-method";
static SCM p_SSLv23_client_method(void) 
{
  return MAKE_SSL_METHOD(SSLv23_client_method());
}

static char s_SSL_get_ciphers[] = MOD "ciphers";
static SCM p_SSL_get_ciphers(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_ciphers);

  return STACK_to_list(SSL_get_ciphers(GET_SSL(ssl)), cp_to_SSL_CIPHER);
}

static char s_SSL_do_handshake[] = MOD "do-handshake";
static SCM p_SSL_do_handshake(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_do_handshake);

  return ((SSL_do_handshake(GET_SSL(ssl)) == 1) ? BOOL_T : BOOL_F);
}

static char s_SSL_renegotiate[] = MOD "renegotiate!";
static SCM p_SSL_renegotiate(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_renegotiate);

  return (SSL_renegotiate(GET_SSL(ssl)) ? BOOL_T : BOOL_F);
}

static char s_SSL_shutdown[] = MOD "shutdown!";
static SCM p_SSL_shutdown(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_shutdown);

  return (SSL_shutdown(GET_SSL(ssl)) ? BOOL_T : BOOL_F);
}

static char s_SSL_get_ssl_method[] = MOD "method";
static SCM p_SSL_get_ssl_method(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_ssl_method);

  return MAKE_SSL_METHOD(SSL_get_ssl_method(GET_SSL(ssl)));
}

static char s_SSL_set_ssl_method[] = MOD "set-method!";
static SCM p_SSL_set_ssl_method(SCM ssl, SCM method)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_set_ssl_method);
  ASSERT(VALID_SSL_METHOD_P(method), method, ARG2, s_SSL_set_ssl_method);

  return (SSL_set_ssl_method(GET_SSL(ssl), GET_SSL_METHOD(method))
	  ? BOOL_T : BOOL_F);
}

static char s_SSL_load_client_CA_file[] = MOD "load-client-ca-file";
static SCM p_SSL_load_client_CA_file(SCM file)
{
  ASSERT(STRINGP(file), file, ARG1, s_SSL_load_client_CA_file);
  return MAKE_SSL_CA_STACK(SSL_load_client_CA_file(mak0strfrom(file)));
}

static char s_SSL_set_client_CA_list[] = MOD "set-client-ca-list!";
static SCM p_SSL_set_client_CA_list(SCM ssl, SCM cal)
{
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_set_client_CA_list);
  ASSERT(VALID_SSL_CA_STACK_P(cal), cal, ARG2, s_SSL_set_client_CA_list);
  if (SSL_P(ssl))
    SSL_set_client_CA_list(GET_SSL(ssl), GET_SSL_CA_STACK(cal));
  else
    SSL_CTX_set_client_CA_list(GET_SSL_CTX(ssl), GET_SSL_CA_STACK(cal));
  return UNSPECIFIED;
}

static char s_SSL_get_client_CA_list[] = MOD "client-ca-list";
static SCM p_SSL_get_client_CA_list(SCM ssl)
{
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_get_client_CA_list);
  if (SSL_P(ssl))
    return MAKE_SSL_CA_STACK(SSL_get_client_CA_list(GET_SSL(ssl)));
  else
    return MAKE_SSL_CA_STACK(SSL_CTX_get_client_CA_list(GET_SSL_CTX(ssl)));
}

static char s_SSL_add_client_CA[] = MOD "add-client-ca!";
static SCM p_SSL_add_client_CA(SCM ssl, SCM x509)
{
  int b;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_add_client_CA);
  ASSERT(VALID_X509_P(x509), x509, ARG2, s_SSL_add_client_CA);
  if (SSL_P(ssl))
    b = SSL_add_client_CA(GET_SSL(ssl), GET_X509(x509));
  else
    b = SSL_CTX_add_client_CA(GET_SSL_CTX(ssl), GET_X509(x509));
  return (b ? BOOL_T : BOOL_F);
}

static char s_SSL_set_connect_state[] = MOD "set-connect-state!";
static SCM p_SSL_set_connect_state(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_set_connect_state);
  SSL_set_connect_state(GET_SSL(ssl));
  return UNSPECIFIED;
}

static char s_SSL_set_accept_state[] = MOD "set-accept-state!";
static SCM p_SSL_set_accept_state(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_set_accept_state);
  SSL_set_accept_state(GET_SSL(ssl));
  return UNSPECIFIED;
}

static char s_SSL_get_default_timeout[] = MOD "default-timeout";
static SCM p_SSL_get_default_timeout(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_default_timeout);
  return long2num(SSL_get_default_timeout(GET_SSL(ssl)));
}

static char s_SSL_CIPHER_description[] = MOD "cipher-description";
static SCM p_SSL_CIPHER_description(SCM ciph)
{
  char buf[128];
  ASSERT(VALID_SSL_CIPHER_P(ciph), ciph, ARG1, s_SSL_CIPHER_description);
  return makfrom0str(SSL_CIPHER_description(GET_SSL_CIPHER(ciph),
					    buf, sizeof(buf)));
}

static char s_SSL_dup[] = MOD "copy";
static SCM p_SSL_dup(SCM x)
{
  ASSERT(VALID_SSL_P(x) || VALID_SSL_CA_STACK_P(x), x, ARG1, s_SSL_dup);
  if (SSL_P(x)) 
    return MAKE_SSL(SSL_dup(GET_SSL(x)));
  else
    return MAKE_SSL_CA_STACK(SSL_dup_CA_list(GET_SSL_CA_STACK(x)));
}

static char s_SSL_get_certificate[] = MOD "certificate";
static SCM p_SSL_get_certificate(SCM ssl)
{
  SSL *s;
  X509 *x;
  ASSERT(VALID_SSL_OR_CTX_P(ssl), ssl, ARG1, s_SSL_get_certificate);
  if (SSL_P(ssl))
    s = GET_SSL(ssl);
  else
    s = SSL_new(GET_SSL_CTX(ssl));
  x = SSL_get_certificate(s);
  if (!SSL_P(ssl))
    SSL_free(s);
  return MAKE_X509(x);
}

static char s_SSL_get_session[] = MOD "session";
static SCM p_SSL_get_session(SCM ssl)
{
  ASSERT(VALID_SSL_P(ssl), ssl, ARG1, s_SSL_get_session);
  return MAKE_SSL_SESSION(SSL_get_session(GET_SSL(ssl)));
}

static char s_kbFlush[] = MOD "kbflush";
static SCM p_kbFlush()
{
#if defined(HAVE_TCFLUSH)
	tcflush(0, TCIFLUSH);
#elif defined(TIOCFLUSH)
#ifndef FREAD
#define FREAD 1 /* The usual value */
#endif
	ioctl(0, TIOCFLUSH, FREAD);
#endif
	return UNSPECIFIED;
}

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

static iproc procs0[] = {
  PROCIFY(init)
  PROCIFY(ERR_get_errors)
  PROCIFY(RAND_get_randBits)
  PROCIFY(RAND_slow_poll)
  PROCIFY(SSL_SESSION_new)
  PROCIFY(SSLv2_method)
  PROCIFY(SSLv2_server_method)
  PROCIFY(SSLv2_client_method)
  PROCIFY(SSLv3_method)
  PROCIFY(SSLv3_server_method)
  PROCIFY(SSLv3_client_method)
  PROCIFY(SSLv23_method)
  PROCIFY(SSLv23_server_method)
  PROCIFY(SSLv23_client_method)
  PROCIFY(kbFlush)
  DONE
};

static iproc procs1[] = {
  PROCIFY(ssl_object_p)
  PROCIFY(ssl_cipher_p)
  PROCIFY(ssl_method_p)
  PROCIFY(ssl_compression_p)
  PROCIFY(ssl_session_p)
  PROCIFY(ssl_ctx_p)
  PROCIFY(x509_p)
  PROCIFY(ssl_ca_stack_p)
  PROCIFY(rsa_p)
  PROCIFY(valid_ssl_ca_stack_p)
  PROCIFY(valid_ssl_object_p)
  PROCIFY(valid_ssl_cipher_p)
  PROCIFY(valid_ssl_method_p)
  PROCIFY(valid_ssl_compression_p)
  PROCIFY(valid_ssl_session_p)
  PROCIFY(valid_ssl_ctx_p)
  PROCIFY(valid_x509_p)
  PROCIFY(valid_ssl_ca_stack_p)
  PROCIFY(valid_rsa_p)
  PROCIFY(ssl_p)
  PROCIFY(valid_ssl_p)
  PROCIFY(RAND_seed)
  PROCIFY(RAND_bytes)
  PROCIFY(RAND_set_randBits)
  PROCIFY(RAND_eat_randBits)
  PROCIFY(SSL_is_init_finished)
  PROCIFY(SSL_in_accept_init)
  PROCIFY(ssl_accepted_p)
  PROCIFY(ssl_connected_p)
  PROCIFY(ssl_packet)
  PROCIFY(ssl_ctx_trace)
  PROCIFY(x509_md5_fingerprint)
  PROCIFY(d2i_X509)
  PROCIFY(RSA_free)
  PROCIFY(d2i_RSAPublicKey)
  PROCIFY(i2d_RSAPublicKey)
  PROCIFY(d2i_RSAPrivateKey)
  PROCIFY(i2d_RSAPrivateKey)
  PROCIFY(x509__rsa_public_key)
  PROCIFY(md5_fingerprint)
  PROCIFY(md5_hash)
  PROCIFY(sha1_fingerprint)
  PROCIFY(sha1_hash)
  PROCIFY(SSL_CTX_new)
  PROCIFY(SSL_CTX_free)
  PROCIFY(SSL_clear)
  PROCIFY(SSL_get_current_cipher)
  PROCIFY(SSL_CIPHER_get_bits)
  PROCIFY(SSL_CIPHER_get_version)
  PROCIFY(SSL_CIPHER_get_name)
  PROCIFY(SSL_get_fd)
  PROCIFY(SSL_get_shared_ciphers)
  PROCIFY(SSL_get_read_ahead)
  PROCIFY(SSL_pending)
  PROCIFY(SSL_get_verify_mode)
  PROCIFY(SSL_get_time)
  PROCIFY(SSL_get_timeout)
  PROCIFY(SSL_SESSION_print)
  PROCIFY(SSL_SESSION_free)
  PROCIFY(i2d_SSL_SESSION)
  PROCIFY(d2i_SSL_SESSION)
  PROCIFY(SSL_get_peer_certificate)
  PROCIFY(SSL_get_peer_cert_chain)
  PROCIFY(SSL_check_private_key)
  PROCIFY(SSL_free)
  PROCIFY(SSL_get_version)
  PROCIFY(SSL_get_ciphers)
  PROCIFY(SSL_do_handshake)
  PROCIFY(SSL_renegotiate)
  PROCIFY(SSL_shutdown)
  PROCIFY(SSL_get_ssl_method)
  PROCIFY(SSL_load_client_CA_file)
  PROCIFY(SSL_get_client_CA_list)
  PROCIFY(SSL_set_connect_state)
  PROCIFY(SSL_set_accept_state)
  PROCIFY(SSL_get_default_timeout)
  PROCIFY(SSL_CIPHER_description)
  PROCIFY(SSL_dup)
  PROCIFY(SSL_get_certificate)
  PROCIFY(SSL_get_session)
  DONE
};

static iproc procs2o[] = {
  PROCIFY(RSA_generate_key)
  PROCIFY(SSL_state_string)
  PROCIFY(SSL_rstate_string)
  PROCIFY(SSL_accept)
  PROCIFY(SSL_connect)
  DONE
};

static iproc procs2[] = {
  PROCIFY(RAND_force_entropy)
  PROCIFY(RSA_sign__md5)
  PROCIFY(RSA_sign__sha1)
  PROCIFY(RSA_public_encrypt)
  PROCIFY(RSA_private_encrypt)
  PROCIFY(RSA_public_decrypt)
  PROCIFY(RSA_private_decrypt)
  PROCIFY(SSL_CTX_flush_sessions)
#if 0
  PROCIFY(SSL_get_cipher_list)
#endif
  PROCIFY(SSL_set_cipher_list)
  PROCIFY(SSL_set_read_ahead)
  PROCIFY(SSL_set_verify)
  PROCIFY(SSL_use_RSAPrivateKey_ASN1)
  PROCIFY(SSL_use_RSAPrivateKey)
  PROCIFY(SSL_use_RSAPrivateKey_file__ASN1)
  PROCIFY(SSL_use_PrivateKey_ASN1__DSA)
  PROCIFY(SSL_use_PrKey_file__PEM)
  PROCIFY(SSL_use_certificate)
  PROCIFY(SSL_use_certificate_ASN1)
  PROCIFY(SSL_use_cert_file__ASN1)
  PROCIFY(SSL_use_cert_file__PEM)
  PROCIFY(SSL_set_time)
  PROCIFY(SSL_set_timeout)
  PROCIFY(SSL_copy_session_id)
  PROCIFY(SSL_set_session)
  PROCIFY(SSL_CTX_add_session)
  PROCIFY(SSL_CTX_remove_session)
  PROCIFY(SSL_new)
  PROCIFY(SSL_peek)
  PROCIFY(SSL_set_ssl_method)
  PROCIFY(SSL_set_client_CA_list)
  PROCIFY(SSL_add_client_CA)
  DONE
};

static iproc procs3[] = {
  PROCIFY(RSA_verify__md5)
  PROCIFY(RSA_verify__sha1)
  DONE
};

void init_ssleay()
{
  tc16_ssl_object = newsmob(&sslsmob);
  tc16_ssl = newptob(&sslptob);
  init_iprocs(procs0,  tc7_subr_0);
  init_iprocs(procs1,  tc7_subr_1);
  init_iprocs(procs2o, tc7_subr_2o);
  init_iprocs(procs2,  tc7_subr_2);
  init_iprocs(procs3,  tc7_subr_3);
  make_gsubr(s_ssl_make_cert, 3, 2, 0, p_ssl_make_cert);
  add_feature("ssl");
}
