stomp.el/stomp.el

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

(require 'map)

(defun stomp-connect (host port)
  "Connect to a server supporting the STOMP protocol"
  (message "Not implemented yet"))

;; TODO: make this send more than just the command
(defun stomp-send-frame (process frame)
  "Send a message to a STOMP process"
  (process-send-string
   process
   (format "%s\n\n\u0000\n" (alist-get 'command 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
        (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))))