edwinb/Idris2-boot
1
1
Fork 0
mirror of https://github.com/edwinb/Idris2-boot.git synced 2024-09-19 20:07:20 +03:00
Code Issues Projects Releases Wiki Activity

initial import of idris 1 network lib

Browse Source
This commit is contained in:
Arnaud Bailly 2019-07-22 17:21:38 +02:00
parent 91262b4800
commit 18d83420da
No known key found for this signature in database
GPG Key ID: 389CC2BC5448321E
9 changed files with 1282 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Makefile
View File

@ -20,7 +20,10 @@ prelude:
base: prelude
make -C libs/base IDRIS2=../../idris2
libs : prelude base
network: prelude
make -C libs/network IDRIS2=../../idris2
libs : prelude base network
clean: clean-libs
make -C src clean
@ -31,6 +34,7 @@ clean: clean-libs
clean-libs:
make -C libs/prelude clean
make -C libs/base clean
make -C libs/network clean
test:
idris --build tests.ipkg
@ -51,3 +55,4 @@ install-exec: idris2
install-libs: libs
make -C libs/prelude install IDRIS2=../../idris2
make -C libs/base install IDRIS2=../../idris2
make -C libs/network install IDRIS2=../../idris2

61
libs/network/Makefile Normal file
View File

@ -0,0 +1,61 @@
RANLIB ?=ranlib
AR ?=ar
MACHINE := $(shell $(CC) -dumpmachine)
ifneq (, $(findstring darwin, $(MACHINE)))
OS :=darwin
else ifneq (, $(findstring cygwin, $(MACHINE)))
OS :=windows
else ifneq (, $(findstring mingw, $(MACHINE)))
OS :=windows
else ifneq (, $(findstring windows, $(MACHINE)))
OS :=windows
else
OS :=unix
endif
ifeq ($(OS),darwin)
SHLIB_SUFFIX :=.dylib
LIBFLAGS :=-dynamiclib
else ifeq ($(OS),windows)
SHLIB_SUFFIX :=.DLL
LIBFLAGS :=-shared
else
SHLIB_SUFFIX :=.so
LIBFLAGS :=-shared
endif
OBJS = idris_net.o
HDRS = idris_net.h
CFLAGS := $(CFLAGS)
ifneq ($(OS), windows)
CFLAGS += -fPIC
endif
DYLIBTARGET = idrnet$(SHLIB_SUFFIX)
LIBTARGET = idrnet.a
TARGET=${HOME}/.idris2
build: $(LIBTARGET) $(DYLIBTARGET)
$(LIBTARGET) : $(OBJS)
$(AR) rc $(LIBTARGET) $(OBJS)
$(RANLIB) $(LIBTARGET)
$(DYLIBTARGET) : $(OBJS)
$(CC) -o $(DYLIBTARGET) $(LIBFLAGS) -shared $(OBJS)
install: build
install $(LIBTARGET) $(HDRS) $(TARGET)
${IDRIS2} --install network.ipkg
clean :
rm -rf $(OBJS) $(LIBTARGET) $(DYLIBTARGET) build
$(OBJS): $(HDRS)
all: $(DYLIBTARGET) $(LIBTARGET)
${IDRIS2} --build network1.ipkg
.PHONY: build install clean

146
libs/network/Network/Cgi.idr Normal file
View File

