uniform-io 0.1.1.0 → 0.2.0.0
raw patch · 10 files changed
+447/−226 lines, 10 filesdep ~uniform-ioPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: uniform-io
API changes (from Hackage documentation)
+ System.IO.Uniform: data StdIO
+ System.IO.Uniform: tlsDHParametersFile :: TlsSettings -> String
- System.IO.Uniform: TlsSettings :: String -> String -> TlsSettings
+ System.IO.Uniform: TlsSettings :: String -> String -> String -> TlsSettings
Files
- dist/build/blockingStub/blockingStub-tmp/blockingStub.hs +5/−0
- dist/build/lazynessStub/lazynessStub-tmp/lazynessStub.hs +0/−5
- dist/build/targetsStub/targetsStub-tmp/targetsStub.hs +5/−0
- src/System/IO/Uniform/Targets.hs +118/−71
- src/System/IO/Uniform/ds.c +106/−73
- src/System/IO/Uniform/ds.h +22/−26
- test/Blocking.hs +88/−0
- test/Lazyness.hs +0/−42
- test/Targets.hs +80/−0
- uniform-io.cabal +23/−9
+ dist/build/blockingStub/blockingStub-tmp/blockingStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import Blocking ( tests )+main :: IO ()+main = stubMain tests
− dist/build/lazynessStub/lazynessStub-tmp/lazynessStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import Lazyness ( tests )-main :: IO ()-main = stubMain tests
+ dist/build/targetsStub/targetsStub-tmp/targetsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import Targets ( tests )+main :: IO ()+main = stubMain tests
src/System/IO/Uniform/Targets.hs view
@@ -2,8 +2,9 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE InterruptibleFFI #-}+{-# LANGUAGE EmptyDataDecls #-} -module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where+module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, StdIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where import Foreign import Foreign.C.Types@@ -14,16 +15,19 @@ import qualified Data.ByteString as BS import qualified Data.List as L import Control.Exception+import Control.Applicative ((<$>)) import qualified Network.Socket as Soc import System.IO.Error import Data.Default.Class +import System.Posix.Types (Fd(..))+ -- | Settings for starttls functions.-data TlsSettings = TlsSettings {tlsPrivateKeyFile :: String, tlsCertificateChainFile :: String} deriving (Read, Show)+data TlsSettings = TlsSettings {tlsPrivateKeyFile :: String, tlsCertificateChainFile :: String, tlsDHParametersFile :: String} deriving (Read, Show) instance Default TlsSettings where- def = TlsSettings "" ""+ def = TlsSettings "" "" "" -- | -- Typeclass for uniform IO targets.@@ -65,58 +69,90 @@ data Nethandler -- | A bounded IP port from where to accept SocketIO connections. newtype BoundedPort = BoundedPort {lis :: (Ptr Nethandler)}-data SockDs-newtype SocketIO = SocketIO {sock :: (Ptr SockDs)}-data FileDs-newtype FileIO = FileIO {fd :: (Ptr FileDs)}+data Ds+newtype SocketIO = SocketIO {sock :: (Ptr Ds)}+newtype FileIO = FileIO {fd :: (Ptr Ds)} data TlsDs newtype TlsStream = TlsStream {tls :: (Ptr TlsDs)}+data StdIO -- | UniformIO IP connections. instance UniformIO SocketIO where- uRead s n = allocaArray n (- \b -> do- count <- c_recvSock (sock s) b (fromIntegral n)- if count < 0- then throwErrno "could not read"- else BS.packCStringLen (b, fromIntegral count)- )- uPut s t = BS.useAsCStringLen t (- \(str, n) -> do- count <- c_sendSock (sock s) str $ fromIntegral n- if count < 0- then throwErrno "could not write"- else return ()- )- uClose s = c_closeSock (sock s)+ uRead s n = do+ allocaArray n (+ \b -> do+ count <- c_recv (sock s) b (fromIntegral n)+ if count < 0+ then throwErrno "could not read"+ else BS.packCStringLen (b, fromIntegral count)+ )+ uPut s t = do+ BS.useAsCStringLen t (+ \(str, n) -> do+ count <- c_send (sock s) str $ fromIntegral n+ if count < 0+ then throwErrno "could not write"+ else return ()+ )+ uClose s = do+ f <- Fd <$> c_prepareToClose (sock s)+ closeFd f startTls st s = withCString (tlsCertificateChainFile st) ( \cert -> withCString (tlsPrivateKeyFile st) (- \key -> do- r <- c_startSockTls (sock s) cert key- if r == nullPtr- then throwErrno "could not start TLS"- else return . TlsStream $ r+ \key -> withCString (tlsDHParametersFile st) (+ \para -> do+ r <- c_startSockTls (sock s) cert key para+ if r == nullPtr+ then throwErrno "could not start TLS"+ else return . TlsStream $ r+ ) ) ) isSecure _ = False +-- | UniformIO IP connections.+instance UniformIO StdIO where+ uRead _ n = do+ allocaArray n (+ \b -> do+ count <- c_recvStd b (fromIntegral n)+ if count < 0+ then throwErrno "could not read"+ else BS.packCStringLen (b, fromIntegral count)+ )+ uPut _ t = do+ BS.useAsCStringLen t (+ \(str, n) -> do+ count <- c_sendStd str $ fromIntegral n+ if count < 0+ then throwErrno "could not write"+ else return ()+ )+ uClose _ = return ()+ startTls _ _ = return . TlsStream $ nullPtr+ isSecure _ = False+ -- | UniformIO type for file IO. instance UniformIO FileIO where- uRead s n = allocaArray n (- \b -> do- count <- c_recvFile (fd s) b $ fromIntegral n- if count < 0- then throwErrno "could not read"- else BS.packCStringLen (b, fromIntegral count)- )- uPut s t = BS.useAsCStringLen t (- \(str, n) -> do- count <- c_sendFile (fd s) str $ fromIntegral n- if count < 0- then throwErrno "could not write"- else return ()- )- uClose s = c_closeFile (fd s)+ uRead s n = do+ allocaArray n (+ \b -> do+ count <- c_recv (fd s) b $ fromIntegral n+ if count < 0+ then throwErrno "could not read"+ else BS.packCStringLen (b, fromIntegral count)+ )+ uPut s t = do+ BS.useAsCStringLen t (+ \(str, n) -> do+ count <- c_send (fd s) str $ fromIntegral n+ if count < 0+ then throwErrno "could not write"+ else return ()+ )+ uClose s = do+ f <- Fd <$> c_prepareToClose (fd s)+ closeFd f -- Not implemented yet. startTls _ _ = return . TlsStream $ nullPtr isSecure _ = False@@ -124,21 +160,26 @@ -- | UniformIO wrapper that applies TLS to communication on IO target. -- This type is constructed by calling startTls on other targets. instance UniformIO TlsStream where- uRead s n = allocaArray n (- \b -> do- count <- c_recvTls (tls s) b $ fromIntegral n- if count < 0- then throwErrno "could not read"- else BS.packCStringLen (b, fromIntegral count)- )- uPut s t = BS.useAsCStringLen t (- \(str, n) -> do- count <- c_sendTls (tls s) str $ fromIntegral n- if count < 0- then throwErrno "could not write"- else return ()- )- uClose s = c_closeTls (tls s)+ uRead s n = do+ allocaArray n (+ \b -> do+ count <- c_recvTls (tls s) b $ fromIntegral n+ if count < 0+ then throwErrno "could not read"+ else BS.packCStringLen (b, fromIntegral count)+ )+ uPut s t = do+ BS.useAsCStringLen t (+ \(str, n) -> do+ count <- c_sendTls (tls s) str $ fromIntegral n+ if count < 0+ then throwErrno "could not write"+ else return ()+ )+ uClose s = do+ d <- c_closeTls (tls s)+ f <- Fd <$> c_prepareToClose d+ closeFd f startTls _ s = return s isSecure _ = True @@ -242,28 +283,34 @@ ) ) +closeFd :: Fd -> IO ()+closeFd (Fd f) = c_closeFd f+ -- | Closes a BoundedPort, and releases any resource used by it. closePort :: BoundedPort -> IO () closePort p = c_closePort (lis p) -foreign import ccall safe "getPort" c_getPort :: CInt -> IO (Ptr Nethandler)-foreign import ccall safe "createFromHandler" c_accept :: Ptr Nethandler -> IO (Ptr SockDs)-foreign import ccall safe "createFromFileName" c_createFile :: CString -> IO (Ptr FileDs)-foreign import ccall safe "createToIPv4Host" c_connect4 :: CUInt -> CInt -> IO (Ptr SockDs)-foreign import ccall safe "createToIPv6Host" c_connect6 :: Ptr CUChar -> CInt -> IO (Ptr SockDs)+foreign import ccall interruptible "getPort" c_getPort :: CInt -> IO (Ptr Nethandler)+foreign import ccall interruptible "createFromHandler" c_accept :: Ptr Nethandler -> IO (Ptr Ds)+foreign import ccall safe "createFromFileName" c_createFile :: CString -> IO (Ptr Ds)+foreign import ccall interruptible "createToIPv4Host" c_connect4 :: CUInt -> CInt -> IO (Ptr Ds)+foreign import ccall interruptible "createToIPv6Host" c_connect6 :: Ptr CUChar -> CInt -> IO (Ptr Ds) -foreign import ccall safe "startSockTls" c_startSockTls :: Ptr SockDs -> CString -> CString -> IO (Ptr TlsDs)-foreign import ccall safe "getPeer" c_getPeer :: Ptr SockDs -> Ptr CUInt -> Ptr CUChar -> Ptr CInt -> IO (CInt)+foreign import ccall interruptible "startSockTls" c_startSockTls :: Ptr Ds -> CString -> CString -> CString -> IO (Ptr TlsDs)+foreign import ccall safe "getPeer" c_getPeer :: Ptr Ds -> Ptr CUInt -> Ptr CUChar -> Ptr CInt -> IO (CInt) -foreign import ccall safe "closeSockDs" c_closeSock :: Ptr SockDs -> IO ()-foreign import ccall safe "closeFileDs" c_closeFile :: Ptr FileDs -> IO ()+--foreign import ccall safe "getFd" c_getFd :: Ptr Ds -> IO CInt+--foreign import ccall safe "getTlsFd" c_getTlsFd :: Ptr TlsDs -> IO CInt+foreign import ccall safe "closeFd" c_closeFd :: CInt -> IO ()++foreign import ccall safe "prepareToClose" c_prepareToClose :: Ptr Ds -> IO CInt foreign import ccall safe "closeHandler" c_closePort :: Ptr Nethandler -> IO ()-foreign import ccall safe "closeTlsDs" c_closeTls :: Ptr TlsDs -> IO ()+foreign import ccall safe "closeTls" c_closeTls :: Ptr TlsDs -> IO (Ptr Ds) -foreign import ccall interruptible "fileDsSend" c_sendFile :: Ptr FileDs -> Ptr CChar -> CInt -> IO CInt-foreign import ccall interruptible "sockDsSend" c_sendSock :: Ptr SockDs -> Ptr CChar -> CInt -> IO CInt+foreign import ccall interruptible "sendDs" c_send :: Ptr Ds -> Ptr CChar -> CInt -> IO CInt+foreign import ccall interruptible "stdDsSend" c_sendStd :: Ptr CChar -> CInt -> IO CInt foreign import ccall interruptible "tlsDsSend" c_sendTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt -foreign import ccall interruptible "fileDsRecv" c_recvFile :: Ptr FileDs -> Ptr CChar -> CInt -> IO CInt-foreign import ccall interruptible "sockDsRecv" c_recvSock :: Ptr SockDs -> Ptr CChar -> CInt -> IO CInt+foreign import ccall interruptible "recvDs" c_recv :: Ptr Ds -> Ptr CChar -> CInt -> IO CInt+foreign import ccall interruptible "stdDsRecv" c_recvStd :: Ptr CChar -> CInt -> IO CInt foreign import ccall interruptible "tlsDsRecv" c_recvTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt
src/System/IO/Uniform/ds.c view
@@ -11,10 +11,14 @@ #include <openssl/bio.h> #include <openssl/ssl.h> #include <openssl/err.h>+#include <pthread.h> #include "ds.h" int openSslLoaded = 0;+char *availableCiphers = "EDH+CAMELLIA:EDH+aRSA:EECDH+aRSA+AESGCM:EECDH+aRSA+SHA256:EECDH:"+ "+CAMELLIA128:+AES128:+SSLv3:!aNULL:!eNULL:!LOW:!3DES:!MD5:!EXP:!PSK:!DSS:!RC4:!SEED:"+ "!IDEA:!ECDSA:kEDH:CAMELLIA128-SHA:AES128-SHA"; void *clear(void *ptr){ int e = errno;@@ -25,15 +29,21 @@ return NULL; } -void loadOpenSSL(){+pthread_mutex_t loadLock;++void loadOpenSSL(const char *dh){+ if(openSslLoaded)+ return;+ pthread_mutex_lock(&loadLock); if(!openSslLoaded){- openSslLoaded = 1; SSL_load_error_strings(); ERR_load_BIO_strings(); ERR_load_crypto_strings(); SSL_library_init();- OpenSSL_add_all_algorithms();+ OpenSSL_add_all_algorithms(); + openSslLoaded = 1; }+ pthread_mutex_unlock(&loadLock); } void copy6addr(unsigned char d[16], const unsigned char s[16]){@@ -52,29 +62,29 @@ nethandler h = (nethandler)malloc(sizeof(s_nethandler)); h->ipv6 = ipv6; if(ipv6){- h->s = socket(AF_INET6, SOCK_STREAM, 0);+ h->fd = socket(AF_INET6, SOCK_STREAM, 0); }else{- h->s = socket(AF_INET, SOCK_STREAM, 0);+ h->fd = socket(AF_INET, SOCK_STREAM, 0); } int optval = 1;- setsockopt(h->s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof(optval));+ setsockopt(h->fd, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof(optval)); int e, en; if(ipv6){ struct sockaddr_in6 add; add.sin6_family = AF_INET6; zero6addr(add.sin6_addr.s6_addr); add.sin6_port = htons(port);- e = bind(h->s, (struct sockaddr*) &add, sizeof(add));+ e = bind(h->fd, (struct sockaddr*) &add, sizeof(add)); }else{ struct sockaddr_in add; add.sin_family = AF_INET; add.sin_addr.s_addr = INADDR_ANY; add.sin_port = htons(port);- e = bind(h->s, (struct sockaddr*) &add, sizeof(add));+ e = bind(h->fd, (struct sockaddr*) &add, sizeof(add)); } if(e) return clear(h);- e = listen(h->s, DEFAULT_LISTENNING_QUEUE);+ e = listen(h->fd, DEFAULT_LISTENNING_QUEUE); if(e) return clear(h); return h;@@ -88,39 +98,42 @@ return getNethandler(1, port); } -fileDs createFromFile(int f){- fileDs d = (fileDs)malloc(sizeof(s_fileDs));- d->f = f;+ds createFromFile(int f){+ ds d = (ds)malloc(sizeof(s_ds));+ d->tp = file;+ d->fd = f; return d; } -fileDs createFromFileName(const char *f){- int fd = open(f, O_CREAT | O_RDWR);+ds createFromFileName(const char *f){+ int fd = open(f, O_CREAT | O_RDWR, 0666); if(fd == -1){ return NULL; } return createFromFile(fd); } -sockDs createFromHandler(nethandler h){- sockDs d = (sockDs)malloc(sizeof(s_sockDs));+ds createFromHandler(nethandler h){+ ds d = (ds)malloc(sizeof(s_ds));+ d->tp = sock; unsigned int s = sizeof(d->peer);- d->s = accept(h->s, (struct sockaddr*)&(d->peer), &s);- if(d->s <= 0)+ d->fd = accept(h->fd, (struct sockaddr*)&(d->peer), &s);+ if(d->fd <= 0) return clear(d); d->ipv6 = d->peer.ss_family == AF_INET6; d->server = 1; return d; } -sockDs createToHost(struct sockaddr *add, const int add_size, const int ipv6){- sockDs d = (sockDs)malloc(sizeof(s_sockDs));+ds createToHost(struct sockaddr *add, const int add_size, const int ipv6){+ ds d = (ds)malloc(sizeof(s_ds));+ d->tp = sock; if(ipv6){- d->s = socket(AF_INET6, SOCK_STREAM, 0);+ d->fd = socket(AF_INET6, SOCK_STREAM, 0); }else{- d->s = socket(AF_INET, SOCK_STREAM, 0);+ d->fd = socket(AF_INET, SOCK_STREAM, 0); }- if(connect(d->s, add, add_size) < 0){+ if(connect(d->fd, add, add_size) < 0){ int e = errno; free(d); errno = e;@@ -130,7 +143,7 @@ return d; } -sockDs createToIPv4Host(const unsigned long host, const int port){+ds createToIPv4Host(const unsigned long host, const int port){ struct sockaddr_in add; add.sin_family = AF_INET; add.sin_port = htons(port);@@ -138,7 +151,7 @@ return createToHost((struct sockaddr*) &add, sizeof(add), 0); } -sockDs createToIPv6Host(const unsigned char host[16], const int port){+ds createToIPv6Host(const unsigned char host[16], const int port){ struct sockaddr_in6 add; add.sin6_family = AF_INET6; add.sin6_port = htons(port);@@ -148,11 +161,11 @@ return createToHost((struct sockaddr*) &add, sizeof(add), 1); } -int getPeer(sockDs d, unsigned long *ipv4peer, unsigned char ipv6peer[16], int *ipv6){+int getPeer(ds d, unsigned long *ipv4peer, unsigned char ipv6peer[16], int *ipv6){ int port = 0; struct sockaddr_storage peer; int peer_size = sizeof(peer);- if(getpeername(d->s, (struct sockaddr*)&peer, &peer_size)){+ if(getpeername(d->fd, (struct sockaddr*)&peer, &peer_size)){ return 0; } if(peer.ss_family == AF_INET){@@ -171,11 +184,8 @@ return port; } -int fileDsSend(fileDs d, const char *b, const int s){- return write(d->f, b, s);-}-int sockDsSend(sockDs d, const char *b, const int s){- return write(d->s, b, s);+int sendDs(ds d, const char *b, const int s){+ return write(d->fd, b, s); } int tlsDsSend(tlsDs d, const char *b, const int s){ return SSL_write(d->s, b, s);@@ -184,11 +194,8 @@ return write(1, b, s); } -int fileDsRecv(fileDs d, char *b, const int s){- return read(d->f, b, s);-}-int sockDsRecv(sockDs d, char *b, const int s){- return read(d->s, b, s);+int recvDs(ds d, char *b, const int s){+ return read(d->fd, b, s); } int tlsDsRecv(tlsDs d, char *b, const int s){ return SSL_read(d->s, b, s);@@ -198,88 +205,114 @@ } -void closeFileDs(fileDs d){- close(d->f);- free(d);-}-void closeSockDs(sockDs d){- close(d->s);+int prepareToClose(ds d){+ int fd = d->fd; free(d);+ return fd; } -void closeTlsDs(tlsDs d){- SSL_shutdown(d->s);+ds closeTls(tlsDs d){+ ds original = d->original; SSL_shutdown(d->s);+ //No bidirectional shutdown supported+ //SSL_shutdown(d->s); SSL_free(d->s);- switch(d->tp){- case file:- closeFileDs(d->original);- break;- case sock:- closeSockDs(d->original);- break;- } free(d);+ return original; } void closeHandler(nethandler h){- close(h->s);+ close(h->fd); free(h); } -tlsDs startSockTls(sockDs d, const char *cert, const char *key){- loadOpenSSL();+tlsDs startSockTls(ds d, const char *cert, const char *key, const char *dh){+ loadOpenSSL(dh); SSL_CTX * ctx = NULL; if(d->server)- ctx = SSL_CTX_new(TLSv1_server_method());+ ctx = SSL_CTX_new(TLSv1_1_server_method()); else- ctx = SSL_CTX_new(TLSv1_client_method());+ ctx = SSL_CTX_new(TLSv1_1_client_method()); if(!ctx) return NULL;+ if(d->server){+ FILE *dhfile = fopen(dh, "r");+ DH *dhdt = PEM_read_DHparams(dhfile, NULL, NULL, NULL);+ fclose(dhfile);+ if(SSL_CTX_set_tmp_dh(ctx, dhdt) <= 0){+ int f = prepareToClose(d);+ closeFd(f);+ clear(dhdt);+ return clear(ctx); + }+ } SSL_CTX_set_options(ctx, SSL_OP_SINGLE_DH_USE); if(cert) if(SSL_CTX_use_certificate_chain_file(ctx, cert) != 1){- closeSockDs(d);+ int f = prepareToClose(d);+ closeFd(f); return clear(ctx); } if(key) if(SSL_CTX_use_PrivateKey_file(ctx, key, SSL_FILETYPE_PEM) != 1){- closeSockDs(d);+ int f = prepareToClose(d);+ closeFd(f); return clear(ctx); }+ if(SSL_CTX_set_cipher_list(ctx, availableCiphers) <= 0){+ int f = prepareToClose(d);+ closeFd(f);+ return clear(ctx);+ } tlsDs t = (tlsDs)malloc(sizeof(s_tlsDs)); t->original = d; if(!(t->s = SSL_new(ctx))){- closeSockDs(d);+ int f = prepareToClose(d);+ closeFd(f); clear(ctx); return clear(t); }- if(!SSL_set_fd(t->s, d->s)){- closeTlsDs(t);+ if(!SSL_set_fd(t->s, d->fd)){+ closeTls(t); return NULL; }- printf("Starting handshake\n"); int retry = 1; int e; while(retry){ retry = 0;- if(d->server)+ if(d->server){+ SSL_set_accept_state(t->s); e = SSL_accept(t->s);- else+ }else{+ SSL_set_connect_state(t->s); e = SSL_connect(t->s);+ } if(e <= 0){- retry = 1;- int erval = SSL_get_error(t->s, e);+ unsigned long erval = SSL_get_error(t->s, e);+ //char ertxt[300];+ //ERR_error_string(erval, ertxt);+ //fprintf(stderr, "SSL Error: %s\n", ertxt); if((erval == SSL_ERROR_WANT_READ) || (erval == SSL_ERROR_WANT_WRITE)){- + //Here goes support to non-blocking IO, once it's supported+ //retry = 1; }else{- printf("Error\n");- ERR_print_errors(t->s->bbio);- closeTlsDs(t);+ closeTls(t); return NULL; } } }- printf("Success\n"); return t;+}++int getFd(ds d){+ return d->fd;+}++int getTlsFd(tlsDs t){+ ds d = t->original;+ return d->fd;+}++void closeFd(int fd){+ close(fd); }
src/System/IO/Uniform/ds.h view
@@ -2,28 +2,25 @@ #include <netinet/in.h> #include <openssl/ssl.h> +typedef enum {+ file, std, sock+} dstype;+ typedef struct {- int s;+ int fd;+ dstype tp; int ipv6; int server; struct sockaddr_storage peer;-} *sockDs, s_sockDs;--typedef struct {- int f;-} *fileDs, s_fileDs;+} *ds, s_ds; #define DEFAULT_LISTENNING_QUEUE 5 typedef struct{- int s;+ int fd; int ipv6; } *nethandler, s_nethandler; -typedef enum {- file, sock-} dstype;- typedef struct { dstype tp; void *original;@@ -33,26 +30,22 @@ nethandler getIPv4Port(const int port); nethandler getPort(const int port); -fileDs createFromFile(int);-fileDs createFromFileName(const char*);-sockDs createFromHandler(nethandler);-sockDs createToIPv4Host(const unsigned long, const int);-sockDs createToIPv6Host(const unsigned char[16], const int);+ds createFromFile(int);+ds createFromFileName(const char*);+ds createFromHandler(nethandler);+ds createToIPv4Host(const unsigned long, const int);+ds createToIPv6Host(const unsigned char[16], const int); -tlsDs startSockTls(sockDs, const char*, const char*);+tlsDs startSockTls(ds, const char*, const char*, const char*); -int getPeer(sockDs, unsigned long*, unsigned char[16], int*);+int getPeer(ds, unsigned long*, unsigned char[16], int*); -void closeSockDs(sockDs);-void closeFileDs(fileDs);+int closeDs(ds); void closeHandler(nethandler);-void closeTlsDs(tlsDs);--int fileDsSend(fileDs, const char[const], const int);-int fileDsRecv(fileDs, char[], const int);+ds closeTls(tlsDs); -int sockDsSend(sockDs, const char[const], const int);-int sockDsRecv(sockDs, char[], const int);+int sendDs(ds, const char[const], const int);+int recvDs(ds, char[], const int); int tlsDsSend(tlsDs, const char[const], const int); int tlsDsRecv(tlsDs, char[], const int);@@ -60,3 +53,6 @@ int stdDsSend(const char[const], const int); int stdDsRecv(char[], const int); +int getFd(ds);+int getTlsFd(tlsDs);+void closeFd(int);
+ test/Blocking.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++module Blocking (tests) where++import Distribution.TestSuite+import Base (simpleTest)+import Control.Concurrent(forkIO) +import qualified System.IO.Uniform as U+import qualified System.IO.Uniform.Streamline as S+import System.Timeout (timeout)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import qualified Data.Attoparsec.ByteString as A+--import Control.Monad.IO.Class (liftIO)++tests :: IO [Test]+tests = return [+ simpleTest "recieveLine"+ (successTimeout "A test\n" (restoreLine S.receiveLine)),+ simpleTest "runAttoparsec with successful parser"+ (successTimeout "abcde" (parseBS (A.string "abcde"))),+ simpleTest "runAttoparsec with failed parser"+ (failTimeout "abcde" (parseBS (A.string "c"))),+ simpleTest "lazyRecieveLine"+ (successTimeout "Another test\n" (concatLine S.lazyRecieveLine)),+ simpleTest "lazyReceiveN"+ (failTimeout "abcde" (concatLine (S.lazyReceiveN 5)))+ ]++parseBS :: A.Parser ByteString -> S.Streamline IO ByteString+parseBS p = do+ t <- S.runAttoparsec p+ case t of+ Left e -> return . C8.pack $ e+ Right s -> return s++restoreLine :: S.Streamline IO ByteString -> S.Streamline IO ByteString+restoreLine f = do+ l <- f+ return $ BS.concat [l, "\n"]+ +concatLine :: S.Streamline IO [ByteString] -> S.Streamline IO ByteString+concatLine f = do+ l <- f+ return . BS.concat $ l++-- | Tests the given command, by sending a string to an echo and running the command.+-- the command must not block.+successTimeout :: ByteString -> S.Streamline IO ByteString -> IO Progress+successTimeout txt f = do+ recv <- U.bindPort 8888+ forkIO $ S.withClient (\_ _ -> do+ l <- f+ S.send l+ return ()+ ) recv+ r' <- timeout 1000000 $ S.withServer (do+ S.send txt+ t <- f+ if t == txt+ then return . Finished $ Pass+ else return . Finished . Fail . C8.unpack $ t+ ) "127.0.0.1" 8888+ U.closePort recv+ case r' of+ Just r -> return r+ Nothing -> return . Finished . Fail $ "Execution blocked"++-- | Tests the given command, by sending text trough the network and running it.+-- Does not care about the result of the command, just wether it blocks.+failTimeout :: ByteString -> S.Streamline IO ByteString -> IO Progress+failTimeout txt f = do+ recv <- U.bindPort 8888+ forkIO $ S.withClient (\_ _ -> do+ f+ S.send "\n"+ return ()+ ) recv+ r' <- timeout 1000000 $ S.withServer (do+ S.send txt+ S.receiveLine+ return . Finished $ Pass+ ) "127.0.0.1" 8888+ U.closePort recv+ case r' of+ Just r -> return r+ Nothing -> return . Finished . Fail $ "Execution blocked"
− test/Lazyness.hs
@@ -1,42 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Lazyness (tests) where--import Distribution.TestSuite-import Control.Concurrent(forkIO) -import qualified System.IO.Uniform as U-import qualified System.IO.Uniform.Streamline as S-import System.Timeout (timeout) --tests :: IO [Test]-tests = return [Test readLine]- where- readLine = TestInstance- {run = testReadLine,- name = "Lazyness of readLine",- tags = [],- options = [],- setOption = \_ _ -> Right readLine- }- -testReadLine :: IO Progress-testReadLine = do- recv <- U.bindPort 8888- forkIO $ S.withClient (\_ _ -> do- l <- S.receiveLine- S.send l- S.send "\n"- return ()- ) recv- r <- timeout 1000000 $ S.withServer (do- S.send "A test\n"- S.receiveLine- return ()- ) "127.0.0.1" 8888- case r of- Just _ -> return . Finished $ Pass- Nothing -> return . Finished . Fail $ "Timeout on Streamline.readLine"----
+ test/Targets.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}++module Targets (tests) where++import Distribution.TestSuite+import Base (simpleTest)+import Control.Concurrent(forkIO) +import qualified System.IO.Uniform as U+import System.Timeout (timeout)+import qualified Data.ByteString.Char8 as C8++tests :: IO [Test]+tests = return [+ simpleTest "network" testNetwork,+ simpleTest "file" testFile,+ simpleTest "network TLS" testTls+ ]++testNetwork :: IO Progress+testNetwork = do+ recv <- U.bindPort 8888+ forkIO $ do+ s <- U.accept recv+ l <- U.uRead s 100+ U.uPut s l+ U.uClose s+ return ()+ r' <- timeout 1000000 $ do+ s <- U.connectToHost "127.0.0.1" 8888+ let l = "abcdef\n"+ U.uPut s l+ l' <- U.uRead s 100+ U.uClose s+ if l == l'+ then return . Finished $ Pass+ else return . Finished . Fail . C8.unpack $ l'+ U.closePort recv+ case r' of+ Just r -> return r+ Nothing -> return . Finished . Fail $ "Execution blocked"++testFile :: IO Progress+testFile = do+ let file = "test/testFile"+ s <- U.openFile file+ let l = "abcde\n"+ U.uPut s l+ U.uClose s+ s' <- U.openFile file+ l' <- U.uRead s' 100+ U.uClose s'+ if l == l'+ then return . Finished $ Pass+ else return . Finished . Fail . C8.unpack $ l'++testTls :: IO Progress+testTls = do+ recv <- U.bindPort 8888+ let set = U.TlsSettings "test/key.pem" "test/cert.pem" "test/dh.pem"+ forkIO $ do+ s' <- U.accept recv+ s <- U.startTls set s'+ l <- U.uRead s 100+ U.uPut s l+ U.uClose s+ return ()+ r' <- timeout 1000000 $ do+ s' <- U.connectToHost "127.0.0.1" 8888+ s <- U.startTls set s'+ let l = "abcdef\n"+ U.uPut s l+ l' <- U.uRead s 100+ U.uClose s+ if l == l'+ then return . Finished $ Pass+ else return . Finished . Fail . C8.unpack $ l'+ U.closePort recv+ case r' of+ Just r -> return r+ Nothing -> return . Finished . Fail $ "Execution blocked"
uniform-io.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.1.0+version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Uniform IO over files, network, watever.@@ -22,9 +22,9 @@ It also includes implementations for standard IO, files and network IO, and easy to use TLS wrapping of any of those. - Currently TLS only wraps sockets, std streams are not exported- and there's no support for TLS certificate verification. Those- are all planned to be added soon.+ Currently TLS only wraps sockets, and there's no support+ for TLS certificate verification. Those are planned+ to be added soon. Requires a '-threaded' compiler switch. @@ -70,7 +70,7 @@ source-repository this type: git location: https://sealgram.com/git/haskell/uniform-io- tag: 0.1.1.0+ tag: 0.2.0.0 library -- Modules exported by the library.@@ -111,15 +111,29 @@ includes: ds.h install-includes: ds.h C-Sources: src/System/IO/Uniform/ds.c- extra-libraries: ssl+ extra-libraries: ssl, pthread -Test-suite lazyness+Test-suite targets type: detailed-0.9- test-module: Lazyness+ test-module: Targets hs-source-dirs: test build-depends: base >=4.7 && <5.0, Cabal >= 1.9.2,- uniform-io == 0.1.1.0+ bytestring >=0.10 && <1.0,+ uniform-io == 0.2.0.0+ ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded++Test-suite blocking+ type: detailed-0.9+ test-module: Blocking+ hs-source-dirs:+ test+ build-depends:+ base >=4.7 && <5.0,+ Cabal >= 1.9.2,+ bytestring >=0.10 && <1.0,+ attoparsec >=0.10 && <1.0,+ uniform-io == 0.2.0.0 ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded