py4j stuff

py4j.lisp

(defpackage #:py4j
  (:use #:cl))

(in-package #:py4j)

;; endpoint: 127.0.0.1 25333

;; Creating a JavaGateway object calls:
;;   create-gateway-client
;;     Instantiates a GatewayClient
;;   create-gateway-property
;;     Instantiates a GatewayProperty
;;   set-gateway-client
;;     Instantiates JavaObject for entry-point and for java-gateway-server
;;     Instantiates a JVMView
;;   eager-load (maybe)
;;     Tries to call System.currentTimeMillis
;;   start-callback-server (maybe)

;; The main thing about GatewayClient is send_command
;; It creates a connection if necessary
;; Creating a connection means instantiating GatewayConnection and calling its start method

(defun create-gateway-connection (node port &key read-timeout)
  (let* ((host-ent (sb-bsd-sockets:get-host-by-name node))
         (address (first (sb-bsd-sockets:host-ent-addresses host-ent)))
         (socket (make-instance 'sb-bsd-sockets:inet-socket
                                :type :stream
                                :protocol :tcp)))
    (sb-bsd-sockets:socket-connect socket address port)
    (sb-bsd-sockets:socket-make-stream socket
                                       :input t
                                       :output t
                                       :timeout read-timeout
                                       :external-format :utf-8
                                       :buffering :full
                                       :auto-close t)))

;; Instantiating a GatewayConnection does the following:
;;
;;   getaddrinfo(address, port) to get af-type
;;
;;   socket(af-type, sock-stream)
;;
;;   set read timeout
;;
;;   wrap with ssl context if provided
;;
;; The start method does the following:
;;
;;   socket.connect(address, port)
;;
;;   authenticate
;;
;; The authenticate method does the following (if auth token is provided):
;;
;;   cmd = AUTH_COMMAND_NAME \n auth-token \n
;;   answer = send_command(cmd)
;;
;; The send_command method does the following:
;;
;;   socket.sendall(utf8(cmd))
;;
;;   answer = utf8(socket.readline().chomp())
;;   if answer.startswith(RETURN_MESSAGE):
;;       answer = answer[1:]
;;   if answer.strip() == "":
;;       error
;;   return answer
;;

;; entry_point = JavaObject(ENTRY_POINT_OBJECT_ID="t", gateway_client)
;;
;;   DIR_COMMAND_NAME + DIR_FIELDS_SUBCOMMAND_NAME + "t" + END_COMMAND_PART:
;;
;;   > d
;;   > f
;;   > t
;;   > e

(defvar *conn*)

(defun connect ()
  (setf *conn*
        (create-gateway-connection "127.0.0.1" 25333)))

(defun disconnect ()
  (when (and (boundp '*conn*)
             (streamp *conn*)
             (open-stream-p *conn*))
    (close *conn*)
    (makunbound '*conn*)))

(defun resolve-target (target)
  (cond ((eq target 't) "t")
        ((eq target 'c) "c")
        ((eq target 'g) "GATEWAY_SERVER")
        ((stringp target) target)
        ((and (listp target) (eq (car target) :class))
         (format nil "z:~A" (cadr target)))
        (t (error "Don't know how to resolve target ~S." target))))

(defun java-import (s &optional (view-id "rj"))
  (command (list "j"
                 "i"
                 view-id
                 (get-command-part s)
                 "e")))

(defun ref-get (name &optional (view-id "rj"))
  (command (list "r" "u" name view-id "e")))

(defun ref-mem (class name)
  (command (list "r" "m" (resolve-class class) name "e")))

(defun call (target method-name &rest args)
  (command (append (list "c" (resolve-target target) method-name)
                   (mapcar #'get-command-part args)
                   (list "e"))))

(defun field (target field-name)
  (command (list "f" "g" (resolve-target target) field-name "e")))

(defun dir (&optional (target 't))
  (let ((target-id (resolve-target target)))
    (list :fields (split-lines (command (list "d" "f" target-id "e")))
          :methods (split-lines (command (list "d" "m" target-id "e"))))))

(defun resolve-class (class)
  (cond ((stringp class) class)
        ((and (listp class) (eq (car class) :class)) (cadr class))
        (t (error "Can't resolve class ~S." class))))

(defun statics (class)
  (split-lines (command (list "d" "s" (resolve-class class) "e"))))

(defun split-lines (string &key include-empty)
  (values
   (split-sequence:split-sequence #\Newline string
                                  :remove-empty-subseqs (not include-empty))))

(defun command (list)
  (dolist (line list)
    (write-line line *conn*))
  (finish-output *conn*)
  (let ((answer (read-line *conn*)))
    (when (and (> (length answer) 0) (char= (char answer 0) #\!))
      (setf answer (subseq answer 1)))
    (when (zerop (length answer))
      (error "Answer from Java side is empty."))
    (get-return-value answer)))

(defun get-return-value (answer)
  (cond ((or (equal answer "")
             (char/= (char answer 0) #\y))
         (cond ((> (length answer) 1)
                (let ((type (char answer 1)))
                  (let ((value (convert-output type (subseq answer 2))))
                    (error "Java error: ~S." value))))
               (t
                (error "Java error (raw answer ~S)." answer))))
        (t
         (let ((type (char answer 1)))
           (convert-output type (subseq answer 2))))))

(defun get-command-part (object)
  (etypecase object
    ((eql :null) "n")
    (null "bfalse")
    ((eql t) "btrue")
    ((integer -2147483648 2147483647) (format nil "i~D" object))
    (integer (format nil "L~D" object))
    (float (format nil "d~F" object))
    (rational (format nil "d~F" (coerce object 'double-float)))
    ((simple-array (unsigned-byte 8))
     (format nil "j~A" (cl-base64:usb8-array-to-base64-string object)))
    (string (format nil "s~A" (escape-new-line object)))))

(defun convert-output (type value)
  (ecase type
    ((#\n) :null)
    ((#\b) (equalp value "true"))
    ((#\L) (values (parse-integer value)))
    ((#\D) (read-from-string value))
    ((#\i) (values (parse-integer value)))
    ((#\j) (cl-base64:base64-string-to-usb8-array value))
    ((#\d) (read-from-string value))
    ((#\s) (unescape-new-line value))
    ((#\v) (values))
    ((#\c) (list :class value))
    ((#\m) (list :method value))))

(defun escape-new-line (string)
  (cond ((position-if (lambda (char)
                        (or (char= #\\ char)
                            (char= #\Newline char)
                            (char= #\Return char)))
                      string)
         (with-output-to-string (out)
           (loop for char across string
                 do (case char
                      ((#\\) (write-string "\\\\" out))
                      ((#\Newline) (write-string "\\n" out))
                      ((#\Return) (write-string "\\r" out))
                      (t (write-char char out))))))
        (t string)))

(defun unescape-new-line (string)
  (cond ((null (position #\\ string)) string)
        (t (with-output-to-string (out)
             (with-input-from-string (in string)
               (loop with esc = nil
                     for char = (read-char in nil nil)
                     while char
                     do (cond ((and esc (eql char #\n))
                               (write-char #\Newline out)
                               (setf esc nil))
                              ((and esc (eql char #\r))
                               (write-char #\Return out)
                               (setf esc nil))
                              ((and esc (eql char #\\))
                               (write-char #\\ out)
                               (setf esc nil))
                              ((eql char #\\)
                               (setf esc t))
                              (t
                               (write-char char out)
                               (setf esc nil)))))))))

;; Example of use
;;
;; PY4J> (connect)
;; #<SB-SYS:FD-STREAM for "socket 127.0.0.1:47594, peer: 127.0.0.1:25333" {10052A7863}>
;; PY4J> (dir)
;; (:FIELDS NIL :METHODS
;;  ("add" "getClass" "wait" "hashCode" "equals" "notifyAll" "main" "toString"
;;   "notify"))
;; PY4J> (call 't "add" 1 2)
;; 3
;; PY4J> (ref-get "System")
;; (:CLASS "java.lang.System")
;; PY4J> (statics *)
;; ("setSecurityManager" "setProperties" "runFinalizersOnExit" "lineSeparator"
;;  "setOut" "out" "clearProperty" "identityHashCode" "load" "arraycopy"
;;  "nanoTime" "inheritedChannel" "gc" "getenv" "setErr" "console" "loadLibrary"
;;  "getProperty" "setIn" "err" "in" "getProperties" "getSecurityManager" "exit"
;;  "mapLibraryName" "setProperty" "currentTimeMillis" "runFinalization")
;; PY4J> (call '(:class "java.lang.System") "currentTimeMillis")
;; 1572656104143
;; PY4J> (disconnect)
;; *CONN*