Mercurial > core / emacs/lib/c2.el

 ;;; c2.el --- remote execution of elisp -*- lexical-binding: t -*-
 ;; Copyright (C) 2021-2024  ellis
 ;; 
 ;; Author: ellis
 ;; Keywords: local, vc, net, process
 ;; 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation, either version 3 of the License, or
 ;; (at your option) any later version.
 ;; 
 ;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 ;; 
 ;; Commentary:
 ;; 
 ;; This package provides functions for executing elisp on a running
 ;; emacs instance remotely.
 ;; 
 ;;; Code:
 (defgroup c2 nil
   "elisp server")
 
 (defcustom c2-directory (join-paths user-stash-directory "c2") "c2 directory."
   :group 'c2)
 
 (defcustom c2-after-make-frame-hook nil
   "Hook run when c2 creates a client frame.
 The created frame is selected when the hook is called."
   :type 'hook
   :group 'c2)
 
 (defcustom c2-done-hook nil
   "Hook run when done editing a buffer with c2."
   :type 'hook
   :group 'c2)
 
 (defcustom c2-port 62824
   "port of the c2 broadcaster"
   :group 'c2)
 
 (defvar c2-process nil
   "The c2 process handle.")
 
 (defvar c2-clients nil
   "List of current c2 clients.
 Each element is a process.")
 
 ;;; Bindat
 (setq c2-header-bindat-spec
       '((dest-ip   ip)
         (dest-port u16)
         (src-ip    ip)
         (src-port  u16)))
 
 (setq c2-body-bindat-spec
       '((type      u8)
         (opcode    u8)
         (length    u16)
         (id        strz 8)
         (data      vec (length))
         (align     4)))
 
 (setq c2-packet-bindat-spec
       '((header    struct header-spec)
         (counters  vec 2 u32r)
         (items     u8)
         (fill      3)
         (item      repeat (items)
                    (struct data-spec))))
 
 (defun c2-insert-string (string)
   (insert string 0 (make-string (- 3 (% (length string) 4)) 0)))
 
 (defun c2-insert-int32 (value)
   (let (bytes)
     (dotimes (i 4)
       (push (% value 256) bytes)
       (setq value (/ value 256)))
     (dolist (byte bytes)
       (insert byte))))
 
 (defun c2-insert-float32 (value)
   (let (s (e 0) f)
     (cond
      ((string= (format "%f" value) (format "%f" -0.0))
       (setq s 1 f 0))
      ((string= (format "%f" value) (format "%f" 0.0))
       (setq s 0 f 0))
      ((= value 1.0e+INF)
       (setq s 0 e 255 f (1- (expt 2 23))))
      ((= value -1.0e+INF)
       (setq s 1 e 255 f (1- (expt 2 23))))
      ((string= (format "%f" value) (format "%f" 0.0e+NaN))
       (setq s 0 e 255 f 1))
      (t
       (setq s (if (>= value 0.0)
 		  (progn (setq f value) 0)
 		(setq f (* -1 value)) 1))
       (while (>= (* f (expt 2.0 e)) 2.0) (setq e (1- e)))
       (if (= e 0) (while (< (* f (expt 2.0 e)) 1.0) (setq e (1+ e))))
       (setq f (round (* (1- (* f (expt 2.0 e))) (expt 2 23)))
 	    e (+ (* -1 e) 127))))
     (insert (+ (lsh s 7) (lsh (logand e #XFE) -1))
 	    (+ (lsh (logand e #X01) 7) (lsh (logand f #X7F0000) -16))
 	    (lsh (logand f #XFF00) -8)
 	    (logand f #XFF))))
 
 (defun c2-read-string ()
   (let ((pos (point)) string)
     (while (not (= (following-char) 0)) (forward-char 1))
     (setq string (buffer-substring-no-properties pos (point)))
     (forward-char (- 4 (% (length string) 4)))
     string))
 
 (defun c2-read-int32 ()
   (let ((value 0))
     (dotimes (i 4)
       (setq value (logior (* value 256) (following-char)))
       (forward-char 1))
     value))
 
 (defun c2-read-float32 ()
   (let ((s (lsh (logand (following-char) #X80) -7))
 	(e (+ (lsh (logand (following-char) #X7F) 1)
 	      (lsh (logand (progn (forward-char) (following-char)) #X80) -7)))
 	(f (+ (lsh (logand (following-char) #X7F) 16)
 	      (lsh (progn (forward-char) (following-char)) 8)
 	      (prog1 (progn (forward-char) (following-char)) (forward-char)))))
     (cond
      ((and (= e 0) (= f 0))
       (* 0.0 (expt -1 s))
       ((and (= e 255) (or (= f (1- (expt 2 23))) (= f 0)))
        (* 1.0e+INF (expt -1 s)))
       ((and (= e 255) (not (or (= f 0) (= f (1- (expt 2 23))))))
        0.0e+NaN)
       (t
        (* (expt -1 s)
 	  (expt 2.0 (- e 127))
 	  (1+ (/ f (expt 2.0 23)))))))))
 
 ;;; Network
 ;;;###autoload
 (defun net-check-opts ()
   ;; https://gnu.huihoo.org/emacs/24.4/emacs-lisp/Network-Options.html#Network-Options
   ;; non-blocking
   (featurep 'make-network-process '(:nowait t))
   ;; UNIX socket
 					;(featurep 'make-network-process '(:family local))
   ;; UDP
   (featurep 'make-network-process '(:type datagram)))
 
 ;;; Process
 (defun c2-make-client (host port)
   (make-network-process
    :name "c2-client"
    :coding 'binary
    :host host
    :service port
    :type 'datagram
    :nowait t))
 
 (defun c2-sentinel (proc msg)
   (when (string= msg "connection broken by remote peer\n")
     (setq c2-clients (assq-delete-all proc c2-clients))
     (c2-log (format "client %s has quit" proc))))
 
 ;;from server.el
 (defun c2-log (string &optional client)
   "If a *c2* buffer exists, write STRING to it for logging purposes."
   (if (get-buffer "*c2*")
       (with-current-buffer "*c2*"
         (goto-char (point-max))
         (insert (if client (format "<%s>: " (format-network-address (process-datagram-address client))))
                 string)
         (or (bolp) (newline)))))
 
 ;;;###autoload
 (defun c2-start nil
   "start c2 over udp"
   (interactive)
   (unless (process-status "c2")
     (make-network-process :name "c2"
 			  :buffer "*c2*"
 			  :family 'ipv4
 			  :service c2-port
 			  :type 'datagram
 			  :coding 'binary
 			  :sentinel 'c2-sentinel
 			  :filter 'c2-filter
 			  :server t
 			  :broadcast t) 
     (setq c2-clients '())
     ;; setup additional filters
     (add-function :after (process-filter (get-process "c2")) #'c2-eval-response-filter))
   (message "c2: ONLINE"))
 
 ;;;###autoload
 (defun c2-stop ()
   "stop the c2 server."
   (interactive)
   (while  c2-clients
     (delete-process (car (car c2-clients)))
     (setq c2-clients (cdr c2-clients)))
   (with-current-buffer "*c2*"
     (let ((proc (get-buffer-process (current-buffer))))
       (if proc (delete-process proc)))
     (set-buffer-modified-p nil)
     (kill-this-buffer))
   (message "c2 stopped"))
 
 (defun c2-filter (proc string)   
   (let ((pending (assoc proc c2-clients))
         message
         index)
     ;;create entry if required
     (unless pending
       (setq c2-clients (cons (cons proc "") c2-clients))
       (setq pending  (assoc proc c2-clients)))
     (setq message (concat (cdr pending) string))
     (while (setq index (string-match "\n" message))
       (setq index (1+ index))
 ;      (process-send-string proc (substring message 0 index))
       (c2-log  (substring message 0 index) proc)
       (setq message (substring message index)))
     (setcdr pending message)))
 
 (defun c2-packet-filter (proc string)
   "process-filter for decoding 'c2-packet-bindat-spec'"
   (bindat-unpack packet-spec string))
 
 (defun ordinary-insertion-filter (proc string)
   (when (buffer-live-p (process-buffer proc))
     (with-current-buffer (process-buffer proc)
       (let ((moving (= (point) (process-mark proc))))
 
         (save-excursion
           ;; Insert the text, advancing the process marker.
           (goto-char (process-mark proc))
           (insert string)
           (set-marker (process-mark proc) (point)))
         (if moving (goto-char (process-mark proc)))))))
 
 (defun c2-eval-response-filter (proc string)
   "execute STRING from PROC."
   (let ((msg (car (read-from-string string))))
     (process-send-string proc (concat (format "%s" (ignore-errors "error: %S" (eval msg))) "\n"))))
 
 ;;;; Signals
 ;;;###autoload
 (defun c2-shutdown ()
   "Save buffers, Quit, and Shutdown (kill) server"
   (interactive)
   (save-some-buffers)
   (kill-emacs))
 
 ;;;###autoload
 (defun c2-restart ()
   "Handler for SIGUSR1 signal, to (re)start an emacs server.
 
 Can be tested from within emacs with:
   (signal-process (emacs-pid) 'sigusr1)
 
 or from the command line with:
 $ kill -USR1 <emacs-pid>
 $ emacsclient -c
 "
   (interactive)
   (server-force-delete)
   (server-start)
   )
 
 (define-key special-event-map [sigusr1] 'c2-restart)
 
 (provide 'c2)
 ;;; c2.el ends here