diff options
Diffstat (limited to 'japanese/navi2ch-emacs20/files/patch-myanmar')
| -rw-r--r-- | japanese/navi2ch-emacs20/files/patch-myanmar | 251 |
1 files changed, 186 insertions, 65 deletions
diff --git a/japanese/navi2ch-emacs20/files/patch-myanmar b/japanese/navi2ch-emacs20/files/patch-myanmar index 6469fb85dd22..91790a206263 100644 --- a/japanese/navi2ch-emacs20/files/patch-myanmar +++ b/japanese/navi2ch-emacs20/files/patch-myanmar @@ -1,50 +1,68 @@ ---- navi2ch-board.el.orig Sun May 2 23:41:51 2004 -+++ navi2ch-board.el Sun Aug 28 22:56:08 2005 -@@ -531,6 +531,15 @@ - (navi2ch-load-info - (navi2ch-board-get-file-name board "spid.txt"))) - -+(defun navi2ch-board-save-cookies (board cookies) -+ (navi2ch-save-info -+ (navi2ch-board-get-file-name board "cookies.txt") -+ cookies)) -+ -+(defun navi2ch-board-load-cookies (board) -+ (navi2ch-load-info -+ (navi2ch-board-get-file-name board "cookies.txt"))) -+ - (defun navi2ch-board-select-view-range () - (interactive) - (setq-default navi2ch-article-view-range --- navi2ch-multibbs.el.orig Sun Sep 12 12:55:25 2004 -+++ navi2ch-multibbs.el Sun Aug 28 22:56:08 2005 -@@ -243,13 +243,13 @@ ++++ navi2ch-multibbs.el Sun Jun 4 23:09:29 2006 +@@ -242,14 +242,8 @@ + (defun navi2ch-multibbs-send-message-retry-confirm (board) (let ((func (or (navi2ch-fboundp navi2ch-multibbs-send-message-retry-confirm-function) - #'yes-or-no-p)) +- #'yes-or-no-p)) - spid) -+ cookies) - (unwind-protect - (let ((result (funcall func "Retry? "))) - (when result +- (unwind-protect +- (let ((result (funcall func "Retry? "))) +- (when result - (setq spid (navi2ch-board-load-spid board))) -+ (setq cookies (navi2ch-board-load-cookies board))) - result) +- result) - (navi2ch-board-save-spid board spid)))) -+ (navi2ch-board-save-cookies board cookies)))) ++ #'yes-or-no-p))) ++ (funcall func "Retry? "))) (defun navi2ch-multibbs-send-message (from mail message subject board article) -@@ -413,7 +413,7 @@ - (from mail message subject bbs key time board article) +@@ -279,10 +273,12 @@ + navi2ch-net-http-proxy-password)) + (tries 2) ; $BAw?.;n9T$N:GBg2s?t(B + (message-str "send message...") +- (result 'retry)) ++ (result 'retry) ++ (case-fold-search nil) ++ (additional-params nil)) + (dotimes (i tries) +- (let ((proc (funcall send from mail message subject bbs key time +- board article))) ++ (let ((proc (apply send from mail message subject bbs key time ++ board article additional-params))) + (message message-str) + (setq result (funcall success-p proc)) + (cond ((eq result 'retry) +@@ -291,6 +287,16 @@ + (insert (decode-coding-string + (navi2ch-net-get-content proc) + navi2ch-coding-system)) ++ (goto-char (point-min)) ++ (setq additional-params nil) ++ (while (re-search-forward "<input +type=\"?hidden\"? +\ ++name=\\(\"\\([^\"]*\\)\"\\|[^\" \n]*\\) +\ ++value=\\(\"\\([^\"]*\\)\"\\|[^\" \n]+\\) *>" ++ nil t) ++ (let ((name (or (match-string 2) (match-string 1))) ++ (value (or (match-string 4) (match-string 3)))) ++ (push (cons name value) ++ additional-params))) + (navi2ch-replace-html-tag-with-buffer) + (goto-char (point-min)) + (while (re-search-forward "[ \t]*\n\\([ \t]*\n\\)*" nil t) +@@ -410,10 +416,9 @@ + list)))) + + (defun navi2ch-2ch-send-message +- (from mail message subject bbs key time board article) ++ (from mail message subject bbs key time board article &rest additional-params) (let ((url (navi2ch-board-get-bbscgi-url board)) (referer (navi2ch-board-get-uri board)) - (spid (navi2ch-board-load-spid board)) -+ (cookies (navi2ch-board-load-cookies board)) (param-alist (list (cons "submit" "$B=q$-9~$`(B") (cons "FROM" (or from "")) -@@ -424,21 +424,30 @@ +@@ -424,21 +429,20 @@ (if subject (cons "subject" subject) (cons "key" key))))) @@ -52,17 +70,9 @@ - (when (and (consp spid) - (navi2ch-compare-times (cdr spid) (current-time))) - (car spid))) -+ (setq cookies -+ (nconc (list (list "NAME" from) -+ (list "MAIL" mail)) -+ (delq nil -+ (mapcar (lambda (elt) -+ (and (navi2ch-compare-times (cddr elt) -+ (current-time)) -+ (not (member (car elt) -+ '("NAME" "MAIL"))) -+ elt)) -+ cookies)))) ++ (dolist (x additional-params) ++ (setq param-alist ++ (navi2ch-put-alist (car x) (cdr x) param-alist))) (let ((proc (navi2ch-net-send-request url "POST" @@ -70,40 +80,151 @@ - (cons "Cookie" (concat "NAME=" from "; MAIL=" mail - (if spid (concat "; SPID=" spid - "; PON=" spid)))) -+ (cons "Cookie" (mapconcat (lambda (elt) -+ (concat (car elt) -+ "=" -+ (cadr elt))) -+ cookies "; ")) ++ (cons "Cookie" ++ (navi2ch-net-cookie-string ++ (navi2ch-net-match-cookies url))) (cons "Referer" referer)) (navi2ch-net-get-param-string param-alist)))) - (setq spid (navi2ch-net-send-message-get-spid proc)) - (if spid (navi2ch-board-save-spid board spid)) -+ (navi2ch-board-save-cookies board -+ (navi2ch-net-get-cookies proc cookies)) ++ (navi2ch-net-update-cookies url proc) ++ (navi2ch-net-save-cookies) proc))) (defun navi2ch-2ch-article-to-url ---- navi2ch-net.el.orig Sun Aug 28 22:55:41 2005 -+++ navi2ch-net.el Sun Aug 28 22:56:08 2005 -@@ -808,6 +808,21 @@ +--- navi2ch-net.el.orig Fri Aug 6 23:02:01 2004 ++++ navi2ch-net.el Sun Jun 4 23:07:43 2006 +@@ -780,6 +780,134 @@ ((string-match "^PON=\\([^;]+\\);" str) (return (cons (match-string 1 str) date)))))))) -+(defun navi2ch-net-get-cookies (proc old-cookies) -+ (let ((case-fold-search t) -+ (cookies (reverse old-cookies))) -+ (dolist (pair (navi2ch-net-get-header proc) (nreverse cookies)) -+ (when (string-equal (car pair) "Set-Cookie") ++;; Cookie $B$O$3$s$J46$8$N(B alist $B$KF~$l$F$*$/!#(B ++;; ((domain1 (/path1 ("name1" "value1" ...) ++;; ("name2" "value2" ...) ...) ++;; (/path2 ...) ...) ++;; (domain2 ...) ...) ++ ++(defvar navi2ch-net-cookies nil) ++ ++(defun navi2ch-net-store-cookie (cookie domain path) ++ (let ((domain (if (stringp domain) (intern (downcase domain)) domain)) ++ (path (if (stringp path) (intern path) path))) ++ (let ((path-alist (assq domain navi2ch-net-cookies))) ++ (unless path-alist ++ (setq path-alist (list domain)) ++ (push path-alist navi2ch-net-cookies)) ++ (let ((cookie-list (assq path (cdr path-alist)))) ++ (if cookie-list ++ (let ((elt (assoc (car cookie) (cdr cookie-list)))) ++ (if elt ++ (setcdr elt (cdr cookie)) ++ (setcdr cookie-list (cons cookie (cdr cookie-list))))) ++ (setq cookie-list (list path cookie)) ++ (setcdr path-alist (cons cookie-list (cdr path-alist)))))))) ++ ++(defun navi2ch-net-match-cookies (url) ++ (let* ((alist (navi2ch-net-split-url url)) ++ (host (cdr (assq 'host alist))) ++ (file (cdr (assq 'file alist))) ++ (domain-list (list (intern (downcase host)))) ++ path-list) ++ (when (string-match "\\..*\\..*\\'" host) ++ (push (intern (downcase (match-string 0 host))) domain-list)) ++ (while (string-match "\\`\\(.*\\)/[^/]*" file) ++ (let ((f (match-string 1 file))) ++ (push (intern (if (string= f "") "/" f)) path-list) ++ (setq file f))) ++ (labels ((mapcan (function list) (apply #'nconc (mapcar function list)))) ++ (mapcan (lambda (domain) ++ (mapcan (lambda (path) ++ (navi2ch-net-expire-cookies ++ (cdr (assq path ++ (cdr (assq domain ++ navi2ch-net-cookies)))))) ++ path-list)) ++ domain-list)))) ++ ++(defvar navi2ch-net-cookie-file "cookie.info") ++ ++(defun navi2ch-net-cookie-file () ++ (expand-file-name navi2ch-net-cookie-file navi2ch-directory)) ++ ++(defun navi2ch-net-save-cookies () ++ (let ((now (current-time))) ++ (labels ((strip (f l) (let ((tmp (delq nil (mapcar f (cdr l))))) ++ (and tmp (cons (car l) tmp))))) ++ (navi2ch-save-info ++ (navi2ch-net-cookie-file) ++ (delq nil ++ (mapcar (lambda (path-alist) ++ (strip (lambda (cookie-list) ++ (strip (lambda (cookie) ++ (and (cddr cookie) ++ (navi2ch-compare-times ++ (cddr cookie) now) ++ cookie)) ++ cookie-list)) ++ path-alist)) ++ navi2ch-net-cookies)))))) ++ ++(defun navi2ch-net-load-cookies () ++ (setq navi2ch-net-cookies ++ (navi2ch-load-info (navi2ch-net-cookie-file)))) ++ ++(add-hook 'navi2ch-save-status-hook 'navi2ch-net-save-cookies) ++(add-hook 'navi2ch-load-status-hook 'navi2ch-net-load-cookies) ++ ++(defun navi2ch-net-update-cookies (url proc) ++ (let* ((case-fold-search t) ++ (alist (navi2ch-net-split-url url)) ++ (host (cdr (assq 'host alist))) ++ (file (cdr (assq 'file alist)))) ++ (dolist (pair (navi2ch-net-get-header proc) navi2ch-net-cookies) ++ (when (string= (car pair) "Set-Cookie") + (let* ((str (cdr pair)) -+ (date (when (string-match "expires=\\([^;]+\\);" str) -+ (navi2ch-http-date-decode (match-string 1 str))))) ++ (date (when (string-match "expires=\\([^;]+\\)" str) ++ (navi2ch-http-date-decode (match-string 1 str)))) ++ (domain (if (string-match "domain=\\([^;]+\\)" str) ++ (match-string 1 str) ++ host)) ++ (path (if (string-match "path=\\([^;]+\\)" str) ++ (match-string 1 str) ++ (if (and (string-match "\\(.*\\)/" file) ++ (> (length (match-string 1 file)) 0)) ++ (match-string 1 file) ++ "/")))) + (when (string-match "^\\([^=]+\\)=\\([^;]*\\)" str) -+ (let ((old (assoc (match-string 1 str) cookies))) -+ (when old (setq cookies (delq old cookies)))) -+ (push (cons (match-string 1 str) -+ (cons (match-string 2 str) date)) -+ cookies))))))) ++ (let ((name (match-string 1 str)) ++ (value (match-string 2 str))) ++ (setq value ++ (decode-coding-string ++ (navi2ch-replace-string "%[0-9A-Za-z][0-9A-Za-z]" ++ (lambda (s) ++ (string (string-to-number ++ (substring s 1) 16))) ++ value t t t) ++ navi2ch-coding-system)) ++ (navi2ch-net-store-cookie (cons name ++ (cons value date)) ++ domain path)))))))) ++ ++(defun navi2ch-net-expire-cookies (cookie-list) ++ "COOKIE-LIST $B$+$i4|8B@Z$l$N%/%C%-!<$r=|$$$?%j%9%H$rJV$9!#(B" ++ (let ((now (current-time))) ++ (delq nil ++ (mapcar (lambda (cookie) ++ (when (or (null (cddr cookie)) ++ (navi2ch-compare-times (cddr cookie) now)) ++ cookie)) ++ cookie-list)))) ++ ++(defun navi2ch-net-cookie-string (cookies) ++ "HTTP $B$N(B Cookie $B%X%C%@$H$7$FEO$9J8;zNs$rJV$9!#(B" ++ (mapconcat (lambda (elt) ++ (concat (navi2ch-net-url-hexify-string (car elt)) ++ "=" ++ (navi2ch-net-url-hexify-string (cadr elt)))) ++ cookies "; ")) + (defun navi2ch-net-download-logo (board) (let ((coding-system-for-read 'binary) |