aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/world/console.lux72
-rw-r--r--stdlib/source/lux/world/shell.lux161
2 files changed, 203 insertions, 30 deletions
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index ff54445ed..0d84ae993 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -6,12 +6,12 @@
[concurrency
["." promise (#+ Promise)]]
[security
- [capability (#+ Capability)]]]
+ ["!" capability (#+ capability:)]]]
[data
["." error (#+ Error)]
["." text
format]]
- ["." io (#+ IO Process io)]
+ ["." io (#+ IO io)]
[host (#+ import:)]
[tool
[compiler
@@ -25,31 +25,36 @@
[cannot-close]
)
-(type: #export (Can-Read ! o)
- (Capability [] (! (Error o))))
+(capability: #export (Can-Read ! o)
+ (can-read [] (! (Error o))))
-(type: #export (Can-Write ! i)
- (Capability i (! (Error Any))))
+(capability: #export (Can-Write ! i)
+ (can-write i (! (Error Any))))
-(type: #export (Can-Close !)
- (Capability [] (! (Error Any))))
+(capability: #export (Can-Close !)
+ (can-close [] (! (Error Any))))
(signature: #export (Console !)
(: (Can-Read ! Nat)
- read)
+ can-read)
(: (Can-Read ! Text)
- read-line)
+ can-read-line)
(: (Can-Write ! Text)
- write)
+ can-write)
(: (Can-Close !)
- close))
+ can-close))
(def: #export (async console)
(-> (Console IO) (Console Promise))
- (`` (structure (~~ (do-template [<capability>]
- [(def: <capability> (|>> (:: console <capability>) promise.future))]
+ (`` (structure (~~ (do-template [<capability> <forge>]
+ [(def: <capability>
+ (<forge>
+ (|>> (!.use (:: console <capability>)) promise.future)))]
- [read] [read-line] [write] [close])))))
+ [can-read ..can-read]
+ [can-read-line ..can-read]
+ [can-write ..can-write]
+ [can-close ..can-close])))))
(`` (for {(~~ (static host.jvm))
(as-is (import: java/lang/String)
@@ -74,30 +79,37 @@
[?jvm-console (System::console)]
(case ?jvm-console
#.None
- (io.fail (ex.construct cannot-open []))
+ (wrap (ex.throw cannot-open []))
(#.Some jvm-console)
(let [jvm-input (System::in)
jvm-output (System::out)]
- (<| io.from-io
- wrap
+ (<| wrap
+ ex.return
(: (Console IO)) ## TODO: Remove ASAP
(structure
- (def: (read _)
- (|> jvm-input
- InputStream::read
- (:: (error.with-error io.functor) map .nat)))
+ (def: can-read
+ (..can-read
+ (function (_ _)
+ (|> jvm-input
+ InputStream::read
+ (:: (error.with-error io.monad) map .nat)))))
- (def: (read-line _)
- (java/io/Console::readLine jvm-console))
+ (def: can-read-line
+ (..can-read
+ (function (_ _)
+ (java/io/Console::readLine jvm-console))))
- (def: (write message)
- (PrintStream::print message jvm-output))
+ (def: can-write
+ (..can-write
+ (function (_ message)
+ (PrintStream::print message jvm-output))))
- (def: close
- (|>> (ex.construct cannot-close) io.fail)))))))))
+ (def: can-close
+ (..can-close
+ (|>> (ex.throw cannot-close) wrap))))))))))
}))
-(def: #export (write-line message Console<!>)
+(def: #export (write-line message console)
(All [!] (-> Text (Console !) (! Any)))
- (:: Console<!> write (format message text.new-line)))
+ (!.use (:: console can-write) (format message text.new-line)))
diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux
new file mode 100644
index 000000000..aefdf2b3c
--- /dev/null
+++ b/stdlib/source/lux/world/shell.lux
@@ -0,0 +1,161 @@
+(.module:
+ [lux #*
+ ["." io (#+ IO)]
+ ["jvm" host (#+ import:)]
+ [control
+ [monad (#+ do)]]
+ [data
+ [number (#+ hex)]
+ ["." product]
+ ["." maybe]
+ ["." error (#+ Error)]
+ ["." text
+ format
+ ["." encoding]]
+ [format
+ ["." context (#+ Context)]]
+ [collection
+ ["." array (#+ Array)]
+ ["." list ("#/." fold functor)]
+ ["." dictionary]]]
+ [tool
+ [compiler
+ ["." host]]]
+ [world
+ ["." console (#+ Console)]]])
+
+## https://en.wikipedia.org/wiki/Code_injection#Shell_injection
+(def: windows?
+ (-> Text Bit)
+ (text.starts-with? "windows"))
+
+(def: (sanitize-command windows?)
+ (-> Bit (-> Text Text))
+ (let [dangerous (format "\&#;`|*?~<>^()[]{}$"
+ (text.from-code (hex "0A"))
+ (text.from-code (hex "FF")))
+ dangerous (if windows?
+ (format dangerous "%!")
+ dangerous)
+ indices (list.n/range 0 (dec (text.size dangerous)))]
+ (function (_ unsafe)
+ (list/fold (function (_ index safer)
+ (let [bad (|> dangerous (text.nth index) maybe.assume text.from-code)
+ good (if windows?
+ " "
+ (format "\" bad))]
+ (text.replace-all bad good safer)))
+ unsafe
+ indices))))
+
+(def: (sanitize-argument windows?)
+ (-> Bit (-> Text Text))
+ (if windows?
+ (|>> (text.replace-all "%" " ")
+ (text.replace-all "!" " ")
+ (text.replace-all text.double-quote " ")
+ (text.enclose' text.double-quote))
+ (|>> (text.replace-all "'" "\'")
+ (text.enclose' "'"))))
+
+(`` (for {(~~ (static host.jvm))
+ (as-is (import: #long java/lang/String
+ (toLowerCase [] java/lang/String))
+
+ (def: (arguments-array arguments)
+ (-> (List Text) (Array java/lang/String))
+ (product.right
+ (list/fold (function (_ argument [idx output])
+ [(inc idx) (jvm.array-write idx argument output)])
+ [0 (jvm.array java/lang/String (list.size arguments))]
+ arguments)))
+
+ (import: #long (java/util/Map k v)
+ (put [k v] v))
+
+ (def: (load-environment input target)
+ (-> Context
+ (java/util/Map java/lang/String java/lang/String)
+ (java/util/Map java/lang/String java/lang/String))
+ (list/fold (function (_ [key value] target')
+ (exec (java/util/Map::put key value target')
+ target'))
+ target
+ (dictionary.entries input)))
+
+ (import: #long java/io/Reader
+ (read [] #io #try int))
+
+ (import: #long java/io/BufferedReader
+ (new [java/io/Reader])
+ (readLine [] #io #try java/lang/String))
+
+ (import: #long java/io/InputStream)
+
+ (import: #long java/io/InputStreamReader
+ (new [java/io/InputStream]))
+
+ (import: #long java/io/OutputStream
+ (write [(Array byte)] #io #try void))
+
+ (import: #long java/lang/Process
+ (getInputStream [] #io #try java/io/InputStream)
+ (getOutputStream [] #io #try java/io/OutputStream)
+ (destroy [] #io #try void))
+
+ (def: (process-console process)
+ (-> java/lang/Process (IO (Error (Console IO))))
+ (do (error.with-error io.monad)
+ [jvm-input (java/lang/Process::getInputStream process)
+ #let [jvm-input (|> jvm-input
+ java/io/InputStreamReader::new
+ java/io/BufferedReader::new)]
+ jvm-output (java/lang/Process::getOutputStream process)]
+ (wrap (: (Console IO)
+ (structure
+ (def: can-read
+ (console.can-read
+ (function (_ _)
+ (|> jvm-input
+ java/io/Reader::read
+ (:: (error.with-error io.monad) map .nat)))))
+
+ (def: can-read-line
+ (console.can-read
+ (function (_ _)
+ (|> jvm-input
+ java/io/BufferedReader::readLine))))
+
+ (def: can-write
+ (console.can-write
+ (function (_ message)
+ (|> jvm-output
+ (java/io/OutputStream::write (encoding.to-utf8 message))))))
+
+ (def: can-close
+ (console.can-close
+ (function (_ _)
+ (|> process
+ java/lang/Process::destroy)))))))))
+
+ (import: #long java/lang/ProcessBuilder
+ (new [(Array java/lang/String)])
+ (environment [] #io #try (java/util/Map java/lang/String java/lang/String))
+ (start [] #io #try java/lang/Process))
+
+ (import: #long java/lang/System
+ (#static getProperty [java/lang/String] #io #try java/lang/String))
+ )}))
+
+(def: #export (execute environment command arguments)
+ (-> Context Text (List Text) (IO (Error (Console IO))))
+ (`` (for {(~~ (static host.jvm))
+ (do (error.with-error io.monad)
+ [windows? (:: @ map (|>> java/lang/String::toLowerCase ..windows?)
+ (java/lang/System::getProperty "os.name"))
+ #let [builder (java/lang/ProcessBuilder::new (arguments-array (list& (sanitize-command windows? command)
+ (list/map (sanitize-argument windows?) arguments))))]
+ environment (:: @ map (load-environment environment)
+ (java/lang/ProcessBuilder::environment builder))
+ process (java/lang/ProcessBuilder::start builder)]
+ (process-console process))})))