@ -0,0 +1,146 @@
module Network.Cgi
import System
%default total
public export
Vars : Type
Vars = List (String, String)
record CGIInfo where
constructor CGISt
GET : Vars
POST : Vars
Cookies : Vars
UserAgent : String
Headers : String
Output : String
add_Headers : String -> CGIInfo -> CGIInfo
add_Headers str st = record { Headers = Headers st ++ str } st
add_Output : String -> CGIInfo -> CGIInfo
add_Output str st = record { Output = Output st ++ str } st
export
data CGI : Type -> Type where
MkCGI : (CGIInfo -> IO (a, CGIInfo)) -> CGI a
getAction : CGI a -> CGIInfo -> IO (a, CGIInfo)
getAction (MkCGI act) = act
export
implementation Functor CGI where
map f (MkCGI c) = MkCGI (\s => do (a, i) <- c s
pure (f a, i))
export
implementation Applicative CGI where
pure v = MkCGI (\s => pure (v, s))
(MkCGI a) <*> (MkCGI b) = MkCGI (\s => do (f, i) <- a s
(c, j) <- b i
pure (f c, j))
export
implementation Monad CGI where
(>>=) (MkCGI f) k = MkCGI (\s => do v <- f s
getAction (k (fst v)) (snd v))
setInfo : CGIInfo -> CGI ()
setInfo i = MkCGI (\s => pure ((), i))
getInfo : CGI CGIInfo
getInfo = MkCGI (\s => pure (s, s))
export
lift : IO a -> CGI a
lift op = MkCGI (\st => do { x <- op
pure (x, st) } )
export
output : String -> CGI ()
output s = do i <- getInfo
setInfo (add_Output s i)
export
queryVars : CGI Vars
queryVars = do i <- getInfo
pure (GET i)
export
postVars : CGI Vars
postVars = do i <- getInfo
pure (POST i)
export
cookieVars : CGI Vars
cookieVars = do i <- getInfo
pure (Cookies i)
export
queryVar : String -> CGI (Maybe String)
queryVar x = do vs <- queryVars
pure (lookup x vs)
getOutput : CGI String
getOutput = do i <- getInfo
pure (Output i)
getHeaders : CGI String
getHeaders = do i <- getInfo
pure (Headers i)
export
flushHeaders : CGI ()
flushHeaders = do o <- getHeaders
lift (putStrLn o)
export
flush : CGI ()
flush = do o <- getOutput
lift (putStr o)
getVars : List Char -> String -> List (String, String)
getVars seps query = mapMaybe readVar (split (\x => elem x seps) query)
where
readVar : String -> Maybe (String, String)
readVar xs with (split (\x => x == '=') xs)
| [k, v] = Just (trim k, trim v)
| _ = Nothing
getContent : Int -> IO String
getContent x = getC (cast x) "" where
getC : Nat -> String -> IO String
getC Z acc = pure $ reverse acc
getC (S k) acc = do x <- getChar
getC k (strCons x acc)
getCgiEnv : String -> IO String
getCgiEnv key = do
val <- getEnv key
pure $ maybe "" id val
export
runCGI : CGI a -> IO a
runCGI prog = do
clen_in <- getCgiEnv "CONTENT_LENGTH"
let clen = prim__fromStrInt clen_in
content <- getContent clen
query <- getCgiEnv "QUERY_STRING"
cookie <- getCgiEnv "HTTP_COOKIE"
agent <- getCgiEnv "HTTP_USER_AGENT"
let get_vars = getVars ['&',';'] query
let post_vars = getVars ['&'] content
let cookies = getVars [';'] cookie
(v, st) <- getAction prog (CGISt get_vars post_vars cookies agent
"Content-type: text/html\n"
"")
putStrLn (Headers st)
putStr (Output st)
pure v

245
libs/network/Network/Socket.idr Normal file
View File

