You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

94 lines
3.3 KiB
EmacsLisp

;; -*- lexical-binding: t -*-
6 years ago
;; stomp.el, interpret STOMP messages.
(require 'map)
6 years ago
(defun stomp-connect (host port)
"Connect to a server supporting the STOMP protocol"
(message "Not implemented yet"))
6 years ago
;; TODO: make this send more than just the sommand
(defun stomp-send-message (process message)
"Send a message to a STOMP process"
(process-send-string
process
(format "%s\n\n\u0000\n" (alist-get 'command message))))
;; TODO: debug this and find a fast way to test it
6 years ago
(defun stomp-filter-function (callback)
"Filter function to be used with processes"
(unless (functionp callback) (signal 'wrong-type-argument 'functionp))
(lambda (proc string)
(with-current-buffer (process-buffer proc)
(goto-char (point-max))
(insert string)
(let ((message (stomp-shift-message (current-buffer))))
(if message (funcall callback message))))))
6 years ago
6 years ago
(defun stomp-shift-message (buffer)
"Read a message from a buffer. After reading a message, it will
be deleted from the buffer."
(let ((message (stomp-read-message buffer)))
(cond
(message (stomp-delete-message buffer) message)
(t nil))))
(defun stomp-delete-message (buffer)
"Delete the top-most messsage in a buffer"
(with-current-buffer buffer
(delete-region (point-min) (+ 2x (stomp-find-message-end-point buffer)))))
6 years ago
(defun stomp-read-message (buffer)
"Attempt to read a single message from a buffer.
The buffer may contain multiple messages, but only the first
message (from top to bottom) will be read. If there are no
messages in the buffer, nil will be returned."
(with-current-buffer buffer
(goto-char (point-min))
(while (search-forward "\r" nil t)
(replace-match ""))
(let ((message ()) (headers ()) (content)
(headers-end-point (stomp-find-headers-end-point buffer)))
(goto-char (point-min))
6 years ago
(map-put message 'command (current-word))
(setq headers (stomp-read-headers buffer headers-end-point))
;; TODO: take content-length header into account
(setq content (buffer-substring
(+ 1 headers-end-point)
(stomp-find-message-end-point buffer)))
6 years ago
(cond
(content
(map-put message 'headers headers)
(map-put message 'content content))
(t nil)))))
(defun stomp-read-headers (buffer end-point &optional headers)
6 years ago
"Attempt to read the headers of a stomp message in *buffer*"
(with-current-buffer buffer
(unless headers (goto-char (point-min)))
(forward-line)
(let ((header (split-string (thing-at-point 'line) ":")))
(cond
((= (line-end-position) end-point) headers)
6 years ago
((> (length header) 2) (throw 'invalid-header nil))
(t (stomp-read-headers buffer end-point
(map-put headers
(car header)
(replace-regexp-in-string "\n$" "" (car (last header))))))))))
6 years ago
(defun stomp-find-message-end-point (buffer)
"Find the null byte at the end of a STOMP message"
6 years ago
(with-current-buffer buffer
(goto-char (point-min))
(search-forward "\u0000")
(- (point) 1)))
6 years ago
(defun stomp-find-headers-end-point (buffer)
"Find the end of the header part of a STOMP frame."
(with-current-buffer buffer
(goto-char (point-min))
(search-forward-regexp "^$")
(line-end-position)))