elmo/elmo-imap4.el

   1 ;;; elmo-imap4.el -- IMAP4 Interface for ELMO.
   2
   3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 (require 'elmo-vars)
  30 (require 'elmo-util)
  31 (require 'elmo-msgdb)
  32 (require 'elmo-date)
  33 (require 'elmo-cache)
  34 (require 'utf7)
  35
  36 ;;; Code:
  37 (condition-case nil
  38     (progn
  39       (require 'sasl))
  40   (error))
  41 ;; silence byte compiler.
  42 (eval-when-compile
  43   (require 'cl)
  44   (condition-case nil
  45       (progn
  46         (require 'starttls)
  47         (require 'sasl))
  48     (error))
  49   (defun-maybe sasl-cram-md5 (username passphrase challenge))
  50   (defun-maybe sasl-digest-md5-digest-response
  51     (digest-challenge username passwd serv-type host &optional realm))
  52   (defun-maybe starttls-negotiate (a))
  53   (defun-maybe elmo-generic-list-folder-unread (spec mark-alist unread-marks))
  54   (defsubst-maybe utf7-decode-string (string &optional imap) string))
  55
  56 (defvar elmo-imap4-use-lock t
  57   "USE IMAP4 with locking process.")
  58 ;;
  59 ;; internal variables
  60 ;;
  61 (defvar elmo-imap4-seq-prefix "elmo-imap4")
  62 (defvar elmo-imap4-seqno 0)
  63 (defvar elmo-imap4-connection-cache nil
  64   "Cache of imap connection.")
  65 (defvar elmo-imap4-use-uid t
  66   "Use UID as message number.")
  67
  68 ;; buffer local variable
  69 (defvar elmo-imap4-read-point 0)
  70
  71 (defvar elmo-imap4-extra-namespace-alist
  72   '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
  73   "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER) ")
  74
  75 ;; buffer local variable
  76 (defvar elmo-imap4-server-capability nil)
  77 (defvar elmo-imap4-server-namespace nil)
  78
  79 (defvar elmo-imap4-lock nil)
  80
  81 ;; For debugging.
  82 (defvar elmo-imap4-debug nil
  83   "Non-nil forces IMAP4 folder as debug mode.
  84 Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
  85
  86 (defsubst elmo-imap4-debug (message &rest args)
  87   (if elmo-imap4-debug
  88       (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
  89         (goto-char (point-max))
  90         (insert (apply 'format message args) "\n"))))
  91
  92 (defun elmo-imap4-flush-connection ()
  93   (interactive)
  94   (let ((cache elmo-imap4-connection-cache)
  95         buffer process)
  96     (while cache
  97       (setq buffer (car (cdr (car cache))))
  98       (if buffer (kill-buffer buffer))
  99       (setq process (car (cdr (cdr (car cache)))))
 100       (if process (delete-process process))
 101       (setq cache (cdr cache)))
 102     (setq elmo-imap4-connection-cache nil)))
 103
 104 (defsubst elmo-imap4-get-process (spec)
 105   (elmo-imap4-connection-get-process (elmo-imap4-get-connection spec)))
 106
 107 (defun elmo-imap4-process-folder-list (string)
 108   (with-temp-buffer
 109     (let ((case-fold-search t)
 110           mailbox-list val)
 111       (elmo-set-buffer-multibyte nil)
 112       (insert string)
 113       (goto-char (point-min))
 114       ;; XXX This doesn't consider literal name response.
 115       (while (re-search-forward
 116               "\\* LIST (\\([^)]*\\)) \"[^\"]*\" \\([^\n]*\\)$" nil t)
 117         (unless (string-match "noselect"
 118                               (elmo-match-buffer 1))
 119           (setq val (elmo-match-buffer 2))
 120           (if (string-match "^\"\\(.*\\)\"$" val)
 121               (setq val (match-string 1 val)))
 122           (setq mailbox-list
 123                 (append mailbox-list
 124                         (list val)))))
 125       mailbox-list)))
 126
 127 (defun elmo-imap4-list-folders (spec &optional hierarchy)
 128   (save-excursion
 129     (let* ((root (elmo-imap4-spec-folder spec))
 130            (process (elmo-imap4-get-process spec))
 131            (delim (or
 132                  (cdr
 133                   (elmo-string-matched-assoc root
 134                                              (save-excursion
 135                                                (set-buffer
 136                                                 (process-buffer process))
 137                                                elmo-imap4-server-namespace)))
 138                  "/"))
 139            response result append-serv ssl)
 140       ;; Append delimiter
 141       (if (and root
 142                (not (string= root ""))
 143                (not (string-match (concat "\\(.*\\)"
 144                                           (regexp-quote delim)
 145                                           "\\'")
 146                                   root)))
 147           (setq root (concat root delim)))
 148       (elmo-imap4-send-command (process-buffer process)
 149                                process
 150                                (format "list \"%s\" *" root))
 151       (setq response (elmo-imap4-read-response (process-buffer process)
 152                                                process))
 153       (setq result (elmo-imap4-process-folder-list response))
 154       (unless (string= (elmo-imap4-spec-username spec)
 155                        elmo-default-imap4-user)
 156         (setq append-serv (concat ":" (elmo-imap4-spec-username spec))))
 157       (unless (string= (elmo-imap4-spec-hostname spec)
 158                        elmo-default-imap4-server)
 159         (setq append-serv (concat append-serv "@" (elmo-imap4-spec-hostname
 160                                                    spec))))
 161       (unless (eq (elmo-imap4-spec-port spec)
 162                   elmo-default-imap4-port)
 163         (setq append-serv (concat append-serv ":"
 164                                   (int-to-string
 165                                    (elmo-imap4-spec-port spec)))))
 166       (unless (eq (setq ssl (elmo-imap4-spec-ssl spec))
 167                   elmo-default-imap4-ssl)
 168         (if ssl
 169             (setq append-serv (concat append-serv "!")))
 170         (if (eq ssl 'starttls)
 171             (setq append-serv (concat append-serv "!"))))
 172       (mapcar '(lambda (fld)
 173                  (concat "%" (elmo-imap4-decode-folder-string fld)
 174                          (and append-serv
 175                               (eval append-serv))))
 176               result))))
 177
 178 (defun elmo-imap4-folder-exists-p (spec)
 179   (let ((process (elmo-imap4-get-process spec)))
 180     (elmo-imap4-send-command (process-buffer process)
 181                              process
 182                              (format "status \"%s\" (messages)"
 183                                      (elmo-imap4-spec-folder spec)))
 184     (elmo-imap4-read-response (process-buffer process) process)))
 185
 186 (defun elmo-imap4-folder-creatable-p (spec)
 187   t)
 188
 189 (defun elmo-imap4-create-folder-maybe (spec dummy)
 190   "Create folder if necessary."
 191   (if (not (elmo-imap4-folder-exists-p spec))
 192       (elmo-imap4-create-folder spec)))
 193
 194 (defun elmo-imap4-create-folder (spec)
 195   (let ((process (elmo-imap4-get-process spec))
 196         (folder (elmo-imap4-spec-folder spec)))
 197     (when folder
 198 ;;     For UW imapd 4.6, this workaround is needed to create #mh mailbox.
 199 ;      (if (string-match "^\\(#mh/\\).*[^/]$" folder)
 200 ;         (setq folder (concat folder "/"))) ;; make directory
 201       (elmo-imap4-send-command (process-buffer process)
 202                                process
 203                                (format "create %s" folder))
 204       (if (null (elmo-imap4-read-response (process-buffer process)
 205                                           process))
 206           (error "Create folder %s failed" folder)
 207         t))))
 208
 209 (defun elmo-imap4-delete-folder (spec)
 210   (let ((process (elmo-imap4-get-process spec))
 211         msgs)
 212     (when (elmo-imap4-spec-folder spec)
 213       (when (setq msgs (elmo-imap4-list-folder spec))
 214         (elmo-imap4-delete-msgs spec msgs))
 215       (elmo-imap4-send-command (process-buffer process) process "close")
 216       (elmo-imap4-read-response (process-buffer process) process)
 217       (elmo-imap4-send-command (process-buffer process)
 218                                process
 219                                (format "delete %s"
 220                                        (elmo-imap4-spec-folder spec)))
 221       (if (null (elmo-imap4-read-response (process-buffer process)
 222                                           process))
 223           (error "Delete folder %s failed" (elmo-imap4-spec-folder spec))
 224         t))))
 225
 226 (defun elmo-imap4-rename-folder (old-spec new-spec)
 227   (let ((process (elmo-imap4-get-process old-spec)))
 228     (when (elmo-imap4-spec-folder old-spec)
 229       (elmo-imap4-send-command (process-buffer process) process "close")
 230       (elmo-imap4-read-response (process-buffer process) process)
 231       (elmo-imap4-send-command (process-buffer process)
 232                                process
 233                                (format "rename %s %s"
 234                                        (elmo-imap4-spec-folder old-spec)
 235                                        (elmo-imap4-spec-folder new-spec)))
 236       (if (null (elmo-imap4-read-response (process-buffer process) process))
 237           (error "Rename folder from %s to %s failed"
 238                  (elmo-imap4-spec-folder old-spec)
 239                  (elmo-imap4-spec-folder new-spec))
 240         t))))
 241
 242 (defun elmo-imap4-max-of-folder (spec)
 243   (save-excursion
 244     (let* ((process (elmo-imap4-get-process spec))
 245            response)
 246       (elmo-imap4-send-command (process-buffer process)
 247                                process
 248                                (format "status \"%s\" (uidnext messages)"
 249                                        (elmo-imap4-spec-folder spec)))
 250       (setq response (elmo-imap4-read-response (process-buffer process)
 251                                                process))
 252       (when (and response (string-match
 253                            "\\* STATUS [^(]* \\(([^)]*)\\)" response))
 254         (setq response (read (downcase (elmo-match-string 1 response))))
 255         (cons (- (cadr (memq 'uidnext response)) 1)
 256               (cadr (memq 'messages response)))))))
 257
 258 (defun elmo-imap4-get-connection (spec)
 259   (let* ((user   (elmo-imap4-spec-username spec))
 260          (server (elmo-imap4-spec-hostname spec))
 261          (port   (elmo-imap4-spec-port spec))
 262          (auth   (elmo-imap4-spec-auth spec))
 263          (ssl    (elmo-imap4-spec-ssl spec))
 264          (user-at-host (format "%s@%s" user server))
 265          ret-val result buffer process proc-stat
 266          user-at-host-on-port)
 267     (if (not (elmo-plugged-p server port))
 268         (error "Unplugged"))
 269     (setq user-at-host-on-port
 270           (concat user-at-host ":" (int-to-string port)
 271                   (if (eq ssl 'starttls) "!!" (if ssl "!"))))
 272     (setq ret-val (assoc user-at-host-on-port
 273                          elmo-imap4-connection-cache))
 274     (if (and ret-val
 275              (or (eq (setq proc-stat
 276                            (process-status (cadr (cdr ret-val))))
 277                      'closed)
 278                  (eq proc-stat 'exit)))
 279         ;; connection is closed...
 280         (progn
 281           (kill-buffer (car (cdr ret-val)))
 282           (setq elmo-imap4-connection-cache
 283                 (delete ret-val elmo-imap4-connection-cache))
 284           (setq ret-val nil)))
 285     (if ret-val
 286         (progn
 287           (setq ret-val (cdr ret-val)) ;; connection cache exists.
 288           ret-val)
 289       (setq result
 290             (elmo-imap4-open-connection server user auth port
 291                                         (elmo-get-passwd user-at-host)
 292                                         ssl))
 293       (if (null result)
 294           (error "Connection failed"))
 295       (elmo-imap4-debug "Connected to %s" user-at-host-on-port)
 296       (setq buffer (car result))
 297       (setq process (cdr result))
 298       (when (and process (null buffer))
 299         (elmo-remove-passwd user-at-host)
 300         (delete-process process)
 301         (error "Login failed"))
 302       (setq elmo-imap4-connection-cache
 303             (append elmo-imap4-connection-cache
 304                     (list
 305                      (cons user-at-host-on-port
 306                            (setq ret-val (list buffer process
 307                                                ""; current-folder..
 308                                                ))))))
 309       ret-val)))
 310
 311 (defun elmo-imap4-process-filter (process output)
 312   (save-match-data
 313     (with-current-buffer (process-buffer process)
 314       (goto-char (point-max))
 315       (insert output)
 316       (forward-line -1)
 317       (beginning-of-line)
 318       (if (looking-at (concat
 319                        "\\(^"
 320                        elmo-imap4-seq-prefix
 321                        (int-to-string elmo-imap4-seqno)
 322                        "\\|^\\* OK\\|^\\* BYE\\'\\|^\\+\\)[^\n]*\n\\'"))
 323           (progn
 324             (setq elmo-imap4-lock nil) ; unlock process buffer.
 325             (elmo-imap4-debug "unlock(%d) %s" elmo-imap4-seqno output))
 326         (elmo-imap4-debug "continue(%d) %s" elmo-imap4-seqno output))
 327       (goto-char (point-max)))))
 328
 329 (defun elmo-imap4-read-response (buffer process &optional not-command)
 330   (save-excursion
 331     (set-buffer buffer)
 332     (let ((case-fold-search nil)
 333           (response-string nil)
 334           (response-continue t)
 335           (return-value nil)
 336           match-end)
 337       (while response-continue
 338         (goto-char elmo-imap4-read-point)
 339         (while (not (search-forward "\r\n" nil t))
 340           (accept-process-output process)
 341           (goto-char elmo-imap4-read-point))
 342
 343         (setq match-end (point))
 344         (setq response-string
 345               (buffer-substring elmo-imap4-read-point (- match-end 2)))
 346         (goto-char elmo-imap4-read-point)
 347         (if (looking-at (format "%s[0-9]+ OK.*$\\|\\+.*$"
 348                                 elmo-imap4-seq-prefix))
 349             (progn (setq response-continue nil)
 350                    (setq elmo-imap4-read-point match-end)
 351                    (setq return-value
 352                          (if return-value
 353                              (concat return-value "\n" response-string)
 354                            response-string)))
 355           (if (looking-at (format "\\(. BYE.*\\|%s[0-9]+ \\(NO\\|BAD\\).*\\)$"
 356                                   elmo-imap4-seq-prefix))
 357               (progn (setq response-continue nil)
 358                      (setq elmo-imap4-read-point match-end)
 359                      (elmo-imap4-debug "error response: %s" response-string)
 360                      (setq return-value nil))
 361             (setq elmo-imap4-read-point match-end)
 362             (if not-command
 363                 (setq response-continue nil))
 364             (setq return-value
 365                   (if return-value
 366                       (concat return-value "\n" response-string)
 367                     response-string)))
 368           (setq elmo-imap4-read-point match-end)))
 369       return-value)))
 370
 371 (defun elmo-imap4-read-contents (buffer process)
 372   "Read OK response"
 373   (save-excursion
 374     (set-buffer buffer)
 375     (let ((case-fold-search nil)
 376           (response-string nil)
 377           match-end)
 378       (goto-char elmo-imap4-read-point)
 379       (while (not (re-search-forward
 380                    (format "%s[0-9]+ \\(NO\\|BAD\\|OK\\).*$"
 381                            elmo-imap4-seq-prefix)
 382                    nil t))
 383         (accept-process-output process)
 384         (goto-char elmo-imap4-read-point))
 385       (beginning-of-line)
 386       (setq match-end (point))
 387       (setq response-string (buffer-substring
 388                              elmo-imap4-read-point match-end))
 389       (if (eq (length response-string) 0)
 390           nil
 391         response-string))))
 392
 393 (defun elmo-imap4-read-bytes (buffer process bytes)
 394   (save-excursion
 395     (set-buffer buffer)
 396     (let ((case-fold-search nil)
 397           (return-value nil)
 398           start gc-message)
 399       (setq start elmo-imap4-read-point);; starting point
 400       (while (< (point-max) (+ start bytes))
 401         (accept-process-output process))
 402       (setq return-value (buffer-substring
 403                           start (+ start bytes)))
 404       (setq return-value (elmo-delete-cr return-value))
 405       (setq elmo-imap4-read-point bytes)
 406       return-value)))
 407
 408 (defun elmo-imap4-read-body (buffer process bytes outbuf)
 409   (let (start gc-message ret-val)
 410     (with-current-buffer buffer
 411       (setq start elmo-imap4-read-point)
 412       (while (< (point-max) (+ start bytes))
 413         (accept-process-output process))
 414       (with-current-buffer outbuf
 415         (erase-buffer)
 416         (insert-buffer-substring buffer start (+ start bytes))
 417         (setq ret-val (elmo-delete-cr-get-content-type)))
 418       (setq elmo-imap4-read-point (+ start bytes))
 419       ret-val)))
 420
 421 (defun elmo-imap4-noop (connection)
 422   (let ((buffer (car connection))
 423         (process (cadr connection)))
 424     (save-excursion
 425       (elmo-imap4-send-command buffer
 426                                process "noop")
 427       (elmo-imap4-read-response buffer process))))
 428
 429 (defun elmo-imap4-commit (spec)
 430   (save-excursion
 431     (let ((connection (elmo-imap4-get-connection spec))
 432           response ret-val beg end)
 433       (and (not (null (elmo-imap4-spec-folder spec)))
 434            (if (not (string= (elmo-imap4-connection-get-cwf connection)
 435                              (elmo-imap4-spec-folder spec)))
 436                (if (null (setq response
 437                                (elmo-imap4-select-folder
 438                                 (elmo-imap4-spec-folder spec)
 439                                 connection)))
 440                    (error "Select folder failed"))
 441              (if elmo-imap4-use-select-to-update-status
 442                  (elmo-imap4-select-folder
 443                   (elmo-imap4-spec-folder spec)
 444                   connection)
 445                (elmo-imap4-check connection)))))))
 446
 447 (defun elmo-imap4-check (connection)
 448   (let ((process (elmo-imap4-connection-get-process connection)))
 449     (save-excursion
 450       (elmo-imap4-send-command (process-buffer process)
 451                                process "check")
 452       (elmo-imap4-read-response (process-buffer process) process))))
 453
 454 (defun elmo-imap4-select-folder (folder connection)
 455   (let ((process (elmo-imap4-connection-get-process connection))
 456         response)
 457     (save-excursion
 458       (unwind-protect
 459           (progn
 460             (elmo-imap4-send-command (process-buffer process)
 461                                      process (format "select \"%s\""
 462                                                      folder))
 463             (setq response (elmo-imap4-read-response
 464                             (process-buffer process) process)))
 465         (if (null response)
 466             (progn
 467               (setcar (cddr connection) nil)
 468               (error "Select folder failed"))
 469           (setcar (cddr connection) folder))))
 470     response))
 471
 472 (defun elmo-imap4-check-validity (spec validity-file)
 473   "get uidvalidity value from server and compare it with validity-file."
 474   (let* ((process (elmo-imap4-get-process spec))
 475          response)
 476     (save-excursion
 477       (elmo-imap4-send-command (process-buffer process)
 478                                process
 479                                (format "status \"%s\" (uidvalidity)"
 480                                        (elmo-imap4-spec-folder spec)))
 481       (setq response (elmo-imap4-read-response
 482                       (process-buffer process) process))
 483       (if (string-match "UIDVALIDITY \\([0-9]+\\)" response)
 484           (string= (elmo-get-file-string validity-file)
 485                    (elmo-match-string 1 response))
 486         nil))))
 487
 488 (defun elmo-imap4-sync-validity  (spec validity-file)
 489   "get uidvalidity value from server and save it to validity-file."
 490   (let* ((process (elmo-imap4-get-process spec))
 491          response)
 492     (save-excursion
 493       (elmo-imap4-send-command (process-buffer process)
 494                                process
 495                                (format "status \"%s\" (uidvalidity)"
 496                                        (elmo-imap4-spec-folder spec)))
 497       (setq response (elmo-imap4-read-response
 498                       (process-buffer process) process))
 499       (if (string-match "UIDVALIDITY \\([0-9]+\\)" response)
 500           (progn
 501             (elmo-save-string
 502              (elmo-match-string 1 response)
 503              validity-file)
 504             t)
 505         nil))))
 506
 507 (defsubst elmo-imap4-list (spec str)
 508   (save-excursion
 509     (let* ((connection (elmo-imap4-get-connection spec))
 510            (process (elmo-imap4-connection-get-process connection))
 511            response ret-val beg end)
 512       (and (elmo-imap4-spec-folder spec)
 513            (if (not (string= (elmo-imap4-connection-get-cwf connection)
 514                              (elmo-imap4-spec-folder spec)))
 515                (if (null (setq response
 516                                (elmo-imap4-select-folder
 517                                 (elmo-imap4-spec-folder spec)
 518                                 connection)))
 519                    (error "Select folder failed"))
 520              ;; for status update.
 521              (if elmo-imap4-use-select-to-update-status
 522                  (elmo-imap4-select-folder (elmo-imap4-spec-folder spec)
 523                                            connection)
 524                (unless (elmo-imap4-check connection)
 525                  ;; Check failed...not selected??
 526                  (elmo-imap4-select-folder (elmo-imap4-spec-folder spec)
 527                                            connection)))))
 528       (elmo-imap4-send-command (process-buffer process)
 529                                process
 530                                (format (if elmo-imap4-use-uid
 531                                            "uid search %s"
 532                                          "search %s") str))
 533       (setq response (elmo-imap4-read-response (process-buffer process)
 534                                                process))
 535       (if (and response (string-match "\\* SEARCH" response))
 536           (progn
 537             (setq response (substring response (match-end 0)))
 538             (if (string-match "\n" response)
 539                 (progn
 540                   (setq end (match-end 0))
 541                   (setq ret-val (read (concat "(" (substring
 542                                                    response
 543                                                    0 end) ")"))))
 544               (error "SEARCH failed"))))
 545       ret-val)))
 546
 547 (defun elmo-imap4-list-folder (spec)
 548   (elmo-imap4-list spec "all"))
 549
 550 (defun elmo-imap4-list-folder-unread (spec mark-alist unread-marks)
 551   (if (elmo-imap4-use-flag-p spec)
 552       (elmo-imap4-list spec "unseen")
 553     (elmo-generic-list-folder-unread spec mark-alist unread-marks)))
 554
 555 (defun elmo-imap4-list-folder-important (spec overview)
 556   (and (elmo-imap4-use-flag-p spec)
 557        (elmo-imap4-list spec "flagged")))
 558
 559 (defun elmo-imap4-search-internal (process buffer filter)
 560   (let ((search-key (elmo-filter-key filter))
 561         word response)
 562     (cond
 563      ((or (string= "since" search-key)
 564           (string= "before" search-key))
 565       (setq search-key (concat "sent" search-key))
 566       (elmo-imap4-send-command buffer process
 567                                (format
 568                                 (if elmo-imap4-use-uid
 569                                     "uid search %s %s"
 570                                   " search %s %s")
 571                                 search-key
 572                                 (elmo-date-get-description
 573                                  (elmo-date-get-datevec
 574                                   (elmo-filter-value filter))))))
 575      (t
 576       (setq word (encode-mime-charset-string (elmo-filter-value filter)
 577                                              elmo-search-mime-charset))
 578       (elmo-imap4-send-command buffer process
 579                                (format
 580                                 (if elmo-imap4-use-uid
 581                                     "uid search CHARSET %s%s %s {%d}"
 582                                   " search CHARSET %s%s %s {%d}")
 583                                 (symbol-name elmo-search-mime-charset)
 584                                 (if (eq (elmo-filter-type filter) 'unmatch)
 585                                     " not" "")
 586                                 (elmo-filter-key filter)
 587                                 (length word)))
 588       (if (null (elmo-imap4-read-response buffer process t))
 589           (error "Searching failed because of server capability??"))
 590       (elmo-imap4-send-string buffer process word)))
 591     (if (null (setq response (elmo-imap4-read-response buffer process)))
 592         (error "Search failed for %s" (elmo-filter-key filter)))
 593     (if (string-match "^\\* SEARCH\\([^\n]*\\)$" response)
 594         (read (concat "(" (elmo-match-string 1 response) ")"))
 595       (error "SEARCH failed"))))
 596
 597 (defun elmo-imap4-search (spec condition &optional from-msgs)
 598   (save-excursion
 599     (let* ((connection (elmo-imap4-get-connection spec))
 600            (process (elmo-imap4-connection-get-process connection))
 601            response ret-val len word)
 602       (if (and (elmo-imap4-spec-folder spec)
 603                (not (string= (elmo-imap4-connection-get-cwf connection)
 604                              (elmo-imap4-spec-folder spec)))
 605                (null (elmo-imap4-select-folder
 606                       (elmo-imap4-spec-folder spec) connection)))
 607           (error "Select folder failed"))
 608       (while condition
 609         (setq response (elmo-imap4-search-internal process
 610                                                    (process-buffer process)
 611                                                    (car condition)))
 612         (setq ret-val (nconc ret-val response))
 613         (setq condition (cdr condition)))
 614       (if from-msgs
 615           (elmo-list-filter
 616            from-msgs
 617            (elmo-uniq-list (sort ret-val '<)))
 618         (elmo-uniq-list (sort ret-val '<))))))
 619
 620 (defsubst elmo-imap4-value (value)
 621   (if (eq value 'NIL) nil
 622     value))
 623
 624 (defmacro elmo-imap4-nth (pos list)
 625   (` (let ((value (nth (, pos) (, list))))
 626        (if (eq 'NIL value)
 627            nil
 628          value))))
 629
 630 (defun elmo-imap4-use-flag-p (spec)
 631   (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
 632                      (elmo-imap4-spec-folder spec))))
 633
 634 (defsubst elmo-imap4-make-address (name mbox host)
 635   (cond (name
 636          (concat name " <" mbox "@" host ">"))
 637         (t
 638          (concat mbox "@" host))))
 639
 640 (static-cond
 641  ((fboundp 'float)
 642   ;; Emacs can parse dot symbol.
 643   (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
 644   (defvar elmo-imap4-header-fields "HEADER\.FIELDS")
 645   (defmacro elmo-imap4-replace-dot-symbols ()) ;; noop
 646   )
 647  (t
 648   ;; Cannot parse dot symbol, replace it.
 649   (defvar elmo-imap4-rfc822-size "RFC822_SIZE")
 650   (defvar elmo-imap4-header-fields "HEADER_FIELDS")
 651   (defmacro elmo-imap4-replace-dot-symbols ()
 652     (goto-char (point-min))
 653     (while (re-search-forward "RFC822\\.SIZE" nil t)
 654       (replace-match elmo-imap4-rfc822-size))
 655     (goto-char (point-min))
 656     (while (re-search-forward "HEADER\\.FIELDS" nil t)
 657       (replace-match elmo-imap4-header-fields))
 658     (goto-char (point-min)))))
 659
 660 (defsubst elmo-imap4-make-attributes-object (string)
 661   (save-match-data
 662     (elmo-set-work-buf
 663      (elmo-set-buffer-multibyte nil)
 664      (insert string)
 665      (goto-char (point-min))
 666      (let ((case-fold-search t))
 667        (goto-char (point-min))
 668        (while (re-search-forward "{\\([0-9]+\\)}\r\n" nil t)
 669          (let (str)
 670            (goto-char (+ (point)
 671                          (string-to-int (elmo-match-buffer 1))))
 672            (setq str (save-match-data
 673                        (elmo-replace-in-string
 674                         (buffer-substring (match-end 0) (point))
 675                         "\r" "")))
 676            (delete-region (match-beginning 0) (point))
 677            (insert (prin1-to-string str))))
 678        (goto-char (point-min))
 679        (elmo-imap4-replace-dot-symbols)
 680        (read (current-buffer))))))
 681
 682
 683 (defun elmo-imap4-parse-overview-string (string)
 684   (if (null string)
 685       (error "Getting overview failed"))
 686   (with-temp-buffer
 687     (let (ret-val beg attr number)
 688       (elmo-set-buffer-multibyte nil)
 689       (insert string)
 690       (goto-char (point-min))
 691       (setq beg (point))
 692       (if (re-search-forward "^\* \\([0-9]+\\) FETCH"
 693                              nil t)
 694           (progn
 695             (setq beg (point))
 696             (unless elmo-imap4-use-uid
 697               (setq number (string-to-int (elmo-match-buffer 1))))
 698             (while (re-search-forward
 699                     "^\* \\([0-9]+\\) FETCH"
 700                     nil t)
 701               (setq attr (elmo-imap4-make-attributes-object
 702                           (buffer-substring beg (match-beginning 0))))
 703               (setq beg (point))
 704               (unless elmo-imap4-use-uid
 705                 (setq attr(nconc (list 'UID number) attr))
 706                 (setq number (string-to-int (elmo-match-buffer 1))))
 707               (setq ret-val (cons attr ret-val)))
 708             ;; process last one...
 709             (setq attr (elmo-imap4-make-attributes-object
 710                         (buffer-substring beg (point-max))))
 711             (unless elmo-imap4-use-uid
 712               (setq attr(nconc (list 'UID number) attr)))
 713             (setq ret-val (cons attr ret-val))))
 714       (nreverse ret-val))))
 715
 716 (defun elmo-imap4-create-msgdb-from-overview-string (str
 717                                                      folder
 718                                                      new-mark
 719                                                      already-mark
 720                                                      seen-mark
 721                                                      important-mark
 722                                                      seen-list
 723                                                      &optional numlist)
 724   (let ((case-fold-search t)
 725         (size-sym (intern elmo-imap4-rfc822-size))
 726         overview attr-list attr pair section
 727         number important message-id from-list from-string
 728         to-string cc-string
 729         number-alist mark-alist
 730         reference subject date-string size flags gmark seen
 731         index extras extra-fields sym value)
 732     (setq attr-list (elmo-imap4-parse-overview-string str))
 733     (while attr-list
 734       (setq attr (car attr-list))
 735       ;; Remove section data. (origin octed is not considered.(OK?))
 736       (setq section (cadr (memq 'BODY attr)))
 737       (if (vectorp section)
 738           (delq section attr))
 739       ;; number
 740       (setq number (cadr (memq 'UID attr)))
 741       (when (or (null numlist)
 742                 (memq number numlist))
 743         (while attr
 744           (setq sym (car attr))
 745           (setq value (cadr attr))
 746           (setq attr (cdr (cdr attr)))
 747           (cond
 748            ((eq sym 'UID))
 749            ;; noop
 750            ((eq sym 'FLAGS)
 751             (setq flags value))
 752            ((eq sym size-sym)
 753             (setq size value))
 754            ((eq sym 'BODY)
 755             (setq extra-fields (elmo-collect-field-from-string value t)))
 756            ((eq sym 'ENVELOPE)
 757             ;; According to rfc2060,
 758             ;; 0 date, 1 subject, 2 from, 3 sender,
 759             ;; 4 reply-to, 5 to, 6 cc, 7 bcc, 8 in-reply-to, 9 message-id.
 760             (setq date-string (elmo-imap4-nth 0 value))
 761             (setq subject (elmo-mime-string (or (elmo-imap4-nth 1 value)
 762                                                 elmo-no-subject)))
 763             (setq from-list (car (elmo-imap4-nth 2 value)))
 764             (setq from-string (or
 765                                (and (or (elmo-imap4-nth 0 from-list)
 766                                         (elmo-imap4-nth 2 from-list)
 767                                         (elmo-imap4-nth 3 from-list))
 768                                     (elmo-delete-char
 769                                      ?\"
 770                                      (elmo-imap4-make-address
 771                                       (elmo-imap4-nth 0 from-list)
 772                                       (elmo-imap4-nth 2 from-list)
 773                                       (elmo-imap4-nth 3 from-list))
 774                                      'uni))
 775                                elmo-no-from))
 776             (setq to-string (mapconcat
 777                              '(lambda (to)
 778                                 (elmo-imap4-make-address
 779                                  (elmo-imap4-nth 0 to)
 780                                  (elmo-imap4-nth 2 to)
 781                                  (elmo-imap4-nth 3 to)))
 782                              (elmo-imap4-nth 5 value) ","))
 783             (setq cc-string (mapconcat
 784                              '(lambda (cc)
 785                                 (elmo-imap4-make-address
 786                                  (elmo-imap4-nth 0 cc)
 787                                  (elmo-imap4-nth 2 cc)
 788                                  (elmo-imap4-nth 3 cc)))
 789                              (elmo-imap4-nth 6 value) ","))
 790             (setq reference (elmo-msgdb-get-last-message-id
 791                              (elmo-imap4-nth 8 value)))
 792             (setq message-id (elmo-imap4-nth 9 value)))))
 793         (when (setq pair (assoc "references" extra-fields))
 794           (setq extra-fields (delq pair extra-fields)))
 795         (unless reference
 796           (setq reference (elmo-msgdb-get-last-message-id (cdr pair))))
 797         (setq overview
 798               (elmo-msgdb-append-element
 799                overview
 800                (cons message-id
 801                      (vector number
 802                              reference
 803                              (elmo-mime-string from-string)
 804                              (elmo-mime-string subject)
 805                              date-string
 806                              to-string
 807                              cc-string
 808                              size
 809                              extra-fields))))
 810         (if (memq 'Flagged flags)
 811             (elmo-msgdb-global-mark-set message-id important-mark))
 812         (setq number-alist
 813               (elmo-msgdb-number-add number-alist number message-id))
 814         (setq seen (member message-id seen-list))
 815         (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 816                             (if (elmo-cache-exists-p message-id) ;; XXX
 817                                 (if (or (memq 'Seen flags) seen)
 818                                     nil
 819                                   already-mark)
 820                               (if (or (memq 'Seen flags) seen)
 821                                   (if elmo-imap4-use-cache
 822                                       seen-mark)
 823                                 new-mark))))
 824             (setq mark-alist (elmo-msgdb-mark-append
 825                               mark-alist
 826                               number
 827                               ;; managing mark with message-id is evil.
 828                               gmark))))
 829       (setq attr-list (cdr attr-list)))
 830     (list overview number-alist mark-alist)))
 831
 832 (defun elmo-imap4-add-to-cont-list (cont-list msg)
 833   (let ((elist cont-list)
 834         (ret-val cont-list)
 835         entity found)
 836     (while (and elist (not found))
 837       (setq entity (car elist))
 838       (cond
 839        ((and (consp entity)
 840              (eq (+ 1 (cdr entity)) msg))
 841         (setcdr entity msg)
 842         (setq found t))
 843        ((and (integerp entity)
 844              (eq (+ 1 entity) msg))
 845         (setcar elist (cons entity msg))
 846         (setq found t))
 847        ((or (and (integerp entity) (eq entity msg))
 848             (and (consp entity)
 849                  (<= (car entity) msg)
 850                  (<= msg (cdr entity)))) ; included
 851         (setq found t))); noop
 852       (setq elist (cdr elist)))
 853     (if (not found)
 854         (setq ret-val (append cont-list (list msg))))
 855     ret-val))
 856
 857 (defun elmo-imap4-make-number-set-list (msg-list &optional chop-length)
 858   "Make RFC2060's message set specifier from MSG-LIST.
 859 Returns a list of (NUMBER . SET-STRING).
 860 SET-STRING is the message set specifier described in RFC2060.
 861 NUMBER is contained message number in SET-STRING.
 862 Every SET-STRING does not contain number of messages longer than CHOP-LENGTH.
 863 If CHOP-LENGTH is not specified, message set is not chopped."
 864   (let (count cont-list set-list)
 865     (setq msg-list (sort msg-list '<))
 866     (while msg-list
 867       (setq cont-list nil)
 868       (setq count 0)
 869       (unless chop-length
 870         (setq chop-length (length msg-list)))
 871       (while (and (not (null msg-list))
 872                   (< count chop-length))
 873         (setq cont-list
 874               (elmo-imap4-add-to-cont-list
 875                cont-list (car msg-list)))
 876         (incf count)
 877         (setq msg-list (cdr msg-list)))
 878       (setq set-list
 879             (cons
 880              (cons
 881               count
 882               (mapconcat
 883                (lambda (x)
 884                  (cond ((consp x)
 885                         (format "%s:%s" (car x) (cdr x)))
 886                        ((integerp x)
 887                         (int-to-string x))))
 888                cont-list
 889                ","))
 890              set-list)))
 891     (nreverse set-list)))
 892
 893 ;;
 894 ;; set mark
 895 ;; read-mark -> "\\Seen"
 896 ;; important -> "\\Flagged"
 897 ;;
 898 ;; (delete -> \\Deleted)
 899 (defun elmo-imap4-mark-set-on-msgs (spec msgs mark &optional unmark no-expunge)
 900   "SET flag of MSGS as MARK.
 901 If optional argument UNMARK is non-nil, unmark."
 902   (save-excursion
 903     (let* ((connection (elmo-imap4-get-connection spec))
 904            (process (elmo-imap4-connection-get-process connection))
 905            (msg-list (copy-sequence msgs))
 906            set-list ent)
 907       (if (and (elmo-imap4-spec-folder spec)
 908                (not (string= (elmo-imap4-connection-get-cwf connection)
 909                              (elmo-imap4-spec-folder spec)))
 910                (null (elmo-imap4-select-folder
 911                       (elmo-imap4-spec-folder spec) connection)))
 912           (error "Select folder failed"))
 913       (setq set-list (elmo-imap4-make-number-set-list msg-list))
 914       (when set-list
 915         (elmo-imap4-send-command (process-buffer process)
 916                                  process
 917                                  (format
 918                                   (if elmo-imap4-use-uid
 919                                       "uid store %s %sflags.silent (%s)"
 920                                     "store %s %sflags.silent (%s)")
 921                                   (cdr (car set-list))
 922                                   (if unmark "-" "+")
 923                                   mark))
 924         (unless (elmo-imap4-read-response (process-buffer process) process)
 925           (error "Store %s flag failed" mark))
 926         (unless no-expunge
 927           (elmo-imap4-send-command
 928            (process-buffer process) process "expunge")
 929           (unless (elmo-imap4-read-response (process-buffer process) process)
 930             (error "Expunge failed"))))
 931       t)))
 932
 933 (defun elmo-imap4-mark-as-important (spec msgs)
 934   (and (elmo-imap4-use-flag-p spec)
 935        (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" nil 'no-expunge)))
 936
 937 (defun elmo-imap4-mark-as-read (spec msgs)
 938   (and (elmo-imap4-use-flag-p spec)
 939        (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" nil 'no-expunge)))
 940
 941 (defun elmo-imap4-unmark-important (spec msgs)
 942   (and (elmo-imap4-use-flag-p spec)
 943        (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" 'unmark
 944                                     'no-expunge)))
 945
 946 (defun elmo-imap4-mark-as-unread (spec msgs)
 947   (and (elmo-imap4-use-flag-p spec)
 948        (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" 'unmark 'no-expunge)))
 949
 950 (defun elmo-imap4-delete-msgs (spec msgs)
 951   (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted"))
 952
 953 (defun elmo-imap4-delete-msgs-no-expunge (spec msgs)
 954   (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted" nil 'no-expunge))
 955
 956 (defun elmo-imap4-msgdb-create-as-numlist (spec numlist new-mark already-mark
 957                                                 seen-mark important-mark
 958                                                 seen-list)
 959   "Create msgdb for SPEC for NUMLIST."
 960   (elmo-imap4-msgdb-create spec numlist new-mark already-mark
 961                            seen-mark important-mark seen-list t))
 962
 963 (defun elmo-imap4-msgdb-create (spec numlist new-mark already-mark seen-mark
 964                                      important-mark seen-list &optional as-num)
 965   "Create msgdb for SPEC."
 966   (when numlist
 967     (save-excursion
 968       (let* ((connection (elmo-imap4-get-connection spec))
 969              (process    (elmo-imap4-connection-get-process connection))
 970              (filter     (and as-num numlist))
 971              (case-fold-search t)
 972              (extra-fields (if elmo-msgdb-extra-fields
 973                                (concat " " (mapconcat
 974                                             'identity
 975                                             elmo-msgdb-extra-fields " "))
 976                              ""))
 977              rfc2060 count ret-val set-list ov-str length)
 978         (setq rfc2060 (with-current-buffer (process-buffer process)
 979                         (if (memq 'imap4rev1 elmo-imap4-server-capability)
 980                             t
 981                           (if (memq 'imap4 elmo-imap4-server-capability)
 982                               nil
 983                             (error "No IMAP4 capability!!")))))
 984         (setq count 0)
 985         (setq length (length numlist))
 986         (setq set-list (elmo-imap4-make-number-set-list
 987                         numlist
 988                         elmo-imap4-overview-fetch-chop-length))
 989         (message "Getting overview...")
 990         (if (and (elmo-imap4-spec-folder spec)
 991                  (not (string= (elmo-imap4-connection-get-cwf connection)
 992                                (elmo-imap4-spec-folder spec)))
 993                  (null (elmo-imap4-select-folder
 994                         (elmo-imap4-spec-folder spec) connection)))
 995             (error "Select imap folder %s failed"
 996                    (elmo-imap4-spec-folder spec)))
 997         (while set-list
 998           (elmo-imap4-send-command
 999            (process-buffer process)
1000            process
1001            ;; get overview entity from IMAP4
1002            (format
1003             (if rfc2060
1004                 (concat
1005                  (if elmo-imap4-use-uid "uid " "")
1006                  "fetch %s (envelope body.peek[header.fields (references"
1007                  extra-fields
1008                  ")] rfc822.size flags)")
1009               (concat
1010                (if elmo-imap4-use-uid "uid " "")
1011                "fetch %s (envelope rfc822.size flags)"))
1012             (cdr (car set-list))))
1013           ;; process string while waiting for response
1014           (with-current-buffer (process-buffer process)
1015             (if ov-str
1016                 (setq ret-val
1017                       (elmo-msgdb-append
1018                        ret-val
1019                        (elmo-imap4-create-msgdb-from-overview-string
1020                         ov-str
1021                         (elmo-imap4-spec-folder spec)
1022                         new-mark already-mark seen-mark important-mark
1023                         seen-list filter)))))
1024           (setq count (+ count (car (car set-list))))
1025           (setq ov-str (elmo-imap4-read-contents (process-buffer process)
1026                                                  process))
1027           (elmo-display-progress
1028            'elmo-imap4-msgdb-create "Getting overview..."
1029            (/ (* count 100) length))
1030           (setq set-list (cdr set-list)))
1031         ;; process last one.
1032         (with-current-buffer (process-buffer process)
1033           (if ov-str
1034               (setq ret-val
1035                     (elmo-msgdb-append
1036                      ret-val
1037                      (elmo-imap4-create-msgdb-from-overview-string
1038                       ov-str
1039                       (elmo-imap4-spec-folder spec)
1040                       new-mark already-mark seen-mark important-mark
1041                       seen-list filter)))))
1042         (message "Getting overview...done.")
1043         ret-val))))
1044
1045 (defun elmo-imap4-parse-response (string)
1046   (if (string-match "^\\*\\(.*\\)$" string)
1047       (read (concat "(" (elmo-match-string 1 string) ")"))))
1048
1049 (defun elmo-imap4-parse-capability (string)
1050   (if (string-match "^\\*\\(.*\\)$" string)
1051       (read (concat "(" (downcase (elmo-match-string 1 string)) ")"))))
1052
1053 (defun elmo-imap4-parse-namespace (obj)
1054   (let ((ns (cdr obj))
1055         (i 0)
1056         prefix delim
1057         cur namespace-alist)
1058     ;; 0: personal, 1: other, 2: shared
1059     (while (< i 3)
1060       (setq cur (elmo-imap4-nth i ns))
1061       (incf i)
1062       (while cur
1063         (setq prefix (elmo-imap4-nth 0 (car cur)))
1064         (setq delim    (elmo-imap4-nth 1 (car cur)))
1065         (if (and prefix delim
1066                  (string-match (concat "\\(.*\\)"
1067                                        (regexp-quote delim)
1068                                        "\\'")
1069                                prefix))
1070             (setq prefix (substring prefix (match-beginning 1)(match-end 1))))
1071         (setq namespace-alist (nconc namespace-alist
1072                                      (list (cons
1073                                             (concat "^" (regexp-quote prefix)
1074                                                     ".*$")
1075                                             delim))))
1076         (setq cur (cdr cur))))
1077     (append
1078      elmo-imap4-extra-namespace-alist
1079      (sort namespace-alist
1080            '(lambda (x y)
1081               (> (length (car x))
1082                  (length (car y))))))))
1083
1084 (defun elmo-imap4-open-connection (imap4-server user auth port passphrase ssl)
1085   "Open Imap connection and returns
1086 the list of (process session-buffer current-working-folder).
1087 Return nil if connection failed."
1088   (let ((process nil)
1089         (host imap4-server)
1090         process-buffer ret-val response capability)
1091     (catch 'done
1092       (as-binary-process
1093        (setq process-buffer
1094              (get-buffer-create (format " *IMAP session to %s:%d" host port)))
1095        (save-excursion
1096          (set-buffer process-buffer)
1097          (elmo-set-buffer-multibyte nil)
1098          (make-variable-buffer-local 'elmo-imap4-server-capability)
1099          (make-variable-buffer-local 'elmo-imap4-lock)
1100          (erase-buffer))
1101        (setq process
1102              (elmo-open-network-stream "IMAP" process-buffer host port ssl))
1103        (and (null process) (throw 'done nil))
1104        (set-process-filter process 'elmo-imap4-process-filter)
1105        ;; flush connections when exiting...
1106        (save-excursion
1107          (set-buffer process-buffer)
1108          (make-local-variable 'elmo-imap4-read-point)
1109          (setq elmo-imap4-read-point (point-min))
1110          (if (null (setq response
1111                          (elmo-imap4-read-response process-buffer process t)))
1112              (throw 'done nil)
1113            (when (string-match "^\\* PREAUTH" response)
1114              (setq ret-val (cons process-buffer process))
1115              (throw 'done nil)))
1116          (elmo-imap4-send-command process-buffer process "capability")
1117          (setq elmo-imap4-server-capability
1118                (elmo-imap4-parse-capability
1119                 (elmo-imap4-read-response process-buffer process)))
1120          (setq capability elmo-imap4-server-capability)
1121          (if (eq ssl 'starttls)
1122              (if (and (memq 'starttls capability)
1123                       (progn
1124                         (elmo-imap4-send-command process-buffer process "starttls")
1125                         (setq response
1126                               (elmo-imap4-read-response process-buffer process)))
1127
1128                       (string-match
1129                        (concat "^\\(" elmo-imap4-seq-prefix
1130                                (int-to-string elmo-imap4-seqno)
1131                                "\\|\\*\\) OK")
1132                        response))
1133                  (starttls-negotiate process)
1134                (error "STARTTLS aborted")))
1135          (if (or (and (string= "auth" auth)
1136                       (not (memq 'auth=login capability)))
1137                  (and (string= "cram-md5" auth)
1138                       (not (memq 'auth=cram-md5 capability)))
1139                  (and (string= "digest-md5" auth)
1140                       (not (memq 'auth=digest-md5 capability))))
1141              (if (or elmo-imap4-force-login
1142                      (y-or-n-p
1143                       (format
1144                        "There's no %s capability in server. continue?" auth)))
1145                  (setq auth "login")
1146                (error "Login aborted")))
1147          (cond
1148           ((string= "auth" auth)
1149            (elmo-imap4-send-command
1150             process-buffer process "authenticate login" 'no-lock)
1151            ;; Base64
1152            (when (null (elmo-imap4-read-response process-buffer process t))
1153              (setq ret-val (cons nil process))
1154              (throw 'done nil))
1155            (elmo-imap4-send-string
1156             process-buffer process (elmo-base64-encode-string user))
1157            (when (null (elmo-imap4-read-response process-buffer process t))
1158              (setq ret-val (cons nil process))
1159              (throw 'done nil))
1160            (elmo-imap4-send-string
1161             process-buffer process (elmo-base64-encode-string passphrase))
1162            (when (null (elmo-imap4-read-response process-buffer process))
1163              (setq ret-val (cons nil process))
1164              (throw 'done nil))
1165            (setq ret-val (cons process-buffer process)))
1166           ((string= "cram-md5" auth)
1167            (elmo-imap4-send-command
1168             process-buffer process "authenticate cram-md5" 'no-lock)
1169            (when (null (setq response
1170                              (elmo-imap4-read-response
1171                               process-buffer process t)))
1172              (setq ret-val (cons nil process))
1173              (throw 'done nil))
1174            (setq response (cadr (split-string response " ")))
1175            (elmo-imap4-send-string
1176             process-buffer process
1177             (elmo-base64-encode-string
1178              (sasl-cram-md5 user passphrase
1179                             (elmo-base64-decode-string response))))
1180            (when (null (elmo-imap4-read-response process-buffer process))
1181              (setq ret-val (cons nil process))
1182              (throw 'done nil))
1183            (setq ret-val (cons process-buffer process)))
1184           ((string= "digest-md5" auth)
1185            (elmo-imap4-send-command
1186             process-buffer process "authenticate digest-md5" 'no-lock)
1187            (when (null (setq response
1188                              (elmo-imap4-read-response
1189                               process-buffer process t)))
1190              (setq ret-val (cons nil process))
1191              (throw 'done nil))
1192            (setq response (cadr (split-string response " ")))
1193            (elmo-imap4-send-string
1194             process-buffer process
1195             (elmo-base64-encode-string
1196              (sasl-digest-md5-digest-response
1197               (elmo-base64-decode-string response)
1198               user passphrase "imap" host)
1199              'no-line-break))
1200            (when (null (elmo-imap4-read-response
1201                         process-buffer process t))
1202              (setq ret-val (cons nil process))
1203              (throw 'done nil))
1204            (elmo-imap4-send-string process-buffer process "")
1205            (when (null (elmo-imap4-read-response process-buffer process))
1206              (setq ret-val (cons nil process))
1207              (throw 'done nil))
1208            (setq ret-val (cons process-buffer process)))
1209           (t ;; not auth... try login
1210            (elmo-imap4-send-command
1211             process-buffer process
1212             (format "login %s \"%s\"" user
1213                     (elmo-replace-in-string passphrase
1214                                             "\"" "\\\\\""))
1215             nil 'no-log) ;; No LOGGING.
1216            (if (null (elmo-imap4-read-response process-buffer process))
1217                (setq ret-val (cons nil process))
1218              (setq ret-val (cons process-buffer process)))))
1219          ;; get namespace of server if possible.
1220          (when (memq 'namespace elmo-imap4-server-capability)
1221            (elmo-imap4-send-command process-buffer process "namespace")
1222            (setq elmo-imap4-server-namespace
1223                  (elmo-imap4-parse-namespace
1224                   (elmo-imap4-parse-response
1225                    (elmo-imap4-read-response process-buffer process))))))))
1226     ret-val))
1227
1228 (defun elmo-imap4-get-seqno ()
1229   (setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))
1230
1231 (defun elmo-imap4-setup-send-buffer (string)
1232   (let ((tmp-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*")))
1233     (save-excursion
1234       (save-match-data
1235         (set-buffer tmp-buf)
1236         (erase-buffer)
1237         (elmo-set-buffer-multibyte nil)
1238         (insert string)
1239         (goto-char (point-min))
1240         (if (eq (re-search-forward "^$" nil t)
1241                 (point-max))
1242             (insert "\n"))
1243         (goto-char (point-min))
1244         (while (search-forward "\n" nil t)
1245           (replace-match "\r\n"))))
1246     tmp-buf))
1247
1248 (defun elmo-imap4-send-command (buffer process command &optional no-lock
1249                                        no-log)
1250   "Send COMMAND string to server with sequence number."
1251   (save-excursion
1252     (set-buffer buffer)
1253     (when (and elmo-imap4-use-lock
1254                elmo-imap4-lock)
1255       (elmo-imap4-debug "send: (%d) is still locking." elmo-imap4-seqno)
1256       (error "IMAP4 process is locked; Please try later (or plug again)"))
1257     (erase-buffer)
1258     (goto-char (point-min))
1259     (setq elmo-imap4-read-point (point))
1260     (unless no-lock
1261       ;; for debug.
1262       (if no-log
1263           (elmo-imap4-debug "lock(%d): (No-logging command)." (+ elmo-imap4-seqno 1))
1264         (elmo-imap4-debug "lock(%d): %s" (+ elmo-imap4-seqno 1) command))
1265       (setq elmo-imap4-lock t))
1266     (process-send-string process (concat (format "%s%d "
1267                                                  elmo-imap4-seq-prefix
1268                                                  (elmo-imap4-get-seqno))
1269                                          command))
1270     (process-send-string process "\r\n")))
1271
1272 (defun elmo-imap4-send-string (buffer process string)
1273   "Send STRING to server."
1274   (save-excursion
1275     (set-buffer buffer)
1276     (erase-buffer)
1277     (goto-char (point-min))
1278     (setq elmo-imap4-read-point (point))
1279     (process-send-string process string)
1280     (process-send-string process "\r\n")))
1281
1282 (defun elmo-imap4-read-part (folder msg part)
1283   (save-excursion
1284     (let* ((spec (elmo-folder-get-spec folder))
1285            (connection (elmo-imap4-get-connection spec))
1286            (process (elmo-imap4-connection-get-process connection))
1287            response ret-val bytes)
1288       (when (elmo-imap4-spec-folder spec)
1289         (when (not (string= (elmo-imap4-connection-get-cwf connection)
1290                             (elmo-imap4-spec-folder spec)))
1291           (if (null (setq response
1292                           (elmo-imap4-select-folder
1293                            (elmo-imap4-spec-folder spec) connection)))
1294               (error "Select folder failed")))
1295         (elmo-imap4-send-command (process-buffer process)
1296                                  process
1297                                  (format
1298                                   (if elmo-imap4-use-uid
1299                                       "uid fetch %s body.peek[%s]"
1300                                     "fetch %s body.peek[%s]")
1301                                   msg part))
1302         (if (null (setq response (elmo-imap4-read-response
1303                                   (process-buffer process)
1304                                   process t)))
1305             (error "Fetch failed"))
1306         (save-match-data
1307           (while (string-match "^\\* OK" response)
1308             (if (null (setq response (elmo-imap4-read-response
1309                                       (process-buffer process)
1310                                       process t)))
1311                 (error "Fetch failed"))))
1312         (save-match-data
1313           (if (string-match ".*{\\([0-9]+\\)}" response)
1314               (setq bytes
1315                     (string-to-int
1316                      (elmo-match-string 1 response)))
1317             (error "Fetch failed")))
1318         (if (null (setq response (elmo-imap4-read-bytes
1319                                   (process-buffer process) process bytes)))
1320             (error "Fetch message failed"))
1321         (setq ret-val response)
1322         (elmo-imap4-read-response (process-buffer process)
1323                                   process)) ;; ignore remaining..
1324       ret-val)))
1325
1326 (defun elmo-imap4-prefetch-msg (spec msg outbuf)
1327   (elmo-imap4-read-msg spec msg outbuf 'unseen))
1328
1329 (defun elmo-imap4-read-msg (spec msg outbuf
1330                                  &optional leave-seen-flag-untouched)
1331   (save-excursion
1332     (let* ((connection (elmo-imap4-get-connection spec))
1333            (process (elmo-imap4-connection-get-process connection))
1334            response ret-val bytes)
1335       (as-binary-process
1336        (when (elmo-imap4-spec-folder spec)
1337          (when (not (string= (elmo-imap4-connection-get-cwf connection)
1338                              (elmo-imap4-spec-folder spec)))
1339            (if (null (setq response
1340                            (elmo-imap4-select-folder
1341                             (elmo-imap4-spec-folder spec)
1342                             connection)))
1343                (error "Select folder failed")))
1344          (elmo-imap4-send-command (process-buffer process)
1345                                   process
1346                                   (format
1347                                    (if elmo-imap4-use-uid
1348                                        "uid fetch %s body%s[]"
1349                                      "fetch %s body%s[]")
1350                                    msg
1351                                    (if leave-seen-flag-untouched
1352                                        ".peek" "")))
1353          (if (null (setq response (elmo-imap4-read-response
1354                                    (process-buffer process)
1355                                    process t)))
1356              (error "Fetch failed"))
1357          (save-match-data
1358            (while (string-match "^\\* OK" response)
1359              (if (null (setq response (elmo-imap4-read-response
1360                                        (process-buffer process)
1361                                        process t)))
1362                  (error "Fetch failed"))))
1363          (save-match-data
1364            (if (string-match ".*{\\([0-9]+\\)}" response)
1365                (setq bytes
1366                      (string-to-int
1367                       (elmo-match-string 1 response)))
1368              (error "Fetch failed")))
1369          (setq ret-val (elmo-imap4-read-body
1370                         (process-buffer process)
1371                         process bytes outbuf))
1372          (elmo-imap4-read-response (process-buffer process)
1373                                    process)) ;; ignore remaining..
1374        )
1375       ret-val)))
1376
1377 (defun elmo-imap4-setup-send-buffer-from-file (file)
1378   (let ((tmp-buf (get-buffer-create
1379                   " *elmo-imap4-setup-send-buffer-from-file*")))
1380     (save-excursion
1381       (save-match-data
1382         (set-buffer tmp-buf)
1383         (erase-buffer)
1384         (as-binary-input-file
1385          (insert-file-contents file))
1386         (goto-char (point-min))
1387         (if (eq (re-search-forward "^$" nil t)
1388                 (point-max))
1389             (insert "\n"))
1390         (goto-char (point-min))
1391         (while (search-forward "\n" nil t)
1392           (replace-match "\r\n"))))
1393     tmp-buf))
1394
1395 (defun elmo-imap4-delete-msgids (spec msgids)
1396   "If actual message-id is matched, then delete it."
1397   (let ((message-ids msgids)
1398         (i 0)
1399         (num (length msgids)))
1400     (while message-ids
1401       (setq i (+ 1 i))
1402       (message "Deleting message...%d/%d" i num)
1403       (elmo-imap4-delete-msg-by-id spec (car message-ids))
1404       (setq message-ids (cdr message-ids)))
1405     (let* ((connection (elmo-imap4-get-connection spec))
1406            (process (elmo-imap4-connection-get-process connection)))
1407       (elmo-imap4-send-command (process-buffer process)
1408                                process "expunge")
1409       (if (null (elmo-imap4-read-response (process-buffer process)
1410                                           process))
1411           (error "Expunge failed")))))
1412
1413 (defun elmo-imap4-delete-msg-by-id (spec msgid)
1414   (save-excursion
1415     (let* ((connection (elmo-imap4-get-connection spec))
1416            (process (elmo-imap4-connection-get-process connection))
1417            ;;(size (length string))
1418            response msgs)
1419       (if (and (elmo-imap4-spec-folder spec)
1420                (not (string= (elmo-imap4-connection-get-cwf connection)
1421                              (elmo-imap4-spec-folder spec)))
1422                (null (elmo-imap4-select-folder
1423                       (elmo-imap4-spec-folder spec)
1424                       connection)))
1425           (error "Select folder failed"))
1426       (save-excursion
1427         (elmo-imap4-send-command (process-buffer process)
1428                                  process
1429                                  (format
1430                                   (if elmo-imap4-use-uid
1431                                       "uid search header message-id \"%s\""
1432                                     "search header message-id \"%s\"")
1433                                   msgid))
1434         (setq response (elmo-imap4-read-response
1435                         (process-buffer process) process))
1436         (if (and response
1437                  (string-match "^\\* SEARCH\\([^\n]*\\)$" response))
1438             (setq msgs (read (concat "(" (elmo-match-string 1 response) ")")))
1439           (error "SEARCH failed"))
1440         (elmo-imap4-delete-msgs-no-expunge spec msgs)))))
1441
1442 (defun elmo-imap4-append-msg-by-id (spec msgid)
1443   (save-excursion
1444     (let* ((connection (elmo-imap4-get-connection spec))
1445            (process (elmo-imap4-connection-get-process connection))
1446            send-buf)
1447       (if (and (elmo-imap4-spec-folder spec)
1448                (not (string= (elmo-imap4-connection-get-cwf connection)
1449                              (elmo-imap4-spec-folder spec)))
1450                (null (elmo-imap4-select-folder
1451                       (elmo-imap4-spec-folder spec) connection)))
1452           (error "Select folder failed"))
1453       (save-excursion
1454         (setq send-buf (elmo-imap4-setup-send-buffer-from-file
1455                         (elmo-cache-get-path msgid)))
1456         (set-buffer send-buf)
1457         (elmo-imap4-send-command (process-buffer process)
1458                                  process
1459                                  (format "append %s (\\Seen) {%d}"
1460                                          (elmo-imap4-spec-folder spec)
1461                                          (buffer-size)))
1462         (process-send-string process (buffer-string))
1463         (process-send-string process "\r\n") ; finished appending.
1464         )
1465       (kill-buffer send-buf)
1466       (if (null (elmo-imap4-read-response (process-buffer process)
1467                                           process))
1468           (error "Append failed")))
1469     t))
1470
1471 (defun elmo-imap4-append-msg (spec string &optional msg no-see)
1472   (save-excursion
1473     (let* ((connection (elmo-imap4-get-connection spec))
1474            (process (elmo-imap4-connection-get-process connection))
1475            send-buf)
1476       (if (and (elmo-imap4-spec-folder spec)
1477                (not (string= (elmo-imap4-connection-get-cwf connection)
1478                              (elmo-imap4-spec-folder spec)))
1479                (null (elmo-imap4-select-folder (elmo-imap4-spec-folder spec)
1480                                                connection)))
1481           (error "Select folder failed"))
1482       (save-excursion
1483         (setq send-buf (elmo-imap4-setup-send-buffer string))
1484         (set-buffer send-buf)
1485         (elmo-imap4-send-command (process-buffer process)
1486                                  process
1487                                  (format "append %s %s{%d}"
1488                                          (elmo-imap4-spec-folder spec)
1489                                          (if no-see "" "(\\Seen) ")
1490                                          (buffer-size)))
1491         (if (null (elmo-imap4-read-response (process-buffer process)
1492                                             process))
1493             (error "Cannot append messages to this folder"))
1494         (process-send-string process (buffer-string))
1495         (process-send-string process "\r\n") ; finished appending.
1496         )
1497       (kill-buffer send-buf)
1498       (current-buffer)
1499       (if (null (elmo-imap4-read-response (process-buffer process)
1500                                           process))
1501           (error "Append failed")))
1502     t))
1503
1504 (defun elmo-imap4-copy-msgs (dst-spec msgs src-spec &optional expunge-it same-number)
1505   "Equivalence of hostname, username is assumed."
1506   (save-excursion
1507     (let* ((src-folder (elmo-imap4-spec-folder src-spec))
1508            (dst-folder (elmo-imap4-spec-folder dst-spec))
1509            (connection (elmo-imap4-get-connection src-spec))
1510            (process (elmo-imap4-connection-get-process connection))
1511            (mlist msgs))
1512       (if (and src-folder
1513                (not (string= (elmo-imap4-connection-get-cwf connection)
1514                              src-folder))
1515                (null (elmo-imap4-select-folder
1516                       src-folder connection)))
1517           (error "Select folder failed"))
1518       (while mlist
1519         (elmo-imap4-send-command (process-buffer process)
1520                                  process
1521                                  (format
1522                                   (if elmo-imap4-use-uid
1523                                       "uid copy %s %s"
1524                                     "copy %s %s")
1525                                   (car mlist) dst-folder))
1526         (if (null (elmo-imap4-read-response (process-buffer process)
1527                                             process))
1528             (error "Copy failed")
1529           (setq mlist (cdr mlist))))
1530       (when expunge-it
1531         (elmo-imap4-send-command (process-buffer process)
1532                                  process "expunge")
1533         (if (null (elmo-imap4-read-response (process-buffer process)
1534                                             process))
1535             (error "Expunge failed")))
1536       t)))
1537
1538 (defun elmo-imap4-server-diff (spec)
1539   "get server status"
1540   (save-excursion
1541     (let* ((connection (elmo-imap4-get-connection spec))
1542            (process (elmo-imap4-connection-get-process connection))
1543            response)
1544       ;; commit when same folder.
1545       (if (string= (elmo-imap4-connection-get-cwf connection)
1546                    (elmo-imap4-spec-folder spec))
1547           (elmo-imap4-commit spec))
1548       (elmo-imap4-send-command (process-buffer process)
1549                                process
1550                                (format
1551                                 "status \"%s\" (unseen messages)"
1552                                 (elmo-imap4-spec-folder spec)))
1553       (setq response (elmo-imap4-read-response
1554                       (process-buffer process) process))
1555       (when (string-match "\\* STATUS [^(]* \\(([^)]*)\\)" response)
1556         (setq response (read (downcase (elmo-match-string 1 response))))
1557         (cons (cadr (memq 'unseen response))
1558               (cadr (memq 'messages response)))))))
1559
1560 (defun elmo-imap4-use-cache-p (spec number)
1561   elmo-imap4-use-cache)
1562
1563 (defun elmo-imap4-local-file-p (spec number)
1564   nil)
1565
1566 (defun elmo-imap4-port-label (spec)
1567   (concat "imap4"
1568           (if (nth 6 spec) "!ssl" "")))
1569
1570 (defsubst elmo-imap4-portinfo (spec)
1571   (list (elmo-imap4-spec-hostname spec) (elmo-imap4-spec-port spec)))
1572
1573 (defun elmo-imap4-plugged-p (spec)
1574   (apply 'elmo-plugged-p
1575          (append (elmo-imap4-portinfo spec)
1576                  (list nil (quote (elmo-imap4-port-label spec))))))
1577
1578 (defun elmo-imap4-set-plugged (spec plugged add)
1579   (apply 'elmo-set-plugged plugged
1580          (append (elmo-imap4-portinfo spec)
1581                  (list nil nil (quote (elmo-imap4-port-label spec)) add))))
1582
1583 (defalias 'elmo-imap4-sync-number-alist 'elmo-generic-sync-number-alist)
1584
1585 (provide 'elmo-imap4)
1586
1587 ;;; elmo-imap4.el ends here