@ -0,0 +1,245 @@
||| Low-Level C Sockets bindings for Idris. Used by higher-level, cleverer things.
|||
||| Original (C) SimonJF, MIT Licensed, 2014
||| Modified (C) The Idris Community, 2015, 2016, 2019
module Network.Socket
import public Network.Socket.Data
import Network.Socket.Raw
%include C "idris_net.h"
%access export
-- ----------------------------------------------------- [ Network Socket API. ]
||| Creates a UNIX socket with the given family, socket type and protocol
||| number. Returns either a socket or an error.
socket : (fam : SocketFamily)
-> (ty : SocketType)
-> (pnum : ProtocolNumber)
-> IO (Either SocketError Socket)
socket sf st pn = do
socket_res <- foreign FFI_C "idrnet_socket"
(Int -> Int -> Int -> IO Int)
(toCode sf) (toCode st) pn
if socket_res == -1
then map Left getErrno
else pure $ Right (MkSocket socket_res sf st pn)
||| Close a socket
close : Socket -> IO ()
close sock = foreign FFI_C "close" (Int -> IO ()) (descriptor sock)
||| Binds a socket to the given socket address and port.
||| Returns 0 on success, an error code otherwise.
bind : (sock : Socket)
-> (addr : Maybe SocketAddress)
-> (port : Port)
-> IO Int
bind sock addr port = do
bind_res <- foreign FFI_C "idrnet_bind"
(Int -> Int -> Int -> String -> Int -> IO Int)
(descriptor sock) (toCode $ family sock)
(toCode $ socketType sock) (saString addr) port
if bind_res == (-1)
then getErrno
else pure 0
where
saString : Maybe SocketAddress -> String
saString (Just sa) = show sa
saString Nothing = ""
||| Connects to a given address and port.
||| Returns 0 on success, and an error number on error.
connect : (sock : Socket)
-> (addr : SocketAddress)
-> (port : Port)
-> IO ResultCode
connect sock addr port = do
conn_res <- foreign FFI_C "idrnet_connect"
(Int -> Int -> Int -> String -> Int -> IO Int)
(descriptor sock) (toCode $ family sock) (toCode $ socketType sock) (show addr) port
if conn_res == (-1)
then getErrno
else pure 0
||| Listens on a bound socket.
|||
||| @sock The socket to listen on.
listen : (sock : Socket) -> IO Int
listen sock = do
listen_res <- foreign FFI_C "listen" (Int -> Int -> IO Int)
(descriptor sock) BACKLOG
if listen_res == (-1)
then getErrno
else pure 0
||| Accept a connection on the provided socket.
|||
||| Returns on failure a `SocketError`
||| Returns on success a pairing of:
||| + `Socket` :: The socket representing the connection.
||| + `SocketAddress` :: The
|||
||| @sock The socket used to establish connection.
accept : (sock : Socket)
-> IO (Either SocketError (Socket, SocketAddress))
accept sock = do
-- We need a pointer to a sockaddr structure. This is then passed into
-- idrnet_accept and populated. We can then query it for the SocketAddr and free it.
sockaddr_ptr <- foreign FFI_C "idrnet_create_sockaddr"
(IO Ptr)
accept_res <- foreign FFI_C "idrnet_accept"
(Int -> Ptr -> IO Int)
(descriptor sock) sockaddr_ptr
if accept_res == (-1)
then map Left getErrno
else do
let (MkSocket _ fam ty p_num) = sock
sockaddr <- getSockAddr (SAPtr sockaddr_ptr)
sockaddr_free (SAPtr sockaddr_ptr)
pure $ Right ((MkSocket accept_res fam ty p_num), sockaddr)
||| Send data on the specified socket.
|||
||| Returns on failure a `SocketError`.
||| Returns on success the `ResultCode`.
|||
||| @sock The socket on which to send the message.
||| @msg The data to send.
send : (sock : Socket)
-> (msg : String)
-> IO (Either SocketError ResultCode)
send sock dat = do
send_res <- foreign FFI_C "idrnet_send"
(Int -> String -> IO Int)
(descriptor sock) dat
if send_res == (-1)
then map Left getErrno
else pure $ Right send_res
||| Receive data on the specified socket.
|||
||| Returns on failure a `SocketError`
||| Returns on success a pairing of:
||| + `String` :: The payload.
||| + `ResultCode` :: The result of the underlying function.
|||
||| @sock The socket on which to receive the message.
||| @len How much of the data to receive.
recv : (sock : Socket)
-> (len : ByteLength)
-> IO (Either SocketError (String, ResultCode))
recv sock len = do
-- Firstly make the request, get some kind of recv structure which
-- contains the result of the recv and possibly the retrieved payload
recv_struct_ptr <- foreign FFI_C "idrnet_recv"
(Int -> Int -> IO Ptr)
(descriptor sock) len
recv_res <- foreign FFI_C "idrnet_get_recv_res"
(Ptr -> IO Int)
recv_struct_ptr
if recv_res == (-1)
then do
errno <- getErrno
freeRecvStruct (RSPtr recv_struct_ptr)
pure $ Left errno
else
if recv_res == 0
then do
freeRecvStruct (RSPtr recv_struct_ptr)
pure $ Left 0
else do
payload <- foreign FFI_C "idrnet_get_recv_payload"
(Ptr -> IO String)
recv_struct_ptr
freeRecvStruct (RSPtr recv_struct_ptr)
pure $ Right (payload, recv_res)
||| Receive all the remaining data on the specified socket.
|||
||| Returns on failure a `SocketError`
||| Returns on success the payload `String`
|||
||| @sock The socket on which to receive the message.
partial
recvAll : (sock : Socket) -> IO (Either SocketError String)
recvAll sock = recvRec sock [] 64
where
partial
recvRec : Socket -> List String -> ByteLength -> IO (Either SocketError String)
recvRec sock acc n = do res <- recv sock n
case res of
Left 0 => pure (Right $ concat $ reverse acc)
Left c => pure (Left c)
Right (str, _) => let n' = min (n * 2) 65536 in
recvRec sock (str :: acc) n'
||| Send a message.
|||
||| Returns on failure a `SocketError`
||| Returns on success the `ResultCode`
|||
||| @sock The socket on which to send the message.
||| @addr Address of the recipient.
||| @port The port on which to send the message.
||| @msg The message to send.
sendTo : (sock : Socket)
-> (addr : SocketAddress)
-> (port : Port)
-> (msg : String)
-> IO (Either SocketError ByteLength)
sendTo sock addr p dat = do
sendto_res <- foreign FFI_C "idrnet_sendto"
(Int -> String -> String -> Int -> Int -> IO Int)
(descriptor sock) dat (show addr) p (toCode $ family sock)
if sendto_res == (-1)
then map Left getErrno
else pure $ Right sendto_res
||| Receive a message.
|||
||| Returns on failure a `SocketError`.
||| Returns on success a triple of
||| + `UDPAddrInfo` :: The address of the sender.
||| + `String` :: The payload.
||| + `Int` :: Result value from underlying function.
|||
||| @sock The channel on which to receive.
||| @len Size of the expected message.
|||
recvFrom : (sock : Socket)
-> (len : ByteLength)
-> IO (Either SocketError (UDPAddrInfo, String, ResultCode))
recvFrom sock bl = do
recv_ptr <- foreign FFI_C "idrnet_recvfrom"
(Int -> Int -> IO Ptr)
(descriptor sock) bl
let recv_ptr' = RFPtr recv_ptr
if !(nullPtr recv_ptr)
then map Left getErrno
else do
result <- foreign FFI_C "idrnet_get_recvfrom_res"
(Ptr -> IO Int)
recv_ptr
if result == -1
then do
freeRecvfromStruct recv_ptr'
map Left getErrno
else do
payload <- foreignGetRecvfromPayload recv_ptr'
port <- foreignGetRecvfromPort recv_ptr'
addr <- foreignGetRecvfromAddr recv_ptr'
freeRecvfromStruct recv_ptr'
pure $ Right (MkUDPAddrInfo addr port, payload, result)

178
libs/network/Network/Socket/Data.idr Normal file
View File

