textlog.el

;;; textlog.el --- Publish text to textlog.cc  -*- lexical-binding: t; -*-

;; Author: hotter
;; Version: 0.1.0
;; Package-Requires: ((emacs "27.1"))

;;; Commentary:

;; Post short notes to a textlog instance from Emacs.
;;
;; textlog's JSON API is read-only, so publishing goes through the same
;; HTML form the /write page submits: a POST to /post carrying the
;; session cookie.  The server rejects cross-origin POSTs, so the
;; request also sends a matching Origin header.
;;
;; The session token is the value of the `textlog' cookie of a logged-in
;; browser session.  Store it in ~/.authinfo.gpg:
;;
;;   machine textlog.cc login <handle> password <cookie-value>

;;; Code:

(require 'auth-source)
(require 'json)
(require 'url)

(defgroup textlog nil
  "Publish text to a textlog instance."
  :group 'applications)

(defcustom textlog-url "https://textlog.cc"
  "Base URL of the textlog instance, without a trailing slash."
  :type 'string)

(defcustom textlog-handle "hotter"
  "Handle posts are published under.  Used to look up the permalink."
  :type 'string)

(defcustom textlog-max-length 280
  "Maximum length of a post the server accepts."
  :type 'integer)

(defvar textlog-session-token nil
  "Session token to use instead of the auth-source entry.")

(defun textlog--host ()
  "Host of `textlog-url'."
  (url-host (url-generic-parse-url textlog-url)))

(defun textlog--token ()
  "Session token for `textlog-url'."
  (or textlog-session-token
      (let ((found (car (auth-source-search :host (textlog--host)
                                            :user textlog-handle :max 1))))
        (when found (auth-info-password found)))
      (user-error "No textlog session token; add a `%s' entry to ~/.authinfo.gpg"
                  (textlog--host))))

(defun textlog--form-error ()
  "Error message rendered in the HTML page in the current buffer, if any."
  (goto-char (point-min))
  (when (re-search-forward "<p class=\"form-error\"[^>]*>\\([^<]*\\)</p>" nil t)
    (string-trim (match-string 1))))

(defun textlog--status ()
  "HTTP status code of the response in the current buffer."
  (goto-char (point-min))
  (if (re-search-forward "^HTTP/[0-9.]+ \\([0-9]+\\)" (line-end-position) t)
      (string-to-number (match-string 1))
    0))

(defun textlog--permalink ()
  "URL of the most recent post of `textlog-handle', or nil."
  (ignore-errors
    (with-current-buffer
        (url-retrieve-synchronously
         (format "%s/api/v1/users/%s/posts?limit=1" textlog-url textlog-handle)
         t t 10)
      (goto-char (point-min))
      (when (search-forward "\n\n" nil t)
        (let* ((json-object-type 'alist)
               (data (alist-get 'data (json-read))))
          (alist-get 'url (aref data 0)))))))

(defun textlog-post (text)
  "Publish TEXT to `textlog-url'.
Interactively, publishes the active region, or prompts for the text
when there is none.  Returns the URL of the new post when the server
reports one."
  (interactive
   (list (if (use-region-p)
             (buffer-substring-no-properties (region-beginning) (region-end))
           (read-string "Post: "))))
  (let ((body (string-trim text)))
    (when (string-empty-p body)
      (user-error "Nothing to post"))
    (when (> (length body) textlog-max-length)
      (user-error "Post is %d characters, limit is %d"
                  (length body) textlog-max-length))
    (let* ((url-request-method "POST")
           ;; A 303 to /latest is the success signal, so keep it in the
           ;; response instead of following it.
           (url-max-redirections 0)
           (url-request-extra-headers
            `(("Content-Type" . "application/x-www-form-urlencoded")
              ("Origin" . ,textlog-url)
              ("Cookie" . ,(concat "textlog=" (textlog--token)))))
           (url-request-data
            (concat "body=" (url-hexify-string (encode-coding-string body 'utf-8)))))
      (with-current-buffer (url-retrieve-synchronously
                            (concat textlog-url "/post") t t 30)
        (let ((status (textlog--status))
              (error-message (textlog--form-error)))
          (kill-buffer)
          (pcase status
            ((or 302 303)
             (let ((link (textlog--permalink)))
               (message "Posted to textlog%s" (if link (concat ": " link) ""))
               link))
            (403 (user-error "textlog: forbidden - session token expired or account unverified"))
            (429 (user-error "textlog: %s" (or error-message "rate limited")))
            (_ (user-error "textlog: %s" (or error-message
                                             (format "post failed with HTTP %d" status))))))))))

(provide 'textlog)
;;; textlog.el ends here