The posting method of 2ch bbs was changed recently and messages can't be

posted with navi2ch.

PR:		ports/98494
Submitted by:	NIIMI Satoshi <sa2c@sa2c.net>

2 files changed, 187 insertions, 66 deletions

diff --git a/japanese/navi2ch-emacs20/Makefile b/japanese/navi2ch-emacs20/Makefile
index a5ddd026d4dc..fcf87d3d7671 100644
--- a/japanese/navi2ch-emacs20/Makefile
+++ b/japanese/navi2ch-emacs20/Makefile
@@ -7,7 +7,7 @@
 
 PORTNAME=	navi2ch
 PORTVERSION=	1.7.5
-PORTREVISION=	2
+PORTREVISION=	3
 PORTEPOCH=	1
 CATEGORIES=	japanese www elisp
 MASTER_SITES=	${MASTER_SITE_SOURCEFORGE}
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)