Mercurial > emacs

comparison lisp/gnus/webmail.el @ 32979:ddc33cf6b78c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
2000-10-27 ShengHuo ZHU <zsh@cs.rochester.edu> * webmail.el (webmail-type-definition): Fix my-deja open url. (webmail-hotmail-list): Fix. (webmail-netscape-open, webmail-hotmail-article, webmail-hotmail-list): Update. (webmail-my-deja-*): Rewrite.
author Dave Love <fx@gnu.org>
date Fri, 27 Oct 2000 18:58:55 +0000
parents 6b20b7e85e3c
children 53eebdb81828
comparison
equal deleted inserted replaced
32978:ca33eb68d9da 32979:ddc33cf6b78c
127 (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") 127 (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")
128 (open-snarf . webmail-netscape-open) 128 (open-snarf . webmail-netscape-open)
129 (login-url 129 (login-url
130 content 130 content
131 ("http://ureg.netscape.com/iiop/UReg2/login/loginform") 131 ("http://ureg.netscape.com/iiop/UReg2/login/loginform")
132 "%s&U2_USERNAME=%s&U2_PASSWORD=%s" 132 "U2_USERNAME=%s&U2_PASSWORD=%s%s"
133 webmail-aux user password) 133 user password webmail-aux)
134 (login-snarf . webmail-netaddress-login) 134 (login-snarf . webmail-netaddress-login)
135 (list-url 135 (list-url
136 "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True" 136 "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
137 webmail-session) 137 webmail-session)
138 (list-snarf . webmail-netaddress-list) 138 (list-snarf . webmail-netaddress-list)
142 "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" 142 "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
143 webmail-session id)) 143 webmail-session id))
144 (my-deja 144 (my-deja
145 (paranoid cookie post) 145 (paranoid cookie post)
146 (address . "www.my-deja.com") 146 (address . "www.my-deja.com")
147 (open-url "http://www.my-deja.com/") 147 (open-url "http://www.deja.com/my/pr.xp")
148 (open-snarf . webmail-my-deja-open) 148 (open-snarf . webmail-my-deja-open)
149 (login-url 149 (login-url
150 content 150 content
151 ("%s" webmail-aux) 151 ("%s" webmail-aux)
152 "member_name=%s&pw=%s&go=&priv_opt_MyDeja99=" 152 "member_name=%s&pw=%s&go=&priv_opt_MyDeja99="
153 user password) 153 user password)
154 (list-url "http://www.deja.com/rg_gotomail.xp") 154 (list-url "http://www.deja.com/rg_gotomail.xp")
155 (list-snarf . webmail-my-deja-list) 155 (list-snarf . webmail-my-deja-list)
156 (article-snarf . webmail-my-deja-article) 156 (article-snarf . webmail-my-deja-article)
157 (trash-url 157 (trash-url webmail-aux id))))
158 "%s/gmm_multiplex.femail?%%2Fgmm_domovemesg_top.femail=Move+to%%3A&folder_top=%s%%3Azzz%%3A%%7E6trash%%3AF%%3A0&docid=%s"
159 webmail-aux user id))))
160 158
161 (defvar webmail-variables 159 (defvar webmail-variables
162 '(address article-snarf article-url list-snarf list-url 160 '(address article-snarf article-url list-snarf list-url
163 login-url login-snarf open-url open-snarf site articles 161 login-url login-snarf open-url open-snarf site articles
164 post-process paranoid trash-url)) 162 post-process paranoid trash-url))
213 (append-to-file (point-min) (point-max) webmail-debug-file))) 211 (append-to-file (point-min) (point-max) webmail-debug-file)))
214 212
215 (defun webmail-error (str) 213 (defun webmail-error (str)
216 (if webmail-error-function 214 (if webmail-error-function
217 (funcall webmail-error-function str)) 215 (funcall webmail-error-function str))
218 (message "%s HTML has changed; please get a new version of webmail (%s)" 216 (message "%s HTML has changed or your w3 package is too old.(%s)"
219 webmail-type str) 217 webmail-type str)
220 (error "%s HTML has changed; please get a new version of webmail (%s)" 218 (error "%s HTML has changed or your w3 package is too old.(%s)"
221 webmail-type str)) 219 webmail-type str))
222 220
223 (defun webmail-setdefault (type) 221 (defun webmail-setdefault (type)
224 (let ((type-def (cdr (assq type webmail-type-definition))) 222 (let ((type-def (cdr (assq type webmail-type-definition)))
225 (vars webmail-variables) 223 (vars webmail-variables)
282 (defun webmail-init () 280 (defun webmail-init ()
283 "Initialize buffers and such." 281 "Initialize buffers and such."
284 (if (gnus-buffer-live-p webmail-buffer) 282 (if (gnus-buffer-live-p webmail-buffer)
285 (set-buffer webmail-buffer) 283 (set-buffer webmail-buffer)
286 (setq webmail-buffer 284 (setq webmail-buffer
287 (mm-with-unibyte 285 (nnheader-set-temp-buffer " *webmail*"))
288 (nnheader-set-temp-buffer " *webmail*"))))) 286 (mm-disable-multibyte)))
289 287
290 (defvar url-package-name) 288 (defvar url-package-name)
291 (defvar url-package-version) 289 (defvar url-package-version)
292 (defvar url-cookie-multiple-line) 290 (defvar url-cookie-multiple-line)
293 (defvar url-confirmation-func) 291 (defvar url-confirmation-func)
410 "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t) 408 "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t)
411 (setq webmail-aux (concat "http://" site (match-string 1))) 409 (setq webmail-aux (concat "http://" site (match-string 1)))
412 (webmail-error "login@2")))) 410 (webmail-error "login@2"))))
413 411
414 (defun webmail-hotmail-list () 412 (defun webmail-hotmail-list ()
415 (let (site url newp) 413 (goto-char (point-min))
416 (goto-char (point-min)) 414 (skip-chars-forward " \t\n\r")
417 (if (re-search-forward "[0-9]+ new" nil t) 415 (let (site url newp (total "0"))
418 (message "Found %s" (match-string 0)) 416 (if (eobp)
419 (webmail-error "maybe your w3 version is too old")) 417 (setq total "0")
420 (goto-char (point-min)) 418 (if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
421 (if (re-search-forward 419 (message "Found %s (%s new)" (setq total (match-string 1))
420 (match-string 2))
421 (if (re-search-forward "\\([0-9]+\\) new" nil t)
422 (message "Found %s new" (setq total (match-string 1)))
423 (webmail-error "list@0"))))
424 (unless (equal total "0")
425 (goto-char (point-min))
426 (if (re-search-forward
422 "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t) 427 "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
423 (setq site (match-string 1)) 428 (setq site (match-string 1))
424 (webmail-error "list@1")) 429 (webmail-error "list@1"))
425 (goto-char (point-min)) 430 (goto-char (point-min))
426 (if (re-search-forward "disk=\\([^&]+\\)&" nil t) 431 (if (re-search-forward "disk=\\([^&]*\\)&" nil t)
427 (setq webmail-aux 432 (setq webmail-aux
428 (concat "http://" site "/cgi-bin/HoTMaiL?disk=" 433 (concat "http://" site "/cgi-bin/HoTMaiL?disk="
429 (match-string 1))) 434 (match-string 1)))
430 (webmail-error "list@2")) 435 (webmail-error "list@2"))
431 (goto-char (point-max)) 436 (goto-char (point-max))
432 (while (re-search-backward 437 (while (re-search-backward
433 "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\"" 438 "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\""
434 nil t) 439 nil t)
435 (if (setq url (match-string 1)) 440 (if (setq url (match-string 1))
436 (progn 441 (progn
437 (if (or newp (not webmail-newmail-only)) 442 (if (or newp (not webmail-newmail-only))
438 (let (id) 443 (let (id)
439 (if (string-match "msg=\\([^&]+\\)" url) 444 (if (string-match "msg=\\([^&]+\\)" url)
440 (setq id (match-string 1 url))) 445 (setq id (match-string 1 url)))
441 (push (cons id (concat "http://" site url "&raw=0")) 446 (push (cons id (concat "http://" site url "&raw=0"))
442 webmail-articles))) 447 webmail-articles)))
443 (setq newp nil)) 448 (setq newp nil))
444 (setq newp t))))) 449 (setq newp t))))))
445 450
446 ;; Thank victor@idaccr.org (Victor S. Miller) for raw=0 451 ;; Thank victor@idaccr.org (Victor S. Miller) for raw=0
447 452
448 (defun webmail-hotmail-article (file id) 453 (defun webmail-hotmail-article (file id)
449 (goto-char (point-min)) 454 (goto-char (point-min))
450 (if (not (search-forward "<pre>" nil t)) 455 (skip-chars-forward " \t\n\r")
451 (webmail-error "article@3")) 456 (unless (eobp)
452 (skip-chars-forward "\n\r\t ") 457 (if (not (search-forward "<pre>" nil t))
453 (delete-region (point-min) (point)) 458 (webmail-error "article@3"))
454 (if (not (search-forward "</pre>" nil t)) 459 (skip-chars-forward "\n\r\t ")
455 (webmail-error "article@3.1")) 460 (delete-region (point-min) (point))
456 (delete-region (match-beginning 0) (point-max)) 461 (if (not (search-forward "</pre>" nil t))
457 (nnweb-remove-markup) 462 (webmail-error "article@3.1"))
458 (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) 463 (delete-region (match-beginning 0) (point-max))
459 (nnweb-decode-entities)) 464 (nnweb-remove-markup)
460 (goto-char (point-min)) 465 (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
461 (while (re-search-forward "\r\n?" nil t) 466 (nnweb-decode-entities))
462 (replace-match "\n")) 467 (goto-char (point-min))
463 (goto-char (point-min)) 468 (while (re-search-forward "\r\n?" nil t)
464 (insert "\n\n") 469 (replace-match "\n"))
465 (if (not (looking-at "\n*From ")) 470 (goto-char (point-min))
466 (insert "From nobody " (current-time-string) "\n") 471 (insert "\n\n")
467 (forward-line)) 472 (if (not (looking-at "\n*From "))
468 (insert "X-Gnus-Webmail: " (symbol-value 'user) 473 (insert "From nobody " (current-time-string) "\n")
469 "@" (symbol-name webmail-type) "\n") 474 (forward-line))
470 (mm-append-to-file (point-min) (point-max) file)) 475 (insert "X-Gnus-Webmail: " (symbol-value 'user)
476 "@" (symbol-name webmail-type) "\n")
477 (mm-append-to-file (point-min) (point-max) file)))
471 478
472 (defun webmail-hotmail-article-old (file id) 479 (defun webmail-hotmail-article-old (file id)
473 (let (p attachment count mime hotmail-direct) 480 (let (p attachment count mime hotmail-direct)
474 (save-restriction 481 (save-restriction
475 (webmail-encode-8bit) 482 (webmail-encode-8bit)
714 721
715 ;;; netaddress 722 ;;; netaddress
716 723
717 (defun webmail-netscape-open () 724 (defun webmail-netscape-open ()
718 (goto-char (point-min)) 725 (goto-char (point-min))
719 (if (re-search-forward "login/hint\\?\\([^\"]+\\)\"" nil t) 726 (setq webmail-aux "")
720 (setq webmail-aux (match-string 1)) 727 (while (re-search-forward
721 (webmail-error "open@1"))) 728 "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
729 nil t)
730 (setq webmail-aux (concat webmail-aux "&" (match-string 1) "="
731 (match-string 2)))))
722 732
723 (defun webmail-netaddress-open () 733 (defun webmail-netaddress-open ()
724 (goto-char (point-min)) 734 (goto-char (point-min))
725 (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t) 735 (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
726 (setq webmail-aux (concat (car webmail-open-url) (match-string 1))) 736 (setq webmail-aux (concat (car webmail-open-url) (match-string 1)))
1039 nil t) 1049 nil t)
1040 (setq webmail-aux (match-string 1)) 1050 (setq webmail-aux (match-string 1))
1041 (webmail-error "open@1"))) 1051 (webmail-error "open@1")))
1042 1052
1043 (defun webmail-my-deja-list () 1053 (defun webmail-my-deja-list ()
1044 (let (item id newp) 1054 (let (item id newp base)
1055 (goto-char (point-min))
1056 (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
1057 nil t)
1058 (let ((url (match-string 1)))
1059 (setq base (match-string 2))
1060 (erase-buffer)
1061 (nnweb-insert url)))
1045 (goto-char (point-min)) 1062 (goto-char (point-min))
1046 (when (re-search-forward 1063 (when (re-search-forward
1047 "(\\([0-9]+\\) message(s), \\([0-9]+\\) new, \\([0-9]+\\)&nbsp;k )" 1064 "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
1048 nil t) 1065 nil t)
1049 (message "Found %s mail(s), %s unread, total size %s K" 1066 (message "Found %s mail(s), %s unread"
1050 (match-string 1) (match-string 2) (match-string 3))) 1067 (match-string 1) (match-string 2)))
1051 (goto-char (point-min)) 1068 (goto-char (point-min))
1052 (while (re-search-forward 1069 (while (re-search-forward
1053 "&#149; &nbsp;&nbsp;\\|\\(http:[^\"]+\\)/display_seemesg\\.femail\\?docid=\\([^&\"]+\\)" 1070 "newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
1054 nil t) 1071 nil t)
1055 (if (setq id (match-string 2)) 1072 (if (setq id (match-string 2))
1056 (when (or newp (not webmail-newmail-only)) 1073 (when (and (or newp (not webmail-newmail-only))
1057 (push 1074 (not (assoc id webmail-articles)))
1058 (cons id (format "%s/gmm_multiplex.femail?docid=%s&femail_page_name=display_page&bool_next_on_disp_pg=true&bool_prev_on_disp_pg=false&display_all_headers=false&%%2Fgmm_save.femail=Download&femail_page_name=display_page&bool_next_on_disp_pg=true&bool_prev_on_disp_pg=false&display_all_headers=false" 1075 (push (cons id (setq webmail-aux
1059 (match-string 1) id)) 1076 (concat base "/" (match-string 1))))
1060 webmail-articles) 1077 webmail-articles)
1061 (setq webmail-aux (match-string 1))
1062 (setq newp nil)) 1078 (setq newp nil))
1063 (setq newp t))) 1079 (setq newp t)))
1064 (setq webmail-articles (nreverse webmail-articles)))) 1080 (setq webmail-articles (nreverse webmail-articles))))
1065 1081
1082 (defun webmail-my-deja-article-part (base)
1083 (let (p)
1084 (cond
1085 ((looking-at "[\t\040\r\n]*<!--[^>]*>")
1086 (replace-match ""))
1087 ((looking-at "[\t\040\r\n]*</PRE>")
1088 (replace-match ""))
1089 ((looking-at "[\t\040\r\n]*<PRE>")
1090 ;; text/plain
1091 (replace-match "")
1092 (save-restriction
1093 (narrow-to-region (point)
1094 (if (re-search-forward "</?PRE>" nil t)
1095 (match-beginning 0)
1096 (point-max)))
1097 (goto-char (point-min))
1098 (nnweb-remove-markup)
1099 (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
1100 (nnweb-decode-entities))
1101 (goto-char (point-max))))
1102 ((looking-at "[\t\040\r\n]*<TABLE")
1103 (save-restriction
1104 (narrow-to-region (point)
1105 (if (search-forward "</TABLE>" nil t 2)
1106 (point)
1107 (point-max)))
1108 (goto-char (point-min))
1109 (let (name type url bufname)
1110 (if (and (search-forward "File Name:" nil t)
1111 (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
1112 (setq name (match-string 1)))
1113 (if (and (search-forward "File Type:" nil t)
1114 (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
1115 (setq type (match-string 1)))
1116 (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
1117 nil t)
1118 (webmail-error "article@5"))
1119 (setq url (concat base "/getattach.cgi/" (match-string 1)
1120 "?sm=Download"))
1121 (while (re-search-forward
1122 "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
1123 nil t)
1124 (setq url (concat url "&" (match-string 1) "="
1125 (match-string 2))))
1126 (delete-region (point-min) (point-max))
1127 (save-excursion
1128 (set-buffer (generate-new-buffer " *webmail-att*"))
1129 (nnweb-insert url)
1130 (push (current-buffer) webmail-buffer-list)
1131 (setq bufname (buffer-name)))
1132 (insert "<#part type=\"" type "\"")
1133 (if name (insert " filename=\"" name "\""))
1134 (insert " buffer=\"" bufname "\"")
1135 (insert " disposition=inline><#/part>"))))
1136 (t
1137 (insert "<#part type=\"text/html\" disposition=inline>")
1138 (goto-char (point-max))
1139 (insert "<#/part>")))))
1140
1066 (defun webmail-my-deja-article (file id) 1141 (defun webmail-my-deja-article (file id)
1067 (let (url) 1142 (let (base)
1068 (goto-char (point-min)) 1143 (goto-char (point-min))
1069 (unless (re-search-forward "\\(http:[^\"]+/attachment/entire_message.txt[^\"]+\\)" nil t) 1144 (unless (string-match "\\([^\"]+\\)/mail" webmail-aux)
1145 (webmail-error "article@0"))
1146 (setq base (match-string 1 webmail-aux))
1147 (when (re-search-forward
1148 "href=\"[^\"]*\\(mailnf\\.[^\"]+act=move[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
1149 nil t)
1150 (setq webmail-aux (concat base "/" (match-string 1)))
1151 (string-match "mid=[^\"&]+" webmail-aux)
1152 (setq webmail-aux (replace-match "mid=%s" nil nil webmail-aux)))
1153 (unless (search-forward "<HR noshade>" nil t)
1070 (webmail-error "article@1")) 1154 (webmail-error "article@1"))
1071 (setq url (match-string 1)) 1155 (delete-region (point-min) (point))
1072 (erase-buffer) 1156 (unless (search-forward "<HR noshade>" nil t)
1073 (mm-with-unibyte-current-buffer 1157 (webmail-error "article@2"))
1074 (nnweb-insert url)) 1158 (save-restriction
1075 (goto-char (point-min)) 1159 (narrow-to-region (point-min) (point))
1076 (while (search-forward "\r\n" nil t) 1160 (while (search-forward "\r\n" nil t)
1077 (replace-match "\n")) 1161 (replace-match "\n"))
1162 (nnweb-remove-markup)
1163 (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
1164 (nnweb-decode-entities))
1165 (goto-char (point-min))
1166 (while (re-search-forward "\n\n+" nil t)
1167 (replace-match "\n"))
1168 (goto-char (point-max)))
1169 (save-restriction
1170 (narrow-to-region (point) (point-max))
1171 (goto-char (point-max))
1172 (unless (search-backward "<HR noshade>" nil t)
1173 (webmail-error "article@3"))
1174 (unless (search-backward "</TT>" nil t)
1175 (webmail-error "article@4"))
1176 (delete-region (point) (point-max))
1177 (goto-char (point-min))
1178 (while (not (eobp))
1179 (webmail-my-deja-article-part base))
1180 (insert "MIME-Version: 1.0\n"
1181 (prog1
1182 (mml-generate-mime)
1183 (delete-region (point-min) (point-max)))))
1078 (goto-char (point-min)) 1184 (goto-char (point-min))
1079 (insert "\n\nFrom nobody " (current-time-string) "\n") 1185 (insert "\n\nFrom nobody " (current-time-string) "\n")
1080 (insert "X-Gnus-Webmail: " (symbol-value 'user) 1186 (insert "X-Gnus-Webmail: " (symbol-value 'user)
1081 "@" (symbol-name webmail-type) "\n") 1187 "@" (symbol-name webmail-type) "\n")
1188 (if (eq (char-after) ?\n)
1189 (delete-char 1))
1082 (mm-append-to-file (point-min) (point-max) file))) 1190 (mm-append-to-file (point-min) (point-max) file)))
1083 1191
1084 (provide 'webmail) 1192 (provide 'webmail)
1085 1193
1086 ;;; webmail.el ends here 1194 ;;; webmail.el ends here