1;;; webmail.el --- interface of web mail
2
3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
7;; Keywords: hotmail netaddress my-deja netscape
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published
13;; by the Free Software Foundation; either version 2, or (at your
14;; option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful, but
17;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19;; 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., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; Note: Now mail.yahoo.com provides POP3 service, the webmail
29;; fetching is not going to be supported.
30
31;; Note: You need to have `url' and `w3' installed for this backend to
32;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone
33;; `url'.
34
35;; Todo: To support more web mail servers.
36
37;; Known bugs:
38;; 1. Net@ddress may corrupt `X-Face'.
39
40;; Warning:
41;; Webmail is an experimental function, which means NO WARRANTY.
42
43;;; Code:
44
45(eval-when-compile (require 'cl))
46
47(require 'nnoo)
48(require 'message)
49(require 'gnus-util)
50(require 'gnus)
51(require 'nnmail)
52(require 'mm-util)
53(require 'mm-url)
54(require 'mml)
55(eval-when-compile
56  (ignore-errors
57    (require 'url)
58    (require 'url-cookie)))
59;; Report failure to find w3 at load time if appropriate.
60(eval '(progn
61	 (require 'url)
62	 (require 'url-cookie)))
63
64;;;
65
66(defvar webmail-type-definition
67  '((hotmail
68     ;; Hotmail hate other HTTP user agents and use one line cookie
69     (paranoid agent cookie post)
70     (address . "www.hotmail.com")
71     (open-url "http://www.hotmail.com/")
72     (open-snarf . webmail-hotmail-open)
73     ;; W3 hate redirect POST
74     (login-url
75      "http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta="
76      webmail-aux user password)
77     ;;(login-snarf . webmail-hotmail-login)
78     ;;(list-url "%s" webmail-aux)
79     (list-snarf . webmail-hotmail-list)
80     (article-snarf . webmail-hotmail-article)
81     (trash-url
82      "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox="
83      webmail-aux user id))
84    (yahoo
85     (paranoid agent cookie post)
86     (address . "mail.yahoo.com")
87     (open-url "http://mail.yahoo.com/")
88     (open-snarf . webmail-yahoo-open)
89     (login-url;; yahoo will not accept GET
90      content
91      ("%s" webmail-aux)
92      ".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s"
93      user password)
94     (login-snarf . webmail-yahoo-login)
95     (list-url "%s&rb=Inbox&YN=1" webmail-aux)
96     (list-snarf . webmail-yahoo-list)
97     (article-snarf . webmail-yahoo-article)
98     (trash-url
99      "%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2="
100      webmail-aux id))
101    (netaddress
102     (paranoid cookie post)
103     (address . "www.netaddress.com")
104     (open-url "http://www.netaddress.com/")
105     (open-snarf . webmail-netaddress-open)
106     (login-url
107      content
108      ("%s" webmail-aux)
109      "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&Domain=usa.net&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s"
110      user password)
111     (login-snarf . webmail-netaddress-login)
112     (list-url
113      "http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
114      webmail-session)
115     (list-snarf . webmail-netaddress-list)
116     (article-url "http://www.netaddress.com/")
117     (article-snarf . webmail-netaddress-article)
118     (trash-url
119      "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
120      webmail-session id))
121    (netscape
122     (paranoid cookie post agent)
123     (address . "webmail.netscape.com")
124     (open-url "http://ureg.netscape.com/iiop/UReg2/login/login?U2_LA=en&U2_BACK_FROM_CJ=true&U2_CS=iso-8859-1&U2_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_NEW_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_EXITURL=http://home.netscape.com/&U2_SOURCE=Webmail")
125     (open-snarf . webmail-netscape-open)
126     (login-url
127      content
128      ("http://ureg.netscape.com/iiop/UReg2/login/loginform")
129      "U2_USERNAME=%s&U2_PASSWORD=%s%s"
130      user password webmail-aux)
131     (login-snarf . webmail-netaddress-login)
132     (list-url
133      "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
134      webmail-session)
135     (list-snarf . webmail-netaddress-list)
136     (article-url "http://webmail.netscape.com/")
137     (article-snarf . webmail-netscape-article)
138     (trash-url
139      "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
140      webmail-session id))
141    (my-deja
142     (paranoid cookie post)
143     (address . "www.my-deja.com")
144     ;;(open-snarf . webmail-my-deja-open)
145     (login-url
146      content
147      ("http://mydeja.google.com/cgi-bin/deja/maillogin.py")
148      "userid=%s&password=%s"
149      user password)
150     (list-snarf . webmail-my-deja-list)
151     (article-snarf . webmail-my-deja-article)
152     (trash-url webmail-aux id))))
153
154(defvar webmail-variables
155  '(address article-snarf article-url list-snarf list-url
156	    login-url login-snarf open-url open-snarf site articles
157	    post-process paranoid trash-url))
158
159(defconst webmail-version "webmail 1.0")
160
161(defvar webmail-newmail-only nil
162  "Only fetch new mails.")
163
164(defvar webmail-move-to-trash-can t
165  "Move mail to trash can after fetch it.")
166
167;;; Internal variables
168
169(defvar webmail-address nil)
170(defvar webmail-paranoid nil)
171(defvar webmail-aux nil)
172(defvar webmail-session nil)
173(defvar webmail-article-snarf nil)
174(defvar webmail-article-url nil)
175(defvar webmail-list-snarf nil)
176(defvar webmail-list-url nil)
177(defvar webmail-login-url nil)
178(defvar webmail-login-snarf nil)
179(defvar webmail-open-snarf nil)
180(defvar webmail-open-url nil)
181(defvar webmail-trash-url nil)
182(defvar webmail-articles nil)
183(defvar webmail-post-process nil)
184
185(defvar webmail-buffer nil)
186(defvar webmail-buffer-list nil)
187
188(defvar webmail-type nil)
189
190(defvar webmail-error-function nil)
191
192(defvar webmail-debug-file "~/.emacs-webmail-debug")
193
194;;; Interface functions
195
196(defun webmail-debug (str)
197  (with-temp-buffer
198    (insert "\n---------------- A bug at " str " ------------------\n")
199    (mapcar #'(lambda (sym)
200		(if (boundp sym)
201		    (gnus-pp `(setq ,sym ',(eval sym)))))
202	    '(webmail-type user))
203    (insert "---------------- webmail buffer ------------------\n\n")
204    (insert-buffer-substring webmail-buffer)
205    (insert "\n---------------- end of buffer ------------------\n\n")
206    (append-to-file (point-min) (point-max) webmail-debug-file)))
207
208(defun webmail-error (str)
209  (if webmail-error-function
210      (funcall webmail-error-function str))
211  (message "%s HTML has changed or your w3 package is too old.(%s)"
212	   webmail-type str)
213  (error "%s HTML has changed or your w3 package is too old.(%s)"
214	 webmail-type str))
215
216(defun webmail-setdefault (type)
217  (let ((type-def (cdr (assq type webmail-type-definition)))
218	(vars webmail-variables)
219	pair)
220    (setq webmail-type type)
221    (dolist (var vars)
222      (if (setq pair (assq var type-def))
223	  (set (intern (concat "webmail-" (symbol-name var))) (cdr pair))
224	(set (intern (concat "webmail-" (symbol-name var))) nil)))))
225
226(defun webmail-eval (expr)
227  (cond
228   ((consp expr)
229    (cons (webmail-eval (car expr)) (webmail-eval (cdr expr))))
230   ((symbolp expr)
231    (eval expr))
232   (t
233    expr)))
234
235(defun webmail-url (xurl)
236  (mm-with-unibyte-current-buffer
237    (cond
238     ((eq (car xurl) 'content)
239      (pop xurl)
240      (mm-url-fetch-simple (if (stringp (car xurl))
241				(car xurl)
242			      (apply 'format (webmail-eval (car xurl))))
243			    (apply 'format (webmail-eval (cdr xurl)))))
244     ((eq (car xurl) 'post)
245      (pop xurl)
246      (mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl))))
247     (t
248      (mm-url-insert (apply 'format (webmail-eval xurl)))))))
249
250(defun webmail-init ()
251  "Initialize buffers and such."
252  (if (gnus-buffer-live-p webmail-buffer)
253      (set-buffer webmail-buffer)
254    (setq webmail-buffer
255	  (nnheader-set-temp-buffer " *webmail*"))
256    (mm-disable-multibyte)))
257
258(defvar url-package-name)
259(defvar url-package-version)
260(defvar url-cookie-multiple-line)
261(defvar url-confirmation-func)
262
263;; Hack W3 POST redirect.  See `url-parse-mime-headers'.
264;;
265;; Netscape uses "GET" as redirect method when orignal method is POST
266;; and status is 302, .i.e no security risks by default without
267;; confirmation.
268;;
269;; Some web servers (at least Apache used by yahoo) return status 302
270;; instead of 303, though they mean 303.
271
272(defun webmail-url-confirmation-func (prompt)
273  (cond
274   ((equal prompt (concat "Honor redirection with non-GET method "
275			  "(possible security risks)? "))
276    nil)
277   ((equal prompt "Continue (with method of GET)? ")
278    t)
279   (t (error prompt))))
280
281(defun webmail-refresh-redirect ()
282  "Redirect refresh url in META."
283  (goto-char (point-min))
284  (while (re-search-forward
285	  "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
286	  nil t)
287    (let ((url (match-string 1)))
288      (erase-buffer)
289      (mm-with-unibyte-current-buffer
290	(mm-url-insert url)))
291    (goto-char (point-min))))
292
293(defun webmail-fetch (file subtype user password)
294  (save-excursion
295    (webmail-setdefault subtype)
296    (let ((url-package-name (if (memq 'agent webmail-paranoid)
297				"Mozilla"
298			      url-package-name))
299	  (url-package-version (if (memq 'agent webmail-paranoid)
300				   "4.0"
301				 url-package-version))
302	  (url-cookie-multiple-line (if (memq 'cookie webmail-paranoid)
303					nil
304				      url-cookie-multiple-line))
305	  (url-confirmation-func (if (memq 'post webmail-paranoid)
306				     'webmail-url-confirmation-func
307				   url-confirmation-func))
308	  (url-http-silence-on-insecure-redirection t)
309	  url-cookie-storage url-cookie-secure-storage
310	  url-cookie-confirmation
311	  item id (n 0))
312      (webmail-init)
313      (setq webmail-articles nil)
314      (when webmail-open-url
315	(erase-buffer)
316	(webmail-url webmail-open-url))
317      (if webmail-open-snarf (funcall webmail-open-snarf))
318      (when webmail-login-url
319	(erase-buffer)
320	(webmail-url webmail-login-url))
321      (if webmail-login-snarf
322	  (funcall webmail-login-snarf))
323      (when webmail-list-url
324	(erase-buffer)
325	(webmail-url webmail-list-url))
326      (if webmail-list-snarf
327	  (funcall webmail-list-snarf))
328      (while (setq item (pop webmail-articles))
329	(message "Fetching mail #%d..." (setq n (1+ n)))
330	(erase-buffer)
331	(mm-with-unibyte-current-buffer
332	  (mm-url-insert (cdr item)))
333	(setq id (car item))
334	(if webmail-article-snarf
335	    (funcall webmail-article-snarf file id))
336	(when (and webmail-trash-url webmail-move-to-trash-can)
337	  (message "Move mail #%d to trash can..." n)
338	  (condition-case err
339	      (progn
340		(webmail-url webmail-trash-url)
341		(let (buf)
342		  (while (setq buf (pop webmail-buffer-list))
343		    (kill-buffer buf))))
344	    (error
345	     (let (buf)
346	       (while (setq buf (pop webmail-buffer-list))
347		 (kill-buffer buf)))
348	     (error err))))))
349    (if webmail-post-process
350	(funcall webmail-post-process))))
351
352(defun webmail-encode-8bit ()
353  (goto-char (point-min))
354  (skip-chars-forward "^\200-\377")
355  (while (not (eobp))
356    (insert (format "&%d;" (mm-char-int (char-after))))
357    (delete-char 1)
358    (skip-chars-forward "^\200-\377")))
359
360;;; hotmail
361
362(defun webmail-hotmail-open ()
363  (goto-char (point-min))
364  (if (re-search-forward
365       "action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t)
366      (setq webmail-aux (match-string 1))
367    (webmail-error "open@1")))
368
369(defun webmail-hotmail-login ()
370  (let (site)
371    (goto-char (point-min))
372    (if (re-search-forward
373	 "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
374	(setq site (match-string 1))
375      (webmail-error "login@1"))
376    (goto-char (point-min))
377    (if (re-search-forward
378	 "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t)
379	(setq webmail-aux (concat "http://" site (match-string 1)))
380      (webmail-error "login@2"))))
381
382(defun webmail-hotmail-list ()
383  (goto-char (point-min))
384  (skip-chars-forward " \t\n\r")
385  (let (site url newp (total "0"))
386    (if (eobp)
387	(setq total "0")
388      (if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
389	  (message "Found %s (%s new)" (setq total (match-string 1))
390		   (match-string 2))
391	(if (re-search-forward "\\([0-9]+\\) new" nil t)
392	    (message "Found %s new" (setq total (match-string 1)))
393	  (webmail-error "list@0"))))
394    (unless (equal total "0")
395      (goto-char (point-min))
396      (if (re-search-forward
397	 "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
398	  (setq site (match-string 1))
399	(webmail-error "list@1"))
400      (goto-char (point-min))
401      (if (re-search-forward "disk=\\([^&]*\\)&" nil t)
402	  (setq webmail-aux
403		(concat "http://" site "/cgi-bin/HoTMaiL?disk="
404			(match-string 1)))
405	(webmail-error "list@2"))
406      (goto-char (point-max))
407      (while (re-search-backward
408	      "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\""
409	      nil t)
410	(if (setq url (match-string 1))
411	    (progn
412	      (if (or newp (not webmail-newmail-only))
413		  (let (id)
414		    (if (string-match "msg=\\([^&]+\\)" url)
415			(setq id (match-string 1 url)))
416		    (push (cons id (concat "http://" site url "&raw=0"))
417			  webmail-articles)))
418	      (setq newp nil))
419	  (setq newp t))))))
420
421;; Thank victor@idaccr.org (Victor S. Miller) for raw=0
422
423(defun webmail-hotmail-article (file id)
424  (goto-char (point-min))
425  (skip-chars-forward " \t\n\r")
426  (unless (eobp)
427    (if (not (search-forward "<pre>" nil t))
428	(webmail-error "article@3"))
429    (skip-chars-forward "\n\r\t ")
430    (delete-region (point-min) (point))
431    (if (not (search-forward "</pre>" nil t))
432	(webmail-error "article@3.1"))
433    (delete-region (match-beginning 0) (point-max))
434    (mm-url-remove-markup)
435    (mm-url-decode-entities-nbsp)
436    (goto-char (point-min))
437    (while (re-search-forward "\r\n?" nil t)
438      (replace-match "\n"))
439    (goto-char (point-min))
440    (insert "\n\n")
441    (if (not (looking-at "\n*From "))
442	(insert "From nobody " (current-time-string) "\n")
443      (forward-line))
444    (insert "X-Gnus-Webmail: " (symbol-value 'user)
445	    "@" (symbol-name webmail-type) "\n")
446    (mm-append-to-file (point-min) (point-max) file)))
447
448(defun webmail-hotmail-article-old (file id)
449  (let (p attachment count mime hotmail-direct)
450    (save-restriction
451      (webmail-encode-8bit)
452      (goto-char (point-min))
453      (if (not (search-forward "<DIV>" nil t))
454	  (if (not (search-forward "Reply&nbsp;All" nil t))
455	      (webmail-error "article@1")
456	    (setq hotmail-direct t))
457	(goto-char (match-beginning 0)))
458      (narrow-to-region (point-min) (point))
459      (if (not (search-backward "<table" nil t 2))
460	  (webmail-error "article@1.1"))
461      (delete-region (point-min) (match-beginning 0))
462      (while (search-forward "<a href=" nil t)
463	(setq p (match-beginning 0))
464	(search-forward "</a>" nil t)
465	(delete-region p (match-end 0)))
466      (mm-url-remove-markup)
467      (mm-url-decode-entities-nbsp)
468      (goto-char (point-min))
469      (delete-blank-lines)
470      (goto-char (point-min))
471      (when (search-forward "\n\n" nil t)
472	(backward-char)
473	(delete-region (point) (point-max)))
474      (goto-char (point-max))
475      (widen)
476      (insert "\n")
477      (setq p (point))
478      (while (re-search-forward
479	      "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
480	      nil t)
481	(if (setq attachment (match-string 1))
482	    (let ((filename (match-string 2))
483		  bufname);; Attachment
484	      (delete-region p (match-end 0))
485	      (save-excursion
486		(set-buffer (generate-new-buffer " *webmail-att*"))
487		(mm-url-insert attachment)
488		(push (current-buffer) webmail-buffer-list)
489		(setq bufname (buffer-name)))
490	      (setq mime t)
491	      (insert "<#part type="
492		      (or (and filename
493			       (string-match "\\.[^\\.]+$" filename)
494			       (mailcap-extension-to-mime
495				(match-string 0 filename)))
496			  "application/octet-stream"))
497	      (insert " buffer=\"" bufname "\"")
498	      (insert " filename=\"" filename "\"")
499	      (insert " disposition=\"inline\"")
500	      (insert "><#/part>\n")
501	      (setq p (point)))
502	  (delete-region p (match-end 0))
503	  (if hotmail-direct
504	      (if (not (search-forward "</tt>" nil t))
505		  (webmail-error "article@1.2")
506		(delete-region (match-beginning 0) (match-end 0)))
507	    (setq count 1)
508	    (while (and (> count 0)
509			(re-search-forward "</div>\\|\\(<div>\\)" nil t))
510	      (if (match-string 1)
511		  (setq count (1+ count))
512		(if (= (setq count (1- count)) 0)
513		    (delete-region (match-beginning 0)
514				   (match-end 0))))))
515	  (narrow-to-region p (point))
516	  (goto-char (point-min))
517	  (cond
518	   ((looking-at "<pre>")
519	    (goto-char (match-end 0))
520	    (if (looking-at "$") (forward-char))
521	    (delete-region (point-min) (point))
522	    (mm-url-remove-markup)
523	    (mm-url-decode-entities-nbsp)
524	    nil)
525	   (t
526	    (setq mime t)
527	    (insert "<#part type=\"text/html\" disposition=inline>")
528	    (goto-char (point-max))
529	    (insert "<#/part>")))
530	  (goto-char (point-max))
531	  (setq p (point))
532	  (widen)))
533      (delete-region p (point-max))
534      (goto-char (point-min))
535      ;; Some blank line to seperate mails.
536      (insert "\n\nFrom nobody " (current-time-string) "\n")
537      (insert "X-Gnus-Webmail: " (symbol-value 'user)
538	      "@" (symbol-name webmail-type) "\n")
539      (if id
540	  (insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
541      (unless (looking-at "$")
542	(if (search-forward "\n\n" nil t)
543	    (forward-line -1)
544	  (webmail-error "article@2")))
545      (narrow-to-region (point) (point-max))
546      (if mime
547	  (insert "MIME-Version: 1.0\n"
548		  (prog1
549		      (mml-generate-mime)
550		    (delete-region (point-min) (point-max)))))
551      (goto-char (point-min))
552      (widen)
553      (let (case-fold-search)
554	(while (re-search-forward "^From " nil t)
555	  (beginning-of-line)
556	  (insert ">"))))
557    (mm-append-to-file (point-min) (point-max) file)))
558
559;;; yahoo
560
561(defun webmail-yahoo-open ()
562  (goto-char (point-min))
563  (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
564      (setq webmail-aux (match-string 1))
565    (webmail-error "open@1")))
566
567(defun webmail-yahoo-login ()
568  (goto-char (point-min))
569  (if (re-search-forward "http://[^/]+[0-9]\\.mail\\.yahoo\\.com/" nil t)
570      (setq webmail-aux (match-string 0))
571    (webmail-error "login@1"))
572  (if (re-search-forward "YY=[0-9]+" nil t)
573      (setq webmail-aux (concat webmail-aux "ym/ShowFolder?"
574				(match-string 0)))
575    (webmail-error "login@2")))
576
577(defun webmail-yahoo-list ()
578  (let (url (newp t) (tofetch 0))
579    (goto-char (point-min))
580    (when (re-search-forward
581	   "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
582      ;;(setq listed (match-string 1))
583      (message "Found %s mail(s)" (match-string 2)))
584    (if (string-match "http://[^/]+" webmail-aux)
585	(setq webmail-aux (match-string 0 webmail-aux))
586      (webmail-error "list@1"))
587    (goto-char (point-min))
588    (while (re-search-forward
589	    "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
590	    nil t)
591      (if (setq url (match-string 1))
592	  (progn
593	    (when (or newp (not webmail-newmail-only))
594	      (push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
595		    webmail-articles)
596	      (setq tofetch (1+ tofetch)))
597	    (setq newp t))
598	(setq newp nil)))
599    (setq webmail-articles (nreverse webmail-articles))
600    (message "Fetching %d mail(s)" tofetch)))
601
602(defun webmail-yahoo-article (file id)
603  (let (p attachment)
604    (save-restriction
605      (goto-char (point-min))
606      (if (not (search-forward "value=\"Done\"" nil t))
607	  (webmail-error "article@1"))
608      (if (not (search-forward "<table" nil t))
609	  (webmail-error "article@2"))
610      (delete-region (point-min) (match-beginning 0))
611      (if (not (search-forward "</table>" nil t))
612	  (webmail-error "article@3"))
613      (narrow-to-region (point-min) (match-end 0))
614      (while (search-forward "<a href=" nil t)
615	(setq p (match-beginning 0))
616	(search-forward "</a>" nil t)
617	(delete-region p (match-end 0)))
618      (mm-url-remove-markup)
619      (mm-url-decode-entities-nbsp)
620      (goto-char (point-min))
621      (delete-blank-lines)
622      (goto-char (point-max))
623      (widen)
624      (insert "\n")
625      (setq p (point))
626      (while (re-search-forward "[^\"]*/ShowLetter/[^\?]+\?[^\"]*" nil t)
627	(setq attachment (match-string 0))
628	(let (bufname ct ctl cd description)
629	  (if (not (search-forward "<table" nil t))
630	      (webmail-error "article@4"))
631	  (delete-region p (match-beginning 0))
632	  (if (not (search-forward "</table>" nil t))
633	      (webmail-error "article@5"))
634	  (narrow-to-region p (match-end 0))
635	  (mm-url-remove-markup)
636	  (mm-url-decode-entities-nbsp)
637	  (goto-char (point-min))
638	  (delete-blank-lines)
639	  (setq ct (mail-fetch-field "content-type")
640		ctl (and ct (mail-header-parse-content-type ct))
641		;;cte (mail-fetch-field "content-transfer-encoding")
642		cd (mail-fetch-field "content-disposition")
643		description (mail-fetch-field "content-description")
644		id (mail-fetch-field "content-id"))
645	  (delete-region (point-min) (point-max))
646	  (widen)
647	  (save-excursion
648	    (set-buffer (generate-new-buffer " *webmail-att*"))
649	    (mm-url-insert (concat webmail-aux attachment))
650	    (push (current-buffer) webmail-buffer-list)
651	    (setq bufname (buffer-name)))
652	  (insert "<#part")
653	  (if (and ctl (not (equal (car ctl) "text/")))
654	      (insert " type=\"" (car ctl) "\""))
655	  (insert " buffer=\"" bufname "\"")
656	  (if cd
657	      (insert " disposition=\"" cd "\""))
658	  (if description
659	      (insert " description=\"" description "\""))
660	  (insert "><#/part>\n")
661	  (setq p (point))))
662      (delete-region p (point-max))
663      (goto-char (point-min))
664      ;; Some blank line to seperate mails.
665      (insert "\n\nFrom nobody " (current-time-string) "\n")
666      (insert "X-Gnus-Webmail: " (symbol-value 'user)
667	      "@" (symbol-name webmail-type) "\n")
668      (if id
669	  (insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
670      (unless (looking-at "$")
671	(if (search-forward "\n\n" nil t)
672	    (forward-line -1)
673	  (webmail-error "article@2")))
674      (narrow-to-region (point) (point-max))
675      (insert "MIME-Version: 1.0\n"
676	      (prog1
677		  (mml-generate-mime)
678		(delete-region (point-min) (point-max))))
679      (goto-char (point-min))
680      (widen)
681      (let (case-fold-search)
682	(while (re-search-forward "^From " nil t)
683	  (beginning-of-line)
684	  (insert ">"))))
685    (mm-append-to-file (point-min) (point-max) file)))
686
687;;; netaddress
688
689(defun webmail-netscape-open ()
690  (goto-char (point-min))
691  (setq webmail-aux "")
692  (while (re-search-forward
693	  "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
694	  nil t)
695    (setq webmail-aux (concat webmail-aux "&" (match-string 1) "="
696			      (match-string 2)))))
697
698(defun webmail-netaddress-open ()
699  (goto-char (point-min))
700  (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
701      (setq webmail-aux (concat (car webmail-open-url) (match-string 1)))
702    (webmail-error "open@1")))
703
704(defun webmail-netaddress-login ()
705  (webmail-refresh-redirect)
706  (goto-char (point-min))
707  (if (re-search-forward  "tpl/[^/]+/\\([^/]+\\)" nil t)
708      (setq webmail-session (match-string 1))
709    (webmail-error "login@1")))
710
711(defun webmail-netaddress-list ()
712  (webmail-refresh-redirect)
713  (let (item id)
714    (goto-char (point-min))
715    (when (re-search-forward
716	   "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
717      (message "Found %s mail(s), %s unread"
718	       (match-string 2) (match-string 1)))
719    (goto-char (point-min))
720    (while (re-search-forward
721	    "MR\\[i\\]\\.R='\\([^']*\\)'\\|MR\\[i\\]\\.Q='\\([^']+\\)'" nil t)
722      (if (setq id (match-string 2))
723	  (setq item
724		(cons id
725		      (format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
726			      (car webmail-article-url)
727			      webmail-session id)))
728	(if (or (not webmail-newmail-only)
729		(equal (match-string 1) "True"))
730	    (push item webmail-articles))))
731    (setq webmail-articles (nreverse webmail-articles))))
732
733(defun webmail-netaddress-single-part ()
734  (goto-char (point-min))
735  (cond
736   ((looking-at "[\t\040\r\n]*<font face=[^>]+>[\t\040\r\n]*")
737    ;; text/plain
738    (replace-match "")
739    (while (re-search-forward "[\t\040\r\n]+" nil t)
740      (replace-match " "))
741    (goto-char (point-min))
742    (while (re-search-forward "<br>" nil t)
743      (replace-match "\n"))
744    (mm-url-remove-markup)
745    (mm-url-decode-entities-nbsp)
746    nil)
747   (t
748    (insert "<#part type=\"text/html\" disposition=inline>")
749    (goto-char (point-max))
750    (insert "<#/part>")
751    t)))
752
753(defun webmail-netaddress-article (file id)
754  (webmail-refresh-redirect)
755  (let (p p1 attachment count mime type)
756    (save-restriction
757      (webmail-encode-8bit)
758      (goto-char (point-min))
759      (if (not (search-forward "Trash" nil t))
760	  (webmail-error "article@1"))
761      (if (not (search-forward "<form>" nil t))
762	  (webmail-error "article@2"))
763      (delete-region (point-min) (match-beginning 0))
764      (if (not (search-forward "</form>" nil t))
765	  (webmail-error "article@3"))
766      (narrow-to-region (point-min) (match-end 0))
767      (goto-char (point-min))
768      (while (re-search-forward "[\040\t\r\n]+" nil t)
769	(replace-match " "))
770      (goto-char (point-min))
771      (while (search-forward "<b>" nil t)
772	(replace-match "\n"))
773      (mm-url-remove-markup)
774      (mm-url-decode-entities-nbsp)
775      (goto-char (point-min))
776      (delete-blank-lines)
777      (goto-char (point-min))
778      (while (re-search-forward "^\040+\\|\040+$" nil t)
779	(replace-match ""))
780      (goto-char (point-min))
781      (while (re-search-forward "\040+" nil t)
782	(replace-match " "))
783      (goto-char (point-max))
784      (widen)
785      (insert "\n\n")
786      (setq p (point))
787      (unless (search-forward "<!-- Data -->" nil t)
788	(webmail-error "article@4"))
789      (forward-line 14)
790      (delete-region p (point))
791      (goto-char (point-max))
792      (unless (re-search-backward
793	       "[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t)
794	(webmail-error "article@5"))
795      (delete-region (point) (point-max))
796      (goto-char p)
797      (while (search-forward
798	      "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
799	      nil t 2)
800	(setq mime t)
801	(unless (search-forward "</TABLE>" nil t)
802	  (webmail-error "article@6"))
803	(setq p1 (point))
804	(if (search-backward "<IMG " p t)
805	    (progn
806	      (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
807		(webmail-error "article@7"))
808	      (setq attachment (match-string 1))
809	      (setq type (match-string 2))
810	      (unless (search-forward "</TABLE>" nil t)
811		(webmail-error "article@8"))
812	      (delete-region p (point))
813	      (let (bufname);; Attachment
814		(save-excursion
815		  (set-buffer (generate-new-buffer " *webmail-att*"))
816		  (mm-url-insert (concat (car webmail-open-url) attachment))
817		  (push (current-buffer) webmail-buffer-list)
818		  (setq bufname (buffer-name)))
819		(insert "<#part type=" type)
820		(insert " buffer=\"" bufname "\"")
821		(insert " disposition=\"inline\"")
822		(insert "><#/part>\n")
823		(setq p (point))))
824	  (delete-region p p1)
825	  (narrow-to-region
826	   p
827	   (if (search-forward
828		"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
829		nil t)
830	       (match-beginning 0)
831	     (point-max)))
832	  (webmail-netaddress-single-part)
833	  (goto-char (point-max))
834	  (setq p (point))
835	  (widen)))
836      (unless mime
837	(narrow-to-region p (point-max))
838	(setq mime (webmail-netaddress-single-part))
839	(widen))
840      (goto-char (point-min))
841      ;; Some blank line to seperate mails.
842      (insert "\n\nFrom nobody " (current-time-string) "\n")
843      (insert "X-Gnus-Webmail: " (symbol-value 'user)
844	      "@" (symbol-name webmail-type) "\n")
845      (if id
846	  (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
847      (unless (looking-at "$")
848	(if (search-forward "\n\n" nil t)
849	    (forward-line -1)
850	  (webmail-error "article@2")))
851      (when mime
852	(narrow-to-region (point-min) (point))
853	(goto-char (point-min))
854	(while (not (eobp))
855	  (if (looking-at "MIME-Version\\|Content-Type")
856	      (delete-region (point)
857			     (progn
858			       (forward-line 1)
859			       (if (re-search-forward "^[^ \t]" nil t)
860				   (goto-char (match-beginning 0))
861				 (point-max))))
862	    (forward-line 1)))
863	(goto-char (point-max))
864	(widen)
865	(narrow-to-region (point) (point-max))
866	(insert "MIME-Version: 1.0\n"
867		(prog1
868		    (mml-generate-mime)
869		  (delete-region (point-min) (point-max))))
870	(goto-char (point-min))
871	(widen))
872      (let (case-fold-search)
873	(while (re-search-forward "^From " nil t)
874	  (beginning-of-line)
875	  (insert ">"))))
876    (mm-append-to-file (point-min) (point-max) file)))
877
878(defun webmail-netscape-article (file id)
879  (let (p p1 attachment count mime type)
880    (save-restriction
881      (webmail-encode-8bit)
882      (goto-char (point-min))
883      (if (not (search-forward "Trash" nil t))
884	  (webmail-error "article@1"))
885      (if (not (search-forward "<form>" nil t))
886	  (webmail-error "article@2"))
887      (delete-region (point-min) (match-beginning 0))
888      (if (not (search-forward "</form>" nil t))
889	  (webmail-error "article@3"))
890      (narrow-to-region (point-min) (match-end 0))
891      (goto-char (point-min))
892      (while (re-search-forward "[\040\t\r\n]+" nil t)
893	(replace-match " "))
894      (goto-char (point-min))
895      (while (re-search-forward "<a href=[^>]*>[^<]*</a>" nil t)
896	(replace-match ""))
897      (goto-char (point-min))
898      (while (search-forward "<b>" nil t)
899	(replace-match "\n"))
900      (mm-url-remove-markup)
901      (mm-url-decode-entities-nbsp)
902      (goto-char (point-min))
903      (delete-blank-lines)
904      (goto-char (point-min))
905      (while (re-search-forward "^\040+\\|\040+$" nil t)
906	(replace-match ""))
907      (goto-char (point-min))
908      (while (re-search-forward "\040+" nil t)
909	(replace-match " "))
910      (goto-char (point-max))
911      (widen)
912      (insert "\n\n")
913      (setq p (point))
914      (unless (search-forward "<!-- Data -->" nil t)
915	(webmail-error "article@4"))
916      (forward-line 14)
917      (delete-region p (point))
918      (goto-char (point-max))
919      (unless (re-search-backward
920	       "<form name=\"Transfer2\"" p t)
921	(webmail-error "article@5"))
922      (delete-region (point) (point-max))
923      (goto-char p)
924      (while (search-forward
925	      "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
926	      nil t 2)
927	(setq mime t)
928	(unless (search-forward "</TABLE>" nil t)
929	  (webmail-error "article@6"))
930	(setq p1 (point))
931	(if (search-backward "<IMG " p t)
932	    (progn
933	      (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
934		(webmail-error "article@7"))
935	      (setq attachment (match-string 1))
936	      (setq type (match-string 2))
937	      (unless (search-forward "</TABLE>" nil t)
938		(webmail-error "article@8"))
939	      (delete-region p (point))
940	      (let (bufname);; Attachment
941		(save-excursion
942		  (set-buffer (generate-new-buffer " *webmail-att*"))
943		  (mm-url-insert (concat (car webmail-open-url) attachment))
944		  (push (current-buffer) webmail-buffer-list)
945		  (setq bufname (buffer-name)))
946		(insert "<#part type=" type)
947		(insert " buffer=\"" bufname "\"")
948		(insert " disposition=\"inline\"")
949		(insert "><#/part>\n")
950		(setq p (point))))
951	  (delete-region p p1)
952	  (narrow-to-region
953	   p
954	   (if (search-forward
955		"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
956		nil t)
957	       (match-beginning 0)
958	     (point-max)))
959	  (webmail-netaddress-single-part)
960	  (goto-char (point-max))
961	  (setq p (point))
962	  (widen)))
963      (unless mime
964	(narrow-to-region p (point-max))
965	(setq mime (webmail-netaddress-single-part))
966	(widen))
967      (goto-char (point-min))
968      ;; Some blank line to seperate mails.
969      (insert "\n\nFrom nobody " (current-time-string) "\n")
970      (insert "X-Gnus-Webmail: " (symbol-value 'user)
971	      "@" (symbol-name webmail-type) "\n")
972      (if id
973	  (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
974      (unless (looking-at "$")
975	(if (search-forward "\n\n" nil t)
976	    (forward-line -1)
977	  (webmail-error "article@2")))
978      (when mime
979	(narrow-to-region (point-min) (point))
980	(goto-char (point-min))
981	(while (not (eobp))
982	  (if (looking-at "MIME-Version\\|Content-Type")
983	      (delete-region (point)
984			     (progn
985			       (forward-line 1)
986			       (if (re-search-forward "^[^ \t]" nil t)
987				   (goto-char (match-beginning 0))
988				 (point-max))))
989	    (forward-line 1)))
990	(goto-char (point-max))
991	(widen)
992	(narrow-to-region (point) (point-max))
993	(insert "MIME-Version: 1.0\n"
994		(prog1
995		    (mml-generate-mime)
996		  (delete-region (point-min) (point-max))))
997	(goto-char (point-min))
998	(widen))
999      (let (case-fold-search)
1000	(while (re-search-forward "^From " nil t)
1001	  (beginning-of-line)
1002	  (insert ">"))))
1003    (mm-append-to-file (point-min) (point-max) file)))
1004
1005;;; my-deja
1006
1007(defun webmail-my-deja-open ()
1008  (webmail-refresh-redirect)
1009  (goto-char (point-min))
1010  (if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\""
1011			 nil t)
1012      (setq webmail-aux (match-string 1))
1013    (webmail-error "open@1")))
1014
1015(defun webmail-my-deja-list ()
1016  (let (item id newp base)
1017    (goto-char (point-min))
1018    (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
1019			     nil t)
1020      (let ((url (match-string 1)))
1021	(setq base (match-string 2))
1022	(erase-buffer)
1023	(mm-url-insert url)))
1024    (goto-char (point-min))
1025    (when (re-search-forward
1026	   "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
1027	   nil t)
1028      (message "Found %s mail(s), %s unread"
1029	       (match-string 1) (match-string 2)))
1030    (goto-char (point-min))
1031    (while (re-search-forward
1032	    "newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
1033	    nil t)
1034      (if (setq id (match-string 2))
1035	  (when (and (or newp (not webmail-newmail-only))
1036		     (not (assoc id webmail-articles)))
1037	    (push (cons id (setq webmail-aux
1038				 (concat base "/" (match-string 1))))
1039		  webmail-articles)
1040	    (setq newp nil))
1041	(setq newp t)))
1042    (setq webmail-articles (nreverse webmail-articles))))
1043
1044(defun webmail-my-deja-article-part (base)
1045  (let (p)
1046    (cond
1047     ((looking-at "[\t\040\r\n]*<!--[^>]*>")
1048      (replace-match ""))
1049     ((looking-at "[\t\040\r\n]*</PRE>")
1050      (replace-match ""))
1051     ((looking-at "[\t\040\r\n]*<PRE>")
1052      ;; text/plain
1053      (replace-match "")
1054      (save-restriction
1055	(narrow-to-region (point)
1056			  (if (re-search-forward "</?PRE>" nil t)
1057			      (match-beginning 0)
1058			    (point-max)))
1059	(goto-char (point-min))
1060	(mm-url-remove-markup)
1061	(mm-url-decode-entities-nbsp)
1062	(goto-char (point-max))))
1063     ((looking-at "[\t\040\r\n]*<TABLE")
1064      (save-restriction
1065	(narrow-to-region (point)
1066			  (if (search-forward "</TABLE>" nil t 2)
1067			      (point)
1068			    (point-max)))
1069	(goto-char (point-min))
1070	(let (name type url bufname)
1071	  (if (and (search-forward "File Name:" nil t)
1072		   (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
1073	      (setq name (match-string 1)))
1074	  (if (and (search-forward "File Type:" nil t)
1075		   (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
1076	      (setq type (match-string 1)))
1077	  (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
1078				     nil t)
1079	    (webmail-error "article@5"))
1080	  (setq url (concat base "/getattach.cgi/" (match-string 1)
1081			    "?sm=Download"))
1082	  (while (re-search-forward
1083		  "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
1084		  nil t)
1085	    (setq url (concat url "&" (match-string 1) "="
1086				  (match-string 2))))
1087	  (delete-region (point-min) (point-max))
1088	  (save-excursion
1089	    (set-buffer (generate-new-buffer " *webmail-att*"))
1090	    (mm-url-insert url)
1091	    (push (current-buffer) webmail-buffer-list)
1092	    (setq bufname (buffer-name)))
1093	  (insert "<#part type=\"" type "\"")
1094	  (if name (insert " filename=\"" name "\""))
1095	  (insert " buffer=\"" bufname "\"")
1096	  (insert " disposition=inline><#/part>"))))
1097     (t
1098      (insert "<#part type=\"text/html\" disposition=inline>")
1099      (goto-char (point-max))
1100      (insert "<#/part>")))))
1101
1102(defun webmail-my-deja-article (file id)
1103  (let (base)
1104    (goto-char (point-min))
1105    (unless (string-match "\\([^\"]+\\)/mail" webmail-aux)
1106      (webmail-error "article@0"))
1107    (setq base (match-string 1 webmail-aux))
1108    (when (re-search-forward
1109	   "href=\"[^\"]*\\(mailnf\\.[^\"]+act=move[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
1110	   nil t)
1111      (setq webmail-aux (concat base "/" (match-string 1)))
1112      (string-match "mid=[^\"&]+" webmail-aux)
1113      (setq webmail-aux (replace-match "mid=%s" nil nil webmail-aux)))
1114    (unless (search-forward "<HR noshade>" nil t)
1115      (webmail-error "article@1"))
1116    (delete-region (point-min) (point))
1117    (unless (search-forward "<HR noshade>" nil t)
1118      (webmail-error "article@2"))
1119    (save-restriction
1120      (narrow-to-region (point-min) (point))
1121      (while (search-forward "\r\n" nil t)
1122	(replace-match "\n"))
1123      (mm-url-remove-markup)
1124      (mm-url-decode-entities-nbsp)
1125      (goto-char (point-min))
1126      (while (re-search-forward "\n\n+" nil t)
1127	(replace-match "\n"))
1128      (goto-char (point-max)))
1129    (save-restriction
1130      (narrow-to-region (point) (point-max))
1131      (goto-char (point-max))
1132      (unless (search-backward "<HR noshade>" nil t)
1133	(webmail-error "article@3"))
1134      (unless (search-backward "</TT>" nil t)
1135	(webmail-error "article@4"))
1136      (delete-region (point) (point-max))
1137      (goto-char (point-min))
1138      (while (not (eobp))
1139	(webmail-my-deja-article-part base))
1140      (insert "MIME-Version: 1.0\n"
1141	      (prog1
1142		  (mml-generate-mime)
1143		(delete-region (point-min) (point-max)))))
1144    (goto-char (point-min))
1145    (insert "\n\nFrom nobody " (current-time-string) "\n")
1146    (insert "X-Gnus-Webmail: " (symbol-value 'user)
1147	    "@" (symbol-name webmail-type) "\n")
1148    (if (eq (char-after) ?\n)
1149	(delete-char 1))
1150    (mm-append-to-file (point-min) (point-max) file)))
1151
1152(provide 'webmail)
1153
1154;;; arch-tag: f75a4558-a8f6-46ec-b1c3-7a6434b3dd71
1155;;; webmail.el ends here
1156