* wl-vars.el (wl-folder-sync-range-alist): Set default range for
[elisp/wanderlust.git] / elmo / elmo-net.el
1 ;;; elmo-net.el --- Network module for ELMO.
2
3 ;; Copyright (C) 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 (eval-when-compile (require 'cl))
30
31 (require 'elmo-util)
32 (require 'elmo-dop)
33 (require 'elmo-vars)
34 (require 'elmo-cache)
35 (require 'elmo)
36
37 ;;; Code:
38 ;;
39
40 ;;; ELMO net folder
41 (eval-and-compile
42   (luna-define-class elmo-net-folder
43                      (elmo-folder)
44                      (user auth server port stream-type))
45   (luna-define-internal-accessors 'elmo-net-folder))
46
47 ;;; Session
48 (eval-and-compile
49   (autoload 'starttls-negotiate "starttls")
50   (autoload 'sasl-find-mechanism "sasl")
51   (autoload 'sasl-make-client "sasl")
52   (autoload 'sasl-mechanism-name "sasl")
53   (autoload 'sasl-next-step "sasl")
54   (autoload 'sasl-step-data "sasl")
55   (autoload 'sasl-step-set-data "sasl"))
56
57 (defvar sasl-mechanisms)
58
59 ;;; Code:
60 ;;
61 (eval-and-compile
62   (luna-define-class elmo-network-session () (name
63                                               server
64                                               port
65                                               user
66                                               auth
67                                               stream-type
68                                               process
69                                               greeting))
70   (luna-define-internal-accessors 'elmo-network-session))
71
72 (luna-define-generic elmo-network-initialize-session (session)
73   "Initialize SESSION (Called before authentication).")
74
75 (luna-define-generic elmo-network-initialize-session-buffer (session buffer)
76   "Initialize SESSION's BUFFER.")
77
78 (luna-define-generic elmo-network-authenticate-session (session)
79   "Authenticate SESSION.")
80
81 (luna-define-generic elmo-network-setup-session (session)
82   "Setup SESSION. (Called after authentication).")
83
84 (luna-define-generic elmo-network-close-session (session)
85   "Close SESSION.")
86
87 (luna-define-method
88   elmo-network-initialize-session-buffer ((session
89                                            elmo-network-session) buffer)
90   (with-current-buffer buffer
91     (elmo-set-buffer-multibyte nil)
92     (buffer-disable-undo (current-buffer))))
93
94 (luna-define-method elmo-network-close-session ((session elmo-network-session))
95   (when (elmo-network-session-process-internal session)
96 ;;; (memq (process-status (elmo-network-session-process-internal session))
97 ;;;       '(open run))
98     (kill-buffer (process-buffer
99                   (elmo-network-session-process-internal session)))
100     (delete-process (elmo-network-session-process-internal session))))
101
102 (defmacro elmo-network-stream-type-spec-string (stream-type)
103   (` (nth 0 (, stream-type))))
104
105 (defmacro elmo-network-stream-type-symbol (stream-type)
106   (` (nth 1 (, stream-type))))
107
108 (defmacro elmo-network-stream-type-feature (stream-type)
109   (` (nth 2 (, stream-type))))
110
111 (defmacro elmo-network-stream-type-function (stream-type)
112   (` (nth 3 (, stream-type))))
113
114 (defsubst elmo-network-session-password-key (session)
115   (format "%s:%s/%s@%s:%d"
116           (upcase
117            (nth 1 (split-string (symbol-name
118                                  (luna-class-name session)) "[4-]")))
119           (elmo-network-session-user-internal session)
120           (elmo-network-session-auth-internal session)
121           (elmo-network-session-server-internal session)
122           (elmo-network-session-port-internal session)))
123
124 (defvar elmo-network-session-cache nil)
125
126 (defsubst elmo-network-session-cache-key (name folder)
127   "Returns session cache key for NAME and FOLDER."
128   (format "%s:%s/%s@%s:%d%s"
129           name
130           (elmo-net-folder-user-internal folder)
131           (elmo-net-folder-auth-internal folder)
132           (elmo-net-folder-server-internal folder)
133           (elmo-net-folder-port-internal folder)
134           (or
135            (elmo-network-stream-type-spec-string
136             (elmo-net-folder-stream-type-internal folder)) "")))
137
138 (defun elmo-network-clear-session-cache ()
139   "Clear session cache."
140   (interactive)
141   (dolist (pair elmo-network-session-cache)
142     (elmo-network-close-session (cdr pair)))
143   (setq elmo-network-session-cache nil))
144
145 (defmacro elmo-network-session-buffer (session)
146   "Get buffer for SESSION."
147   (` (process-buffer (elmo-network-session-process-internal
148                       (, session)))))
149
150 (defun elmo-network-get-session (class name folder &optional if-exists)
151   "Get network session from session cache or a new network session.
152 CLASS is the class name of the session.
153 NAME is the name of the process.
154 FOLDER is the ELMO folder structure.
155 Returns a `elmo-network-session' instance.
156 If optional argument IF-EXISTS is non-nil, it does not return session
157 if there is no session cache.
158 if making session failed, returns nil."
159   (let (pair session key)
160     (if (not (elmo-plugged-p
161               (elmo-net-folder-server-internal folder)
162               (elmo-net-folder-port-internal folder)
163               (elmo-network-stream-type-symbol
164                (elmo-net-folder-stream-type-internal folder))))
165         (error "Unplugged"))
166     (setq pair (assoc (setq key (elmo-network-session-cache-key name folder))
167                       elmo-network-session-cache))
168     (when (and pair
169                (not (memq (process-status
170                            (elmo-network-session-process-internal
171                             (cdr pair)))
172                           '(open run))))
173       (setq elmo-network-session-cache
174             (delq pair elmo-network-session-cache))
175       (elmo-network-close-session (cdr pair))
176       (setq pair nil))
177     (if pair
178         (cdr pair)                      ; connection cache exists.
179       (unless if-exists
180         (setq session
181               (elmo-network-open-session
182                class
183                name
184                (elmo-net-folder-server-internal folder)
185                (elmo-net-folder-port-internal folder)
186                (elmo-net-folder-user-internal folder)
187                (elmo-net-folder-auth-internal folder)
188                (elmo-net-folder-stream-type-internal folder)))
189         (setq elmo-network-session-cache
190               (cons (cons key session)
191                     elmo-network-session-cache))
192         session))))
193
194 (defun elmo-network-open-session (class name server port user auth
195                                         stream-type)
196   "Open an authenticated network session.
197 CLASS is the class name of the session.
198 NAME is the name of the process.
199 SERVER is the name of the server server.
200 PORT is the port number of the service.
201 USER is the user-id for the authenticate.
202 AUTH is the authenticate method name (symbol).
203 STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
204 Returns a process object.  if making session failed, returns nil."
205   (let ((session
206          (luna-make-entity class
207                            :name name
208                            :server server
209                            :port port
210                            :user user
211                            :auth auth
212                            :stream-type stream-type
213                            :process nil
214                            :greeting nil))
215         (buffer (format " *%s session for %s@%s:%d%s"
216                         name
217                         user
218                         server
219                         port
220                         (or (elmo-network-stream-type-spec-string stream-type)
221                             "")))
222         process)
223     (condition-case error
224         (progn
225           (if (get-buffer buffer) (kill-buffer buffer))
226           (setq buffer (get-buffer-create buffer))
227           (elmo-network-initialize-session-buffer session buffer)
228           (elmo-network-session-set-process-internal
229            session
230            (setq process (elmo-open-network-stream
231                           (elmo-network-session-name-internal session)
232                           buffer server port stream-type)))
233           (when process
234             (elmo-network-initialize-session session)
235             (elmo-network-authenticate-session session)
236             (elmo-network-setup-session session)))
237       (error
238        (when (eq (car error) 'elmo-open-error)
239          (elmo-set-plugged nil server port
240                            (elmo-network-stream-type-symbol stream-type)
241                            (current-time))
242          (message "Auto plugged off at %s:%d :%s" server port (cadr error))
243          (sit-for 1))
244        (when (eq (car error) 'elmo-authenticate-error)
245          (elmo-remove-passwd (elmo-network-session-password-key session)))
246        (elmo-network-close-session session)
247        (signal (car error)(cdr error))))
248     session))
249
250 (defun elmo-open-network-stream (name buffer server service stream-type)
251   (let ((auto-plugged (and elmo-auto-change-plugged
252                            (> elmo-auto-change-plugged 0)))
253         process)
254     (if (and stream-type
255              (elmo-network-stream-type-feature stream-type))
256         (require (elmo-network-stream-type-feature stream-type)))
257     (condition-case err
258         (let (process-connection-type)
259           (as-binary-process
260            (setq process
261                  (if stream-type
262                      (funcall (elmo-network-stream-type-function stream-type)
263                               name buffer server service)
264                    (open-network-stream name buffer server service)))))
265       (error
266        (when auto-plugged
267          (elmo-set-plugged nil server service
268                            (elmo-network-stream-type-symbol stream-type)
269                            (current-time))
270          (message "Auto plugged off at %s:%d" server service)
271          (sit-for 1))
272        (signal (car err) (cdr err))))
273     (when process
274       (process-kill-without-query process)
275       (when auto-plugged
276         (elmo-set-plugged t server service
277                           (elmo-network-stream-type-symbol stream-type)))
278       process)))
279
280 (defun elmo-get-network-stream-type (symbol)
281   "Return network stream type corresponding to SYMBOL.
282 Returned value is searched from `elmo-network-stream-type-alist'."
283   (let ((alist elmo-network-stream-type-alist)
284         spec)
285     (while alist
286       (when (eq (nth 1 (car alist)) symbol)
287         (setq spec (car alist))
288         (setq alist nil))
289       (setq alist (cdr alist)))
290     spec))
291
292 (luna-define-method elmo-folder-initialize ((folder
293                                              elmo-net-folder)
294                                             name)
295   ;; user and auth should be set in subclass.
296   (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name)
297     (if (match-beginning 1)
298         (elmo-net-folder-set-server-internal
299          folder
300          (elmo-match-substring 1 name 1)))
301     (if (match-beginning 2)
302         (elmo-net-folder-set-port-internal
303          folder
304          (string-to-int (elmo-match-substring 2 name 1))))
305     (if (match-beginning 3)
306         (elmo-net-folder-set-stream-type-internal
307          folder
308          (assoc (elmo-match-string 3 name)
309                 elmo-network-stream-type-alist)))
310     (substring name 0 (match-beginning 0))))
311
312 (luna-define-method elmo-net-port-info ((folder elmo-net-folder))
313   (list (elmo-net-folder-server-internal folder)
314         (elmo-net-folder-port-internal folder)
315         (elmo-network-stream-type-symbol
316          (elmo-net-folder-stream-type-internal folder))))
317
318 (defun elmo-net-port-label (folder)
319   (concat
320    (symbol-name (elmo-folder-type-internal folder))
321    (if (elmo-net-folder-stream-type-internal folder)
322        (concat "!" (symbol-name
323                     (elmo-network-stream-type-symbol
324                      (elmo-net-folder-stream-type-internal
325                       folder)))))))
326
327 (luna-define-method elmo-folder-plugged-p ((folder elmo-net-folder))
328   (apply 'elmo-plugged-p
329          (append (elmo-net-port-info folder)
330                  (list nil (quote (elmo-net-port-label folder))))))
331
332 (luna-define-method elmo-folder-set-plugged ((folder elmo-net-folder)
333                                              plugged &optional add)
334   (apply 'elmo-set-plugged plugged
335          (append (elmo-net-port-info folder)
336                  (list nil nil (quote (elmo-net-port-label folder)) add))))
337
338 (luna-define-method elmo-folder-create ((folder elmo-net-folder))
339   (if (elmo-folder-plugged-p folder)
340       (elmo-folder-send folder 'elmo-folder-create-plugged)
341     (elmo-folder-send folder 'elmo-folder-create-unplugged)))
342
343 (luna-define-method elmo-folder-create-unplugged ((folder elmo-net-folder))
344   (if elmo-enable-disconnected-operation
345       (elmo-folder-create-dop folder)
346     (error "Unplugged")))
347
348 (luna-define-method elmo-folder-exists-p ((folder elmo-net-folder))
349   (if (elmo-folder-plugged-p folder)
350       (elmo-folder-send folder 'elmo-folder-exists-p-plugged)
351     ;; If unplugged, guess by msgdb.
352     (file-directory-p (elmo-folder-msgdb-path folder))))
353
354 (luna-define-method elmo-folder-status ((folder elmo-net-folder))
355   (if (elmo-folder-plugged-p folder)
356       (elmo-folder-send folder 'elmo-folder-status-plugged)
357     (elmo-folder-send folder 'elmo-folder-status-unplugged)))
358
359 (luna-define-method elmo-folder-status-unplugged
360   ((folder elmo-net-folder))
361   (if elmo-enable-disconnected-operation
362       (elmo-folder-status-dop folder)
363     (error "Unplugged")))
364
365 (luna-define-method elmo-folder-list-messages-internal
366   ((folder elmo-net-folder) &optional nohide)
367   (elmo-net-folder-list-messages-internal folder nohide))
368
369 (defun elmo-net-folder-list-messages-internal (folder nohide)
370   (if (elmo-folder-plugged-p folder)
371       (elmo-folder-send folder 'elmo-folder-list-messages-plugged nohide)
372     (elmo-folder-send folder 'elmo-folder-list-messages-unplugged)))
373
374 (luna-define-method elmo-folder-list-messages-plugged
375   ((folder elmo-net-folder))
376   nil)
377
378 ;; Should consider offline append and removal.
379 (luna-define-method elmo-folder-list-messages-unplugged ((folder
380                                                           elmo-net-folder))
381   (if elmo-enable-disconnected-operation
382       (let ((deleting (elmo-dop-list-deleting-messages folder)))
383         (nconc
384          ;; delete deleting messages
385          (elmo-delete-if
386           (lambda (number) (memq number deleting))
387           ;; current number-list.
388           (elmo-msgdb-list-messages (elmo-folder-msgdb folder)))
389          ;; append appending messages
390          (mapcar (lambda (x) (* -1 x))
391                  (elmo-dop-spool-folder-list-messages folder))))
392     t))
393
394 (luna-define-method elmo-folder-list-unreads :around ((folder
395                                                        elmo-net-folder))
396   (if (and (elmo-folder-plugged-p folder)
397            (elmo-folder-use-flag-p folder))
398       (elmo-folder-send folder 'elmo-folder-list-unreads-plugged)
399     (luna-call-next-method)))
400
401 (luna-define-method elmo-folder-list-importants :around ((folder
402                                                           elmo-net-folder))
403   (if (and (elmo-folder-plugged-p folder)
404            (elmo-folder-use-flag-p folder))
405       (elmo-folder-send folder 'elmo-folder-list-importants-plugged)
406     (luna-call-next-method)))
407
408 (luna-define-method elmo-folder-list-answereds :around ((folder
409                                                          elmo-net-folder))
410   (if (and (elmo-folder-plugged-p folder)
411            (elmo-folder-use-flag-p folder))
412       (elmo-folder-send folder 'elmo-folder-list-answereds-plugged)
413     (luna-call-next-method)))
414
415 (luna-define-method elmo-folder-list-unreads-plugged
416   ((folder elmo-net-folder))
417   t)
418
419 (luna-define-method elmo-folder-list-importants-plugged
420   ((folder elmo-net-folder))
421   t)
422
423 (luna-define-method elmo-folder-list-answereds-plugged
424   ((folder elmo-net-folder))
425   t)
426
427 (luna-define-method elmo-folder-delete-messages ((folder elmo-net-folder)
428                                                  numbers)
429   (if (elmo-folder-plugged-p folder)
430       (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers)
431     (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers)))
432
433 (luna-define-method elmo-folder-delete-messages-unplugged ((folder
434                                                             elmo-net-folder)
435                                                            numbers)
436   (elmo-folder-delete-messages-dop folder numbers))
437
438 (luna-define-method elmo-folder-msgdb-create ((folder elmo-net-folder)
439                                               numbers flag-table)
440   (if (elmo-folder-plugged-p folder)
441       (elmo-folder-send folder 'elmo-folder-msgdb-create-plugged
442                         numbers flag-table)
443     (elmo-folder-send folder 'elmo-folder-msgdb-create-unplugged
444                       numbers flag-table)))
445
446 (luna-define-method elmo-folder-msgdb-create-unplugged ((folder
447                                                          elmo-net-folder)
448                                                         numbers
449                                                         flag-table)
450   ;; XXXX should be appended to already existing msgdb.
451   (elmo-dop-msgdb
452    (elmo-folder-msgdb-create (elmo-dop-spool-folder folder)
453                              (mapcar 'abs numbers)
454                              flag-table)))
455
456 (luna-define-method elmo-folder-unflag-important :before ((folder
457                                                            elmo-net-folder)
458                                                           numbers
459                                                           &optional
460                                                           is-local)
461   (when (and (elmo-folder-use-flag-p folder)
462              (not is-local))
463     (if (elmo-folder-plugged-p folder)
464         (elmo-folder-send folder 'elmo-folder-unflag-important-plugged
465                           numbers)
466       (elmo-folder-send folder
467                         'elmo-folder-unflag-important-unplugged numbers))))
468
469 (luna-define-method elmo-folder-flag-as-important :before ((folder
470                                                             elmo-net-folder)
471                                                            numbers
472                                                            &optional
473                                                            is-local)
474   (when (and (elmo-folder-use-flag-p folder)
475              (not is-local))
476     (if (elmo-folder-plugged-p folder)
477         (elmo-folder-send folder 'elmo-folder-flag-as-important-plugged
478                           numbers)
479       (elmo-folder-send folder 'elmo-folder-flag-as-important-unplugged
480                         numbers))))
481
482 (luna-define-method elmo-folder-unflag-read :before ((folder elmo-net-folder)
483                                                      numbers
484                                                      &optional is-local)
485   (when (and (elmo-folder-use-flag-p folder)
486              (not is-local))
487     (if (elmo-folder-plugged-p folder)
488         (elmo-folder-send folder 'elmo-folder-unflag-read-plugged numbers)
489       (elmo-folder-send folder 'elmo-folder-unflag-read-unplugged numbers))))
490
491 (luna-define-method elmo-folder-flag-as-read :before ((folder elmo-net-folder)
492                                                       numbers
493                                                       &optional is-local)
494   (when (and (elmo-folder-use-flag-p folder)
495              (not is-local))
496     (if (elmo-folder-plugged-p folder)
497         (elmo-folder-send folder 'elmo-folder-flag-as-read-plugged numbers)
498       (elmo-folder-send
499        folder 'elmo-folder-flag-as-read-unplugged numbers))))
500
501 (luna-define-method elmo-folder-unflag-answered :before ((folder
502                                                           elmo-net-folder)
503                                                          numbers
504                                                          &optional is-local)
505   (when (and (elmo-folder-use-flag-p folder)
506              (not is-local))
507     (if (elmo-folder-plugged-p folder)
508         (elmo-folder-send folder 'elmo-folder-unflag-answered-plugged
509                           numbers)
510       (elmo-folder-send folder
511                         'elmo-folder-unflag-answered-unplugged numbers))))
512
513 (luna-define-method elmo-folder-flag-as-answered :before ((folder
514                                                            elmo-net-folder)
515                                                           numbers
516                                                           &optional is-local)
517   (when (and (elmo-folder-use-flag-p folder)
518              (not is-local))
519     (if (elmo-folder-plugged-p folder)
520         (elmo-folder-send folder 'elmo-folder-flag-as-answered-plugged
521                           numbers)
522       (elmo-folder-send folder 'elmo-folder-flag-as-answered-unplugged
523                         numbers))))
524
525 (luna-define-method elmo-folder-flag-as-read-unplugged ((folder
526                                                          elmo-net-folder)
527                                                         numbers)
528   (elmo-folder-flag-as-read-dop folder numbers))
529
530 (luna-define-method elmo-folder-unflag-read-unplugged ((folder elmo-net-folder)
531                                                      numbers)
532   (elmo-folder-unflag-read-dop folder numbers))
533
534 (luna-define-method elmo-folder-flag-as-important-unplugged ((folder
535                                                               elmo-net-folder)
536                                                              numbers)
537   (elmo-folder-flag-as-important-dop folder numbers))
538
539 (luna-define-method elmo-folder-unflag-important-unplugged ((folder
540                                                              elmo-net-folder)
541                                                             numbers)
542   (elmo-folder-unflag-important-dop folder numbers))
543
544 (luna-define-method elmo-folder-flag-as-answered-unplugged ((folder
545                                                              elmo-net-folder)
546                                                             numbers)
547   (elmo-folder-flag-as-answered-dop folder numbers))
548
549 (luna-define-method elmo-folder-unflag-answered-unplugged
550   ((folder elmo-net-folder) numbers)
551   (elmo-folder-unflag-answered-dop folder numbers))
552
553 (luna-define-method elmo-message-encache :around ((folder elmo-net-folder)
554                                                   number &optional read)
555   (if (elmo-folder-plugged-p folder)
556       (luna-call-next-method)
557     (if elmo-enable-disconnected-operation
558         (elmo-message-encache-dop folder number read)
559       (error "Unplugged"))))
560
561 (luna-define-generic elmo-message-fetch-plugged (folder number strategy
562                                                         &optional
563                                                         section
564                                                         outbuf
565                                                         unseen)
566   "")
567
568 (luna-define-generic elmo-message-fetch-unplugged (folder number strategy
569                                                           &optional
570                                                           section
571                                                           outbuf
572                                                           unseen)
573   "")
574
575 (luna-define-method elmo-message-fetch-internal ((folder elmo-net-folder)
576                                                  number strategy
577                                                  &optional section unseen)
578   (if (elmo-folder-plugged-p folder)
579       (elmo-message-fetch-plugged folder number
580                                   strategy section
581                                   (current-buffer) unseen)
582     (elmo-message-fetch-unplugged folder number
583                                   strategy section
584                                   (current-buffer) unseen)))
585
586 (luna-define-method elmo-message-fetch-unplugged
587   ((folder elmo-net-folder) number strategy  &optional section outbuf unseen)
588   (if (and elmo-enable-disconnected-operation
589            (< number 0))
590       (elmo-message-fetch-internal
591        (elmo-dop-spool-folder folder) (abs number) strategy
592        section unseen)
593     (error "Unplugged")))
594
595 (luna-define-method elmo-folder-check ((folder elmo-net-folder))
596   (if (elmo-folder-plugged-p folder)
597       (elmo-folder-send folder 'elmo-folder-check-plugged)))
598
599 (luna-define-method elmo-folder-close :after ((folder elmo-net-folder))
600   (if (elmo-folder-plugged-p folder)
601       (elmo-folder-send folder 'elmo-folder-check-plugged)))
602
603 (luna-define-method elmo-folder-diff :around ((folder elmo-net-folder))
604   (if (and (elmo-folder-use-flag-p folder)
605            (elmo-folder-plugged-p folder))
606       (elmo-folder-send folder 'elmo-folder-diff-plugged)
607     (luna-call-next-method)))
608
609 (luna-define-method elmo-folder-local-p ((folder elmo-net-folder))
610   nil)
611
612 (luna-define-method elmo-quit ((folder elmo-net-folder))
613   (elmo-network-clear-session-cache))
614
615 (require 'product)
616 (product-provide (provide 'elmo-net) (require 'elmo-version))
617
618 ;;; elmo-net.el ends here