@ -0,0 +1,178 @@
||| Low-Level C Sockets bindings for Idris. Used by higher-level, cleverer things.
||| Types used by Network.Socket.Raw and Network.Socket.
|||
||| Original (C) SimonJF, MIT Licensed, 2014
||| Modified (C) The Idris Community, 2015, 2016, 2019
module Network.Socket.Data
-- ------------------------------------------------------------ [ Type Aliases ]
-- FIXME should be generic name with OS-dependent suffix
%cg chez "./libidrnet.dylib"
export
ByteLength : Type
ByteLength = Int
export
ResultCode : Type
ResultCode = Int
||| Protocol Number.
|||
||| Generally good enough to just set it to 0.
export
ProtocolNumber : Type
ProtocolNumber = Int
||| SocketError: Error thrown by a socket operation
export
SocketError : Type
SocketError = Int
||| SocketDescriptor: Native C Socket Descriptor
export
SocketDescriptor : Type
SocketDescriptor = Int
export
Port : Type
Port = Int
-- --------------------------------------------------------------- [ Constants ]
||| Backlog used within listen() call -- number of incoming calls
BACKLOG : Int
BACKLOG = 20
EAGAIN : Int
EAGAIN =
-- I'm sorry
-- maybe
unsafePerformIO $ foreign FFI_C "idrnet_geteagain" (() -> IO Int) ()
-- -------------------------------------------------------------- [ Interfaces ]
interface ToCode a where
toCode : a -> Int
-- --------------------------------------------------------- [ Socket Families ]
||| Socket Families
|||
||| The ones that people might actually use. We're not going to need US
||| Government proprietary ones.
data SocketFamily : Type where
||| Unspecified
AF_UNSPEC : SocketFamily
||| IP / UDP etc. IPv4
AF_INET : SocketFamily
||| IP / UDP etc. IPv6
AF_INET6 : SocketFamily
Show SocketFamily where
show AF_UNSPEC = "AF_UNSPEC"
show AF_INET = "AF_INET"
show AF_INET6 = "AF_INET6"
ToCode SocketFamily where
toCode AF_UNSPEC = unsafePerformIO (foreign FFI_C "#AF_UNSPEC" (IO Int))
toCode AF_INET = unsafePerformIO (foreign FFI_C "#AF_INET" (IO Int))
toCode AF_INET6 = unsafePerformIO (foreign FFI_C "#AF_INET6" (IO Int))
getSocketFamily : Int -> Maybe SocketFamily
getSocketFamily i =
Prelude.List.lookup i [ (toCode AF_UNSPEC, AF_UNSPEC)
, (toCode AF_INET, AF_INET)
, (toCode AF_INET6, AF_INET6)
]
-- ------------------------------------------------------------ [ Socket Types ]
||| Socket Types.
data SocketType : Type where
||| Not a socket, used in certain operations
NotASocket : SocketType
||| TCP
Stream : SocketType
||| UDP
Datagram : SocketType
||| Raw sockets
RawSocket : SocketType
Show SocketType where
show NotASocket = "Not a socket"
show Stream = "Stream"
show Datagram = "Datagram"
show RawSocket = "Raw"
ToCode SocketType where
toCode NotASocket = 0
toCode Stream = 1
toCode Datagram = 2
toCode RawSocket = 3
-- --------------------------------------------------------------- [ Addresses ]
||| Network Addresses
data SocketAddress : Type where
IPv4Addr : Int -> Int -> Int -> Int -> SocketAddress
||| Not implemented (yet)
IPv6Addr : SocketAddress
Hostname : String -> SocketAddress
||| Used when there's a parse error
InvalidAddress : SocketAddress
Show SocketAddress where
show (IPv4Addr i1 i2 i3 i4) = concat $ Prelude.List.intersperse "." (map show [i1, i2, i3, i4])
show IPv6Addr = "NOT IMPLEMENTED YET"
show (Hostname host) = host
show InvalidAddress = "Invalid"
||| Parses a textual representation of an IPv4 address into a SocketAddress
parseIPv4 : String -> SocketAddress
parseIPv4 str =
case splitted of
(i1 :: i2 :: i3 :: i4 :: _) => IPv4Addr i1 i2 i3 i4
otherwise => InvalidAddress
where
toInt' : String -> Integer
toInt' = cast
toInt : String -> Int
toInt s = fromInteger $ toInt' s
splitted : List Int
splitted = map toInt (Prelude.Strings.split (\c => c == '.') str)
-- --------------------------------------------------------- [ UDP Information ]
-- TODO: Expand to non-string payloads
record UDPRecvData where
constructor MkUDPRecvData
remote_addr : SocketAddress
remote_port : Port
recv_data : String
data_len : Int
record UDPAddrInfo where
constructor MkUDPAddrInfo
remote_addr : SocketAddress
remote_port : Port
-- ----------------------------------------------------------------- [ Sockets ]
||| The metadata about a socket
record Socket where
constructor MkSocket
descriptor : SocketDescriptor
family : SocketFamily
socketType : SocketType
protocolNumber : ProtocolNumber

199
libs/network/Network/Socket/Raw.idr Normal file
View File

