commit 3ca9c1c381e167d33fbc88a7d9cba9e414a7ca10 Author: Jakub Date: Sat May 9 12:23:18 2026 +0800 Basic websocket client diff --git a/gomuks.el b/gomuks.el new file mode 100644 index 0000000..d0fd962 --- /dev/null +++ b/gomuks.el @@ -0,0 +1,150 @@ +;;; gomuks.el --- summary -*- lexical-binding: t -*- + +;; This file is not part of GNU Emacs + +;; 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 . + + +;;; Commentary: + +;; commentary + +;;; Code: + +(cl-defstruct gomuks-state rooms spaces) +(cl-defstruct room id name topic events) +(cl-defstruct message row-id id sender body) + +(defvar client-state (make-gomuks-state :rooms '() :spaces '())) + +(defvar gomuks-server-buffer (get-buffer-create "*gomuks-server*")) +(defvar gomuks-socket-buffer "*gomuks-socket-frame*") +(defvar gomuks-server-name "*gomuks-server*") +(defvar gomuks-server-bin "~/Downloads/gomuks") +(defvar gomuks-server-proc + (start-process gomuks-server-name gomuks-server-buffer gomuks-server-bin)) + +(defvar gomuks-url "http://localhost:29325") +(defvar gomuks-auth-endpoint (concat gomuks-url "/_gomuks/auth")) +(defvar gomuks-auth-cookie ) + +(defvar gomuks-ws-endpoint (concat gomuks-url "/_gomuks/websocket")) + +(defvar gomuks-auth-cookie nil) +(defvar gomuks-websocket nil) +(defvar gomuks-ping-timer nil) +(defun gomuks-connect (gomuks-username) + "Opens a websocket connection with the specified gomuks endpoint" + (interactive "sGomuks Username: \n") + (let ((gomuks-password (read-passwd "Gomuks Password:"))) + (setq gomuks-auth-cookie (let ((request--curl-cookie-jar (expand-file-name (make-temp-name "gomuks-cookie-") + temporary-file-directory))) + (request gomuks-auth-endpoint + :type "POST" + :headers `(("Authorization" . + ,(concat "Basic " + (base64-encode-string + (concat gomuks-username ":" gomuks-password)))))) + (sleep-for 0.5) + (cdar (request--netscape-get-cookies request--curl-cookie-jar "localhost" "/_gomuks" t))))) + (setq gomuks-ping-timer (run-with-timer + 0 + 15 + (lambda () + (message "pinging") + (websocket-send-text gomuks-websocket + "{\"command\":\"ping\"}")))) + (setq gomuks-websocket (websocket-open "ws://localhost:29325/_gomuks/websocket" + :custom-header-alist + `(("Cookie" . ,(concat "gomuks_auth=" gomuks-auth-cookie))) + :on-message (lambda (_ws frame) + (message "frame %s %s" (websocket-frame-completep frame) (websocket-frame-text + frame)) + (cond + ((not (websocket-frame-completep frame)) + (message "frame incomplete") + (with-current-buffer (get-buffer-create gomuks-socket-buffer) + (goto-char (point-max)) + (insert (websocket-frame-payload frame)))) + (t + (message "frame complete") + (let* ((combined-payload + (unwind-protect + (with-current-buffer (get-buffer-create gomuks-socket-buffer) + (goto-char (point-max)) + (insert (websocket-frame-payload frame)) + (message "%s" (buffer-string)) + (buffer-string)) + (kill-buffer (get-buffer-create gomuks-socket-buffer)))) + (msg (json-parse-string (decode-coding-string combined-payload 'utf-8) + :object-type 'alist + :array-type 'list + :null-object '()))) + (message "test %S" msg) + (cond ((equal (alist-get 'command msg) "sync_complete") + (gomuks-sync-state (alist-get 'data msg))))))))))) + +(defun gomuks-disconnect () + "Disconnect the gomuks websocket." + (interactive) + (cancel-timer gomuks-ping-timer) + (websocket-close gomuks-websocket)) + +(defun gomuks-process-initial-events (events) + (mapcar + (lambda (event) + (cond + ((and (or + (equal (alist-get 'type event) "m.room.message") + (equal (alist-get 'decrypted_type event) "m.room.message")) + (not (assoc 'relation_type event))) ;; Not an edit + (cons + (alist-get 'event_id event) + (make-message :row-id (alist-get 'rowid event) + :id (alist-get 'event_id event) + :sender (alist-get 'sender event) + :body (if (assoc 'decrypted event) + (alist-get 'body (alist-get 'decrypted event)) + (alist-get 'body (alist-get 'content event)))))) + (t + (cons (alist-get 'event_id event) + nil)))) + events)) + +(defun gomuks-sync-state (data) + (let ((spaces (alist-get 'top_level_spaces data)) + (rooms (alist-get 'rooms data))) + (when (< 0 (length spaces)) + (setf (gomuks-state-spaces client-state) spaces)) + (when (< 0 (length rooms)) + (dolist (rm rooms) + (when (not (alist-get 'tombstone (alist-get 'meta (cdr rm)))) + (if (not (alist-get (car rm) (gomuks-state-rooms client-state))) + (setf (gomuks-state-rooms client-state) + (cons (cons + (car rm) + (make-room :id (car rm) + :name (alist-get 'name (alist-get 'meta (cdr rm))) + :topic (alist-get 'topic (alist-get 'meta (cdr rm))) + :events (gomuks-process-initial-events (alist-get 'events (cdr rm))))) + (gomuks-state-rooms client-state))) + (let ((target-room (alist-get (car rm) (gomuks-state-rooms client-state)))) + (setf (room-name target-room) (alist-get 'name (alist-get 'meta (cdr rm)))) + (setf (room-topic target-room) (alist-get 'topic (alist-get 'meta (cdr rm)))) + (setf (room-events target-room) (append (room-events target-room) + (gomuks-process-initial-events (alist-get 'events (cdr rm)))))))))))) + +(provide 'gomuks) + +;;; gomuks.el ends here