stomp.el/stomp.el

;; -*- lexical-binding: t -*-
;; stomp.el, interpret STOMP messages.

(require 'map)

(defun stomp-send-frame (process frame)
  "Send a message to a STOMP process"
  (process-send-string process (stomp-frame-to-string frame)))
                       
(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 ((frame (stomp-shift-frame (current-buffer))))
        (if frame (funcall callback frame))))))

(defun stomp-shift-frame (buffer)
  "Read a frame from a buffer. After reading a frame, it will
   be deleted from the buffer."
  (let ((frame (stomp-read-frame buffer)))
    (cond
     (frame (stomp-delete-frame buffer) frame)
     (t nil))))

(defun stomp-delete-frame (buffer)
  "Delete the top-most messsage in a buffer"
  (with-current-buffer buffer
    (delete-region (point-min) (+ 2 (stomp-find-frame-end-point buffer)))))

(defun stomp-read-frame (buffer)
  "Attempt to read a single frame from a buffer.
   The buffer may contain multiple frames, but only the first
   frame (from top to bottom) will be read. If there are no
   frames in the buffer, nil will be returned."
  (with-current-buffer buffer
    (goto-char (point-min))
    (while (search-forward "\r" nil t)
      (replace-match ""))
    (let ((frame ())
          (headers-end-point (stomp-find-headers-end-point buffer))
          (frame-end-point (stomp-find-frame-end-point buffer)))
      (goto-char (point-min))
      (cond
       ((and frame-end-point headers-end-point)
        (map-put frame 'command (current-word))
        (map-put frame 'headers (stomp-read-headers buffer headers-end-point))
        ;; TODO: take content-length header into account
        ;; This is might be hard to do if the content contains carriage returns.
        (map-put frame 'content (buffer-substring (+ 1 headers-end-point) frame-end-point)))
       (t nil)))))

(defun stomp-read-headers (buffer end-point &optional headers)
  "Attempt to read the headers of a stomp frame 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)
       ((> (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))))))))))

(defun stomp-find-frame-end-point (buffer)
  "Find the null byte at the end of a STOMP frame"
  (with-current-buffer buffer
    (goto-char (point-min))
    (search-forward "\u0000")
    (- (point) 1)))

(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))
    (condition-case nil
        (progn (search-forward-regexp "^$") (line-end-position))
      (error nil))))

(defun stomp-frame-to-string (frame)
  "Convert a lisp datastructure describing a STOMP frame into a
   string that could be sent to a server or client. The
   datastructure should be an alist and should at least have a
   'command key. Other optional keys are 'headers (another alist)
   and 'content"
  (unless (assq 'command frame)
    (throw 'invalid-frame "A STOMP frame must define a command"))
  (let ((headers (if (assq 'headers frame) (alist-get 'headers frame) '()))
        (content (if (assq 'content frame) (alist-get 'content frame) "")))
    (format "%s\n%s\n%s\u0000"
            (alist-get 'command frame)
            (mapconcat (lambda (h) (format "%s:%s\n" (car h) (cdr h))) headers "")
            content)))

(provide 'stomp)