From 789b163fd54d80d08d15cef4d48357a638a00f24 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 5 Dec 2018 21:59:56 -0400 Subject: Now tainting values coming from the outside world. --- stdlib/source/lux/control/security/taint.lux | 12 +- stdlib/source/lux/world/console.lux | 40 ++++-- stdlib/source/lux/world/environment.jvm.lux | 11 +- stdlib/source/lux/world/file.lux | 81 +++++++------ stdlib/source/lux/world/net.lux | 5 + stdlib/source/lux/world/net/tcp.jvm.lux | 175 ++++++++++++++------------- stdlib/source/lux/world/net/udp.jvm.lux | 146 ++++++++++++---------- 7 files changed, 255 insertions(+), 215 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/control/security/taint.lux b/stdlib/source/lux/control/security/taint.lux index 745baa95f..afdc1904c 100644 --- a/stdlib/source/lux/control/security/taint.lux +++ b/stdlib/source/lux/control/security/taint.lux @@ -1,10 +1,11 @@ (.module: [lux #* [control - [predicate (#+ Predicate)] [functor (#+ Functor)] [apply (#+ Apply)] [monad (#+ Monad)]] + [data + [error (#+ Error)]] [type abstract]]) @@ -15,12 +16,9 @@ (All [a] (-> a (Dirty a))) (|>> :abstraction)) - (def: #export (validate valid? dirty) - (All [a] (-> (Predicate a) (Dirty a) (Maybe a))) - (let [value (:representation dirty)] - (if (valid? value) - (#.Some value) - #.None))) + (def: #export (validate validator dirty) + (All [a b] (-> (-> a (Error b)) (Dirty a) (Error b))) + (validator (:representation dirty))) (def: #export trust (All [a] (-> (Dirty a) a)) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index cf7d2f2d4..99d290479 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -2,15 +2,20 @@ [lux #* [control [monad (#+ do)] - ["ex" exception (#+ exception:)]] + ["ex" exception (#+ exception:)] + [security + ["." taint (#+ Dirty taint)]]] [data - ["." error] + ["." error (#+ Error)] ["." text format]] ["." io (#+ IO Process io)] + [concurrency + ["." promise (#+ Promise)]] [host (#+ import:)] - [compiler - ["." host]]]) + [platform + [compiler + ["." host]]]]) (do-template [] [(exception: #export () @@ -21,15 +26,22 @@ ) (signature: #export (Console !) - (: (-> [] (! Nat)) + (: (-> Any (! (Error (Dirty Nat)))) read) - (: (-> [] (! Text)) + (: (-> Any (! (Error (Dirty Text)))) read-line) - (: (-> Text (! Any)) + (: (-> Text (! (Error Any))) write) - (: (-> [] (! Any)) + (: (-> Any (! (Error Any))) close)) +(def: #export (async console) + (-> (Console IO) (Console Promise)) + (`` (structure (~~ (do-template [] + [(def: (|>> (:: console ) promise.future))] + + [read] [read-line] [write] [close]))))) + (`` (for {(~~ (static host.jvm)) (as-is (import: java/lang/String) @@ -47,8 +59,8 @@ (#static in java/io/InputStream) (#static out java/io/PrintStream)) - (def: #export open - (Process (Console Process)) + (def: #export system + (IO (Error (Console IO))) (do io.Monad [?jvm-console (System::console)] (case ?jvm-console @@ -60,15 +72,17 @@ jvm-output (System::out)] (<| io.from-io wrap - (: (Console Process)) ## TODO: Remove ASAP + (: (Console IO)) ## TODO: Remove ASAP (structure (def: (read _) (|> jvm-input InputStream::read - (:: io.Functor map .nat))) + (:: io.Functor map (|>> .nat taint)))) (def: (read-line _) - (java/io/Console::readLine jvm-console)) + (|> jvm-console + java/io/Console::readLine + (:: io.Functor map taint))) (def: (write message) (PrintStream::print message jvm-output)) diff --git a/stdlib/source/lux/world/environment.jvm.lux b/stdlib/source/lux/world/environment.jvm.lux index 2a64c31f8..57ffcd465 100644 --- a/stdlib/source/lux/world/environment.jvm.lux +++ b/stdlib/source/lux/world/environment.jvm.lux @@ -1,5 +1,8 @@ (.module: [lux #* + [control + [security + ["." taint (#+ Dirty taint)]]] [data ["." text] [format @@ -9,6 +12,9 @@ [io (#- run)] [host (#+ import:)]]) +## Do not trust the values of environment variables +## https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables + (import: java/lang/String) (import: (java/util/Map$Entry k v) @@ -41,9 +47,10 @@ (Map$Entry::getValue entry)]) (def: #export read - (IO Context) + (IO (Dirty Context)) (io (|> (System::getenv) Map::entrySet Set::iterator (consume-iterator entry-to-kv) - (dictionary.from-list text.Hash)))) + (dictionary.from-list text.Hash) + taint))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index e97668917..9b53e4453 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -2,7 +2,9 @@ [lux #* [control ["." monad (#+ Monad do)] - ["ex" exception (#+ Exception exception:)]] + ["ex" exception (#+ Exception exception:)] + [security + ["." taint (#+ Dirty taint)]]] [data ["." maybe] ["." error (#+ Error)] @@ -15,10 +17,13 @@ ["." duration]] [world ["." binary (#+ Binary)]] - ["." io (#+ Process)] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise)]] [host (#+ import:)] - [compiler - ["." host]]]) + [platform + [compiler + ["." host]]]]) (type: #export File Text) @@ -28,63 +33,70 @@ #Execute) (signature: #export (System !) - (: (Monad !) - &monad) - - (: (All [e a] (-> (Exception e) e (! a))) - throw) - - (: (All [a] (-> (! a) (! (Error a)))) - try) - - (: (All [a] (-> (Error a) (! a))) - lift) - (do-template [] - [(: (-> Binary File (! Any)) + [(: (-> Binary File (! (Error Any))) )] [append] [write]) (do-template [ ] - [(: (-> File (! )) + [(: (-> File (! (Error ))) )] - [read Binary] + [read (Dirty Binary)] [size Nat] [files (List File)] [last-modified Instant]) (do-template [] - [(: (-> File (! Bit)) + [(: (-> File (! (Error Bit))) )] [file?] [directory?] ) - (: (-> Permission File (! Bit)) + (: (-> Permission File (! (Error Bit))) can?) (do-template [] - [(: (-> File (! Any)) + [(: (-> File (! (Error Any))) )] [make-directory] [delete] ) - (: (-> File File (! Any)) + (: (-> File File (! (Error Any))) move) - (: (-> Instant File (! Any)) + (: (-> Instant File (! (Error Any))) modify) (: Text separator) ) +(def: #export (async system) + (-> (System IO) (System Promise)) + (`` (structure + (~~ (do-template [] + [(def: ( parameter file) + (promise.future (:: system parameter file)))] + + [append] [write] + [can?] [move] [modify])) + + (~~ (do-template [] + [(def: (|>> (:: system ) promise.future))] + + [read] [size] [files] [last-modified] + [file?] [directory?] + [make-directory] [delete])) + + (def: separator (:: system separator))))) + (def: #export (un-nest System file) (All [!] (-> (System !) File (Maybe [File Text]))) (case (text.last-index-of (:: System separator) file) @@ -152,18 +164,7 @@ (import: java/io/FileInputStream (new [java/io/File] #io #try)) - (structure: #export JVM@System (System Process) - (def: &monad io.Monad) - - (def: throw io.throw) - - (def: (try computation) - (do io.Monad - [outcome computation] - (:: io.Monad wrap outcome))) - - (def: lift (:: io.Monad wrap)) - + (structure: #export _ (System IO) (do-template [ ] [(def: ( data file) (do io.Monad @@ -185,7 +186,7 @@ bytes-read (InputStream::read data stream) _ (AutoCloseable::close stream)] (if (i/= size bytes-read) - (wrap data) + (wrap (taint data)) (io.io (ex.throw cannot-read-all-data file))))) (def: size @@ -258,9 +259,9 @@ )) })) -(def: #export (exists? System file) - (All [!] (-> (System !) File (! Bit))) - (do (:: System &monad) +(def: #export (exists? Monad System file) + (All [!] (-> (Monad !) (System !) File (! (Error Bit)))) + (do (error.ErrorT Monad) [??? (:: System file? file)] (if ??? (wrap ???) diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux index c7e597a66..867430af0 100644 --- a/stdlib/source/lux/world/net.lux +++ b/stdlib/source/lux/world/net.lux @@ -2,4 +2,9 @@ lux) (type: #export Address Text) + (type: #export Port Nat) + +(type: #export Location + {#address Address + #port Port}) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index 50191c407..329d256e0 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -1,19 +1,22 @@ (.module: [lux #* [control - monad] + monad + [security + ["." taint (#+ Dirty taint)]]] [concurrency ["." promise (#+ Promise promise)] [task (#+ Task)] ["." frp]] [data - ["e" error]] - [type - abstract] + ["." error (#+ Error)]] [world - [binary (#+ Binary)]] - ["." io (#+ Process)] - [host (#+ import:)]] + ["." binary (#+ Binary)]] + ["." io (#+ IO)] + [host (#+ import:)] + [platform + [compiler + ["." host]]]] ["." //]) (import: java/lang/AutoCloseable @@ -30,8 +33,8 @@ (import: java/net/Socket (new [String int] #io #try) - (getInputStream [] #io #try InputStream) - (getOutputStream [] #io #try OutputStream)) + (getInputStream [] #try InputStream) + (getOutputStream [] #try OutputStream)) (import: java/net/ServerSocket (new [int] #io #try) @@ -41,80 +44,80 @@ ############################################################ ############################################################ -(abstract: #export TCP {} - {#socket Socket - #in InputStream - #out OutputStream} - - (def: #export (read data offset length self) - (-> Binary Nat Nat TCP (Task Nat)) - (promise.future - (do io.Monad - [bytes-read (InputStream::read data (.int offset) (.int length) - (get@ #in (:representation self)))] - (wrap (.nat bytes-read))))) - - (def: #export (write data offset length self) - (-> Binary Nat Nat TCP (Task Any)) - (let [out (get@ #out (:representation self))] - (promise.future - (do io.Monad - [_ (OutputStream::write data (.int offset) (.int length) - out)] - (Flushable::flush out))))) - - (def: #export (close self) - (-> TCP (Task Any)) - (let [(^open ".") (:representation self)] - (promise.future - (do io.Monad - [_ (AutoCloseable::close in) - _ (AutoCloseable::close out)] - (AutoCloseable::close socket))))) - - (def: (tcp-client socket) - (-> Socket (Process TCP)) - (do io.Monad - [input (Socket::getInputStream socket) - output (Socket::getOutputStream socket)] - (wrap (:abstraction {#socket socket - #in input - #out output})))) - ) - -(def: #export (client address port) - (-> //.Address //.Port (Task TCP)) - (promise.future - (do io.Monad - [socket (Socket::new address (.int port))] - (tcp-client socket)))) - -(def: #export (server port) - (-> //.Port (Task [(Promise Any) - (frp.Channel TCP)])) - (promise.future - (do (e.ErrorT io.Monad) - [server (ServerSocket::new (.int port)) - #let [signal (: (Promise Any) - (promise #.None)) - _ (promise.await (function (_ _) - (AutoCloseable::close server)) - signal) - output (: (frp.Channel TCP) - (frp.channel [])) - _ (: (Promise Any) - (promise.future - (loop [_ []] - (do io.Monad - [?client (do (e.ErrorT io.Monad) - [socket (ServerSocket::accept server)] - (tcp-client socket))] - (case ?client - (#e.Error error) - (wrap []) - - (#e.Success client) - (do @ - [_ (frp.publish output client)] - (recur [])))))))]] - (wrap [signal output])))) +(signature: #export (TCP !) + (: (-> Nat (! (Error [Nat (Dirty Binary)]))) + read) + + (: (-> Binary (! (Error Any))) + write) + + (: (-> Any (! (Error Any))) + close)) + +(def: #export (async tcp) + (-> (TCP IO) (TCP Promise)) + (`` (structure (~~ (do-template [] + [(def: (|>> (:: tcp ) promise.future))] + + [read] [write] [close]))))) + +(`` (for {(~~ (static host.jvm)) + (as-is (def: (tcp socket) + (-> Socket (Error (TCP IO))) + (do error.Monad + [input (Socket::getInputStream socket) + output (Socket::getOutputStream socket)] + (wrap (: (TCP IO) + (structure (def: (read size) + (do io.Monad + [#let [data (binary.create size)] + bytes-read (InputStream::read data +0 (.int size) input)] + (wrap [(.nat bytes-read) + (taint data)]))) + + (def: (write data) + (do io.Monad + [_ (OutputStream::write data +0 (.int (binary.size data)) + output)] + (Flushable::flush output))) + + (def: (close _) + (do io.Monad + [_ (AutoCloseable::close input) + _ (AutoCloseable::close output)] + (AutoCloseable::close socket)))))))) + + (def: #export (client address port) + (-> //.Address //.Port (IO (Error (TCP IO)))) + (do io.Monad + [socket (Socket::new address (.int port))] + (io.io (tcp socket)))) + + (def: #export (server port) + (-> //.Port (IO (Error [(Promise Any) + (frp.Channel (TCP IO))]))) + (do io.Monad + [server (ServerSocket::new (.int port)) + #let [close-signal (: (Promise Any) + (promise #.None)) + _ (promise.await (function (_ _) + (AutoCloseable::close server)) + close-signal) + output (: (frp.Channel (TCP IO)) + (frp.channel [])) + _ (: (Promise Any) + (promise.future + (loop [_ []] + (do io.Monad + [?client (do io.Monad + [socket (ServerSocket::accept server)] + (io.io (tcp socket)))] + (case ?client + (#error.Error error) + (wrap []) + + (#error.Success client) + (do @ + [_ (frp.publish output client)] + (recur [])))))))]] + (wrap [close-signal output]))))})) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index 8b785eb98..842f1c969 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -2,22 +2,25 @@ [lux #* [control monad - ["ex" exception (#+ exception:)]] + ["ex" exception (#+ exception:)] + [security + ["." taint (#+ Dirty taint)]]] [concurrency - ["P" promise] - ["T" task]] + ["." promise (#+ Promise)] + [task (#+ Task)]] [data - ["e" error] + ["." error (#+ Error)] ["." maybe] [collection ["." array]]] - [type - abstract] [world - [binary (#+ Binary)]] - ["." io] - [host (#+ import:)]] - ["." //]) + ["." binary (#+ Binary)]] + ["." io (#+ IO)] + [host (#+ import:)] + [platform + [compiler + ["." host]]]] + ["." // (#+ Location)]) (import: java/lang/AutoCloseable (close [] #io #try void)) @@ -47,62 +50,71 @@ ############################################################ (exception: #export (cannot-resolve-address {address //.Address}) - address) + (ex.report ["Address" address])) (exception: #export (multiple-candidate-addresses {address //.Address}) - address) - -(def: (resolve address) - (-> //.Address (io.IO (e.Error InetAddress))) - (do (e.ErrorT io.Monad) - [addresses (InetAddress::getAllByName address)] - (: (io.IO (e.Error InetAddress)) - (case (array.size addresses) - 0 (io.io (ex.throw cannot-resolve-address address)) - 1 (wrap (maybe.assume (array.read 0 addresses))) - _ (io.io (ex.throw multiple-candidate-addresses address)))))) - -(abstract: #export UDP {} - {#socket DatagramSocket} - - (def: #export (read data offset length self) - (-> Binary Nat Nat UDP (T.Task [Nat //.Address //.Port])) - (let [(^open ".") (:representation self) - packet (DatagramPacket::new|receive data (.int offset) (.int length))] - (P.future - (do (e.ErrorT io.Monad) - [_ (DatagramSocket::receive packet socket) - #let [bytes-read (.nat (DatagramPacket::getLength packet))]] - (wrap [bytes-read - (|> packet DatagramPacket::getAddress InetAddress::getHostAddress) - (.nat (DatagramPacket::getPort packet))]))))) - - (def: #export (write address port data offset length self) - (-> //.Address //.Port Binary Nat Nat UDP (T.Task Any)) - (P.future - (do (e.ErrorT io.Monad) - [address (resolve address) - #let [(^open ".") (:representation self)]] - (DatagramSocket::send (DatagramPacket::new|send data (.int offset) (.int length) address (.int port)) - socket)))) - - (def: #export (close self) - (-> UDP (T.Task Any)) - (let [(^open ".") (:representation self)] - (P.future - (AutoCloseable::close socket)))) - - (def: #export (client _) - (-> Any (T.Task UDP)) - (P.future - (do (e.ErrorT io.Monad) - [socket (DatagramSocket::new|client)] - (wrap (:abstraction (#socket socket)))))) - - (def: #export (server port) - (-> //.Port (T.Task UDP)) - (P.future - (do (e.ErrorT io.Monad) - [socket (DatagramSocket::new|server (.int port))] - (wrap (:abstraction (#socket socket)))))) - ) + (ex.report ["Address" address])) + +(signature: #export (UDP !) + (: (-> Nat (! (Error [Nat Location (Dirty Binary)]))) + read) + + (: (-> Location Binary (! (Error Any))) + write) + + (: (-> Any (! (Error Any))) + close)) + +(def: #export (async udp) + (-> (UDP IO) (UDP Promise)) + (`` (structure (def: read (|>> (:: udp read) promise.future)) + + (def: (write location data) + (promise.future (:: udp write location data))) + + (def: close (|>> (:: udp close) promise.future))))) + +(`` (for {(~~ (static host.jvm)) + (as-is (def: (resolve address) + (-> //.Address (IO (Error InetAddress))) + (do io.Monad + [addresses (InetAddress::getAllByName address)] + (: (IO (Error InetAddress)) + (case (array.size addresses) + 0 (io.io (ex.throw cannot-resolve-address address)) + 1 (wrap (maybe.assume (array.read 0 addresses))) + _ (io.io (ex.throw multiple-candidate-addresses address)))))) + + (def: (udp socket) + (-> DatagramSocket (UDP IO)) + (structure (def: (read size) + (let [data (binary.create size) + packet (DatagramPacket::new|receive data +0 (.int size))] + (do io.Monad + [_ (DatagramSocket::receive packet socket) + #let [bytes-read (.nat (DatagramPacket::getLength packet))]] + (wrap [bytes-read + {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress) + #//.port (.nat (DatagramPacket::getPort packet))} + (taint data)])))) + + (def: (write location data) + (do io.Monad + [address (resolve (get@ #//.address location))] + (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location))) + socket))) + + (def: (close _) + (AutoCloseable::close socket)))) + + (def: #export client + (IO (Error (UDP IO))) + (|> (DatagramSocket::new|client) + (:: io.Monad map udp))) + + (def: #export server + (-> //.Port (IO (Error (UDP IO)))) + (|>> .int + DatagramSocket::new|server + (:: io.Monad map udp))) + )})) -- cgit v1.2.3