;;; Commentary:
;;
;; acap.el is an elisp library providing an interface for talking to
-;; ACAP (RFC2244) servers.
-;;
+;; ACAP (RFC2244) servers.
+;;
;; This is a transcript of short interactive session for demonstration
;; purposes.
;;
;; (acap-close proc)
;; => t
+;;
+;; Todo:
+;; * Send literal data for STORE.
;;; History:
;;
;;; Code:
-(eval-when-compile
- (require 'cl)
- (require 'static))
+(eval-when-compile (require 'cl))
(require 'pces)
(require 'sasl)
(defvar acap-response nil
"ACAP Response.")
+(defvar acap-logging-out nil
+ "Non-nil when ACAP is logging out.")
+
(make-variable-buffer-local 'acap-state)
(make-variable-buffer-local 'acap-auth)
(make-variable-buffer-local 'acap-capability)
(make-variable-buffer-local 'acap-server)
(make-variable-buffer-local 'acap-port)
(make-variable-buffer-local 'acap-response)
+(make-variable-buffer-local 'acap-logging-out)
(defvar acap-network-stream-alist
'((default . open-network-stream-as-binary)))
(defvar acap-passphrase-alist nil)
+(eval-and-compile
+ (autoload 'ange-ftp-read-passwd "ange-ftp"))
+
(defun acap-read-passphrase (prompt)
"Prompt is not used."
(or acap-passphrase
(if (functionp 'read-passwd)
(read-passwd prompt)
(if (load "passwd" t)
- (read-passwd prompt))))))
+ (read-passwd prompt)
+ (ange-ftp-read-passwd prompt))))))
;;; Debug.
(defvar acap-debug t)
(delq (assoc key acap-passphrase-alist)
acap-passphrase-alist))))
-;;; Open, Close
+;;; Open, Close
(defun acap-open (server &optional user auth port type)
(let* ((user (or user acap-default-user))
(buffer (get-buffer-create (concat " *acap on " user " at " server)))
process passphrase mechanism tag)
(with-current-buffer buffer
+ (erase-buffer)
(if acap-process
(delete-process acap-process))
(setq process (acap-network-stream-open buffer server port type)
acap-process process)
- (erase-buffer)
(set-buffer-multibyte nil)
(buffer-disable-undo)
(setq acap-state 'initial)
(defun acap-close (process)
(with-current-buffer (process-buffer process)
+ (setq acap-logging-out t)
(unless (acap-response-ok-p (acap-send-command-wait process "LOGOUT"))
(message "Server %s didn't let me log out" acap-server))
(when (memq (process-status process) '(open run))
(defun acap-store (process entries)
"Execute STORE command on PROCESS.
ENTRIES is a store-entry list."
- (acap-send-command-wait process (concat "STORE " (prin1-to-string entries))))
+ (with-temp-buffer
+ ;; As far as I know, current implementation of ACAP server
+ ;; (cyrus-smlacapd 0.5) does not accept literal argument for STORE.
+ ;; If literal argument is available, command arguments can be sent using
+ ;; function `acap-send-command-wait'.
+ (set-buffer-multibyte nil)
+ (insert "STORE (")
+ (let (beg tag)
+ (while entries
+ (cond
+ ((stringp (car entries))
+ (setq beg (point))
+ (insert (car entries))
+ (goto-char beg)
+ (while (re-search-forward "\\\\" nil t)
+ (replace-match "\\\\\\\\"))
+ (goto-char beg)
+ (while (re-search-forward "\"" nil t)
+ (replace-match "\\\\\""))
+ (goto-char beg)
+ (insert "\"")
+ (goto-char (point-max))
+ (insert "\""))
+ ((symbolp (car entries))
+ (insert (prin1-to-string (car entries)))))
+ (if (cdr entries)(insert " "))
+ (setq entries (cdr entries)))
+ (insert ")")
+ (goto-char (point-min))
+ (insert (with-current-buffer (process-buffer process)
+ (number-to-string (setq tag (setq acap-tag (1+ acap-tag)))))
+ " ")
+ (process-send-region process (point-min) (point-max))
+ (acap-debug (concat (buffer-string) acap-client-eol))
+ (process-send-string process acap-client-eol)
+ (acap-wait-for-response process tag))))
(defun acap-deletedsince (process name time)
"Execute DELETEDSINCE command on PROCESS."
(defun acap-response-ok-p (response)
(assq 'done-ok response))
+(defun acap-response-bye-p (response)
+ (assq 'bye response))
+
+(defun acap-response-bye-message (response)
+ (nth 1 (cdr (assq 'bye response))))
+
(defun acap-response-cont-p (response)
(assq 'cont response))
(with-current-buffer (process-buffer process)
(while (and (not (acap-response-cont-p acap-response))
(< acap-reached-tag tag))
+ (when (acap-response-bye-p acap-response)
+ (if acap-logging-out
+ (setq acap-response nil)
+ (error "%s"
+ (prog1 (acap-response-bye-message acap-response)
+ (setq acap-response nil)))))
(or (and (not (memq (process-status process) '(open run)))
(sit-for 1))
- (let ((len (/ (point-max) 1024))
+ (let ((len (/ (point-max) 1024))
message-log-max)
- (unless (< len 10)
- (message "acap read: %dk" len))
- (accept-process-output process 1))))
+ (unless (< len 10)
+ (message "acap read: %dk" len))
+ (accept-process-output process 1))))
(message "")
acap-response))
(while (setq end (acap-find-next-line))
(save-restriction
(narrow-to-region (point-min) end)
- (delete-backward-char (length acap-server-eol))
+ (delete-char (- (length acap-server-eol)))
(goto-char (point-min))
(unwind-protect
(cond ((or (eq acap-state 'auth)
(progn
(acap-forward)
(acap-parse-return-data-list)))))
- (ALERT ;(cons 'alert (acap-parse-resp-body))
- (message (nth 1 (acap-parse-resp-body))))
- (BYE ;(cons 'bye (acap-parse-resp-body)))
- ;;(message (nth 1 (acap-parse-resp-body)))
- ;;(ding)
- )
+ (ALERT
+;;; (cons 'alert (acap-parse-resp-body))
+ (message "%s" (nth 1 (acap-parse-resp-body))))
+ ((BYE Bye bye)
+ (cons 'bye (acap-parse-resp-body)))
(CHANGE (cons 'change
(list (acap-parse-quoted)
(progn
;; response-stat
(OK (cons 'stat-ok (acap-parse-resp-body)))
(NO (cons 'stat-no (acap-parse-resp-body)))
- (BAD ;(cons 'stat-bad (acap-parse-resp-body))
+ (BAD
+;;; (cons 'stat-bad (acap-parse-resp-body))
;; XXX cyrus-sml-acap does not return tagged bad response?
- (error (nth 1 (acap-parse-resp-body))))))
+ (error "%s" (nth 1 (acap-parse-resp-body))))))
((integerp token)
;; tagged response.
(setq tag token)
projects / elisp / wanderlust.git / blobdiff