/** -*-C-*-ish
    Kaya standard library
    Copyright (C) 2006 Chris Morris

    This file is distributed under the terms of the GNU Lesser General
    Public Licence. See COPYING for licence.
*/
"<summary>TLS network connection encryption</summary>
<prose>This module provides TLS network encryption. The functions in this module are called by the <moduleref>Net</moduleref> module and cannot usefully be used directly.</prose>
<prose>TLS encryption is only useful if the identity of the server connected to can be verified. The various networking functions in the <moduleref>Net</moduleref> and <moduleref>HTTP</moduleref> modules allow a list of certificate files to be specified. On POSIX systems, Certification Authority certificates are often stored in the <code>/etc/ssl/certs</code> directory, and if the signer of the server certificate is not known in advance, you may wish to specify many or all of the <code>.pem</code> files in this directory that correspond to CAs that you trust.</prose>"
module TLS;

import Prelude;
import Binary;

%include "tls_glue.h";
%include "gnutls/gnutls.h";
%imported "tls_glue";
%link "gnutls";
%link "gcrypt"; // needed for minGW, harmless on POSIX

"<summary>A TLS connection session</summary>
<prose>A TLS connection session</prose>"
abstract data TLSsession(Ptr sess, Ptr conn, Ptr cred);

"<argument>The argument is an error code from GNU TLS</argument> 
<summary>TLS handshake failed</summary>
<prose>This Exception will be thrown if the TLS connection cannot be established.</prose>"
Exception TLSFailed(Int err);

"<summary>TLS timeout</summary>
<prose>This Exception will be thrown if the TLS connection times out.</prose>"
Exception TLSTimeout;


"<argument>The argument is a description of the error</argument> 
<summary>TLS peer verification failed</summary>
<prose>This Exception will be thrown if verification of the TLS connection in <functionref>verifyCertificate</functionref> fails.</prose>"
Exception VerifyFailed(String err);

"<summary>TLS certificate acceptance failed</summary>
<prose>This Exception will be thrown if a TLS certificate file was invalid.</prose>"
Exception AcceptCertificateFailed;


foreign "tls_glue.o" {
  Void global_init_TLS() = gnutls_global_init;
  Ptr init_TLS(Ptr cred) = do_gnutls_init;
  Ptr initcred_TLS() = do_gnutls_makecred;
  Int assign_TLS(Ptr tls, Ptr conn) = do_gnutls_transport;
  Void put_TLS(Ptr tls, String toput) = do_gnutls_put;
  Void put_TLSbin(Ptr tls, Ptr toput, Int len) = do_gnutls_putbin;
  Void put_TLSbyte(Ptr tls, Int toput) = do_gnutls_putbyte;
  String get_TLS(Ptr tls, Ptr vm, Int len) = do_gnutls_get;
  Int get_TLSByte(Ptr tls, Ptr vm) = do_gnutls_getbyte;
  Ptr get_TLSBytes(Ptr tls, Ptr vm, a len) = do_gnutls_getbin;
  Void close_TLS(Ptr tls, Ptr cred) = do_gnutls_close;
  Void do_addcert(Ptr vm, Ptr cred, String fn) = do_addcert;
  Void do_verifycert(Ptr vm, Ptr sess, String host) = do_verifycert;
}

"<argument name='conn'>A pointer to the network connection resource</argument>
<summary>Initialise a TLS connection</summary>
<prose>Initialise a TLS connection. Called by <functionref>Net::connect</functionref> when the <code>usetls</code> parameter is true.</prose>
<related><functionref>acceptCertificate</functionref></related>
<related><functionref>verifyCertificate</functionref></related>"
public TLSsession makeTLS(Ptr conn) {
  global_init_TLS();
  cred = initcred_TLS();
  tls = init_TLS(cred);
  err = assign_TLS(tls,conn);
  if (err < 0) {
    throw(TLSFailed(err));
  }
  return TLSsession(tls,conn,cred);
}

"<argument name='session'>An open TLS Session</argument>
<argument name='certfile'>A file containing one or more PEM-encoded Certification Authority certificates.</argument>
<summary>Accept certificates.</summary>
<prose>Accept the certificates in the given file as signing certificates for the current connection.</prose>
<related><functionref>verifyCertificate</functionref></related>"
public Void acceptCertificate(TLSsession session, String certfile) {
  try {
    do_addcert(getVM(),session.cred,certfile);
  } catch(e) {
    throw(AcceptCertificateFailed);
  }
}

"<argument name='session'>An open TLS session</argument>
<argument name='hostname'>The hostname of the server connected to. This may be left blank, in which case only the validity of the certificate will be checked. It is much more secure to specify a hostname, so that it can be confirmed that the host connected to is the expected one.</argument>
<summary>Verify a server's certificate</summary>
<prose>Verify that the server connected to has a valid server certificate. This should be called before sending or receiving confidential data on the connection.</prose>
<related><functionref>acceptCertificate</functionref></related>"
public Void verifyCertificate(TLSsession session, String hostname="") {
  try {
    do_verifycert(getVM(),session.sess,hostname);
  } catch(InternalError(code)) {
    case code of {
      1 -> throw(VerifyFailed("Unexpected verification error"));
      | 2 -> throw(VerifyFailed("Signature was invalid"));
      | 3 -> throw(VerifyFailed("Certificate was revoked"));
      | 4 -> throw(VerifyFailed("Certificate signer untrusted"));
      | 5 -> throw(VerifyFailed("Hostname mismatch"));
      | 6 -> throw(VerifyFailed("Unexpected hostname verification error"));
    }
  }
}

