633 lines
24 KiB
EmacsLisp
633 lines
24 KiB
EmacsLisp
;;; weechat-relay --- Implementation of Weechat's relay protocol ;; -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2013 Moritz Ulrich
|
|
|
|
;; Author: Moritz Ulrich (moritz@tarn-vedra.de)
|
|
;; Rüdiger Sonderfeld <ruediger@c-plusplus.de>
|
|
;; Aristid Breitkreuz <aristidb@gmail.com>
|
|
;; Keywords: irc chat network weechat
|
|
|
|
;; 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 <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
;; This file implements low-level code used by weechat.el to connect
|
|
;; to remote WeeChat instances using the relay protocol:
|
|
|
|
;; http://www.weechat.org/files/doc/devel/weechat_relay_protocol.en.html
|
|
|
|
(require 'weechat-core)
|
|
|
|
(require 'bindat)
|
|
(require 'format-spec)
|
|
(require 's)
|
|
(require 'pp)
|
|
(require 'cl-lib)
|
|
|
|
(defcustom weechat-relay-buffer-name "*weechat-relay*"
|
|
"Buffer holding the connection to the host weechat instance."
|
|
:type 'string
|
|
:group 'weechat-relay)
|
|
|
|
(defcustom weechat-relay-message-function nil
|
|
"Function to call when receiving a new weechat message."
|
|
:type '(choice (const :tag "Off" nil)
|
|
(function :tag "Callback Function"))
|
|
:group 'weechat-relay)
|
|
|
|
(defvar weechat-relay-ignored-message-ids '("_nicklist")
|
|
"IDs to ignore.")
|
|
|
|
(defcustom weechat-relay-disconnect-hook nil
|
|
"Hook run when the relay disconnects.
|
|
It will NOT run when the user disconnects via
|
|
`weechat-disconnect'."
|
|
:type 'hook
|
|
:group 'weechat-relay)
|
|
|
|
(defcustom weechat-relay-connect-hook nil
|
|
"Hook run when the relay connects.
|
|
Note: This DOES NOT mean the client can is already authenticated
|
|
to the relay server."
|
|
:type 'hook
|
|
:group 'weechat-relay)
|
|
|
|
(defcustom weechat-relay-ping-idle-seconds 60
|
|
"Idle time in seconds after weechat.el will ping the server."
|
|
:type '(choice integer
|
|
(const nil))
|
|
:group 'weechat-relay)
|
|
|
|
;;; Code:
|
|
|
|
(defvar weechat--relay-id-callback-hash (make-hash-table :test 'equal)
|
|
"Alist mapping from ids to functions.
|
|
Incoming message-ids will be searched in this alist and the
|
|
corresponding function will be called.")
|
|
|
|
(defun weechat--relay-send-message (text &optional id)
|
|
"Send message TEXT with optional ID.
|
|
Trim TEXT prior to sending it."
|
|
(let ((msg (concat (when id (format "(%s) " id)) (s-trim text) "\n")))
|
|
(weechat-relay-log (format "Sending msg: '%s'" (s-trim msg))
|
|
:debug)
|
|
(let ((process (get-buffer-process weechat-relay-buffer-name)))
|
|
(if process
|
|
(send-string process msg)
|
|
(weechat-warn "`get-buffer-process' returned nil for `weechat-relay-buffer-name'")))))
|
|
|
|
(defun weechat-relay-authenticate (password &optional compression)
|
|
"Authenticate to weechat with PASSWORD.
|
|
|
|
PASSWORD can be a string, a function or nil.
|
|
|
|
If COMPRESSION is non-nil, enable compression on this connection.
|
|
Currently unsupported."
|
|
(cl-assert (or (null password)
|
|
(stringp password)
|
|
(functionp password)))
|
|
(let ((pass (if (functionp password)
|
|
(funcall password)
|
|
password)))
|
|
(when (stringp pass)
|
|
(setq pass (if (s-blank? (s-trim pass))
|
|
nil
|
|
(s-trim pass))))
|
|
(weechat--relay-send-message
|
|
(concat "init "
|
|
(s-join ","
|
|
(cl-remove-if #'s-blank?
|
|
(list
|
|
(when pass (format "password=%s" (s-trim pass)))
|
|
(format "compression=%s" (if compression "zlib" "off")))))
|
|
"\n"))))
|
|
|
|
(defun weechat--relay-bindat-unsigned-to-signed (num bytes)
|
|
"Convert an unsigned int NUM to signed int.
|
|
NUM is in two-complement representation with BYTES bytes.
|
|
Useful because bindat does not support signed numbers."
|
|
(if (> num (- (expt 2 (- (* 8 bytes) 1)) 1))
|
|
(- num (expt 2 (* 8 bytes)))
|
|
num))
|
|
|
|
(defun weechat--relay-unpack-int (data)
|
|
"Unpack a four-byte signed integer from unibyte string DATA.
|
|
Return the value and number of bytes consumed."
|
|
(cl-values
|
|
(weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field
|
|
(bindat-unpack '((val u32)) data)
|
|
'val)
|
|
4)
|
|
4))
|
|
|
|
(defconst weechat--relay-lon-spec
|
|
'((len u8)
|
|
(val str (eval (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field struct 'len)
|
|
1)))))
|
|
|
|
(defun weechat--relay-unpack-lon (data)
|
|
(let ((obj (bindat-unpack weechat--relay-lon-spec data)))
|
|
(cl-values (string-to-number (decode-coding-string (bindat-get-field obj 'val) 'utf-8))
|
|
(bindat-length weechat--relay-lon-spec obj))))
|
|
|
|
(defun weechat--relay-unpack-chr (data)
|
|
"Unpack a one byte char from unibyte string DATA.
|
|
Returns value and bytes consumed."
|
|
(cl-values
|
|
(bindat-get-field
|
|
(bindat-unpack '((val u8)) data)
|
|
'val)
|
|
1))
|
|
|
|
(defconst weechat--relay-str-spec
|
|
'((len u32)
|
|
(val str (eval (let ((len (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field struct 'len)
|
|
4)))
|
|
;; Hack for signed/unsigned problems
|
|
(if (<= len 0) 0 len))))))
|
|
|
|
(defun weechat--relay-unpack-str (data)
|
|
"Unpacks a weechat-relay-string from unibyte string DATA.
|
|
Optional second return value contains length of parsed data."
|
|
(let ((obj (bindat-unpack weechat--relay-str-spec data)))
|
|
(cl-values (decode-coding-string (bindat-get-field obj 'val) 'utf-8)
|
|
(bindat-length weechat--relay-str-spec obj))))
|
|
|
|
(defconst weechat--relay-buf-spec
|
|
'((len u32)
|
|
(val vec (eval (let ((len (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field struct 'len)
|
|
4)))
|
|
;; Hack for signed/unsigned problems
|
|
(if (<= len 0) 0 len))))))
|
|
|
|
(defun weechat--relay-unpack-buf (data)
|
|
(let ((obj (bindat-unpack weechat--relay-buf-spec data)))
|
|
(cl-values (bindat-get-field obj 'val)
|
|
(bindat-length weechat--relay-buf-spec obj))))
|
|
|
|
(defconst weechat--relay-ptr-spec
|
|
'((len u8)
|
|
(val str (eval (let ((len (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field struct 'len)
|
|
1)))
|
|
;; Hack for signed/unsigned problems
|
|
(if (<= len 0) 0 len))))))
|
|
|
|
(defun weechat--relay-unpack-ptr (data)
|
|
"Unpack a string encoded in weechat's binary representation.
|
|
DATA must be an unibyte string. Return string-value and number
|
|
of bytes consumed."
|
|
(let ((obj (bindat-unpack weechat--relay-ptr-spec data)))
|
|
(cl-values (unless (string= "0" (bindat-get-field obj 'val))
|
|
(concat "0x" (bindat-get-field obj 'val)))
|
|
(bindat-length weechat--relay-ptr-spec obj))))
|
|
|
|
(defconst weechat--relay-tim-spec
|
|
'((len u8)
|
|
(val str (eval (let ((len (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field struct 'len)
|
|
1)))
|
|
;; Hack for signed/unsigned problems
|
|
(if (<= len 0) 0 len))))))
|
|
|
|
(defun weechat--relay-unpack-tim (data)
|
|
(let ((obj (bindat-unpack weechat--relay-tim-spec data)))
|
|
(cl-values (let ((val (string-to-number
|
|
(bindat-get-field obj 'val))))
|
|
(unless (zerop val)
|
|
(seconds-to-time val)))
|
|
(bindat-length weechat--relay-tim-spec obj))))
|
|
|
|
(defconst weechat--relay-htb-spec
|
|
'((key-type str 3)
|
|
(val-type str 3)
|
|
(count u32)))
|
|
|
|
(defun weechat--relay-unpack-htb (data)
|
|
(let* ((obj (bindat-unpack weechat--relay-htb-spec data))
|
|
(count (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field obj 'count)
|
|
4))
|
|
(key-type (bindat-get-field obj 'key-type))
|
|
(val-type (bindat-get-field obj 'val-type))
|
|
(key-fn (symbol-function (intern (concat "weechat--relay-unpack-" key-type))))
|
|
(val-fn (symbol-function (intern (concat "weechat--relay-unpack-" val-type))))
|
|
(offset (bindat-length weechat--relay-htb-spec obj))
|
|
(acc ()))
|
|
(dotimes (_ count)
|
|
(cl-multiple-value-bind (key key-len) (funcall key-fn (substring data offset))
|
|
(cl-multiple-value-bind (val val-len) (funcall val-fn (substring data (+ offset key-len)))
|
|
(setq acc (cons (cons key val) acc))
|
|
(setq offset (+ offset key-len val-len)))))
|
|
(cl-values acc
|
|
offset)))
|
|
|
|
(defconst weechat--relay-arr-spec
|
|
'((type str 3)
|
|
(count u32)))
|
|
|
|
(defun weechat--relay-unpack-arr (data)
|
|
(let* ((obj (bindat-unpack weechat--relay-arr-spec data))
|
|
(count (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field obj 'count)
|
|
4))
|
|
(type (bindat-get-field obj 'type))
|
|
(unpack-fn (symbol-function (intern (concat "weechat--relay-unpack-" type))))
|
|
(offset (bindat-length weechat--relay-arr-spec obj))
|
|
(acc ()))
|
|
(dotimes (_ count)
|
|
(cl-multiple-value-bind (val val-len) (funcall unpack-fn (substring data offset))
|
|
(setq acc (append acc (list val)))
|
|
(setq offset (+ offset val-len))))
|
|
(cl-values acc offset)))
|
|
|
|
(defalias 'weechat--relay-parse-chr 'weechat--relay-unpack-chr)
|
|
(defalias 'weechat--relay-parse-int 'weechat--relay-unpack-int)
|
|
(defalias 'weechat--relay-parse-lon 'weechat--relay-unpack-lon)
|
|
(defalias 'weechat--relay-parse-str 'weechat--relay-unpack-str)
|
|
(defalias 'weechat--relay-parse-buf 'weechat--relay-unpack-buf)
|
|
(defalias 'weechat--relay-parse-ptr 'weechat--relay-unpack-ptr)
|
|
(defalias 'weechat--relay-parse-tim 'weechat--relay-unpack-tim)
|
|
(defalias 'weechat--relay-parse-arr 'weechat--relay-unpack-arr)
|
|
|
|
(defun weechat--relay-parse-inf (data)
|
|
(cl-multiple-value-bind (name len) (weechat--relay-unpack-str data)
|
|
(cl-multiple-value-bind (value len*) (weechat--relay-unpack-str (substring data len))
|
|
(cl-values (cons name value)
|
|
(+ len len*)))))
|
|
|
|
(defconst weechat--relay-inl-item-spec
|
|
'((name struct weechat--relay-str-spec)
|
|
(type str 3)))
|
|
|
|
(defun weechat--relay-parse-inl-item (data)
|
|
(let* ((count (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field
|
|
(bindat-unpack '((len u32)) data) 'len)
|
|
4))
|
|
(offset 4)
|
|
(acc ()))
|
|
(while (< (length acc) count)
|
|
(let* ((obj (bindat-unpack weechat--relay-inl-item-spec
|
|
(substring data offset)))
|
|
(fun (symbol-function (intern (concat "weechat--relay-unpack-"
|
|
(bindat-get-field obj 'type))))))
|
|
(setq offset (+ offset (bindat-length weechat--relay-inl-item-spec obj)))
|
|
(cl-multiple-value-bind (value offset*) (funcall fun (substring data offset))
|
|
(setq offset (+ offset offset*))
|
|
(setq acc (cons
|
|
(cons (bindat-get-field obj 'name 'val) value)
|
|
acc)))))
|
|
(cl-values acc
|
|
offset)))
|
|
|
|
(defconst weechat--relay-inl-spec
|
|
'((name struct weechat--relay-str-spec)
|
|
(count u32)))
|
|
|
|
(defun weechat--relay-parse-inl (data)
|
|
(let* ((obj (bindat-unpack weechat--relay-inl-spec data))
|
|
(acc ())
|
|
(count (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field obj 'count)
|
|
4))
|
|
(offset (bindat-length weechat--relay-inl-spec obj)))
|
|
(dotimes (_ count)
|
|
(cl-multiple-value-bind (item offset*) (weechat--relay-parse-inl-item (substring data offset))
|
|
(setq acc (cons item acc))
|
|
(setq offset (+ offset offset*))))
|
|
(cl-values acc
|
|
offset)))
|
|
|
|
(defun weechat--relay-parse-hda-item (h-path-length name-type-alist data)
|
|
(let ((p-path ())
|
|
(offset 0)
|
|
(result ()))
|
|
(dotimes (_ h-path-length)
|
|
(cl-multiple-value-bind (el offset*) (weechat--relay-unpack-ptr (substring data offset))
|
|
(setq p-path (cons el p-path))
|
|
(setq offset (+ offset offset*))))
|
|
(dolist (name-type name-type-alist)
|
|
(let ((fun (symbol-function (intern (concat "weechat--relay-unpack-" (cdr name-type))))))
|
|
(cl-multiple-value-bind (obj offset*) (funcall fun (substring data offset))
|
|
(setq result (cons (cons (car name-type) obj) result))
|
|
(setq offset (+ offset offset*)))))
|
|
(cl-values (cons (reverse p-path) result)
|
|
offset)))
|
|
|
|
(defconst weechat--relay-hdh-spec
|
|
'((h-path struct weechat--relay-str-spec)
|
|
(keys struct weechat--relay-str-spec)
|
|
(count u32)))
|
|
|
|
;;; from http://lists.gnu.org/archive/html/help-gnu-emacs/2009-06/msg00764.html
|
|
(defun weechat--partition-list (list length)
|
|
(cl-loop while list
|
|
collect (cl-subseq list 0 length)
|
|
do (setf list (nthcdr length list))))
|
|
|
|
(defun weechat--hda-split-keys-string (str)
|
|
(mapcar (lambda (x)
|
|
(cons (car x)
|
|
(cadr x)))
|
|
(weechat--partition-list (split-string str "[:,]") 2)))
|
|
|
|
(defun weechat--relay-parse-hda (data)
|
|
(let* ((obj (bindat-unpack weechat--relay-hdh-spec data))
|
|
(count (weechat--relay-bindat-unsigned-to-signed
|
|
(bindat-get-field obj 'count)
|
|
4))
|
|
(name-type-alist (weechat--hda-split-keys-string
|
|
(bindat-get-field obj 'keys 'val)))
|
|
(h-path-length (length (split-string (bindat-get-field obj 'h-path 'val) "[/]")))
|
|
(offset (+ (bindat-length weechat--relay-hdh-spec obj)))
|
|
(acc ()))
|
|
(dotimes (_ count)
|
|
(cl-multiple-value-bind (obj offset*) (weechat--relay-parse-hda-item
|
|
h-path-length name-type-alist (substring data offset))
|
|
(setq acc (cons obj acc))
|
|
(setq offset (+ offset offset*))))
|
|
(let ((h-path (bindat-get-field obj 'h-path 'val)))
|
|
(cl-values (list h-path acc)
|
|
offset))))
|
|
|
|
(defconst weechat--relay-message-spec
|
|
'((length u32)
|
|
(compression u8)
|
|
(id struct weechat--relay-str-spec)
|
|
(data vec (eval (let ((l (- (bindat-get-field struct 'length)
|
|
4 ;length
|
|
1 ;compression
|
|
(+ 4 (length (bindat-get-field struct 'id 'val))))))
|
|
l)))))
|
|
|
|
(defun weechat--unpack-message-contents (data)
|
|
(let* ((type (substring data 0 3))
|
|
(fun (symbol-function (intern (concat "weechat--relay-parse-" type)))))
|
|
(cl-multiple-value-bind (obj len) (funcall fun (string-make-unibyte (substring data 3)))
|
|
(cl-values obj
|
|
(+ len 3)))))
|
|
|
|
(defun weechat-unpack-message (message-data)
|
|
"Unpack weechat relay message in MESSAGE-DATA.
|
|
Return a list: (id data)."
|
|
(let* ((msg (bindat-unpack weechat--relay-message-spec message-data))
|
|
(data (concat (bindat-get-field msg 'data)))
|
|
(msg-id (bindat-get-field msg 'id 'val))
|
|
(ignore-msg (member msg-id weechat-relay-ignored-message-ids))
|
|
(offset 0)
|
|
(acc ()))
|
|
;; Only no-compression is supported atm
|
|
(unless (= 0 (bindat-get-field msg 'compression))
|
|
(error "Compression not supported"))
|
|
(unless ignore-msg
|
|
(while (< offset (length data))
|
|
(cl-multiple-value-bind (obj offset*) (weechat--unpack-message-contents
|
|
(substring data offset))
|
|
(setq offset (+ offset offset*))
|
|
(setq acc (cons obj acc)))))
|
|
(cl-values (cons msg-id (if ignore-msg '(ignored) (reverse acc)))
|
|
(bindat-get-field msg 'length))))
|
|
|
|
(defun weechat--message-available-p ()
|
|
"Check if a weechat relay message available in current buffer."
|
|
(and (> (buffer-size) 5)
|
|
(>= (buffer-size)
|
|
(bindat-get-field
|
|
(bindat-unpack '((len u32))
|
|
(buffer-string))
|
|
'len))))
|
|
|
|
(defun weechat--relay-parse-new-message ()
|
|
(when (weechat--message-available-p)
|
|
(cl-multiple-value-bind (ret len) (weechat-unpack-message
|
|
(buffer-string))
|
|
(weechat-relay-log (format "Consumed %d bytes" len) :debug)
|
|
(let ((inhibit-read-only t))
|
|
(delete-region (point-min) (+ (point-min) len)))
|
|
ret)))
|
|
|
|
(defun weechat-relay-get-id-callback (id)
|
|
(gethash id weechat--relay-id-callback-hash))
|
|
|
|
(defun weechat-relay-remove-id-callback (id)
|
|
(let ((fun (weechat-relay-get-id-callback id)))
|
|
(remhash id weechat--relay-id-callback-hash)
|
|
fun))
|
|
|
|
(defun weechat-relay-add-id-callback (id function &optional one-shot force)
|
|
(unless id
|
|
(error "ID must not be nil"))
|
|
(when (weechat-relay-get-id-callback id)
|
|
(unless force
|
|
(error "ID '%s' is already in `weechat--relay-id-callback-hash'" id))
|
|
(weechat-relay-remove-id-callback id))
|
|
(let ((function* (if one-shot
|
|
(lambda (x)
|
|
(funcall function x)
|
|
(weechat-relay-remove-id-callback id))
|
|
function)))
|
|
(puthash id function* weechat--relay-id-callback-hash)))
|
|
|
|
(defun weechat-relay-send-command (command &optional callback)
|
|
"Send COMMAND to relay and call CALLBACK with reply.
|
|
CALLBACK takes one argument (the response data) which is a list."
|
|
(let ((id (symbol-name (cl-gensym))))
|
|
(when (functionp callback)
|
|
(weechat-relay-add-id-callback id callback 'one-shot))
|
|
(weechat--relay-send-message command id)))
|
|
|
|
(defvar weechat-relay-last-receive nil
|
|
"Stores the time when the last message was received.")
|
|
|
|
|
|
(defun weechat--relay-send-ping (&optional pong-callback)
|
|
(weechat-relay-send-command "info version" pong-callback))
|
|
|
|
;;; TODO: Move this functionality to weechat.el
|
|
(defvar weechat--relay-ping-timer nil)
|
|
(defun weechat--relay-stop-ping-timer ()
|
|
(when (timerp weechat--relay-ping-timer)
|
|
(cancel-timer weechat--relay-ping-timer)
|
|
(setq weechat--relay-ping-timer nil)))
|
|
|
|
(defun weechat--relay-start-ping-timer ()
|
|
(weechat--relay-stop-ping-timer)
|
|
(setq weechat--relay-ping-timer
|
|
(run-with-timer 0
|
|
(/ weechat-relay-ping-idle-seconds 2)
|
|
(lambda ()
|
|
(if (weechat-relay-connected-p)
|
|
(when (>= (float-time (time-since weechat-relay-last-receive))
|
|
weechat-relay-ping-idle-seconds)
|
|
(weechat--relay-send-ping))
|
|
;; Stop the ping timer if we aren't connected
|
|
(weechat--relay-stop-ping-timer))))))
|
|
|
|
(defun weechat--relay-process-filter (proc string)
|
|
(with-current-buffer (process-buffer proc)
|
|
(weechat-relay-log (format "Received %d bytes" (length string)) :debug)
|
|
;; Insert the text, advancing the process marker.
|
|
(goto-char (point-max))
|
|
(let ((inhibit-read-only t))
|
|
(insert (string-make-unibyte string)))
|
|
(let ((inhibit-redisplay t))
|
|
(while (weechat--message-available-p)
|
|
(let* ((data (weechat--relay-parse-new-message))
|
|
(id (weechat--message-id data)))
|
|
(setq weechat-relay-last-receive (current-time))
|
|
;; If buffer is available, log message.
|
|
(when (eq weechat-relay-log-level :debug)
|
|
(weechat-relay-log (pp-to-string data) :debug))
|
|
;; Call `weechat-relay-message-function'
|
|
(when (functionp weechat-relay-message-function)
|
|
(funcall weechat-relay-message-function data))
|
|
;; Call callback from `weechat--relay-id-callback-hash'
|
|
(if (functionp (weechat-relay-get-id-callback id))
|
|
(funcall (weechat-relay-get-id-callback id)
|
|
(weechat--message-data data))))))))
|
|
|
|
(defvar weechat--relay-connected-callback)
|
|
|
|
(defun weechat--relay-handle-process-status (status)
|
|
(weechat-relay-log (format "Received status event: %s\n" status))
|
|
(cl-case status
|
|
((closed exit) (run-hooks 'weechat-relay-disconnect-hook))
|
|
(failed (error "Failed to connect to weechat relay")
|
|
(weechat-relay-disconnect))))
|
|
|
|
(defun weechat--relay-process-sentinel (proc _)
|
|
(weechat--relay-handle-process-status (process-status proc)))
|
|
|
|
(defun weechat--relay-open-socket (name buffer host service)
|
|
(make-network-process :name name
|
|
:buffer buffer
|
|
:host host
|
|
:service service
|
|
:coding 'binary
|
|
:keepalive t
|
|
:noquery t))
|
|
|
|
(defun weechat--relay-plain-socket (bname host port)
|
|
(weechat-relay-log (format "PLAIN %s:%d" host port) :info)
|
|
(weechat--relay-open-socket "weechat-relay" bname host port))
|
|
|
|
(defun weechat--relay-tls-socket (bname host port)
|
|
(weechat-relay-log (format "TLS %s:%d" host port) :info)
|
|
(require 'gnutls)
|
|
(open-network-stream "weechat-relay-tls"
|
|
bname
|
|
host
|
|
port
|
|
:type 'tls
|
|
:coding 'binary))
|
|
|
|
(defun weechat--relay-from-command (cmdspec)
|
|
(lambda (bname host port)
|
|
(let ((cmd (format-spec cmdspec (format-spec-make
|
|
?h host
|
|
?p port))))
|
|
(weechat-relay-log (format "COMMAND %s:%s: `%s'" host port cmd))
|
|
(let ((process-connection-type nil)) ; Use a pipe.
|
|
(start-process-shell-command "weechat-relay-cmd" bname cmd)))))
|
|
|
|
(defun weechat-relay-connect (host port mode &optional callback)
|
|
"Open a new weechat relay connection to HOST at PORT.
|
|
|
|
Argument MODE Null or 'plain for a plain socket, t or 'ssl for a TLS socket;
|
|
a string denotes a command to run. You can use %h and %p to interpolate host
|
|
and port number respectively.
|
|
|
|
Optional argument CALLBACK Called after initialization is finished."
|
|
;; Clean relay buffer to start with clean state
|
|
(with-current-buffer (get-buffer-create weechat-relay-buffer-name)
|
|
(let ((inhibit-read-only t))
|
|
(delete-region (point-min) (point-max))))
|
|
(let* ((pfun (cond
|
|
((or (null mode) (eq mode 'plain)) #'weechat--relay-plain-socket)
|
|
((or (eq mode t) (eq mode 'ssl)) #'weechat--relay-tls-socket)
|
|
((stringp mode) (weechat--relay-from-command mode))))
|
|
(process
|
|
(funcall pfun weechat-relay-buffer-name host port)))
|
|
(set-process-sentinel process #'weechat--relay-process-sentinel)
|
|
(set-process-coding-system process 'binary)
|
|
(set-process-filter process #'weechat--relay-process-filter)
|
|
(with-current-buffer (get-buffer weechat-relay-buffer-name)
|
|
(setq buffer-read-only t)
|
|
(set-buffer-multibyte nil)
|
|
(buffer-disable-undo)))
|
|
|
|
(with-current-buffer (get-buffer-create
|
|
weechat-relay-log-buffer-name)
|
|
(buffer-disable-undo))
|
|
(when (functionp callback)
|
|
(funcall callback))
|
|
(run-hooks 'weechat-relay-connect-hook))
|
|
|
|
(defun weechat-relay-connected-p ()
|
|
(and (get-buffer weechat-relay-buffer-name)
|
|
(get-buffer-process weechat-relay-buffer-name)
|
|
(process-live-p (get-buffer-process weechat-relay-buffer-name))
|
|
t))
|
|
|
|
(defun weechat-relay-disconnect ()
|
|
"Disconnect current weechat relay connection and close all buffers."
|
|
(when (weechat-relay-connected-p)
|
|
(weechat--relay-send-message "quit")
|
|
(with-current-buffer weechat-relay-buffer-name
|
|
(let ((proc (get-buffer-process (current-buffer))))
|
|
;; When disconnecting interactively (e.g. when this function
|
|
;; is called), prevent running any disconnect hooks.
|
|
(set-process-sentinel proc nil)
|
|
(delete-process proc)
|
|
;; Stop the ping timer
|
|
(weechat--relay-stop-ping-timer))
|
|
(kill-buffer))
|
|
(when (get-buffer weechat-relay-log-buffer-name)
|
|
(kill-buffer weechat-relay-log-buffer-name))))
|
|
|
|
(defun weechat--message-id (message)
|
|
(car message))
|
|
|
|
(defun weechat--message-data (message)
|
|
"Return a list with data in MESSAGE."
|
|
(cdr message))
|
|
|
|
(defun weechat--hdata-path (hdata)
|
|
(car hdata))
|
|
|
|
(defun weechat--hdata-values (hdata)
|
|
(cadr hdata))
|
|
|
|
(defun weechat--hdata-value-pointer-path (value)
|
|
(car value))
|
|
|
|
(defun weechat--hdata-value-alist (value)
|
|
(cdr value))
|
|
|
|
(defun weechat-unload-function ()
|
|
(ad-disable-advice 'open-gnutls-stream 'around 'weechat-verifying))
|
|
|
|
(provide 'weechat-relay)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; weechat-relay.el ends here
|
|
|