blob: c6890ddbb0a7865b24211567ea84b10fe27228e1 (
plain) (
tree)
|
|
;;; rt-liberation-rest.el --- Interface to the RT REST API -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;;
;; Authors: Yoni Rabkin <yrk@gnu.org>
;;
;; This file is a part of rt-liberation.
;;
;; 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, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;; History:
;;
;; Started in May of 2014 in order to remove rt-liberation's
;; dependency on a local copy of the RT CLI.
;;; Code:
(require 'url)
(require 'url-util)
(require 'auth-source)
;;; ------------------------------------------------------------------
;;; variables and constants
;;; ------------------------------------------------------------------
(defvar rt-liber-rest-debug-buffer-name "*rt-liber-rest debug log*"
"Buffer name of debug capture.")
(defvar rt-liber-rest-debug-p nil
"If non-nil, record traffic in a debug buffer.")
(defvar rt-liber-rest-scheme "https"
"Scheme used for transport. Is one of http or https.")
(defvar rt-liber-rest-url ""
"URL of RT installation.")
(defvar rt-liber-rest-username nil
"Username of RT account.")
(defvar rt-liber-rest-password nil
"Password of RT account.")
(defvar rt-liber-rest-verbose-p t
"If non-nil, be verbose about what's happening.")
(defvar rt-liber-ticket-old-threshold 30
"Age in days before a ticket is considered old.")
(defvar rt-liber-field-dictionary
'((owner . "Owner")
(queue . "Queue")
(status . "Status")
(priority . "Priority"))
"Mapping between field symbols and RT field strings.
The field symbols provide the programmer with a consistent way of
referring to RT fields.")
(defvar rt-liber-debug-log-enable nil
"If t then enable logging of communication to a buffer.
Careful! This might create a sizable buffer.")
(defvar rt-liber-debug-log-buffer-name "*rt-liber debug log*"
"Name of debug log buffer.")
;;; ------------------------------------------------------------------
;;; functions
;;; ------------------------------------------------------------------
(defun rt-liber-rest-write-debug (str)
"Write to debug buffer."
(when (not (stringp str))
(error "argument not string"))
(when rt-liber-rest-debug-p
(with-current-buffer
(get-buffer-create rt-liber-rest-debug-buffer-name)
(goto-char (point-max))
(insert str))))
(defun rt-liber-rest-auth ()
"Try to get the REST credentials."
(if (and (stringp rt-liber-rest-username)
(stringp rt-liber-rest-password)
(< 0 (length rt-liber-rest-username))
(< 0 (length rt-liber-rest-password)))
t
(message "rt-liber: no REST credentials set, so attempting auth-source")
(let ((auth-source-found-p
(auth-source-search :host "rt-liberation" :require '(:user :secret) :create nil)))
(when (not auth-source-found-p)
(error "no auth-source found for login"))
(setq rt-liber-rest-password (funcall (plist-get (nth 0 auth-source-found-p) :secret))
rt-liber-rest-username (plist-get (nth 0 auth-source-found-p) :user)))))
(defun rt-liber-rest-search-string (scheme url username password query)
"Return the search query string."
(let ((user (url-encode-url username))
(pass (url-encode-url password)))
(concat scheme
"://"
url
"/REST/1.0/search/ticket" "?"
"user=" user "&"
"pass=" pass "&"
"query=" (url-encode-url query) "&"
"format=i" "&"
"orderby=+Created")))
(defun rt-liber-rest-show-string (scheme url ticket-id-list username password _query)
"Return the ticket show string."
(let ((user (url-encode-url username))
(pass (url-encode-url password)))
(concat scheme
"://"
url
"/REST/1.0/ticket/" ticket-id-list
"/show" "?"
"user=" user "&"
"pass=" pass "&")))
(defun rt-liber-rest-history-string (scheme url ticket-id username password)
"Return the ticket show string."
(let ((user (url-encode-url username))
(pass (url-encode-url password)))
(concat scheme
"://"
url
"/REST/1.0/ticket/" ticket-id
"/history" "?"
"format=l" "&"
"user=" user "&"
"pass=" pass)))
(defun rt-liber-rest-command-edit-string (scheme url ticket-id username password)
"Return the ticket edit string."
(let ((user (url-encode-url username))
(pass (url-encode-url password)))
(concat scheme
"://"
url
"/REST/1.0/ticket/" ticket-id
"/edit" "?"
"user=" user "&"
"pass=" pass)))
(defun rt-liber-rest-call (url)
"Perform a REST call with URL."
(let ((url-request-method "POST"))
(let ((response
(url-retrieve-synchronously url))
str)
(setq str
(decode-coding-string
(with-current-buffer response
(buffer-substring-no-properties (point-min)
(point-max)))
'utf-8))
(message "done")
(rt-liber-rest-write-debug
(format "outgoing rest call -->\n%s\n<-- incoming\n%s\n" url str))
str)))
(defun rt-liber-rest-query-runner (op query-string)
"Run OP on QUERY-STRING."
(when (or (not (stringp op))
(not (stringp query-string)))
(error "bad arguments"))
(rt-liber-rest-auth)
(cond ((string= op "ls")
(rt-liber-rest-call
(rt-liber-rest-search-string rt-liber-rest-scheme
rt-liber-rest-url
rt-liber-rest-username
rt-liber-rest-password
query-string)))
((string= op "show")
(rt-liber-rest-call
(rt-liber-rest-show-string rt-liber-rest-scheme
rt-liber-rest-url
query-string
rt-liber-rest-username
rt-liber-rest-password
query-string)))
((string= op "history")
(rt-liber-rest-call
(rt-liber-rest-history-string rt-liber-rest-scheme
rt-liber-rest-url
query-string
rt-liber-rest-username
rt-liber-rest-password)))
(t (error "unknown op [%s]" op))))
(defun rt-liber-rest-parse-http-header ()
"Parse the HTTP header from the server."
(let ((http-ok-regexp "^HTTP.*200 OK$")
(rt-ok-regexp "^rt/.*200 ok$"))
(condition-case nil
(progn
(re-search-forward http-ok-regexp (point-max))
(re-search-forward rt-ok-regexp (point-max)))
(error "bad HTTP response from server")))) ;FIXME: Unused string!
(defun rt-liber-rest-show-process (response)
"Process and return the show query response."
(when (not (stringp response))
(error "argument not a string"))
(with-temp-buffer
(save-excursion
(insert response))
(rt-liber-rest-parse-http-header)
(buffer-substring (point) (point-max))))
(defun rt-liber-rest-show-query-runner (idsublist)
"Iterate over IDSUBLIST and return the collected result."
(when (not (listp idsublist))
(error "argument not list"))
(with-temp-buffer
(let ((ticket-ids (reverse (copy-tree idsublist)))
(c 1)
(l (length idsublist)))
(while ticket-ids
(when rt-liber-rest-verbose-p
(message "retrieving ticket %d/%d" c l)
(setq c (1+ c)))
(insert
(rt-liber-rest-show-process
(rt-liber-rest-query-runner "show" (caar ticket-ids))))
(setq ticket-ids (cdr ticket-ids))
(when ticket-ids
(insert "\n--\n")))
(when rt-liber-rest-verbose-p
(message "done retrieving %d tickets" l)))
(buffer-substring (point-min) (point-max))))
(defun rt-liber-rest-handle-response (buffer)
"Handle the response provided in BUFFER."
(with-current-buffer buffer
(rt-liber-rest-write-debug (buffer-string))))
(defun rt-liber-rest-edit-runner (ticket-id field value)
"Run edit comment to set FIELD to VALUE."
(message "started edit command at %s..." (current-time-string))
(message "ticket #%s, %s <- %s" ticket-id field value)
(rt-liber-rest-auth)
(let ((request-data
(format "content=%s: %s"
(url-hexify-string field)
(url-hexify-string value))))
(rt-liber-rest-write-debug (concat request-data "\n"))
(let ((url-request-method "POST")
(url-request-data request-data)
response-buffer)
(setq response-buffer
(url-retrieve-synchronously
(rt-liber-rest-command-edit-string
rt-liber-rest-scheme
rt-liber-rest-url
ticket-id
rt-liber-rest-username
rt-liber-rest-password)))
(rt-liber-rest-handle-response response-buffer)))
(message "edit command ended at %s" (current-time-string)))
;;; --------------------------------------------------------
;;; Debug log
;;; --------------------------------------------------------
(defun rt-liber-debug-log-write (str)
"Write STR to debug log."
(when (not (stringp str))
(error "must be a string"))
(with-current-buffer (get-buffer-create
rt-liber-debug-log-buffer-name)
(goto-char (point-max))
(insert str)))
;;; --------------------------------------------------------
;;; Parse Answer
;;; --------------------------------------------------------
(defun rt-liber-parse-answer (answer-string parser-f)
"Operate on ANSWER-STRING with PARSER-F."
(with-temp-buffer
(insert answer-string)
(goto-char (point-min))
(when rt-liber-debug-log-enable
(rt-liber-debug-log-write (buffer-substring (point-min)
(point-max))))
(funcall parser-f)))
;;; --------------------------------------------------------
;;; Ticket list retriever
;;; --------------------------------------------------------
(put 'rt-liber-no-result-from-query-error
'error-conditions
'(error rt-liber-errors rt-liber-no-result-from-query-error))
(put 'rt-liber-no-result-from-query-error
'error-message
"No results from query")
(defun rt-liber-ticket-base-retriever-parser-f ()
"Parser function for ticket list."
(let (ticketbase-list ticketbase (continue t))
(while (save-excursion
(re-search-forward "^id:" (point-max) t))
(while (and continue
(re-search-forward
"^\\(\\([.{} #[:alpha:]]+\\): \\(.*\\)\\)$\\|^--$"
(point-max) t))
(if (string= (match-string-no-properties 0) "--")
(setq continue nil)
(push (cons (match-string-no-properties 2)
(match-string-no-properties 3))
ticketbase)))
(push (copy-sequence ticketbase) ticketbase-list)
(setq ticketbase nil
continue t))
ticketbase-list))
(defun rt-liber-rest-ticketsql-runner-parser-f ()
"Parser function for a textual list of tickets."
(let (idsub-list)
(rt-liber-rest-parse-http-header)
(while (re-search-forward "ticket/\\([0-9].+\\)" (point-max) t)
(push (list (match-string-no-properties 1)
".")
idsub-list))
idsub-list))
(defun rt-liber-rest-run-ls-query (query)
"Run an \"ls\" type query against the server with QUERY."
(rt-liber-parse-answer
(rt-liber-rest-query-runner "ls" query)
'rt-liber-rest-ticketsql-runner-parser-f))
(defun rt-liber-rest-run-show-base-query (idsublist)
"Run \"show\" type query against the server with IDSUBLIST."
(rt-liber-parse-answer
(rt-liber-rest-show-query-runner idsublist)
#'rt-liber-ticket-base-retriever-parser-f))
(defun rt-liber-rest-run-ticket-history-base-query (ticket-id)
"Run history query against server for TICKET-ID."
(rt-liber-parse-answer
(rt-liber-rest-query-runner "history" ticket-id)
#'(lambda ()
(rt-liber-rest-parse-http-header)
(buffer-substring (point) (point-max)))))
(defun rt-liber-rest-command-set (id field status)
"Set ticket ID status to be STATUS."
(rt-liber-parse-answer
(rt-liber-rest-edit-runner id field status)
'rt-liber-command-runner-parser-f))
;;; --------------------------------------------------------
;;; Ticket utilities
;;; --------------------------------------------------------
(defun rt-liber-ticket-days-old (ticket-alist)
"Return the age of the ticket in positive days."
(days-between (format-time-string "%Y-%m-%dT%T%z" (current-time))
(cdr (assoc "Created" ticket-alist))))
(defun rt-liber-ticket-old-p (ticket-alist)
(<= rt-liber-ticket-old-threshold
(rt-liber-ticket-days-old ticket-alist)))
(defun rt-liber-ticket-id-only (ticket-alist)
"Return numerical portion of ticket number from TICKET-ALIST."
(if ticket-alist
(substring (cdr (assoc "id" ticket-alist)) 7)
nil))
(defun rt-liber-ticket-priority-only (ticket-alist)
"Return an integer value priority or NIL."
(if ticket-alist
(let ((p-str (cdr (assoc "Priority" ticket-alist))))
(if p-str
(string-to-number p-str)
nil))
nil))
(defun rt-liber-ticket-owner-only (ticket-alist)
"Return the string value of the ticket owner."
(when (not ticket-alist)
(error "null ticket-alist"))
(cdr (assoc (rt-liber-get-field-string 'owner)
ticket-alist)))
(defun rt-liber-get-field-string (field-symbol)
(when (not field-symbol)
(error "null field symbol"))
(cdr (assoc field-symbol rt-liber-field-dictionary)))
(provide 'rt-liberation-rest)
;;; rt-liberation-rest.el ends here.
|