167
|
1
|
;;; c2.el --- remote execution of elisp -*- lexical-binding: t; -*- |
|
2
|
;; Copyright (C) 2021-2024 ellis |
|
3
|
;; |
|
4
|
;; Author: ellis |
|
5
|
;; Keywords: local, vc, net, process |
|
6
|
;; |
|
7
|
;; This program is free software; you can redistribute it and/or modify |
|
8
|
;; it under the terms of the GNU General Public License as published by |
|
9
|
;; the Free Software Foundation, either version 3 of the License, or |
|
10
|
;; (at your option) any later version. |
|
11
|
;; |
|
12
|
;; This program is distributed in the hope that it will be useful, |
|
13
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
14
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
15
|
;; GNU General Public License for more details. |
|
16
|
;; |
|
17
|
;; You should have received a copy of the GNU General Public License |
|
18
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>. |
|
19
|
;; |
|
20
|
;; Commentary: |
|
21
|
;; |
|
22
|
;; This package provides functions for executing elisp on a running |
|
23
|
;; emacs instance remotely. |
|
24
|
;; |
|
25
|
;;; Code: |
|
26
|
(defgroup c2 nil |
|
27
|
"elisp server") |
|
28
|
|
|
29
|
(defcustom c2-dir "~/c2" "c2 directory." |
|
30
|
:group 'c2) |
|
31
|
|
|
32
|
(defcustom c2-after-make-frame-hook nil |
|
33
|
"Hook run when c2 creates a client frame. |
|
34
|
The created frame is selected when the hook is called." |
|
35
|
:type 'hook |
|
36
|
:group 'c2) |
|
37
|
|
|
38
|
(defcustom c2-done-hook nil |
|
39
|
"Hook run when done editing a buffer with c2." |
|
40
|
:type 'hook |
|
41
|
:group 'c2) |
|
42
|
|
|
43
|
(defcustom c2-port 62824 |
|
44
|
"port of the c2 broadcaster" |
|
45
|
:group 'c2) |
|
46
|
|
|
47
|
(defvar c2-process nil |
|
48
|
"The c2 process handle.") |
|
49
|
|
|
50
|
(defvar c2-clients nil |
|
51
|
"List of current c2 clients. |
|
52
|
Each element is a process.") |
|
53
|
|
|
54
|
;;; Bindat |
|
55
|
(setq c2-header-bindat-spec |
|
56
|
'((dest-ip ip) |
|
57
|
(dest-port u16) |
|
58
|
(src-ip ip) |
|
59
|
(src-port u16))) |
|
60
|
|
|
61
|
(setq c2-body-bindat-spec |
|
62
|
'((type u8) |
|
63
|
(opcode u8) |
|
64
|
(length u16) |
|
65
|
(id strz 8) |
|
66
|
(data vec (length)) |
|
67
|
(align 4))) |
|
68
|
|
|
69
|
(setq c2-packet-bindat-spec |
|
70
|
'((header struct header-spec) |
|
71
|
(counters vec 2 u32r) |
|
72
|
(items u8) |
|
73
|
(fill 3) |
|
74
|
(item repeat (items) |
|
75
|
(struct data-spec)))) |
|
76
|
|
|
77
|
(defun c2-insert-string (string) |
|
78
|
(insert string 0 (make-string (- 3 (% (length string) 4)) 0))) |
|
79
|
|
|
80
|
(defun c2-insert-int32 (value) |
|
81
|
(let (bytes) |
|
82
|
(dotimes (i 4) |
|
83
|
(push (% value 256) bytes) |
|
84
|
(setq value (/ value 256))) |
|
85
|
(dolist (byte bytes) |
|
86
|
(insert byte)))) |
|
87
|
|
|
88
|
(defun c2-insert-float32 (value) |
|
89
|
(let (s (e 0) f) |
|
90
|
(cond |
|
91
|
((string= (format "%f" value) (format "%f" -0.0)) |
|
92
|
(setq s 1 f 0)) |
|
93
|
((string= (format "%f" value) (format "%f" 0.0)) |
|
94
|
(setq s 0 f 0)) |
|
95
|
((= value 1.0e+INF) |
|
96
|
(setq s 0 e 255 f (1- (expt 2 23)))) |
|
97
|
((= value -1.0e+INF) |
|
98
|
(setq s 1 e 255 f (1- (expt 2 23)))) |
|
99
|
((string= (format "%f" value) (format "%f" 0.0e+NaN)) |
|
100
|
(setq s 0 e 255 f 1)) |
|
101
|
(t |
|
102
|
(setq s (if (>= value 0.0) |
|
103
|
(progn (setq f value) 0) |
|
104
|
(setq f (* -1 value)) 1)) |
|
105
|
(while (>= (* f (expt 2.0 e)) 2.0) (setq e (1- e))) |
|
106
|
(if (= e 0) (while (< (* f (expt 2.0 e)) 1.0) (setq e (1+ e)))) |
|
107
|
(setq f (round (* (1- (* f (expt 2.0 e))) (expt 2 23))) |
|
108
|
e (+ (* -1 e) 127)))) |
|
109
|
(insert (+ (lsh s 7) (lsh (logand e #XFE) -1)) |
|
110
|
(+ (lsh (logand e #X01) 7) (lsh (logand f #X7F0000) -16)) |
|
111
|
(lsh (logand f #XFF00) -8) |
|
112
|
(logand f #XFF)))) |
|
113
|
|
|
114
|
(defun c2-read-string () |
|
115
|
(let ((pos (point)) string) |
|
116
|
(while (not (= (following-char) 0)) (forward-char 1)) |
|
117
|
(setq string (buffer-substring-no-properties pos (point))) |
|
118
|
(forward-char (- 4 (% (length string) 4))) |
|
119
|
string)) |
|
120
|
|
|
121
|
(defun c2-read-int32 () |
|
122
|
(let ((value 0)) |
|
123
|
(dotimes (i 4) |
|
124
|
(setq value (logior (* value 256) (following-char))) |
|
125
|
(forward-char 1)) |
|
126
|
value)) |
|
127
|
|
|
128
|
(defun c2-read-float32 () |
|
129
|
(let ((s (lsh (logand (following-char) #X80) -7)) |
|
130
|
(e (+ (lsh (logand (following-char) #X7F) 1) |
|
131
|
(lsh (logand (progn (forward-char) (following-char)) #X80) -7))) |
|
132
|
(f (+ (lsh (logand (following-char) #X7F) 16) |
|
133
|
(lsh (progn (forward-char) (following-char)) 8) |
|
134
|
(prog1 (progn (forward-char) (following-char)) (forward-char))))) |
|
135
|
(cond |
|
136
|
((and (= e 0) (= f 0)) |
|
137
|
(* 0.0 (expt -1 s)) |
|
138
|
((and (= e 255) (or (= f (1- (expt 2 23))) (= f 0))) |
|
139
|
(* 1.0e+INF (expt -1 s))) |
|
140
|
((and (= e 255) (not (or (= f 0) (= f (1- (expt 2 23)))))) |
|
141
|
0.0e+NaN) |
|
142
|
(t |
|
143
|
(* (expt -1 s) |
|
144
|
(expt 2.0 (- e 127)) |
|
145
|
(1+ (/ f (expt 2.0 23))))))))) |
|
146
|
|
|
147
|
;;; Network |
|
148
|
;;;###autoload |
|
149
|
(defun net-check-opts () |
|
150
|
;; https://gnu.huihoo.org/emacs/24.4/emacs-lisp/Network-Options.html#Network-Options |
|
151
|
;; non-blocking |
|
152
|
(featurep 'make-network-process '(:nowait t)) |
|
153
|
;; UNIX socket |
|
154
|
;(featurep 'make-network-process '(:family local)) |
|
155
|
;; UDP |
|
156
|
(featurep 'make-network-process '(:type datagram))) |
|
157
|
|
|
158
|
;;; Process |
|
159
|
(defun c2-make-client (host port) |
|
160
|
(make-network-process |
|
161
|
:name "c2-client" |
|
162
|
:coding 'binary |
|
163
|
:host host |
|
164
|
:service port |
|
165
|
:type 'datagram |
|
166
|
:nowait t)) |
|
167
|
|
|
168
|
(defun c2-sentinel (proc msg) |
|
169
|
(when (string= msg "connection broken by remote peer\n") |
|
170
|
(setq c2-clients (assq-delete-all proc c2-clients)) |
|
171
|
(c2-log (format "client %s has quit" proc)))) |
|
172
|
|
|
173
|
;;from server.el |
|
174
|
(defun c2-log (string &optional client) |
|
175
|
"If a *c2* buffer exists, write STRING to it for logging purposes." |
|
176
|
(if (get-buffer "*c2*") |
|
177
|
(with-current-buffer "*c2*" |
|
178
|
(goto-char (point-max)) |
|
179
|
(insert (if client (format "<%s>: " (format-network-address (process-datagram-address client)))) |
|
180
|
string) |
|
181
|
(or (bolp) (newline))))) |
|
182
|
|
|
183
|
;;;###autoload |
|
184
|
(defun c2-start nil |
|
185
|
"start c2 over udp" |
|
186
|
(interactive) |
|
187
|
(unless (process-status "c2") |
|
188
|
(make-network-process :name "c2" |
|
189
|
:buffer "*c2*" |
|
190
|
:family 'ipv4 |
|
191
|
:service c2-port |
|
192
|
:type 'datagram |
|
193
|
:coding 'binary |
|
194
|
:sentinel 'c2-sentinel |
|
195
|
:filter 'c2-filter |
|
196
|
:server t |
|
197
|
:broadcast t) |
|
198
|
(setq c2-clients '()) |
|
199
|
;; setup additional filters |
|
200
|
(add-function :after (process-filter (get-process "c2")) #'c2-eval-response-filter)) |
|
201
|
(message "c2: ONLINE")) |
|
202
|
|
|
203
|
;;;###autoload |
|
204
|
(defun c2-stop () |
|
205
|
"stop the c2 server." |
|
206
|
(interactive) |
|
207
|
(while c2-clients |
|
208
|
(delete-process (car (car c2-clients))) |
|
209
|
(setq c2-clients (cdr c2-clients))) |
|
210
|
(with-current-buffer "*c2*" |
|
211
|
(let ((proc (get-buffer-process (current-buffer)))) |
|
212
|
(if proc (delete-process proc))) |
|
213
|
(set-buffer-modified-p nil) |
|
214
|
(kill-this-buffer)) |
|
215
|
(message "c2 stopped")) |
|
216
|
|
|
217
|
(defun c2-filter (proc string) |
|
218
|
(let ((pending (assoc proc c2-clients)) |
|
219
|
message |
|
220
|
index) |
|
221
|
;;create entry if required |
|
222
|
(unless pending |
|
223
|
(setq c2-clients (cons (cons proc "") c2-clients)) |
|
224
|
(setq pending (assoc proc c2-clients))) |
|
225
|
(setq message (concat (cdr pending) string)) |
|
226
|
(while (setq index (string-match "\n" message)) |
|
227
|
(setq index (1+ index)) |
|
228
|
; (process-send-string proc (substring message 0 index)) |
|
229
|
(c2-log (substring message 0 index) proc) |
|
230
|
(setq message (substring message index))) |
|
231
|
(setcdr pending message))) |
|
232
|
|
|
233
|
(defun c2-packet-filter (proc string) |
|
234
|
"process-filter for decoding 'c2-packet-bindat-spec'" |
|
235
|
(bindat-unpack packet-spec string)) |
|
236
|
|
|
237
|
(defun ordinary-insertion-filter (proc string) |
|
238
|
(when (buffer-live-p (process-buffer proc)) |
|
239
|
(with-current-buffer (process-buffer proc) |
|
240
|
(let ((moving (= (point) (process-mark proc)))) |
|
241
|
|
|
242
|
(save-excursion |
|
243
|
;; Insert the text, advancing the process marker. |
|
244
|
(goto-char (process-mark proc)) |
|
245
|
(insert string) |
|
246
|
(set-marker (process-mark proc) (point))) |
|
247
|
(if moving (goto-char (process-mark proc))))))) |
|
248
|
|
|
249
|
(defun c2-eval-response-filter (proc string) |
|
250
|
"execute STRING from PROC." |
|
251
|
(let ((msg (car (read-from-string string)))) |
|
252
|
(process-send-string proc (concat (format "%s" (ignore-errors "error: %S" (eval msg))) "\n")))) |
|
253
|
|
|
254
|
;;;; Signals |
|
255
|
;;;###autoload |
|
256
|
(defun c2-shutdown () |
|
257
|
"Save buffers, Quit, and Shutdown (kill) server" |
|
258
|
(interactive) |
|
259
|
(save-some-buffers) |
|
260
|
(kill-emacs)) |
|
261
|
|
|
262
|
;;;###autoload |
|
263
|
(defun c2-restart () |
|
264
|
"Handler for SIGUSR1 signal, to (re)start an emacs server. |
|
265
|
|
|
266
|
Can be tested from within emacs with: |
|
267
|
(signal-process (emacs-pid) 'sigusr1) |
|
268
|
|
|
269
|
or from the command line with: |
|
270
|
$ kill -USR1 <emacs-pid> |
|
271
|
$ emacsclient -c |
|
272
|
" |
|
273
|
(interactive) |
|
274
|
(server-force-delete) |
|
275
|
(server-start) |
|
276
|
) |
|
277
|
|
|
278
|
(define-key special-event-map [sigusr1] 'c2-restart) |
|
279
|
|
|
280
|
(provide 'c2) |
|
281
|
;;; c2.el ends here |