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