Added machinery to interact with the operating-system's shell.

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))})))