/** -*-C-*-ish
    Kaya standard library
    Copyright (C) 2004, 2005 Edwin Brady

    This file is distributed under the terms of the GNU Lesser General
    Public Licence. See COPYING for licence.
*/
"<summary>Networking functions</summary>
<prose>This module contains functions for setting up TCP network connections and sending and receiving data, and listening on TCP ports. If <code>libgnutls</code> was available when Kaya was configured, then <moduleref>TLS</moduleref> may be used to set up encrypted connections.</prose>"
module Net;

import Builtins;
import System;
import Prelude;
// TODO: TLS currently available for client only, server support needed
import TLS;
import Binary;

%include "network_glue.h";
%include "unistd.h";
%imported "network_glue";
@NETLIB@%link "wsock32";

foreign "network_glue.o" {
    Void do_net_init(Ptr vm) = net_init;
    String net_recv(Ptr vm, Ptr handle, a len) = net_recv;
    Ptr net_recvchars(Ptr vm, Ptr handle, a len) = net_recvchars;
    Int net_recvbyte(Ptr vm, Ptr handle) = net_recvbyte;
    Ptr net_connect(Ptr vm, Int proto, String server, Int port) = net_connect;
    Bool net_connwaiting(Ptr vm, Int socket, Int timeout) = net_connwaiting;
    Int net_listen(Ptr vm, Int proto, Int port, Int backlog) = net_listen;
    Ptr net_accept(Ptr vm, Int socket) = net_accept;
    Void net_shutdown(Ptr h) = net_shutdown;
    Void net_close(Ptr vm, Ptr h) = net_close;
    Void close(Int x) = close;
    Void net_send(Ptr vm, Ptr h, String d) = net_send;
    Void net_sendchars(Ptr vm, Ptr h, Ptr d, Int len) = net_sendchars;
    Void net_sendbyte(Ptr vm, Ptr h, Int byte) = net_sendbyte;
    Bool net_pending(Ptr vm, Ptr h, Int timeout) = net_pending;
    String net_getaddr(Ptr h) = net_getaddr;
}

"<summary>Can't bind to port</summary>
<prose>This Exception is thrown when it is not possible to listen on a TCP port.</prose>"
Exception CantBind();
"<summary>Can't listen on port</summary>
<prose>This Exception is thrown when it is not possible to listed on a TCP port, but binding to the port was successful.</prose>"
Exception CantListen();
"<summary>Failed to accept connection</summary>
<prose>This Exception is thrown when a listening socket fails to accept a connection.</prose>"
Exception AcceptFailed();
"<summary>Sending data failed</summary>
<prose>This Exception is thrown when sending data to a network connection fails.</prose>"
Exception SendFailed();
"<summary>No data to receive</summary>
<prose>This Exception is thrown when no data is receivable on a network connection.</prose>"
Exception NothingToReceive();
"<summary>Testing connection failed</summary>
<prose>This Exception is thrown when an attempt to check if there is data waiting on a connection fails.</prose>"
Exception SelectError();
"<summary>Initialisation failed</summary>
<prose>This Exception is thrown if initialisation of the networking libraries failed.</prose>"
Exception CantInit();
"<summary>Protocol not supported</summary>
<prose>This Exception is thrown if the protocol chosen was not supported. Currently IPv6 is not supported.</prose>"
Exception ProtocolNotSupported();
"<summary>Host not known</summary>
<prose>The system was unable to look up the host in DNS.</prose>"
Exception CantGetHost();
"<summary>Connection failed</summary>
<prose>The connection to the remote host failed.</prose>"
Exception ConnectError();
"<summary>Close failed</summary>
<prose>An error occurred when trying to close a connection.</prose>"
Exception CloseError();
"<summary>Negative Length</summary>
<prose>A negative length was specified when receiving data.</prose>"
Exception NegativeLength();

Void netError(Int code)
{
    case code of {
	1 -> throw(CantBind);
	| 2 -> throw(CantListen);
	| 3 -> throw(AcceptFailed);
	| 4 -> throw(SendFailed);
	| 5 -> throw(NothingToReceive);
	| 6 -> throw(SelectError);
	| 7 -> throw(CantInit);
	| 8 -> throw(ProtocolNotSupported);
	| 9 -> throw(CantGetHost);
	| 10 -> throw(ConnectError);
	| 11 -> throw(CloseError);
	| default -> throw(InternalError(code));
    }
}

