blob: 7782665963a133893274c74d3ac8d1dd706f1a27 (
plain) (
tree)
|
|
;;; rt-liberation-rest.el --- Interface to the RT REST API
;; 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.
;;
;; Note: Licensed under GPLv2+ and not GPLv3+ in order to be
;; compatible with the license of RT.
;;; 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 'rt-liberation) ; FIXME: Circular dependency
(declare-function rt-liber-parse-answer "rt-liberation" (answer-string parser-f))
(declare-function rt-liber-ticket-base-retriever-parser-f "rt-liberation" ())
(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 ""
"Username of RT account.")
(defvar rt-liber-rest-password ""
"Password of RT account.")
(defvar rt-liber-rest-verbose-p t
"If non-nil, be verbose about what's happening.")
(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-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))
(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"))
(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-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)
;; the output should be compatible with the input to
;; `rt-liber-create-tickets-string'
(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-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-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-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)
(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)))
(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))
(provide 'rt-liberation-rest)
;;; rt-liberation-rest.el ends here.
|