-
Notifications
You must be signed in to change notification settings - Fork 18
/
zmq.el
732 lines (652 loc) · 28.5 KB
/
zmq.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
;;; zmq.el --- ZMQ bindings in Emacs-Lisp -*- lexical-binding: t -*-
;; Copyright (C) 2018-2024 Nathaniel Nicandro
;; Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
;; Created: 05 Jan 2018
;; URL: https://github.com/nnicandro/emacs-zmq
;; Keywords: comm
;; Version: 1.0.2
;; Package-Requires: ((cl-lib "0.5") (emacs "26"))
;; 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 2, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Bindings to the ZMQ distributed messaging library in
;; Emacs.
;;; Code:
(require 'cl-lib)
(defgroup zmq nil
"ZMQ bindings for Emacs"
:group 'communication)
(defconst zmq-emacs-version "v1.0.2")
(defvar zmq-current-context nil
"The context set by the function `zmq-current-context'.")
(cl-deftype zmq-socket () '(satisfies zmq-socket-p))
(defun zmq-current-context ()
"Return the value of the variable `zmq-current-context' if non-nil.
Otherwise, create a new `zmq-context', bind it to the
variable `zmq-current-context', and return the newly created
context."
(or zmq-current-context
(setq zmq-current-context (zmq-context))))
(defun zmq-assoc (item list)
"Find the first match whose car is equal to ITEM in LIST.
`zmq-equal' is used for comparison."
(cl-assoc item list :test #'zmq-equal))
;;; Tunneling
;; TODO: Add password handling
(defun zmq-make-tunnel (lport rport server &optional remoteip)
"Forward traffic from LPORT on the localhost to REMOTEIP:RPORT on SERVER.
If REMOTEIP is nil, forward LPORT to RPORT on SERVER.
Forwarding is done with ssh."
(or remoteip (setq remoteip "127.0.0.1"))
(start-process
"zmq-tunnel" nil
"ssh"
;; Run in background
"-f"
;; Wait until the tunnel is open
"-o ExitOnForwardFailure=yes"
;; Local forward
"-L" (format "127.0.0.1:%d:%s:%d" lport remoteip rport)
server
;; Close the tunnel if no other connections are made within 60
;; seconds
"sleep 60"))
;;; Socket functions
(defun zmq-bind-to-random-port (sock addr &optional min-port max-port max-tries)
"Bind SOCK to ADDR on a random port.
ADDR must be an address string without the port.
Randomly bind SOCK to ADDR on a port in the range
[MIN-PORT,MAX-PORT)
If the port assigned is in use on ADDR, try a different port. If
SOCK could not be bound after MAX-TRIES return nil, otherwise
return the port SOCK was bound to. MIN-PORT defaults to 49152,
MAX-PORT defaults to 65536, and MAX-TRIES defaults to 100."
(setq min-port (or min-port 49152)
max-port (or max-port 65536)
max-tries (or max-tries 100))
(let (port)
(while (not (or port (zerop max-tries)))
(setq port (+ (cl-random (- max-port min-port)) min-port))
(condition-case nil
(zmq-bind sock (format "%s:%d" addr port))
((zmq-EACCES zmq-EADDRINUSE)
(setq port nil
max-tries (1- max-tries)))))
port))
;;; Sending/receiving multipart messages
(defun zmq-send-multipart (sock parts &optional flags)
"Send a multipart message on SOCK.
PARTS is a list of message parts to send on SOCK. FLAGS has the
same meaning as `zmq-send'."
(or flags (setq flags 0))
(while parts
(let ((part (zmq-message (car parts))))
(zmq-message-send
part sock (if (not (null (cdr parts)))
(logior flags zmq-SNDMORE)
flags))
(pop parts))))
(defun zmq-recv-multipart (sock &optional flags)
"Receive a multipart message from SOCK.
FLAGS has the same meaning as in `zmq-recv'."
(let (parts)
(while (let ((part (zmq-message)))
(zmq-message-recv part sock flags)
(push (zmq-message-data part) parts)
(zmq-message-more-p part)))
(nreverse parts)))
;;; Setting/getting options from contexts, sockets, messages
(defun zmq--set-get-option (set object option &optional value)
"Helper function for `zmq-get-option' and `zmq-set-option'.
If SET is non-nil, set OBJECT's OPTION to VALUE. Otherwise get
OPTION's value, ignoring any VALUE argument."
(let ((fun (cond
((zmq-socket-p object)
(if set #'zmq-socket-set #'zmq-socket-get))
((zmq-context-p object)
(if set #'zmq-context-set #'zmq-context-get))
((zmq-message-p object)
(if set #'zmq-message-set #'zmq-message-get))
(t (signal 'wrong-type-argument
(list
'(zmq-socket-p zmq-context-p zmq-message-p)
object))))))
(if set (funcall fun object option value)
(funcall fun object option))))
(defun zmq-set-option (object option value)
"For OBJECT, set OPTION to VALUE.
OBJECT can be a `zmq-socket', `zmq-context', or a `zmq-message'.
The OPTION set should correspond to one of the options available
for that particular object."
(zmq--set-get-option 'set object option value))
(defun zmq-get-option (object option)
"For OBJECT, get OPTION's value.
OBJECT can be a `zmq-socket', `zmq-context', or a `zmq-message'.
The OPTION to get should correspond to one of the options
available for that particular object."
(zmq--set-get-option nil object option))
(defconst zmq-message-properties '((:socket-type . "Socket-Type")
(:identity . "Identity")
(:resource . "Resource")
(:peer-address . "Peer-Address")
(:user-id . "User-Id"))
"Alist mapping keywords to their corresponding message property.
A message's metadata property can be accessed through
`zmq-message-property'.")
(defun zmq-message-property (message property)
"Get a MESSAGE's metadata PROPERTY.
PROPERTY is a keyword and can only be one of those in
`zmq-message-properties'."
(let ((prop (cdr (assoc property zmq-message-properties))))
(unless prop
(signal 'args-out-of-range
(list (mapcar #'car zmq-message-properties) prop)))
(decode-coding-string (zmq-message-gets message prop) 'utf-8)))
;;; Subprocesses
(define-error 'zmq-subprocess-error "Error in ZMQ subprocess")
(defun zmq-flush (stream)
"Flush STREAM.
STREAM can be one of `stdout', `stdin', or `stderr'."
(let ((mode (set-binary-mode stream t)))
(set-binary-mode stream mode)))
(defun zmq-prin1 (sexp)
"Print SEXP using `prin1' and flush `stdout' afterwards."
(prin1 sexp)
(zmq-flush 'stdout))
(defvar zmq--subprocess-debug nil
"If non-nil, capture backtraces in subprocesses.
Send backtraces as subprocess errors to the parent Emacs process.
In addition, log any stderr messages produced by the subprocess
as messages in the parent Emacs process.")
(defvar zmq-backtrace nil
"The backtrace stored when debugging the subprocess.")
(defun zmq--init-subprocess (&optional backtrace)
"Initialize the ZMQ subprocess.
Call `zmq-subprocess-read' and assuming the read s-expression is
a function, call the function. If the function accepts a single
argument, pass the `zmq-current-context' as the argument.
If BACKTRACE is non-nil and an error occurs when evaluating, send
the backtrace to the parent process. This should only be used for
debugging purposes."
(if (not noninteractive) (error "Not a subprocess")
(let* ((debug-on-event nil)
(coding-system-for-write 'utf-8-emacs)
(signal-hook-function
(if backtrace
(lambda (&rest _)
(setq zmq-backtrace
(with-temp-buffer
(let ((standard-output (current-buffer)))
(backtrace))
(buffer-string))))
signal-hook-function)))
(condition-case err
(let ((sexp (eval (zmq-subprocess-read))))
(unless (functionp sexp)
(error "Read initialization form not a function"))
(setq sexp (byte-compile sexp))
(if (eq (car (func-arity sexp)) 1)
(funcall sexp (zmq-current-context))
(funcall sexp)))
(error
(zmq-prin1 (cons 'error (list (car err)
(or zmq-backtrace
(cdr err))))))))))
(defvar-local zmq--subprocess-parse-state nil
"The parse state of the output read from a subprocess.")
(defsubst zmq--subprocess-skip-delete-to-sexp ()
"Skip to the start of a list.
Delete the region between `point' and the start of the next list.
Only skip and delete if `zmq--subprocess-parse-state' is nil."
(unless zmq--subprocess-parse-state
(delete-region
(point) (+ (point) (skip-syntax-forward "^(")))))
(defun zmq--subprocess-read-output (output)
"Return a list of s-expressions read from OUTPUT.
OUTPUT is inserted into the `current-buffer' and `read' until the
first incomplete s-expression or until all s-expressions of
OUTPUT have been processed. After reading, the contents of the
`current-buffer' from `point-min' up to the last valid
s-expression is removed and a list of all the valid s-expressions
in OUTPUT is returned.
Any other text in OUTPUT that is not an s-expression is ignored.
Also note, for this function to work properly the same buffer
should be current for subsequent calls."
(let (accum)
(save-excursion (insert output))
(zmq--subprocess-skip-delete-to-sexp)
(while (/= (point) (point-max))
(setq zmq--subprocess-parse-state
(parse-partial-sexp
(point) (point-max) 0
nil zmq--subprocess-parse-state))
(when (= (nth 0 zmq--subprocess-parse-state) 0)
;; When a complete top-level s-expression has been
;; parsed, collect into the accumulated list of
;; complete s-expressions.
(let ((beg (nth 2 zmq--subprocess-parse-state))
(end (point)))
(goto-char beg)
(unwind-protect
(push (read (current-buffer)) accum)
(setq zmq--subprocess-parse-state nil)
(goto-char end)
(delete-region beg end))))
(zmq--subprocess-skip-delete-to-sexp))
(nreverse accum)))
(defun zmq--subprocess-handle-stderr (process)
"Print PROCESS' stderr as messages.
Do this only if the PROCESS has a non-nil :debug property."
(when (process-get process :debug)
(let ((stderr (process-get process :stderr)))
(unless (zerop (buffer-size (process-buffer stderr)))
(with-current-buffer (process-buffer stderr)
(let ((prefix (concat "STDERR[" (process-name process) "]: ")))
(goto-char (point-min))
(while (/= (point) (point-max))
(message "%s%s" prefix (buffer-substring
(line-beginning-position)
(line-end-position)))
(forward-line))
(erase-buffer)))))))
(defun zmq--subprocess-filter (process output)
"Create a stream of s-expressions based on PROCESS' OUTPUT.
If PROCESS has a non-nil `:filter' property then it should be a
function with the same meaning as the EVENT-FILTER argument in
`zmq-start-process', OUTPUT will be converted into a list of
s-expressions and the `:filter' function called for every valid
s-expression in OUTPUT.
As a special case, if the `car' of an s-expression is the symbol
error, a `zmq-subprocess-error' is signaled using the `cdr' of
the list for the error data."
(zmq--subprocess-handle-stderr process)
(with-current-buffer (process-buffer process)
(goto-char (process-mark process))
(let ((filter (process-get process :filter)))
(when filter
(let ((stream (let ((inhibit-read-only t))
(zmq--subprocess-read-output output))))
(cl-loop
for event in stream
if (and (listp event) (eq (car event) 'error)) do
;; TODO: Better way to handle this
(signal 'zmq-subprocess-error (cdr event))
else do (with-demoted-errors "Error in ZMQ subprocess filter: %S"
(funcall filter event))))))
(set-marker (process-mark process) (point-max))))
(defun zmq--subprocess-sentinel (process event)
"Sentinel function for ZMQ subprocesses.
If a PROCESS has a `:sentinel' property that is a function, the
function is called with identical arguments as this function.
When EVENT represents any of the events that notify when a
subprocess has exited, kill the process buffer only when the
`:owns-buffer' property of the PROCESS is non-nil. Otherwise the
process buffer is left alive and assumed to be a buffer that was
initially passed to `zmq-start-process'."
(let ((sentinel (process-get process :sentinel)))
(unwind-protect
(when (functionp sentinel)
(funcall sentinel process event))
(when (memq (process-status process) '(exit signal))
(delete-process process)
(when (process-get process :owns-buffer)
(kill-buffer (process-buffer process)))
(let ((stderr (process-get process :stderr)))
(when (process-live-p stderr)
(delete-process stderr))
(when (buffer-live-p (process-buffer stderr))
(kill-buffer (process-buffer stderr))))))))
(defvar zmq--subprocess-send-buffer nil)
;; Adapted from `async--insert-sexp' in the `async' package :)
(defun zmq-subprocess-send (process sexp)
"Send an s-expression to PROCESS' STDIN.
PROCESS should be an Emacs subprocess that decodes messages sent
on its STDIN using `zmq-subprocess-read'.
The SEXP is first encoded with the `utf-8-emacs' coding system and
then encoded using Base 64 encoding before being sent to the
subprocess."
(declare (indent 1))
(let ((print-circle t)
(print-escape-nonascii t)
print-level print-length)
(with-current-buffer
(if (buffer-live-p zmq--subprocess-send-buffer)
zmq--subprocess-send-buffer
(setq zmq--subprocess-send-buffer
(get-buffer-create " *zmq-subprocess-send*")))
(erase-buffer)
(prin1 sexp (current-buffer))
(encode-coding-region (point-min) (point-max) 'utf-8-emacs)
(base64-encode-region (point-min) (point-max) t)
(goto-char (point-min)) (insert ?\")
(goto-char (point-max)) (insert ?\" ?\n)
(process-send-region process (point-min) (point-max)))))
(defun zmq-subprocess-read ()
"Read a single s-expression from STDIN.
This does the decoding of the encoding described in
`zmq-subprocess-send' and returns the s-expression. This is only
meant to be called from an Emacs subprocess."
(if (not noninteractive) (error "Not in a subprocess")
(read (decode-coding-string
(base64-decode-string (read-minibuffer ""))
'utf-8-emacs))))
(defun zmq-set-subprocess-filter (process event-filter)
"Set the event filter function for PROCESS.
EVENT-FILTER has the same meaning as in `zmq-start-process'."
(process-put process :filter event-filter))
(defun zmq-set-subprocess-sentinel (process sentinel)
"Set the sentinel function for PROCESS.
SENTINEL has the same meaning as in `zmq-start-process'."
(process-put process :sentinel sentinel))
(defun zmq-set-subprocess-buffer (process buffer)
"Set PROCESS' buffer to BUFFER.
Delete PROCESS' current buffer if it was automatically created
when `zmq-start-process' was called. It is the responsibility of
the caller to cleanup BUFFER when PROCESS exits after a call to
this function."
(let ((marker (process-mark process)))
;; Copy over any pending results
(with-current-buffer (process-buffer process)
(copy-to-buffer buffer (point-min) (point-max)))
(set-process-buffer process buffer)
(set-marker marker (marker-position marker) buffer)
(when (process-get process :owns-buffer)
(kill-buffer (process-buffer process))
(setf (process-get process :owns-buffer) nil))))
(cl-defun zmq-start-process (sexp &key filter sentinel buffer debug)
"Start an Emacs subprocess initializing it with SEXP.
Return the newly created process.
SEXP is either a lambda form or a function symbol. In both cases
the function can either take 0 or 1 arguments. If SEXP takes 1
argument, then a new context object will be passed as the
argument of the function.
FILTER is a function that takes a single argument, a complete
s-expression read from the process' stdout. This means that care
should be taken when writing SEXP to ensure that it only prints
out lists. Any other value that SEXP prints will be ignored.
SENTINEL has the same meaning as in `make-process'.
BUFFER will be set as the `process-buffer' for the returnd
process if non-nil. When BUFFER is nil, a new buffer will be
created. When a BUFFER is supplied, it should not be used for any
other purpose after a call to this function since it will be used
to store intermediate output from the subprocess. If this
function creates a new buffer, that buffer will be killed on
process exit, but it is the responsiblity of the caller to kill
the buffer if a buffer is supplied to this function.
If DEBUG is non-nil, then the subprocess returns a backtrace if
it errors out and prints its stderr as messages in the parent
Emacs process."
(or debug (setq debug zmq--subprocess-debug))
(cond
((functionp sexp)
(when (symbolp sexp)
(setq sexp (symbol-function sexp))))
(t (error "Can only send functions to processes")))
(cl-destructuring-bind (min . max) (func-arity sexp)
(unless (and (<= min 1) (or (not (numberp max)) (<= max 1)))
(error "Invalid function to send to process, can only have 0 or 1 arguments")))
(let* ((zmq-path (locate-library "zmq.el"))
(cmd (format "(zmq--init-subprocess %s)" (when debug t)))
;; stderr is split from stdout since the former is used by
;; Emacs to print messages that we don't want intermixed
;; with what the subprocess returns.
(stderr (make-pipe-process
:name "zmq stderr"
:buffer (generate-new-buffer " *zmq*")
:noquery t
:stop (not debug)))
(process (make-process
:name "zmq"
:buffer (or buffer (generate-new-buffer " *zmq*"))
:noquery t
:connection-type 'pipe
:coding 'no-conversion
:filter #'zmq--subprocess-filter
:sentinel #'zmq--subprocess-sentinel
:stderr stderr
:command (list
(file-truename
(expand-file-name invocation-name
invocation-directory))
"-Q" "-batch"
"-L" (file-name-directory zmq-path)
"-l" zmq-path "--eval" cmd))))
(process-put process :debug debug)
(process-put process :stderr stderr)
(process-put process :filter filter)
(process-put process :sentinel sentinel)
(process-put process :owns-buffer (null buffer))
(with-current-buffer (process-buffer process)
(let ((inhibit-read-only t))
(erase-buffer))
(special-mode))
(zmq-subprocess-send process (macroexpand-all sexp))
process))
;;; Download releases
(defun zmq--system-configuration-list (string)
(save-match-data
(string-match "\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)\\(?:-\\(.+\\)\\)?" string)
(let ((arch (match-string 1 string))
(vendor (match-string 2 string))
(sys (match-string 3 string))
(abi (match-string 4 string)))
(list arch vendor sys abi))))
(defun zmq--system-configuration ()
(cl-destructuring-bind (arch vendor sys abi)
(zmq--system-configuration-list system-configuration)
;; Attempt to handle common systems
(cond
((string-prefix-p "darwin" sys)
;; On OSX the sys part of the host is like
;; darwin17.1.0, but the binaries are compatible across
;; multiple versions. TODO: Figure out the actual ABI
;; compatibility.
(concat arch "-" vendor "-darwin"))
((and (member vendor '("pc" "unknown" "none"))
(equal sys "linux"))
(concat arch "-" sys "-" abi))
(t
system-configuration))))
(defun zmq--insert-url-contents (url)
;; Attempt to download URL using various methods
(cond
((and (executable-find "curl")
;; -s = silent, -L = follow redirects
(let ((default-process-coding-system '(binary . binary)))
(zerop (call-process "curl" nil (current-buffer) nil
"-s" "-L" url)))))
((and (executable-find "wget")
;; -q = quiet, -O - = output to stdout
(let ((default-process-coding-system '(binary . binary)))
(zerop (call-process "wget" nil (current-buffer) nil
"-q" "-O" "-" url)))))
(t
(require 'url-handlers)
(let ((buf (url-retrieve-synchronously url)))
(url-insert buf)))))
(defmacro zmq--download-url (url &rest body)
(declare (indent 1))
`(with-temp-buffer
(set-buffer-multibyte nil)
(zmq--insert-url-contents ,url)
(goto-char (point-min))
,@body))
(defun zmq--download-and-extract-file (url tgz-file)
(message "Downloading %s/%s" url tgz-file)
(let ((sig (zmq--download-url (concat url "/" tgz-file ".sha256")
(forward-sexp)
(let ((end (point)))
(buffer-substring
(progn (backward-sexp) (point))
end)))))
(message "Verifying sha256 signature of %s" tgz-file)
(zmq--download-url (concat url "/" tgz-file)
(if (not (equal sig (secure-hash 'sha256 (buffer-string))))
(error "Signature did not match content")
;; We write the tar.gz file so that Emacs properly uncompresses
;; it through `jka-compr' otherwise `tar-untar-buffer' will
;; fail with a weird error.
(set-buffer-multibyte nil)
(write-region nil nil tgz-file)))
(let ((buffer (find-file-noselect tgz-file)))
(unwind-protect
(with-current-buffer buffer
(require 'tar-mode)
(tar-untar-buffer))
(kill-buffer buffer)
(delete-file tgz-file)))))
(defvar json-object-type)
(defun zmq--download-module (tag)
(let ((msg "Check%s for compatible module binary to download%s"))
(when (or noninteractive (y-or-n-p (format msg "" "? ")))
(when noninteractive
(message msg "ing" ""))
(catch 'failure
(let* ((api-url "https://api.github.com/repos/nnicandro/emacs-zmq/")
(repo-url "https://github.com/nnicandro/emacs-zmq/")
(release-url (concat api-url "releases/"))
(info (zmq--download-url (concat release-url tag)
(require 'json)
(let ((json-object-type 'plist))
(ignore-errors (json-read)))))
(tag-name (or (plist-get info :tag_name)
(throw 'failure nil)))
(ezmq-sys (concat "emacs-zmq-" (zmq--system-configuration)))
(assets (cl-remove-if-not
(lambda (x) (string-prefix-p ezmq-sys x))
(mapcar (lambda (x) (plist-get x :name))
(append (plist-get info :assets) nil)))))
(when assets
;; We have a signature file and a tar.gz file for each binary so the
;; minimum number of files is two.
(if (> (length assets) 2)
(error "TODO More than one file found")
(let* ((tgz-file (cl-find-if (lambda (x) (string-suffix-p ".tar.gz" x))
assets))
(tgz-dir (expand-file-name
(substring tgz-file 0
(- (length tgz-file)
(length ".tar.gz"))))))
(zmq--download-and-extract-file
(concat repo-url "releases/download/" tag-name) tgz-file)
(let* ((pat "emacs-zmq\\.\\(dll\\|so\\|dylib\\)$")
(lib (car (directory-files tgz-dir t pat))))
(copy-file lib (expand-file-name (file-name-nondirectory lib))))
t))))))))
;;; Load emacs-zmq
(defun zmq-load ()
"Load the ZMQ dynamic module."
(unless (featurep 'zmq-core)
(if module-file-suffix
(let ((default-directory (file-name-directory (locate-library "zmq.el"))))
(if (load (expand-file-name "emacs-zmq") t)
(add-hook 'post-gc-hook #'zmq--cleanup-globrefs)
;; Can also be "latest"
(if (zmq--download-module (concat "tags/" zmq-emacs-version))
(zmq-load)
(let ((msg "ZMQ module not found. Build%s it%s"))
(when (or noninteractive (y-or-n-p (format msg "" "? ")))
(when noninteractive
(message msg "ing" ""))
(let ((emacs
(when (and invocation-directory invocation-name)
(file-truename
(expand-file-name invocation-name
invocation-directory)))))
(cl-labels
((load-zmq
(_buf status)
(if (string= status "finished\n")
(zmq-load)
(warn "Something went wrong when compiling the ZMQ module!"))
(remove-hook 'compilation-finish-functions #'load-zmq)
(exit-recursive-edit)))
(add-hook 'compilation-finish-functions #'load-zmq)
(compile (concat "make" (when emacs (concat " EMACS=" emacs))))
(recursive-edit))))))))
(user-error "Modules are not supported"))))
(unless (featurep 'zmq-core)
(dolist (fun '(zmq--cleanup-globrefs
zmq-socket
zmq-send
zmq-recv
zmq-bind
zmq-connect
zmq-join
zmq-unbind
zmq-disconnect
zmq-leave
zmq-close
zmq-proxy
zmq-proxy-steerable
zmq-socket-monitor
zmq-socket-set
zmq-socket-get
zmq-context
zmq-context-terminate
zmq-context-shutdown
zmq-context-get
zmq-context-set
zmq-message
zmq-message-size
zmq-message-data
zmq-message-more-p
zmq-message-copy
zmq-message-move
zmq-message-close
zmq-message-set
zmq-message-get
zmq-message-recv
zmq-message-send
zmq-message-gets
zmq-message-routing-id
zmq-message-set-routing-id
zmq-message-group
zmq-message-set-group
zmq-poll
zmq-poller
zmq-poller-add
zmq-poller-modify
zmq-poller-remove
zmq-poller-destroy
zmq-poller-wait
zmq-poller-wait-all
zmq-version
zmq-has
zmq-z85-decode
zmq-z85-encode
zmq-curve-keypair
zmq-curve-public
zmq-equal
zmq-message-p
zmq-socket-p
zmq-context-p
zmq-poller-p))
(defalias fun
(lambda (&rest args)
(when (featurep 'zmq-core)
(error "Hot loading function masking core function"))
(zmq-load)
(if (featurep 'zmq-core)
(apply fun args)
(error "Loading of `zmq-core' failed")))
(format "Stub definition of `%s'.
Calling this function will attempt to load `zmq-core', the core
module containing the ZMQ bindings. After loading, it will call
the intended function with the provided arguments.
To manually load `zmq-core', see `zmq-load'." fun))))
(provide 'zmq)
;; Local Variables:
;; byte-compile-warnings: (not free-vars unresolved)
;; End:
;;; zmq.el ends here