"<summary>A network connection</summary>
<prose>A network connection in use.</prose>"
abstract data NetHandle = NetH(Ptr handle, Maybe<TLSsession> tls, String hostname);

Int MAXCONN = 128;

"<summary>The protocol to use</summary>
<prose>The network protocol to use for connections. IPv6 is not currently supported.</prose>"
public data Protocol = TCP | TCP_IPv4 | TCP_IPv6;

globals {
    Bool initRun = netInit();
}

"<summary>Initialises networking libraries.</summary>
<prose>Initialises the networking libraries. This is called automatically when this module is imported, but is harmless to call again. On operating systems other than Windows, this function does nothing.</prose>"
public Bool netInit() {
    if (initRun) {
	return true;
    }
    try {
	do_net_init(getVM());
    } catch(InternalError(e)) {
	netError(e);
    }
    return true;
}

"<argument name='proto'>The network protocol to use</argument>
<argument name='server'>The hostname or IP address of the server to connect to (e.g. <code>service.example.com</code>, <code>localhost</code> or <code>192.168.20.25</code>)</argument>
<argument name='port'>The network port to connect to</argument>
<argument name='usetls'>If this is true, and the TLS library is available, then the connection will be encrypted. This parameter may be omitted and defaults to false.</argument>
<argument name='certs'>An optional list of certificate files for TLS encrypted connections. Each file should contain one or more PEM-encoded certificates for a trusted certification authority. If this list is empty (the default), no certificate verification will be performed on encrypted connections, which is insecure.</argument>
<summary>Connect to a server</summary>
<prose>Connect to a server (optionally using TLS). Returns a connection handle.</prose>
<related><dataref>NetHandle</dataref></related>
<related><dataref>Protocol</dataref></related>
<related><functionref>closeConnection</functionref></related>
<related><functionref>recv</functionref></related>
<related><functionref>shutdown</functionref></related>
<related><functionref>send</functionref></related>"
public NetHandle connect(Protocol proto, String server, Int port, Bool usetls=false, [String] certfiles=[])
{
    try{
	h = net_connect(getVM(),protocolToInt(proto),server,port);
	if (usetls) {
	    tls = makeTLS(h);
	    if (size(certfiles) > 0) {
	      for cf in certfiles {
		acceptCertificate(tls,cf);
	      }
	      verifyCertificate(tls,server);
	    }
	    return NetH(h,just(tls),server);
	} else {
	    return NetH(h,nothing,server);
	}
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='proto'>The network protocol to use</argument>
<argument name='port'>The port to listen on</argument>
<argument name='backlog'>The maximum number of unaccepted connections.</argument>
<summary>Listen on a port.</summary>
<prose>Listen on a port, returning a socket id.</prose>
<related><dataref>Protocol</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>closeSocket</functionref></related>"
public Int listen(Protocol proto, Int port, Int backlog)
{
    try {
	return net_listen(getVM(),protocolToInt(proto),port,backlog);
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"Return the Int representation of protocol needed by the C glue library."
Int protocolToInt(Protocol proto) = case proto of {
	TCP -> 1;
      | TCP_IPv4 -> 1;
      | TCP_IPv6 -> 2;
};

"<argument name='socket'>A socket number returned from <functionref>listen</functionref>.</argument>
<argument name='timeout'>The number of seconds to wait for a connection attempt before timing out (defaults to zero)</argument>
<summary>Check for connections waiting on a socket.</summary>
<prose>Returns whether any connections are waiting on a socket opened with <functionref>listen</functionref>.</prose>
<related><functionref>listen</functionref></related>
<related><functionref>accept</functionref></related>"
public Bool connWaiting(Int socket, Int timeout = 0) {
    try {
	return net_connwaiting(getVM(),socket,timeout*1000000);
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='socket'>A socket number returned from <functionref>listen</functionref>.</argument>
<summary>Accept a connection on a socket.</summary>
<prose>Accept a connection on a socket. Returns a connection handle. If no connections are currently waiting then an Exception will be thrown - you can call <functionref>connWaiting</functionref> first to determine if connections are available, although this may not be completely reliable in threaded applications.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>closeConnection</functionref></related>
<related><functionref>closeSocket</functionref></related>
<related><functionref>connWaiting</functionref></related>
<related><functionref>listen</functionref></related>
<related><functionref>recv</functionref></related>
<related><functionref>shutdown</functionref></related>
<related><functionref>send</functionref></related>"
public NetHandle accept(Int socket) {
    try {
	h = net_accept(getVM(),socket);
	return NetH(h,nothing,"");
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The handle to shut down</argument>
<summary>Shutdown a network handle.</summary>
<prose>Shutdown a network handle so that no further data can be sent or received.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>closeConnection</functionref></related>"
public Void shutdown(NetHandle h) {
    try {
	net_shutdown(h.handle);
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The handle to close</argument>
<summary>Close a connection handle.</summary>
<prose>Close a connection handle. You should always close connection handles once you have finished with them.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>connect</functionref></related>"
public Void closeConnection(NetHandle h) {
    try {
	case h.tls of {
	    nothing -> ;
	    | just(tls) -> closeTLS(tls);
	}
	net_close(getVM,h.handle);
    } catch(InternalError(e)) {
	netError(e);
    }
}

"<argument name='x'>The socket returned by <functionref>listen</functionref>.</argument>
<summary>Close a socket.</summary>
<prose>Stop listening on a socket and accept no further connections.</prose>
<related><functionref>listen</functionref></related>"
public Void closeSocket(Int x) {
    close(x);
}

"<argument name='h'>The connection</argument>
<argument name='d'>The data to send</argument>
<summary>Send data across a connection.</summary>
<prose>Send data across a connection. This function is not suitable for data containing null bytes, for which <functionref>sendByte</functionref> or <functionref>sendBytes</functionref> should be used.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>closeConnection</functionref></related>
<related><functionref>connect</functionref></related>
<related><functionref>sendByte</functionref></related>
<related><functionref>sendBytes</functionref></related>
<related><functionref>recv</functionref></related>"
public Void send(NetHandle h, String d) {
    try {
	case h.tls of {
	    nothing -> net_send(getVM(),h.handle,d);
	    | just(tls) -> putTLS(tls,d);
	}
    } catch(InternalError(e)) {
	netError(e);
    }
}

"<argument name='h'>The connection</argument>
<argument name='d'>The data to send</argument>
<summary>Send binary data across a connection.</summary>
<prose>Send binary data across a connection. This function does not yet support TLS connections.</prose>
<related><dataref>Binary::Binary</dataref></related>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>closeConnection</functionref></related>
<related><functionref>connect</functionref></related>
<related><functionref>send</functionref></related>
<related><functionref>sendByte</functionref></related>
<related><functionref>recv</functionref></related>"
public Void sendBytes(NetHandle h, Binary d) {
    try {
	case h.tls of {
	    nothing -> net_sendchars(getVM(),h.handle,blockData(d),blockSize(d));
	    | just(tls) -> putTLSBytes(tls,d);
	}
    } catch(InternalError(e)) {
	netError(e);
    }
}

"<argument name='h'>The connection</argument>
<argument name='byte'>The byte to send</argument>
<summary>Send a single byte across a connection.</summary>
<prose>Send a single byte across a connection. The Int passed should be between 0 and 255, or the results are unpredictable. This function does not yet support TLS connections.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>closeConnection</functionref></related>
<related><functionref>connect</functionref></related>
<related><functionref>send</functionref></related>
<related><functionref>sendBytes</functionref></related>
<related><functionref>recv</functionref></related>"
public Void sendByte(NetHandle h, Int byte) {
    try {
	case h.tls of {
	    nothing -> net_sendbyte(getVM(),h.handle,byte);
	    | just(tls) -> putTLSByte(tls,byte);
	}
    } catch(InternalError(e)) {
	netError(e);
    }
}

"<argument name='h'>The connection</argument>
<argument name='maxlen'>The maximum number of bytes to read (or unlimited, if negative). For TLS connections, this is always unlimited. Note that if the data to be received contains multi-byte characters, care must be taken to avoid ending receiving part-way through a multi-byte character.</argument>
<argument name='timeout'>The number of seconds to wait without input before timing out. The default is zero. For TLS connections, this parameter is ignored.</argument>
<summary>Recieve data from a connection.</summary>
<prose>Reads up to <variable>maxlen</variable> bytes from the connection, and times out after <variable>timeout</variable> seconds.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>connect</functionref></related>
<related><functionref>microPending</functionref></related>
<related><functionref>microRecv</functionref></related>
<related><functionref>pending</functionref></related>
<related><functionref>recvByte</functionref></related>
<related><functionref>recvBytes</functionref></related>
<related><functionref>send</functionref></related>"
public String recv(NetHandle h, Int maxlen = -1, Int timeout = 0) 
{
    try {
	case h.tls of {
	    nothing -> return dorecv(h, maxlen, timeout*1000000);
	    | just(tls) -> try {
	      return getTLS(tls,true,maxlen,timeout*1000000,microPending@(h)); // for now, set iiscompensation here
	    } catch(TLSTimeout) {
	      throw(NothingToReceive);
	    }
	}
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The connection</argument>
<argument name='maxlen'>The maximum number of bytes to read. This argument must be a positive integer</argument>
<argument name='timeout'>The number of microseconds to wait without input before timing out. The default is zero. <!-- For TLS connections, this parameter is ignored.--></argument>
<summary>Recieve binary data from a connection.</summary>
<prose>Reads up to <variable>maxlen</variable> bytes from the connection as binary data, and times out after <variable>timeout</variable> microseconds. This function does not yet support TLS connections.</prose>
<related><dataref>Binary::Binary</dataref></related>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>connect</functionref></related>
<related><functionref>microPending</functionref></related>
<related><functionref>microRecv</functionref></related>
<related><functionref>pending</functionref></related>
<related><functionref>recv</functionref></related>
<related><functionref>recvByte</functionref></related>
<related><functionref>send</functionref></related>"
public Binary recvBytes(NetHandle h, Int maxlen = 1024, Int timeout = 0) 
{
    if (maxlen < 1) {
        throw(NegativeLength);
    }
    try {
      if (timeout <= 0 || microPending(h,timeout)) {
	case h.tls of {
	    nothing -> ptr = net_recvchars(getVM,h.handle,maxlen);
	    return createInitialisedBlock(ptr,maxlen);
	    | just(tls) -> return getTLSBytes(tls,true); // for now, set iiscompensation here
	}
      } else {
	throw(NothingToReceive);
      }
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The connection</argument>
<argument name='timeout'>The number of microseconds to wait without input before timing out. The default is zero. <!--For TLS connections, this parameter is ignored.--></argument>
<summary>Recieve data from a connection.</summary>
<prose>Reads a single byte from the connection, and times out after <variable>timeout</variable> microseconds. This function does not yet support TLS connections.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>connect</functionref></related>
<related><functionref>microPending</functionref></related>
<related><functionref>microRecv</functionref></related>
<related><functionref>pending</functionref></related>
<related><functionref>recv</functionref></related>
<related><functionref>recvBytes</functionref></related>
<related><functionref>send</functionref></related>"
public Int recvByte(NetHandle h, Int timeout = 0) 
{
    try {
      if (timeout <= 0 || microPending(h,timeout)) {
	case h.tls of {
	    nothing -> return net_recvbyte(getVM,h.handle);
	    | just(tls) -> r = getTLSByte(tls,true); // for now, set iiscompensation here
	    if (r == -1) {
	      throw(NothingToReceive);
	    } else {
	      return r;
	    }
	}
      } else {
	throw(NothingToReceive);
      }
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The connection</argument>
<argument name='maxlen'>The maximum number of bytes to read (or unlimited, if negative). For TLS connections, this is always unlimited.</argument>
<argument name='timeout'>The number of microseconds to wait without input before timing out. The default is zero. For TLS connections, this parameter is ignored.</argument>
<summary>Recieve data from a connection.</summary>
<prose>Reads up to <variable>maxlen</variable> bytes from the connection, and times out after <variable>timeout</variable> microseconds. Apart from the units the timeout is measured in, this is otherwise identical to <functionref>recv</functionref></prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>connect</functionref></related>
<related><functionref>microPending</functionref></related>
<related><functionref>pending</functionref></related>
<related><functionref>recv</functionref></related>
<related><functionref>send</functionref></related>"
public String microRecv(NetHandle h, Int maxlen = -1, Int microtimeout = 0) 
{
    try {
	case h.tls of {
	    nothing -> return dorecv(h, maxlen, microtimeout);
	    | just(tls) -> return getTLS(tls,true,maxlen,microtimeout,microPending@(h));
	}
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

// timeout in microseconds
String dorecv(NetHandle h, Int maxlen = -1, Int timeout = 0) {
    try {
	len = maxlen;
	rpt = false;
	if (maxlen==-1) {
	    len = 65535; // Repeatedly read in 64k chunks.
	    rpt = true;
	}

	str="";
	do {
	    if (timeout<=0) {
		str += net_recv(getVM(),h.handle,len);
//	    putStrLn(str);
	    }
	    else {
		if (microPending(h,timeout)) {
		    str += net_recv(getVM(),h.handle,len);
		}
		else {
		    throw(NothingToReceive());
		}
	    }
	    if (len==0) { rpt=false; }
	}
	while (rpt);
	return str;
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The connection</argument>
<argument name='timeout'>The number of seconds to wait for data before timing out (defaults to five)</argument>
<summary>Return whether data is waiting at a socket.</summary>
<prose>Return whether data is waiting at a socket, returning true if so, and returning false if there is still no data after the timeout period.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>microPending</functionref></related>
<related><functionref>microRecv</functionref></related>
<related><functionref>recv</functionref></related>"
public Bool pending(NetHandle h, Int timeout = 5) {
    try {
	return net_pending(getVM(),h.handle,timeout*1000000);
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The connection</argument>
<argument name='timeout'>The number of microseconds to wait for data before timing out (defaults to 100)</argument>
<summary>Return whether data is waiting at a socket.</summary>
<prose>Return whether data is waiting at a socket, returning true if so, and returning false if there is still no data after the timeout period.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>microRecv</functionref></related>
<related><functionref>pending</functionref></related>
<related><functionref>recv</functionref></related>"
public Bool microPending(NetHandle h, Int timeout = 100) {
    try {
	return net_pending(getVM(),h.handle,timeout);
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}


"<argument name='h'>The connection handle</argument>
<summary>Get the host name from a connection handle.</summary>
<prose>Get the host name from a connection handle. This is most useful with connections created with <functionref>accept</functionref>.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>accept</functionref></related>
<related><functionref>connect</functionref></related>"
public String getHost(NetHandle h) {
    try {
	return net_getaddr(h.handle);
    } catch(InternalError(e)) {
	netError(e);
    }
    throw(InternalError(e));
}

"<argument name='h'>The connection handle</argument>
<argument name='certs'>An optional list of certificate files for TLS encrypted connections. Each file should contain one or more PEM-encoded certificates for a trusted certification authority. If this list is empty (the default), no certificate verification will be performed on encrypted connections, which is insecure.</argument>
<summary>Convert an existing connection to use TLS.</summary>
<prose>Begins TLS encryption on an existing connection equivilant to having set
usetls to true when creating it. Useful for secure SMTP connections. This function will fail silently if TLS encryption is already in use on the connection.</prose>
<prose>Note that this function is only designed for client connections started with <functionref>connect</functionref> rather than server connections from <functionref>accept</functionref>.</prose>
<related><dataref>NetHandle</dataref></related>
<related><functionref>connect</functionref></related>"
public Void startTLS(NetHandle h, [String] certfiles=[])
{
  case h.tls of {
    nothing -> try{
      tls = makeTLS(h.handle);
      if (size(certfiles) > 0) {
	for cf in certfiles {
	  acceptCertificate(tls,cf);
	}
	verifyCertificate(tls,h.hostname);
      }
      h.tls = just(tls);
      return;
    } catch(InternalError(e)) {
      netError(e);
    }
    throw(InternalError(e));
    | just(t) -> return; // don't start twice.
  }
}