Commit 964913c3 authored by Peter Achten's avatar Peter Achten

Merge remote-tracking branch 'remotes/origin/master' into...

Merge remote-tracking branch 'remotes/origin/master' into defunctionalized-functionalized-SVG-functions-plus-paths-for-efficient-lookup
parents 76e9ef07 c037c12b
Pipeline #21990 failed with stage
in 2 minutes and 58 seconds
......@@ -2,3 +2,11 @@ Clean System Files
_Tests
_Tests.*
*.o
*-sapl
*-www
*-data
*.prj
*.prp
* Time Profile.pcl
*.exe
a.out
......@@ -18,3 +18,4 @@ test-stable:
image: "camilstaps/clean:nightly"
script:
- make -C tests/linux64 run
allow_failure: true
module client
import StdEnv
import Data.Error
import Data.Maybe
import Network.IP
import System.Socket
import System.Socket.Ipv4
Start :: *World -> (MaybeOSError String, *World)
Start w
= case socket SocketStream w of
(Error e, w) = (Error e, w)
(Ok sockfd, w)
#! (merr, sockfd) = connect {ipv4_socket_port=8124,ipv4_socket_addr=Just (fromString "127.0.0.1")} sockfd
| isError merr = (liftError merr, w)
#! (merr, sockfd) = recv 128 [] sockfd
| isError merr = (merr, w)
# (Ok msg) = merr
# (merr, w) = close sockfd w
| isError merr = (liftError merr, w)
= (Ok msg, w)
module server
import StdDebug
import StdEnv
import Data.Error
import Data.Maybe
import System.Socket
import System.Socket.Ipv4
Start :: *World -> (MaybeOSError (), *World)
Start w
= case socket SocketStream w of
(Error e, w) = (Error e, w)
(Ok sockfd, w)
#! (merr, sockfd) = bind {ipv4_socket_port=8124,ipv4_socket_addr=Nothing} sockfd
| isError merr = (merr, w)
#! (merr, sockfd) = listen 3 sockfd
| isError merr = (merr, w)
= case accept sockfd of
(Error e, sockfd) = (Error e, w)
(Ok (sock, addr), sockfd)
# (merr, sock) = send "Hello world!" [] sock
| isError merr = (liftError merr, w)
# (merr, w) = close sock w
| isError merr = (merr, w)
# (merr, w) = close sockfd w
| isError merr = (merr, w)
= (Ok (), w)
#include <stdio.h>
#include <stddef.h>
#ifdef _WIN32
#include <winsock2.h>
#include <ws2tcpip.h>
#else
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <sys/un.h>
#endif
int main(void)
{
printf("AF_INET :== %lu\n", AF_INET);
#ifdef linux
printf("AF_UNIX :== %lu\n", AF_UNIX);
#endif
printf("AF_INET6 :== %lu\n", AF_INET6);
printf("AF_IPX :== %lu\n", AF_IPX);
printf("AF_APPLETALK :== %lu\n", AF_APPLETALK);
printf("AF_IRDA :== %lu\n", AF_IRDA);
printf("SOCK_STREAM :== %lu\n", SOCK_STREAM);
printf("SOCK_DGRAM :== %lu\n", SOCK_DGRAM);
printf("MSG_DONTROUTE :== %lu\n", MSG_DONTROUTE);
printf("MSG_OOB :== %lu\n", MSG_OOB);
printf("MSG_PEEK :== %lu\n", MSG_PEEK);
printf("MSG_WAITALL :== %lu\n", MSG_WAITALL);
printf("\nsockaddr_in offsets:\n");
printf("sin_family: %lu\n", offsetof(struct sockaddr_in, sin_family));
printf("sin_port: %lu\n", offsetof(struct sockaddr_in, sin_port));
printf("sin_addr: %lu\n", offsetof(struct sockaddr_in, sin_addr));
printf("in_addr offsets:\n");
printf("s_addr: %lu\n", offsetof(struct in_addr, s_addr));
#ifdef linux
printf("\nsockaddr_un offsets:\n");
printf("sun_family: %lu\n", offsetof(struct sockaddr_un, sun_family));
printf("sun_path: %lu\n", offsetof(struct sockaddr_un, sun_path));
#endif
printf("\nsockaddr_in6 offsets:\n");
printf("sin6_family: %lu\n",
offsetof(struct sockaddr_in6, sin6_family));
printf("sin6_port: %lu\n", offsetof(struct sockaddr_in6, sin6_port));
printf("sin6_flowinfo: %lu\n",
offsetof(struct sockaddr_in6, sin6_flowinfo));
printf("sin6_addr: %lu\n", offsetof(struct sockaddr_in6, sin6_addr));
printf("sin6_scope_id: %lu\n",
offsetof(struct sockaddr_in6, sin6_scope_id));
printf("in6_addr offsets:\n");
printf("s6_addr: %lu\n", offsetof(struct in6_addr, s6_addr));
#ifdef _WIN32
printf("sizeof(WSADATA): %lu\n", sizeof(WSADATA));
#endif
return 0;
}
definition module System.Socket
from StdOverloaded import class toInt
from Data.Error import :: MaybeError, :: MaybeErrorString
from System._Pointer import :: Pointer(..)
from System._Socket import :: Socket
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorMessage, :: OSErrorCode
:: SocketType = SocketStream | SocketDataGram
:: SendFlag = SendFlagOob | SendFlagDontRoute
:: RecvFlag = RecvFlagOob | RecvFlagWaitAll | RecvFlagPeek
instance toInt SocketType, SendFlag, RecvFlag
class SocketAddress sa where
sa_length :: !sa -> Int
sa_serialize :: !sa !Pointer !*env -> *(!Pointer, !*env)
sa_deserialize :: !Pointer -> MaybeErrorString sa
sa_domain :: !sa -> Int
sa_null :: sa
/**
* Register a socket with the given type
*
* @param type of communication semantics
* @param environment
* @return socket
* @return new environment
*/
socket :: !SocketType !*env -> *(!MaybeOSError *(Socket sa), !*env) | SocketAddress sa
/**
* Bind a socket to an address
*
* @param address
* @param socket
* @return error if something went wrong
* @return new socket
*/
bind :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
/**
* Listen for connections on a socket
*
* @param maximum number of backlog connections
* @param socket
* @return error if something went wrong
* @return new socket
*/
listen :: !Int !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
/**
* Accept a connection from a listening socket
*
* @param socket
* @return error if something went wrong or a connected socket with its address if it went okay
* @return new socket
*/
accept :: !*(Socket sa) -> *(!MaybeOSError (!*Socket sa, !sa), !*Socket sa) | SocketAddress sa
/**
* Close a socket
*
* @param socket
* @param environment
* @return error if something went wrong
* @return new environmnt
*/
close :: !*(Socket sa) !*env -> *(!MaybeOSError (), !*env) | SocketAddress sa
/**
* Connect to a listening address
*
* @param address
* @param socket
* @return error if something went wrong
* @return new socket
*/
connect :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
/**
* Send data to a socket
*
* @param data
* @param flags
* @return error if something went wrong or the number of bytes sent otherwise
* @return new socket
*/
send :: !String ![SendFlag] !*(Socket sa) -> *(!MaybeOSError Int, !*Socket sa)
/**
* Receive data from a socket
*
* @param number of bytes to receive
* @param flags
* @return error if something went wrong or the data received otherwise
* @return new socket
*/
recv :: !Int ![RecvFlag] !*(Socket sa) -> *(!MaybeOSError String, !*Socket sa)
/**
* Convert a short in network order to a short in host order
*/
networkToHostByteOrderShort :: !Int -> Int
/**
* Convert a short in network order to a short in host order
*/
hostToNetworkByteOrderShort :: !Int -> Int
/**
* Convert a long in network order to a long in host order
*/
networkToHostByteOrderLong :: !Int -> Int
/**
* Convert a long in network order to a long in host order
*/
hostToNetworkByteOrderLong :: !Int -> Int
implementation module System.Socket
import StdEnv
import System._Socket => qualified socket, bind, listen, accept, close, connect, send, recv, hostToNetworkByteOrderLong, hostToNetworkByteOrderShort, networkToHostByteOrderShort, networkToHostByteOrderLong
import System.OSError
instance toInt SocketType where
toInt SocketStream = SOCK_STREAM
toInt SocketDataGram = SOCK_DGRAM
instance toInt SendFlag where
toInt SendFlagOob = MSG_OOB
toInt SendFlagDontRoute = MSG_DONTROUTE
instance toInt RecvFlag where
toInt RecvFlagOob = MSG_OOB
toInt RecvFlagWaitAll = MSG_WAITALL
toInt RecvFlagPeek = MSG_PEEK
socket :: !SocketType !*env -> *(!MaybeOSError *(Socket sa), !*env) | SocketAddress sa
socket a b = 'System._Socket'.socket a b
bind :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
bind a b = 'System._Socket'.bind a b
listen :: !Int !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
listen a b = 'System._Socket'.listen a b
accept :: !*(Socket sa) -> *(!MaybeOSError (!*Socket sa, !sa), !*(Socket sa)) | SocketAddress sa
accept a = 'System._Socket'.accept a
close :: !*(Socket sa) !*env -> *(!MaybeOSError (), !*env) | SocketAddress sa
close a b = 'System._Socket'.close a b
connect :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
connect a b = 'System._Socket'.connect a b
send :: !String ![SendFlag] !*(Socket sa) -> *(!MaybeOSError Int, !*Socket sa)
send a b c = 'System._Socket'.send a b c
recv :: !Int ![RecvFlag] !*(Socket sa) -> *(!MaybeOSError String, !*Socket sa)
recv a b c = 'System._Socket'.recv a b c
networkToHostByteOrderShort :: !Int -> Int
networkToHostByteOrderShort a = 'System._Socket'.networkToHostByteOrderShort a
hostToNetworkByteOrderShort :: !Int -> Int
hostToNetworkByteOrderShort a = 'System._Socket'.hostToNetworkByteOrderShort a
networkToHostByteOrderLong :: !Int -> Int
networkToHostByteOrderLong a = 'System._Socket'.networkToHostByteOrderShort a
hostToNetworkByteOrderLong :: !Int -> Int
hostToNetworkByteOrderLong a = 'System._Socket'.hostToNetworkByteOrderLong a
definition module System.Socket.Ipv4
from StdOverloaded import class toString
from Network.IP import :: IPAddress
from StdMaybe import :: Maybe
from System.Socket import class SocketAddress
:: Ipv4SocketAddress =
{ ipv4_socket_port :: !Int
, ipv4_socket_addr :: !Maybe IPAddress
}
instance SocketAddress Ipv4SocketAddress
instance toString Ipv4SocketAddress
implementation module System.Socket.Ipv4
import StdEnv
import Network.IP
import Data.Error
import System.Socket
import System._Pointer
import Text.GenPrint
instance SocketAddress Ipv4SocketAddress where
sa_serialize sa p w
# p = writeInt2 p 0 (sa_domain sa)
# p = writeInt2 p 2 (hostToNetworkByteOrderShort sa.ipv4_socket_port)
# p = writeInt4 p 4 (maybe 0 toInt sa.ipv4_socket_addr)
= (p, w)
sa_deserialize p
= Ok {ipv4_socket_port=networkToHostByteOrderShort (readInt2Z p 2),ipv4_socket_addr=Just (fromInt (readInt4Z p 4))}
sa_length _ = 16
sa_domain _ = 2
sa_null = {ipv4_socket_port=0, ipv4_socket_addr=Nothing}
gPrint{|IPAddress|} a s = gPrint{|*|} (toString a) s
derive gPrint Ipv4SocketAddress, Maybe
instance toString Ipv4SocketAddress where toString s = printToString s
definition module System.Socket.Ipv6
from StdOverloaded import class toString
from Network.IP import :: IPAddress
from StdMaybe import :: Maybe
from System.Socket import class SocketAddress
:: Ipv6SocketAddress =
{ ipv6_socket_port :: !Int
, ipv6_socket_flowinfo :: !Int
, ipv6_socket_addr :: !Maybe String
, ipv6_socket_scope_id :: !Int
}
instance SocketAddress Ipv6SocketAddress
instance toString Ipv6SocketAddress
implementation module System.Socket.Ipv6
import StdEnv
import Data.Error
import Data.Maybe
import System.Socket
import System._Pointer
import Text.GenPrint
from System._Socket import AF_INET6
instance SocketAddress Ipv6SocketAddress where
sa_serialize sa p w
# p = writeInt2 p 0 (sa_domain sa)
# p = writeInt2 p 2 (hostToNetworkByteOrderShort sa.ipv6_socket_port)
# p = writeInt4 p 4 (sa.ipv6_socket_flowinfo)
# p = writeCharArray (p+8) (pad16 (fromMaybe "::" sa.ipv6_socket_addr))
# p = writeInt4 p 24 (sa.ipv6_socket_scope_id)
= (p, w)
where
pad16 s = s +++ {'\0'\\_<-[0..16-1-size s]}
sa_deserialize p = Ok
{ ipv6_socket_port = networkToHostByteOrderShort (readInt2Z p 2)
, ipv6_socket_flowinfo = readInt4Z p 4
, ipv6_socket_addr = Just (derefCharArray (p+8) 16)
, ipv6_socket_scope_id = readInt4Z p 24
}
sa_length _ = 28
sa_domain _ = AF_INET6
sa_null = {ipv6_socket_port=0,ipv6_socket_flowinfo=0,ipv6_socket_addr=Nothing,ipv6_socket_scope_id=0}
derive gPrint Ipv6SocketAddress, Maybe
instance toString Ipv6SocketAddress where toString s = printToString s
definition module System.Socket.Unix
from System.FilePath import :: FilePath(..)
from StdOverloaded import class toString
from System.Socket import class SocketAddress
:: UnixSocketAddress =
{ unix_socket_path :: !FilePath
}
instance SocketAddress UnixSocketAddress
instance toString UnixSocketAddress
implementation module System.Socket.Unix
import StdEnv
import Data.Error
import System.FilePath
import System.Socket
import System._Pointer
from System._Socket import AF_UNIX
instance SocketAddress UnixSocketAddress where
sa_serialize sa p w
# p = writeInt2 p 0 (sa_domain sa)
# p = writeCharArray (p+2) (packString sa.unix_socket_path)
= (p, w)
sa_deserialize p
= Ok {unix_socket_path=derefString (p+2)}
sa_length _ = 110
sa_domain _ = AF_UNIX
sa_null = {unix_socket_path="/"}
instance toString UnixSocketAddress where toString s = s.unix_socket_path
definition module System._Socket
from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorMessage, :: OSErrorCode
from System.Socket import :: SocketType, class SocketAddress, :: SendFlag, :: RecvFlag
:: *Socket a
AF_INET :== 2
AF_UNIX :== 1
AF_INET6 :== 10
AF_IPX :== 4
AF_APPLETALK :== 5
AF_IRDA :== 23
SOCK_STREAM :== 1
SOCK_DGRAM :== 2
MSG_DONTROUTE :== 4
MSG_OOB :== 1
MSG_PEEK :== 2
MSG_WAITALL :== 256
socket :: !SocketType !*env -> *(!MaybeOSError *(Socket sa), !*env) | SocketAddress sa
bind :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
listen :: !Int !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
accept :: !*(Socket sa) -> *(!MaybeOSError (!*Socket sa, !sa), !*Socket sa) | SocketAddress sa
close :: !*(Socket sa) !*env -> *(!MaybeOSError (), !*env) | SocketAddress sa
connect :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
send :: !String ![SendFlag] !*(Socket sa) -> *(!MaybeOSError Int, !*Socket sa)
recv :: !Int ![RecvFlag] !*(Socket sa) -> *(!MaybeOSError String, !*Socket sa)
networkToHostByteOrderShort :: !Int -> Int
hostToNetworkByteOrderShort :: !Int -> Int
networkToHostByteOrderLong :: !Int -> Int
hostToNetworkByteOrderLong :: !Int -> Int
implementation module System._Socket
import StdEnv
import Data.Error
import System.OSError
import System._Pointer
import System._Posix
import System.Socket => qualified socket, bind, listen, accept, close, connect, send, recv, networkToHostByteOrderLong, networkToHostByteOrderShort, hostToNetworkByteOrderLong, hostToNetworkByteOrderShort
:: *Socket a :== Int
socket :: !SocketType !*env -> *(!MaybeOSError *(Socket sa), !*env) | SocketAddress sa
socket type w
# (sockfd, w) = socket` (sa_domain msa) (toInt type) 0 w
# (fd, sockfd) = getFd sockfd
| fd == -1 = getLastOSError w
= (Ok (coerce sockfd msa), w)
where
msa = sa_null
coerce :: *(Socket sa) sa -> *(Socket sa)
coerce x y = x
socket` :: !Int !Int !Int !*env -> *(!*Int, !*env)
socket` _ _ _ _ = code {
ccall socket "III:I:A"
}
bind :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
bind addr sockfd
# (p, sockfd) = mallocSt (sa_length addr) sockfd
| p == 0 = getLastOSError sockfd
# (p, sockfd) = sa_serialize addr p sockfd
# len = sa_length addr
# (fd, sockfd) = getFd sockfd
# (r, sockfd) = bind` fd p len sockfd
# sockfd = freeSt p sockfd
| r == -1 = getLastOSError sockfd
= (Ok (), sockfd)
where
bind` :: !Int !Pointer !Int !*env -> *(!Int, !*env)
bind` _ _ _ _ = code {
ccall bind "IpI:I:A"
}
listen :: !Int !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
listen backlog sockfd
#! r = listen` sockfd backlog
| r == -1 = getLastOSError sockfd
= (Ok (), sockfd)
where
listen` :: !Int !Int -> Int
listen` _ _ = code {
ccall listen "II:I"
}
accept :: !*(Socket sa) -> *(!MaybeOSError (!*Socket sa, !sa), !*Socket sa) | SocketAddress sa
accept sockfd
# (fd, sockfd) = getFd sockfd
# (p1, sockfd) = mallocSt 64 sockfd
| p1 == 0 = getLastOSError sockfd
# (p2, sockfd) = mallocSt 8 sockfd
| p2 == 0 = getLastOSError (freeSt p2 sockfd)
# p2 = writeInt p2 0 64
= case accept` fd p1 p2 sockfd of
(-1, sockfd)
#! sockfd = freeSt p1 sockfd
#! sockfd = freeSt p2 sockfd
= getLastOSError sockfd
(sock, sockfd)
#! (merr, p1) = readP sa_deserialize p1
#! sockfd = freeSt p1 sockfd
#! sockfd = freeSt p2 sockfd
| isError merr = (Error (0, fromError merr), sockfd)
= (Ok (sock, fromOk merr), sockfd)
where
accept` :: !Int !Pointer !Int !*env -> *(!*Int, !*env)
accept` _ _ _ _ = code {
ccall accept "IpI:I:A"
}
connect :: !sa !*(Socket sa) -> *(!MaybeOSError (), !*Socket sa) | SocketAddress sa
connect addr sockfd
# (p, sockfd) = mallocSt (sa_length addr) sockfd
| p == 0 = getLastOSError sockfd
# (p, sockfd) = sa_serialize addr p sockfd
# (fd, sockfd) = getFd sockfd
# (r, sockfd) = connect` fd p (sa_length addr) sockfd
# sockfd = freeSt p sockfd
| r == -1 = getLastOSError sockfd
= (Ok (), sockfd)
where
connect` :: !Int !Pointer !Int !*env -> *(!Int, !*env)
connect` _ _ _ _ = code {
ccall connect "IpI:I:A"
}
send :: !String ![SendFlag] !*(Socket sa) -> *(!MaybeOSError Int, !*Socket sa)
send data flags sockfd
# flags = foldr (bitor) 0 (map toInt flags)
# (fd, sockfd) = getFd sockfd
# (r, sockfd) = send` fd (packString data) (size data) flags sockfd
| r == -1 = getLastOSError sockfd
= (Ok r, sockfd)
where
send` :: !Int !String !Int !Int !*env -> *(!Int, !*env)
send` _ _ _ _ _ = code {
ccall send "IsII:I:A"
}
recv :: !Int ![RecvFlag] !*(Socket sa) -> *(!MaybeOSError String, !*Socket sa)
recv length flags sockfd
# flags = foldr (bitor) 0 (map toInt flags)
# (p, sockfd) = mallocSt length sockfd
| p == 0 = getLastOSError sockfd
# (fd, sockfd) = getFd sockfd
# (r, sockfd) = recv` fd p length flags sockfd
| r == -1 = getLastOSError (freeSt p sockfd)
# (s, p) = readP derefString p
# sockfd = freeSt p sockfd
= (Ok s, sockfd)
where
recv` :: !Int !Pointer !Int !Int !*env -> *(!Int, !*env)
recv` _ _ _ _ _ = code {
ccall recv "IpII:I:A"
}
close :: !*(Socket sa) !*env -> *(!MaybeOSError (), !*env) | SocketAddress sa
close sock w
# r = close` sock
| r == -1 = getLastOSError w
= (Ok (), w)
where
close` :: !Int -> Int
close` _ = code {
ccall close "I:I"
}
networkToHostByteOrderShort :: !Int -> Int
networkToHostByteOrderShort a = code {
ccall ntohs "I:I"
}
hostToNetworkByteOrderShort :: !Int -> Int
hostToNetworkByteOrderShort a = code {
ccall htons "I:I"
}
networkToHostByteOrderLong :: !Int -> Int
networkToHostByteOrderLong a = code {
ccall ntohl "I:I"
}
hostToNetworkByteOrderLong :: !Int -> Int
hostToNetworkByteOrderLong a = code {
ccall htonl "I:I"
}
getFd :: !*(Socket sa) -> *(!Int, !*Socket sa)
getFd s = code {
push_b 0
}
definition module System._Socket
from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorMessage, :: OSErrorCode
from System.Socket import :: SocketType, class SocketAddress, :: SendFlag, :: RecvFlag
:: *Socket a
AF_INET :== 2
AF_INET6 :== 23
AF_IPX :== 6
AF_APPLETALK :== 16
AF_NETBIOS :== 17
AF_IRDA :== 26
AF_BTH :== 32
SOCK_STREAM :== 1
SOCK_DGRAM :== 2
SOCK_RAW :== 3
SOCK_RDM :== 4
SOCK_SEQPACKET :== 5