"<argument name='tls'>A TLS session</argument>
<argument name='toput'>The unencrypted data to send</argument>
<summary>Send encrypted data</summary>
<prose>Send encrypted data. This function is called by <code>Net::send</code> as necessary.</prose>"
public Void putTLS(TLSsession tls, String toput) {
  put_TLS(tls.sess,toput);
}

"<argument name='tls'>A TLS session</argument>
<argument name='toput'>The unencrypted data to send (as a <dataref>Binary::Binary</dataref> set of bytes)</argument>
<summary>Send encrypted binary data</summary>
<prose>Send encrypted binary data. This function is called by <code>Net::sendBytes</code> as necessary.</prose>"
public Void putTLSBytes(TLSsession tls, Binary toput) {
  put_TLSbin(tls.sess,blockData(toput),blockSize(toput));
}

"<argument name='tls'>A TLS session</argument>
<argument name='toput'>The unencrypted byte to send</argument>
<summary>Send a single encrypted byte</summary>
<prose>Send a single encrypted byte. This function is called by <code>Net::sendByte</code> as necessary.</prose>"
public Void putTLSByte(TLSsession tls, Int toput) {
  put_TLSbyte(tls.sess,toput);
}

"<argument name='tls'>A TLS session</argument>
<argument name='iiscompensation'>Whether to compensate for bugs in the HTTPS handling in Microsoft IIS servers (optional, defaults to false)</argument>
<summary>Receive encrypted data</summary>
<prose>Receive encrypted data. This function is called by <code>Net::recv</code> as necessary.</prose>"
public String getTLS(TLSsession tls, Bool iiscompensation=false, Int maxlen=-1, Int timeout=0, Bool(Int) checktimeout) {
  output = "";
  if (maxlen==-1) {
    do {
      if (timeout==0 || checktimeout(timeout)) {
	temp = doTLSrecv(tls,iiscompensation,4096);
	output += temp;
      } else {
	if (output == "") {
	  throw(TLSTimeout);
	}
	temp = "";
      }
    } while (temp != "");
  } else {
    if (timeout==0 || checktimeout(timeout)) {
      output += doTLSrecv(tls,iiscompensation,4096);
    } else {
      throw(TLSTimeout);
    }
  }
  return output;
}

String doTLSrecv(TLSsession tls, Bool iiscompensation, Int maxlen) {
  vm = getVM();

  if (!iiscompensation) {
    temp = get_TLS(tls.sess,vm,maxlen);
  } else {
    try {
      temp = get_TLS(tls.sess,vm,maxlen);
    } catch(InternalError(code)) {
      if (code == -9) {
	temp = "";
      } else {
	throw(TLSFailed(code)); // re-throw, it's not the expected error
      }
    }
  }
  return temp;
}

"<argument name='tls'>A TLS session</argument>
<argument name='iiscompensation'>Whether to compensate for bugs in the HTTPS handling in Microsoft IIS servers (optional, defaults to false)</argument>
<summary>Receive encrypted binary data</summary>
<prose>Receive encrypted binary data. This function is called by <code>Net::recvBytes</code> as necessary.</prose>"
public Binary getTLSBytes(TLSsession tls, Bool iiscompensation=false) {
  vm = getVM();
  maxlen = 0;
  if (!iiscompensation) {
    ptr = get_TLSBytes(tls.sess,vm,maxlen);
  } else {
    try {
      ptr = get_TLSBytes(tls.sess,vm,maxlen);
    } catch(InternalError(code)) {
      if (code == -9) {
	return createBlock(0);
      } else {
	throw(TLSFailed(code)); // re-throw, it's not the expected error
      }
    }
  }
  return createInitialisedBlock(ptr,maxlen);
}

"<argument name='tls'>A TLS session</argument>
<argument name='iiscompensation'>Whether to compensate for bugs in the HTTPS handling in Microsoft IIS servers (optional, defaults to false)</argument>
<summary>Receive encrypted byte</summary>
<prose>Receive encrypted byte. This function is called by <code>Net::recvByte</code> as necessary. This function may return -1 if IIS bug compensation is on and the connection has been closed (if called via <code>recvByte</code> this will lead to a <exceptref>Net::NothingToReceive</exceptref> exception.</prose>"
public Int getTLSByte(TLSsession tls, Bool iiscompensation=false) {
  vm = getVM();
  if (!iiscompensation) {
    byte = get_TLSByte(tls.sess,vm);
  } else {
    try {
      byte = get_TLSByte(tls.sess,vm);
    } catch(InternalError(code)) {
      if (code == -9) {
	return -1;
      } else {
	throw(TLSFailed(code)); // re-throw, it's not the expected error
      }
    }
  }
  return byte;
}

"<argument name='tls'>A TLS session</argument>
<summary>Close TLS connection</summary>
<prose>Close a TLS connection. This function is called by <code>Net::closeConnection</code> as necessary.</prose>"
public Void closeTLS(TLSsession tls) {
  close_TLS(tls.sess,tls.cred);
}