@ -0,0 +1,199 @@
||| Low-Level C Sockets bindings for Idris. Used by higher-level, cleverer things.
||| Type-unsafe parts. Use Network.Socket for a safe variant.
|||
||| Original (C) SimonJF, MIT Licensed, 2014
||| Modified (C) The Idris Community, 2015, 2016
module Network.Socket.Raw
import public Network.Socket.Data
%include C "idris_net.h"
%access public export
-- ---------------------------------------------------------------- [ Pointers ]
data RecvStructPtr = RSPtr Ptr
data RecvfromStructPtr = RFPtr Ptr
data BufPtr = BPtr Ptr
data SockaddrPtr = SAPtr Ptr
-- ---------------------------------------------------------- [ Socket Utilies ]
||| Frees a given pointer
sock_free : BufPtr -> IO ()
sock_free (BPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr
sockaddr_free : SockaddrPtr -> IO ()
sockaddr_free (SAPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr
||| Allocates an amount of memory given by the ByteLength parameter.
|||
||| Used to allocate a mutable pointer to be given to the Recv functions.
sock_alloc : ByteLength -> IO BufPtr
sock_alloc bl = map BPtr $ foreign FFI_C "idrnet_malloc" (Int -> IO Ptr) bl
||| Retrieves a socket address from a sockaddr pointer
getSockAddr : SockaddrPtr -> IO SocketAddress
getSockAddr (SAPtr ptr) = do
addr_family_int <- foreign FFI_C "idrnet_sockaddr_family"
(Ptr -> IO Int)
ptr
-- ASSUMPTION: Foreign call returns a valid int
assert_total (case getSocketFamily addr_family_int of
Just AF_INET => do
ipv4_addr <- foreign FFI_C "idrnet_sockaddr_ipv4"
(Ptr -> IO String)
ptr
pure $ parseIPv4 ipv4_addr
Just AF_INET6 => pure IPv6Addr
Just AF_UNSPEC => pure InvalidAddress)
freeRecvStruct : RecvStructPtr -> IO ()
freeRecvStruct (RSPtr p) =
foreign FFI_C "idrnet_free_recv_struct"
(Ptr -> IO ())
p
||| Utility to extract data.
freeRecvfromStruct : RecvfromStructPtr -> IO ()
freeRecvfromStruct (RFPtr p) =
foreign FFI_C "idrnet_free_recvfrom_struct"
(Ptr -> IO ())
p
||| Sends the data in a given memory location
|||
||| Returns on failure a `SocketError`
||| Returns on success the `ResultCode`
|||
||| @sock The socket on which to send the message.
||| @ptr The location containing the data to send.
||| @len How much of the data to send.
sendBuf : (sock : Socket)
-> (ptr : BufPtr)
-> (len : ByteLength)
-> IO (Either SocketError ResultCode)
sendBuf sock (BPtr ptr) len = do
send_res <- foreign FFI_C "idrnet_send_buf"
(Int -> Ptr -> Int -> IO Int)
(descriptor sock) ptr len
if send_res == (-1)
then map Left getErrno
else pure $ Right send_res
||| Receive data from a given memory location.
|||
||| Returns on failure a `SocketError`
||| Returns on success the `ResultCode`
|||
||| @sock The socket on which to receive the message.
||| @ptr The location containing the data to receive.
||| @len How much of the data to receive.
recvBuf : (sock : Socket)
-> (ptr : BufPtr)
-> (len : ByteLength)
-> IO (Either SocketError ResultCode)
recvBuf sock (BPtr ptr) len = do
recv_res <- foreign FFI_C "idrnet_recv_buf"
(Int -> Ptr -> Int -> IO Int)
(descriptor sock) ptr len
if (recv_res == (-1))
then map Left getErrno
else pure $ Right recv_res
||| Send a message stored in some buffer.
|||
||| Returns on failure a `SocketError`
||| Returns on success the `ResultCode`
|||
||| @sock The socket on which to send the message.
||| @addr Address of the recipient.
||| @port The port on which to send the message.
||| @ptr A Pointer to the buffer containing the message.
||| @len The size of the message.
sendToBuf : (sock : Socket)
-> (addr : SocketAddress)
-> (port : Port)
-> (ptr : BufPtr)
-> (len : ByteLength)
-> IO (Either SocketError ResultCode)
sendToBuf sock addr p (BPtr dat) len = do
sendto_res <- foreign FFI_C "idrnet_sendto_buf"
(Int -> Ptr -> Int -> String -> Int -> Int -> IO Int)
(descriptor sock) dat len (show addr) p (toCode $ family sock)
if sendto_res == (-1)
then map Left getErrno
else pure $ Right sendto_res
||| Utility function to get the payload of the sent message as a `String`.
foreignGetRecvfromPayload : RecvfromStructPtr -> IO String
foreignGetRecvfromPayload (RFPtr p) =
foreign FFI_C "idrnet_get_recvfrom_payload"
(Ptr -> IO String)
p
||| Utility function to return senders socket address.
foreignGetRecvfromAddr : RecvfromStructPtr -> IO SocketAddress
foreignGetRecvfromAddr (RFPtr p) = do
sockaddr_ptr <- map SAPtr $ foreign FFI_C "idrnet_get_recvfrom_sockaddr"
(Ptr -> IO Ptr)
p
getSockAddr sockaddr_ptr
||| Utility function to return sender's IPV4 port.
foreignGetRecvfromPort : RecvfromStructPtr -> IO Port
foreignGetRecvfromPort (RFPtr p) = do
sockaddr_ptr <- foreign FFI_C "idrnet_get_recvfrom_sockaddr"
(Ptr -> IO Ptr)
p
port <- foreign FFI_C "idrnet_sockaddr_ipv4_port"
(Ptr -> IO Int)
sockaddr_ptr
pure port
||| Receive a message placed on a 'known' buffer.
|||
||| Returns on failure a `SocketError`.
||| Returns on success a pair of
||| + `UDPAddrInfo` :: The address of the sender.
||| + `Int` :: Result value from underlying function.
|||
||| @sock The channel on which to receive.
||| @ptr Pointer to the buffer to place the message.
||| @len Size of the expected message.
|||
recvFromBuf : (sock : Socket)
-> (ptr : BufPtr)
-> (len : ByteLength)
-> IO (Either SocketError (UDPAddrInfo, ResultCode))
recvFromBuf sock (BPtr ptr) bl = do
recv_ptr <- foreign FFI_C "idrnet_recvfrom_buf"
(Int -> Ptr -> Int -> IO Ptr)
(descriptor sock) ptr bl
let recv_ptr' = RFPtr recv_ptr
if !(nullPtr recv_ptr)
then map Left getErrno
else do
result <- foreign FFI_C "idrnet_get_recvfrom_res"
(Ptr -> IO Int)
recv_ptr
if result == -1
then do
freeRecvfromStruct recv_ptr'
map Left getErrno
else do
port <- foreignGetRecvfromPort recv_ptr'
addr <- foreignGetRecvfromAddr recv_ptr'
freeRecvfromStruct recv_ptr'
pure $ Right (MkUDPAddrInfo addr port, result + 1)

350
libs/network/idris_net.c Normal file
View File

@ -0,0 +1,350 @@
// C-Side of the Idris network library
// (C) Simon Fowler, 2014
// MIT Licensed. Have fun!
#include "idris_net.h"
#include <errno.h>
#include <stdbool.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#ifndef _WIN32
#include <netinet/in.h>
#include <arpa/inet.h>
#else
static int socket_inited = 0;
static WSADATA wsa_data;
static void clean_sockets(void) {
WSACleanup();
}
static int check_init(void) {
if (!socket_inited) {
int result = WSAStartup(MAKEWORD(2, 2), &wsa_data);
if (result == NO_ERROR) {
socket_inited = 1;
atexit(clean_sockets);
}
}
return socket_inited;
}
#endif
void buf_htonl(void* buf, int len) {
int* buf_i = (int*) buf;
int i;
for (i = 0; i < (len / sizeof(int)) + 1; i++) {
buf_i[i] = htonl(buf_i[i]);
}
}
void buf_ntohl(void* buf, int len) {
int* buf_i = (int*) buf;
int i;
for (i = 0; i < (len / sizeof(int)) + 1; i++) {
buf_i[i] = ntohl(buf_i[i]);
}
}
void* idrnet_malloc(int size) {
return malloc(size);
}
void idrnet_free(void* ptr) {
free(ptr);
}
int idrnet_socket(int domain, int type, int protocol) {
#ifdef _WIN32
if (!check_init()) {
return -1;
}
#endif
return socket(domain, type, protocol);
}
// We call this from quite a few functions. Given a textual host and an int port,
// populates a struct addrinfo.
int idrnet_getaddrinfo(struct addrinfo** address_res, char* host, int port,
int family, int socket_type) {
struct addrinfo hints;
// Convert port into string
char str_port[8];
sprintf(str_port, "%d", port);
// Set up hints structure
memset(&hints, 0, sizeof(hints)); // zero out hints
hints.ai_family = family;
hints.ai_socktype = socket_type;
// If the length of the hostname is 0 (i.e, it was set to Nothing in Idris)
// then we want to instruct the C library to fill in the IP automatically
if (strlen(host) == 0) {
hints.ai_flags = AI_PASSIVE; // fill in IP automatically
return getaddrinfo(NULL, str_port, &hints, address_res);
}
return getaddrinfo(host, str_port, &hints, address_res);
}
int idrnet_bind(int sockfd, int family, int socket_type, char* host, int port) {
struct addrinfo* address_res;
int addr_res = idrnet_getaddrinfo(&address_res, host, port, family, socket_type);
if (addr_res != 0) {
//printf("Lib err: bind getaddrinfo\n");
return -1;
}
int bind_res = bind(sockfd, address_res->ai_addr, address_res->ai_addrlen);
if (bind_res == -1) {
//freeaddrinfo(address_res);
//printf("Lib err: bind\n");
return -1;
}
return 0;
}
int idrnet_connect(int sockfd, int family, int socket_type, char* host, int port) {
struct addrinfo* remote_host;
int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, socket_type);
if (addr_res != 0) {
return -1;
}
int connect_res = connect(sockfd, remote_host->ai_addr, remote_host->ai_addrlen);
if (connect_res == -1) {
freeaddrinfo(remote_host);
return -1;
}
freeaddrinfo(remote_host);
return 0;
}
int idrnet_sockaddr_family(void* sockaddr) {
struct sockaddr* addr = (struct sockaddr*) sockaddr;
return (int) addr->sa_family;
}
char* idrnet_sockaddr_ipv4(void* sockaddr) {
struct sockaddr_in* addr = (struct sockaddr_in*) sockaddr;
char* ip_addr = (char*) malloc(sizeof(char) * INET_ADDRSTRLEN);
inet_ntop(AF_INET, &(addr->sin_addr), ip_addr, INET_ADDRSTRLEN);
//printf("Lib: ip_addr: %s\n", ip_addr);
return ip_addr;
}
int idrnet_sockaddr_ipv4_port(void* sockaddr) {
struct sockaddr_in* addr = (struct sockaddr_in*) sockaddr;
return ((int) ntohs(addr->sin_port));
}
void* idrnet_create_sockaddr() {
return malloc(sizeof(struct sockaddr_storage));
}
int idrnet_accept(int sockfd, void* sockaddr) {
struct sockaddr* addr = (struct sockaddr*) sockaddr;
socklen_t addr_size = sizeof(struct sockaddr_storage);
return accept(sockfd, addr, &addr_size);
}
int idrnet_send(int sockfd, char* data) {
int len = strlen(data); // For now.
return send(sockfd, (void*) data, len, 0);
}
int idrnet_send_buf(int sockfd, void* data, int len) {
void* buf_cpy = malloc(len);
memset(buf_cpy, 0, len);
memcpy(buf_cpy, data, len);
buf_htonl(buf_cpy, len);
int res = send(sockfd, buf_cpy, len, 0);
free(buf_cpy);
return res;
}
void* idrnet_recv(int sockfd, int len) {
idrnet_recv_result* res_struct =
(idrnet_recv_result*) malloc(sizeof(idrnet_recv_result));
char* buf = malloc(len + 1);
memset(buf, 0, len + 1);
int recv_res = recv(sockfd, buf, len, 0);
res_struct->result = recv_res;
if (recv_res > 0) { // Data was received
buf[recv_res + 1] = 0x00; // Null-term, so Idris can interpret it
}
res_struct->payload = buf;
return (void*) res_struct;
}
int idrnet_recv_buf(int sockfd, void* buf, int len) {
int recv_res = recv(sockfd, buf, len, 0);
if (recv_res != -1) {
buf_ntohl(buf, len);
}
return recv_res;
}
int idrnet_get_recv_res(void* res_struct) {
return (((idrnet_recv_result*) res_struct)->result);
}
char* idrnet_get_recv_payload(void* res_struct) {
return (((idrnet_recv_result*) res_struct)->payload);
}
void idrnet_free_recv_struct(void* res_struct) {
idrnet_recv_result* i_res_struct =
(idrnet_recv_result*) res_struct;
if (i_res_struct->payload != NULL) {
free(i_res_struct->payload);
}
free(res_struct);
}
int idrnet_errno() {
return errno;
}
int idrnet_sendto(int sockfd, char* data, char* host, int port, int family) {
struct addrinfo* remote_host;
int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, SOCK_DGRAM);
if (addr_res != 0) {
return -1;
}
int send_res = sendto(sockfd, data, strlen(data), 0,
remote_host->ai_addr, remote_host->ai_addrlen);
freeaddrinfo(remote_host);
return send_res;
}
int idrnet_sendto_buf(int sockfd, void* buf, int buf_len, char* host, int port, int family) {
struct addrinfo* remote_host;
int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, SOCK_DGRAM);
if (addr_res != 0) {
//printf("lib err: sendto getaddrinfo \n");
return -1;
}
buf_htonl(buf, buf_len);
int send_res = sendto(sockfd, buf, buf_len, 0,
remote_host->ai_addr, remote_host->ai_addrlen);
if (send_res == -1) {
perror("lib err: sendto \n");
}
//freeaddrinfo(remote_host);
return send_res;
}
void* idrnet_recvfrom(int sockfd, int len) {
/*
* int recvfrom(int sockfd, void *buf, int len, unsigned int flags,
struct sockaddr *from, int *fromlen);
*/
// Allocate the required structures, and nuke them
struct sockaddr_storage* remote_addr =
(struct sockaddr_storage*) malloc(sizeof(struct sockaddr_storage));
char* buf = (char*) malloc(len + 1);
idrnet_recvfrom_result* ret =
(idrnet_recvfrom_result*) malloc(sizeof(idrnet_recvfrom_result));
memset(remote_addr, 0, sizeof(struct sockaddr_storage));
memset(buf, 0, len + 1);
memset(ret, 0, sizeof(idrnet_recvfrom_result));
socklen_t fromlen = sizeof(struct sockaddr_storage);
int recv_res = recvfrom(sockfd, buf, len, 0, (struct sockaddr*) remote_addr, &fromlen);
ret->result = recv_res;
// Check for failure...
if (recv_res == -1) {
free(buf);
free(remote_addr);
} else {
// If data was received, process and populate
ret->result = recv_res;
ret->remote_addr = remote_addr;
// Ensure the last byte is NULL, since in this mode we're sending strings
buf[len] = 0x00;
ret->payload = (void*) buf;
}
return ret;
}
void* idrnet_recvfrom_buf(int sockfd, void* buf, int len) {
// Allocate the required structures, and nuke them
struct sockaddr_storage* remote_addr =
(struct sockaddr_storage*) malloc(sizeof(struct sockaddr_storage));
idrnet_recvfrom_result* ret =
(idrnet_recvfrom_result*) malloc(sizeof(idrnet_recvfrom_result));
memset(remote_addr, 0, sizeof(struct sockaddr_storage));
memset(ret, 0, sizeof(idrnet_recvfrom_result));
socklen_t fromlen = 0;
int recv_res = recvfrom(sockfd, buf, len, 0, (struct sockaddr*) remote_addr, &fromlen);
// Check for failure... But don't free the buffer! Not our job.
ret->result = recv_res;
if (recv_res == -1) {
free(remote_addr);
}
// Payload will be NULL -- since it's been put into the user-specified buffer. We
// still need the return struct to get our hands on the remote address, though.
if (recv_res > 0) {
buf_ntohl(buf, len);
ret->payload = NULL;
ret->remote_addr = remote_addr;
}
return ret;
}
int idrnet_get_recvfrom_res(void* res_struct) {
return (((idrnet_recvfrom_result*) res_struct)->result);
}
char* idrnet_get_recvfrom_payload(void* res_struct) {
return (((idrnet_recvfrom_result*) res_struct)->payload);
}
void* idrnet_get_recvfrom_sockaddr(void* res_struct) {
idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
return recv_struct->remote_addr;
}
int idrnet_get_recvfrom_port(void* res_struct) {
idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
if (recv_struct->remote_addr != NULL) {
struct sockaddr_in* remote_addr_in =
(struct sockaddr_in*) recv_struct->remote_addr;
return ((int) ntohs(remote_addr_in->sin_port));
}
return -1;
}
void idrnet_free_recvfrom_struct(void* res_struct) {
idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
if (recv_struct != NULL) {
if (recv_struct->payload != NULL) {
free(recv_struct->payload);
}
if (recv_struct->remote_addr != NULL) {
free(recv_struct->remote_addr);
}
}
}
int idrnet_geteagain() {
return EAGAIN;
}

