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/>.

(require 'map)

(define-error 'stomp-error
  "Error encountered in implementation of the STOMP protocol")

(define-error 'stomp-invalid-header
  "Invalid STOMP frame header encounterd")

(define-error 'stomp-invalid-frame
  "Invalid STOMP frame encountered")

(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 proc 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) frame)
     (t nil))))

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

(defun stomp-frame-header (header frame)
  "Shortcut to access frame headers"
  (assoc-default
   header
   (alist-get 'headers frame nil) 'string-equal nil))

(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
    (let ((frame ())
          (headers-end-point (stomp-find-headers-end-point buffer)))
      (goto-char (point-min))
      (cond
       ((and headers-end-point)
        (map-put frame 'command (current-word))
        (map-put frame 'headers (stomp-read-headers buffer headers-end-point))

        (let ((frame-end-point (stomp-find-frame-end-point buffer frame headers-end-point)))
          (if frame-end-point
              (map-put frame 'content (buffer-substring (+ 1 headers-end-point) frame-end-point))
            nil)))
       (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) (signal 'stomp-invalid-header (list header)))
       (t (stomp-read-headers
           buffer
           end-point
           (map-put headers
                    (car header)
                    (replace-regexp-in-string "\\(\n\\|\r\n\\)$" "" (car (last header))))))))))

(defun stomp-find-frame-end-point (buffer frame &optional headers-end-point)
  "Find the end point of a STOMP frame at the top of a buffer,
   either by using the content-length header or by searching for
   the null octet."
  (with-current-buffer buffer
    (let* ((content-length (stomp-frame-header "content-length" frame))
           (headers-end-point
            (if headers-end-point headers-end-point (stomp-find-headers-end-point buffer)))
           (end-point (if content-length
                          (+ headers-end-point 1 (string-to-number content-length))
                        (progn
                          (goto-char (point-min))
                          (search-forward-regexp "\u0000\\|\u0000\r" nil t)
                          (- (point) 1)))))
      (if (or (> end-point (point-max)) (<= end-point 0))
          nil
        end-point))))

(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 "^\\(\\|\r\\)$") (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)
    (signal 'stomp-invalid-frame (list "Expected frame to have a command" frame)))
  (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)