stomp.el/stomp.el

;;; stomp.el --- STOMP protocol library -*- lexical-binding: t -*-

;; Copyright (C) 2018 Hugo Thunnissen

;; Author: Hugo Thunnissen <hugo.thunnissen@gmail.com>
;; Created: 17 October 2018
;; Version: dev-master
;; Keywords: stomp STOMP messaging message
;; Package-Requires: (map)

;; 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 <https://www.gnu.org/licenses/>.
;; 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)