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/test/test/lux/control/security/taint.lux | 11 +- stdlib/test/test/lux/world/file.lux | 195 +++++++++++++----------- stdlib/test/test/lux/world/net/tcp.lux | 69 ++++----- stdlib/test/test/lux/world/net/udp.lux | 58 +++---- 4 files changed, 180 insertions(+), 153 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/control/security/taint.lux b/stdlib/test/test/lux/control/security/taint.lux index 0b18111ef..5b33e7127 100644 --- a/stdlib/test/test/lux/control/security/taint.lux +++ b/stdlib/test/test/lux/control/security/taint.lux @@ -6,6 +6,7 @@ [security ["@" taint]]] [data + ["." error] ["." text ("text/." Equivalence) format]] [math @@ -20,11 +21,15 @@ (test "Can clean a tainted value by trusting it." (text/= raw (@.trust dirty))) (test "Can validate a tainted value." - (case (@.validate (|>> text.size (n/> 0)) dirty) - (#.Some clean) + (case (@.validate (function (_ value) + (if (|> value text.size (n/> 0)) + (#error.Success value) + (#error.Error "Empty text is invalid."))) + dirty) + (#error.Success clean) (text/= raw clean) - #.None + (#error.Error error) false)) ))) diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux index b9bd2457a..1332ebdfc 100644 --- a/stdlib/test/test/lux/world/file.lux +++ b/stdlib/test/test/lux/world/file.lux @@ -1,21 +1,23 @@ (.module: [lux #* - [io] + ["." io (#+ IO)] [control - [monad (#+ do)]] + [monad (#+ do)] + [security + ["." taint (#+ Dirty)]]] [concurrency - [promise]] + ["." promise]] [data - [error] - [number] + ["." error (#+ Error)] + ["." number] ["." text format]] [time - [instant] - [duration]] + ["." instant] + ["." duration]] [world - ["@" file] - [binary]] + ["@" file (#+ File)] + ["." binary (#+ Binary)]] [math ["r" random]]] lux/test @@ -30,114 +32,125 @@ [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) dataL (_binary.binary file-size) dataR (_binary.binary file-size) - code r.nat last-modified (|> r.int (:: @ map (|>> (:: number.Number abs) truncate-millis duration.from-millis instant.absolute)))] ($_ seq (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 0 code)))] + [#let [file "temp_file_0"] result (promise.future - (do (:: @.JVM@System &monad) - [pre! (@.exists? @.JVM@System file) - _ (:: @.JVM@System write dataL file) - post! (@.exists? @.JVM@System file) - _ (:: @.JVM@System delete file) - remains? (@.exists? @.JVM@System file)] - (wrap (and (not pre!) post! + (do io.Monad + [#let [check-existence! (: (IO (Error Bit)) + (@.exists? io.Monad @.System file))] + pre! check-existence! + _ (:: @.System write dataL file) + post! check-existence! + _ (:: @.System delete file) + remains? check-existence!] + (wrap (and (not pre!) + post! (not remains?)))))] (assert "Can create/delete files." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 1 code)))] + [#let [file "temp_file_1"] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System write dataL file) - output (:: @.JVM@System read file) - _ (:: @.JVM@System delete file)] - (wrap (:: binary.Equivalence = dataL output))))] + (do io.Monad + [_ (:: @.System write dataL file) + output (:: @.System read file) + _ (:: @.System delete file)] + (wrap (:: binary.Equivalence = dataL (taint.trust output)))))] (assert "Can write/read files." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 2 code)))] + [#let [file "temp_file_2"] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System write dataL file) - read-size (:: @.JVM@System size file) - _ (:: @.JVM@System delete file)] + (do io.Monad + [_ (:: @.System write dataL file) + read-size (:: @.System size file) + _ (:: @.System delete file)] (wrap (n/= file-size read-size))))] (assert "Can read file size." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 3 code)))] + [#let [file "temp_file_3"] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System write dataL file) - _ (:: @.JVM@System append dataR file) - output (:: @.JVM@System read file) - read-size (:: @.JVM@System size file) - _ (:: @.JVM@System delete file)] + (do io.Monad + [_ (:: @.System write dataL file) + _ (:: @.System append dataR file) + output (:: @.System read file) + read-size (:: @.System size file) + _ (:: @.System delete file)] (wrap (and (n/= (n/* 2 file-size) read-size) - (:: binary.Equivalence = dataL (error.assume (binary.slice 0 (dec file-size) output))) - (:: binary.Equivalence = dataR (error.assume (binary.slice file-size (dec read-size) output)))))))] + (:: binary.Equivalence = + dataL + (error.assume (binary.slice 0 (dec file-size) + (taint.trust output)))) + (:: binary.Equivalence = + dataR + (error.assume (binary.slice file-size (dec read-size) + (taint.trust output))))))))] (assert "Can append to files." (error.default #0 result)))) (wrap (do promise.Monad - [#let [dir (format "temp_dir_" (%n (n/+ 4 code)))] + [#let [dir "temp_dir_4"] result (promise.future - (do (:: @.JVM@System &monad) - [pre! (@.exists? @.JVM@System dir) - _ (:: @.JVM@System make-directory dir) - post! (@.exists? @.JVM@System dir) - _ (:: @.JVM@System delete dir) - remains? (@.exists? @.JVM@System dir)] - (wrap (and (not pre!) post! + (do io.Monad + [#let [check-existence! (: (IO (Error Bit)) + (@.exists? io.Monad @.System dir))] + pre! check-existence! + _ (:: @.System make-directory dir) + post! check-existence! + _ (:: @.System delete dir) + remains? check-existence!] + (wrap (and (not pre!) + post! (not remains?)))))] (assert "Can create/delete directories." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 5 code))) - dir (format "temp_dir_" (%n (n/+ 5 code)))] + [#let [file "temp_file_5" + dir "temp_dir_5"] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System write dataL file) - file-is-file (:: @.JVM@System file? file) - file-is-directory (:: @.JVM@System directory? file) - _ (:: @.JVM@System delete file) - _ (:: @.JVM@System make-directory dir) - directory-is-file (:: @.JVM@System file? dir) - directory-is-directory (:: @.JVM@System directory? dir) - _ (:: @.JVM@System delete dir)] + (do io.Monad + [_ (:: @.System write dataL file) + file-is-file (:: @.System file? file) + file-is-directory (:: @.System directory? file) + _ (:: @.System delete file) + _ (:: @.System make-directory dir) + directory-is-file (:: @.System file? dir) + directory-is-directory (:: @.System directory? dir) + _ (:: @.System delete dir)] (wrap (and file-is-file (not file-is-directory) (not directory-is-file) directory-is-directory))))] (assert "Can differentiate files from directories." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 6 code))) - dir (format "temp_dir_" (%n (n/+ 6 code)))] + [#let [file "temp_file_6" + dir "temp_dir_6"] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System make-directory dir) + (do io.Monad + [_ (:: @.System make-directory dir) #let [file' (format dir "/" file)] - _ (:: @.JVM@System write dataL file') - read-size (:: @.JVM@System size file') - _ (:: @.JVM@System delete file') - _ (:: @.JVM@System delete dir)] + _ (:: @.System write dataL file') + read-size (:: @.System size file') + _ (:: @.System delete file') + _ (:: @.System delete dir)] (wrap (n/= file-size read-size))))] (assert "Can create files inside of directories." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 7 code))) - dir (format "temp_dir_" (%n (n/+ 7 code)))] + [#let [file "temp_file_7" + dir "temp_dir_7"] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System make-directory dir) + (do io.Monad + [_ (:: @.System make-directory dir) #let [file' (format dir "/" file)] - _ (:: @.JVM@System write dataL file') - children (:: @.JVM@System files dir) - _ (:: @.JVM@System delete file') - _ (:: @.JVM@System delete dir)] + _ (:: @.System write dataL file') + children (:: @.System files dir) + _ (:: @.System delete file') + _ (:: @.System delete dir)] (wrap (case children (^ (list child)) (text.ends-with? file' child) @@ -147,28 +160,32 @@ (assert "Can list files inside a directory." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file (format "temp_file_" (%n (n/+ 8 code)))] + [#let [file "temp_file_8"] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System write dataL file) - _ (:: @.JVM@System modify last-modified file) - time-read (:: @.JVM@System last-modified file) - _ (:: @.JVM@System delete file)] + (do io.Monad + [_ (:: @.System write dataL file) + _ (:: @.System modify last-modified file) + time-read (:: @.System last-modified file) + _ (:: @.System delete file)] (wrap (:: instant.Equivalence = last-modified time-read))))] (assert "Can change the time of last modification." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file0 (format "temp_file_" (%n (n/+ 9 code)) "+0") - file1 (format "temp_file_" (%n (n/+ 9 code)) "+1")] + [#let [file0 (format "temp_file_9+0") + file1 (format "temp_file_9+1")] result (promise.future - (do (:: @.JVM@System &monad) - [_ (:: @.JVM@System write dataL file0) - pre! (@.exists? @.JVM@System file0) - _ (:: @.JVM@System move file1 file0) - post! (@.exists? @.JVM@System file0) - confirmed? (@.exists? @.JVM@System file1) - _ (:: @.JVM@System delete file1)] - (wrap (and pre! (not post!) confirmed?))))] + (do io.Monad + [#let [check-existence! (: (-> File (IO (Error Bit))) + (@.exists? io.Monad @.System))] + _ (:: @.System write dataL file0) + pre! (check-existence! file0) + _ (:: @.System move file1 file0) + post! (check-existence! file0) + confirmed? (check-existence! file1) + _ (:: @.System delete file1)] + (wrap (and pre! + (not post!) + confirmed?))))] (assert "Can move a file from one path to another." (error.default #0 result)))) ))) diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux index 7520a2fbc..ecae405d7 100644 --- a/stdlib/test/test/lux/world/net/tcp.lux +++ b/stdlib/test/test/lux/world/net/tcp.lux @@ -3,13 +3,14 @@ ["." io] [control [monad (#+ do)] - ["ex" exception (#+ exception:)]] + ["ex" exception (#+ exception:)] + [security + ["." taint]]] [concurrency - ["P" promise] - ["T" task] + ["." promise (#+ Promise promise)] [frp ("frp/." Functor)]] [data - ["E" error] + ["." error] ["." text format]] [world @@ -23,6 +24,7 @@ ["_." binary]]) (def: localhost net.Address "127.0.0.1") + (def: port (r.Random net.Port) (|> r.nat @@ -35,36 +37,35 @@ [port ..port size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) from (_binary.binary size) - to (_binary.binary size) - #let [temp-from (binary.create size) - temp-to (binary.create size)]] + to (_binary.binary size)] ($_ seq - (wrap (do P.Monad - [result (do T.Monad - [[server-close server] (@.server port) - #let [from-worked? (: (T.Task Bit) - (P.promise #.Nil)) - _ (frp/map (function (_ socket) - (do @ - [bytes-from (@.read temp-from 0 size socket) - #let [_ (io.run (P.resolve (#E.Success (and (n/= size bytes-from) - (:: binary.Equivalence = from temp-from))) - from-worked?))]] - (@.write to 0 size socket))) - server)] - - client (@.client localhost port) - _ (@.write from 0 size client) - from-worked? from-worked? - #################### - bytes-to (@.read temp-to 0 size client) - #let [to-worked? (and (n/= size bytes-to) - (:: binary.Equivalence = to temp-to))] - #################### - _ (@.close client) - _ (T.from-promise (P.future (P.resolve [] server-close)))] - (wrap (and from-worked? - to-worked?)))] + (wrap (do promise.Monad + [#let [from-worked? (: (Promise Bit) + (promise #.Nil))] + result (promise.future + (do io.Monad + [[server-close server] (@.server port) + #let [_ (frp/map (function (_ client) + (promise.future + (do @ + [[trasmission-size transmission] (:: client read size) + #let [_ (io.run (promise.resolve (and (n/= size trasmission-size) + (:: binary.Equivalence = from (taint.trust transmission))) + from-worked?))]] + (:: client write to)))) + server)] + client (@.client localhost port) + _ (:: client write from) + #################### + [trasmission-size transmission] (:: client read size) + #let [to-worked? (and (n/= size trasmission-size) + (:: binary.Equivalence = to (taint.trust transmission)))] + #################### + _ (:: client close []) + _ (io.from-io (promise.resolve [] server-close))] + (wrap to-worked?))) + from-worked? from-worked?] (assert "Can communicate between client and server." - (E.default #0 result)))) + (and from-worked? + (error.default #0 result))))) ))) diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux index 497cef8f3..d630816d8 100644 --- a/stdlib/test/test/lux/world/net/udp.lux +++ b/stdlib/test/test/lux/world/net/udp.lux @@ -1,14 +1,16 @@ (.module: [lux #* [control - [monad (#+ do)]] + [monad (#+ do)] + [security + ["." taint]]] [concurrency - ["P" promise] - ["T" task]] + ["." promise]] [data - ["E" error] + ["." error] ["." text format]] + ["." io] [world ["." binary] ["." net @@ -32,29 +34,31 @@ [port ..port size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) from (_binary.binary size) - to (_binary.binary size) - #let [temp (binary.create size)]] + to (_binary.binary size)] ($_ seq - (wrap (do P.Monad - [result (do T.Monad - [server (@.server port) - client (@.client []) - #################### - _ (@.write localhost port from 0 size client) - [bytes-from from-address from-port] (@.read temp 0 size server) - #let [from-worked? (and (n/= size bytes-from) - (:: binary.Equivalence = from temp))] - #################### - _ (@.write from-address from-port to 0 size server) - [bytes-to to-address to-port] (@.read temp 0 size client) - #let [to-worked? (and (n/= size bytes-to) - (:: binary.Equivalence = to temp) - (n/= port to-port))] - #################### - _ (@.close client) - _ (@.close server)] - (wrap (and from-worked? - to-worked?)))] + (wrap (do promise.Monad + [result (promise.future + (do io.Monad + [server (@.server port) + client @.client + #################### + _ (:: client write [localhost port] from) + [bytes-from [from-address from-port] temp] (:: server read size) + #let [from-worked? (and (n/= size bytes-from) + (:: binary.Equivalence = from (taint.trust temp)))] + #################### + _ (:: server write [from-address from-port] to) + [bytes-to [to-address to-port] temp] (:: client read size) + #let [to-worked? (and (n/= size bytes-to) + (:: binary.Equivalence = to (taint.trust temp)) + (n/= port to-port))] + #################### + _ (:: client close []) + _ (:: server close [])] + ## (wrap false) + (wrap (and from-worked? + to-worked?)) + ))] (assert "Can communicate between client and server." - (E.default #0 result)))) + (error.default #0 result)))) ))) -- cgit v1.2.3