91
libs/network/idris_net.h Normal file
View File

@ -0,0 +1,91 @@
#ifndef IDRISNET_H
#define IDRISNET_H
// Includes used by the idris-file.
#ifdef _WIN32
#include <winsock2.h>
#include <Ws2tcpip.h>
#else
#include <netdb.h>
#include <unistd.h>
#include <sys/types.h>
#include <sys/socket.h>
#endif
struct sockaddr_storage;
struct addrinfo;
typedef struct idrnet_recv_result {
int result;
void* payload;
} idrnet_recv_result;
// Same type of thing as idrnet_recv_result, but for UDP, so stores some
// address information
typedef struct idrnet_recvfrom_result {
int result;
void* payload;
struct sockaddr_storage* remote_addr;
} idrnet_recvfrom_result;
// Memory management functions
void* idrnet_malloc(int size);
void idrnet_free(void* ptr);
// Gets value of errno
int idrnet_errno();
int idrnet_socket(int domain, int type, int protocol);
// Bind
int idrnet_bind(int sockfd, int family, int socket_type, char* host, int port);
// Connect
int idrnet_connect(int sockfd, int family, int socket_type, char* host, int port);
// Accessor functions for struct_sockaddr
int idrnet_sockaddr_family(void* sockaddr);
char* idrnet_sockaddr_ipv4(void* sockaddr);
int idrnet_sockaddr_ipv4_port(void* sockaddr);
void* idrnet_create_sockaddr();
// Accept
int idrnet_accept(int sockfd, void* sockaddr);
// Send
int idrnet_send(int sockfd, char* data);
int idrnet_send_buf(int sockfd, void* data, int len);
// Receive
// Creates a result structure containing result and payload
void* idrnet_recv(int sockfd, int len);
// Receives directly into a buffer
int idrnet_recv_buf(int sockfd, void* buf, int len);
// UDP Send
int idrnet_sendto(int sockfd, char* data, char* host, int port, int family);
int idrnet_sendto_buf(int sockfd, void* buf, int buf_len, char* host, int port, int family);
// UDP Receive
void* idrnet_recvfrom(int sockfd, int len);
void* idrnet_recvfrom_buf(int sockfd, void* buf, int len);
// Receive structure accessors
int idrnet_get_recv_res(void* res_struct);
char* idrnet_get_recv_payload(void* res_struct);
void idrnet_free_recv_struct(void* res_struct);
// Recvfrom structure accessors
int idrnet_get_recvfrom_res(void* res_struct);
char* idrnet_get_recvfrom_payload(void* res_struct);
void* idrnet_get_recvfrom_sockaddr(void* res_struct);
void idrnet_free_recvfrom_struct(void* res_struct);
int idrnet_getaddrinfo(struct addrinfo** address_res, char* host,
int port, int family, int socket_type);
int idrnet_geteagain();
#endif

6
libs/network/network.ipkg Normal file
View File

@ -0,0 +1,6 @@
package network
modules = Network.Socket,
Network.Socket.Data,
Network.Socket.Raw,
Network.Cgi