Add Racket implementation

.github/workflows/ci.yml

@@ -19,7 +19,7 @@ jobs:
     steps:
     - uses: actions/checkout@v2
     - name: Install python and other dependencies
-      run: sudo apt-get update && sudo apt-get --assume-yes install python3-wheel python3-setuptools ruby ocaml opam rustc cargo
+      run: sudo apt-get update && sudo apt-get --assume-yes install python3-wheel python3-setuptools ruby ocaml opam rustc cargo racket
     - name: Install meson and ninja
       run: pip3 install --user meson ninja PyYAML
     - name: Checkout rizin
@@ -112,6 +112,14 @@ jobs:
         make
       working-directory: ruby
 
+    - name: Run Racket rz-pipe test
+      run: |
+        export PATH=${HOME}/bin:${HOME}/.local/bin:${PATH}
+        export LD_LIBRARY_PATH=${HOME}/lib/$(uname -m)-linux-gnu:${HOME}/lib:${HOME}/lib64:${LD_LIBRARY_PATH}
+        export PKG_CONFIG_PATH=${HOME}/lib/pkgconfig:${HOME}/lib/$(uname -m)-linux-gnu/pkgconfig:${PKG_CONFIG_PATH}
+        raco test main.rkt
+      working-directory: racket
+
   rust-fmt-clippy:
     runs-on: ubuntu-latest
 

.gitignore

@@ -2,3 +2,4 @@ __pycache__
 .idea
 rzpipe.egg-info
 target/
+.DS_Store

README.md

@@ -33,3 +33,4 @@ The current supported languages are:
   * OCaml
   * Rust
   * Ruby
+  * Racket

racket/.gitignore

@@ -0,0 +1 @@
+/compiled/

racket/README.md

@@ -0,0 +1,25 @@
+# rz-pipe for (Typed) Racket
+
+This rz-pipe implementation can be used both in Typed Racket with static
+type checking, and in untyped Racket with contracts evaluated at runtime.
+
+## Installation
+
+In this directory, to install the package user-wide:
+
+```
+raco pkg install
+```
+
+### Usage example
+
+```racket
+#lang racket
+
+(require (prefix-in rz: rz-pipe))
+
+(define rz (rz:open "/bin/ls"))
+(printf "~v\n" (rz:cmd rz "ao @ main"))          ; string result
+(printf "~v\n" (rz:cmdj rz "aoj @ main"))        ; json result
+(rz:close rz)
+```

racket/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+(define collection "rz-pipe")
+(define license '(LGPL-3.0-only OR MIT))

racket/main.rkt

@@ -0,0 +1,70 @@
+#lang typed/racket/base
+
+(require racket/string
+         racket/port
+         typed/json)
+
+(provide
+  Rizin
+  rizin?
+  open
+  close
+  cmd
+  cmdj
+  (struct-out exn:fail:rz-pipe:rizin-not-found)
+  (struct-out exn:fail:rz-pipe:unexpected-data))
+
+(struct rizin
+  ([sp : Subprocess]
+   [out : Input-Port]
+   [in : Output-Port])
+  #:type-name Rizin)
+
+(struct exn:fail:rz-pipe:rizin-not-found exn:fail ())
+(struct exn:fail:rz-pipe:unexpected-data exn:fail ())
+
+(define (open [filename : (U Bytes Path-String)] #:stderr [err-mode : (U 'forward 'ignore) 'forward]) : Rizin
+  (define rizin-path (find-executable-path "rizin"))
+  (unless rizin-path
+    (raise (exn:fail:rz-pipe:rizin-not-found "open: rizin executable was not found in PATH" (current-continuation-marks))))
+  (define-values (sp out in err)
+    (subprocess #f #f #f rizin-path #"-q0" filename))
+  (define err-dst
+    ; we could pass (current-error-port) to subprocess above, but this will not work if
+    ; that is not a file-stream-port?, as is the case in DrRacket for example.
+    (case err-mode
+      [(forward) (current-error-port)]
+      [(ignore) (open-output-nowhere)]))
+  (thread
+    (λ ()
+      (copy-port err err-dst)
+      (close-input-port err)))
+  (unless (equal? (read-byte out) 0) ; read initial \0
+    (raise (exn:fail:rz-pipe:unexpected-data "open: rizin did not write initial 0-byte" (current-continuation-marks))))
+  (rizin sp out in))
+
+(define (close [rz : Rizin])
+  (cmd rz "q")
+  (close-input-port (rizin-out rz))
+  (close-output-port (rizin-in rz))
+  (subprocess-wait (rizin-sp rz)))
+
+(define (cmd [rz : Rizin] [command : String]) : String
+  (define normalized (string-replace command "\n" ";"))
+  (write-string normalized (rizin-in rz))
+  (newline (rizin-in rz))
+  (flush-output (rizin-in rz))
+  (define m (regexp-match #rx#"^([^\0]*)\0" (rizin-out rz)))
+  (unless m (raise (exn:fail:rz-pipe:unexpected-data "cmd: rizin stdout was closed" (current-continuation-marks))))
+  (bytes->string/utf-8 (assert (cadr m) bytes?)))
+
+(define (cmdj [rz : Rizin] [command : String]) : JSExpr (string->jsexpr (cmd rz command)))
+
+(module+ test
+  (require typed/rackunit)
+  (define rz (open "malloc://1024"))
+  (void (cmd rz "w \"Hello World\""))
+  (check-equal? (cmd rz "ps") "Hello World\n")
+  (define j (cmdj rz "psj"))
+  (check-equal? (hash-ref (assert j hash?) 'string) "Hello World")
+  (close rz))