ports/85400: japanese/navi2ch-emacs20: patch to insert wait between HTTP connections and to add support HTTP cookies
NIIMI Satoshi
sa2c at sa2c.net
Sun Aug 28 14:30:24 UTC 2005
>Number: 85400
>Category: ports
>Synopsis: japanese/navi2ch-emacs20: patch to insert wait between HTTP connections and to add support HTTP cookies
>Confidential: no
>Severity: non-critical
>Priority: low
>Responsible: freebsd-ports-bugs
>State: open
>Quarter:
>Keywords:
>Date-Required:
>Class: change-request
>Submitter-Id: current-users
>Arrival-Date: Sun Aug 28 14:30:22 GMT 2005
>Closed-Date:
>Last-Modified:
>Originator: NIIMI Satoshi
>Release: FreeBSD 5.4-RELEASE-p6 i386
>Organization:
>Environment:
System: FreeBSD berkeley.l.sa2c.net 5.4-RELEASE-p6 FreeBSD 5.4-RELEASE-p6 #2: Sat Aug 27 13:20:51 JST 2005 root at berkeley.l.sa2c.net:/usr/obj/usr/src/sys/MYKERNEL i386
>Description:
chase the recent changes of 2ch.net.
>How-To-Repeat:
>Fix:
--- navi2ch.diff begins here ---
Index: Makefile
===================================================================
RCS file: /home/ncvs/ports/japanese/navi2ch-emacs20/Makefile,v
retrieving revision 1.50
diff -u -u -r1.50 Makefile
--- Makefile 13 Oct 2004 02:15:50 -0000 1.50
+++ Makefile 28 Aug 2005 14:12:01 -0000
@@ -7,6 +7,7 @@
PORTNAME= navi2ch
PORTVERSION= 1.7.5
+PORTREVISION= 1
PORTEPOCH= 1
CATEGORIES= japanese www elisp
MASTER_SITES= ${MASTER_SITE_SOURCEFORGE}
Index: files/patch-bourbon
===================================================================
RCS file: files/patch-bourbon
diff -N files/patch-bourbon
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-bourbon 28 Aug 2005 14:11:32 -0000
@@ -0,0 +1,60 @@
+--- navi2ch-net.el.orig Fri Aug 6 23:02:01 2004
++++ navi2ch-net.el Sun Aug 28 22:55:41 2005
+@@ -127,6 +127,33 @@
+ (list shell-file-name shell-command-switch command)
+ command))))
+
++;; (let ((sum 0))
++;; (dotimes (i 400 sum)
++;; (setq sum (+ sum (1- (floor (expt 1.00925 i)))))))
++;; => 3602
++(defvar navi2ch-net-connect-wait-power 1.00925)
++(defvar navi2ch-net-connect-time-list '())
++
++(defun navi2ch-net-connect-wait (host)
++ (let* ((host (intern host))
++ (now (navi2ch-float-time))
++ (limit (- now 3600.0))
++ (list (delq nil (mapcar (lambda (x) (if (> (cdr x) limit) x))
++ navi2ch-net-connect-time-list)))
++ (len (length (delq nil (mapcar (lambda (x)
++ (if (eq host (car x)) x))
++ list))))
++ (wait (floor (- (+ (expt navi2ch-net-connect-wait-power len)
++ (or (cdr (assq host list)) now))
++ 1
++ now))))
++ (when (> wait 0)
++ (message "waiting for %dsec..." wait)
++ (sleep-for wait)
++ (message "waiting for %dsec...done" wait))
++ (setq navi2ch-net-connect-time-list
++ (cons (cons host (navi2ch-float-time)) list))))
++
+ (defun navi2ch-net-send-request (url method &optional other-header content)
+ (setq navi2ch-net-last-url url)
+ (unless navi2ch-net-enable-http11
+@@ -141,6 +168,7 @@
+ file (cdr (assq 'file list))
+ port (cdr (assq 'port list))
+ host2ch (cdr (assq 'host2ch list))))
++ (navi2ch-net-connect-wait host)
+ (when navi2ch-net-http-proxy
+ (setq credentials (navi2ch-net-http-proxy-basic-credentials
+ navi2ch-net-http-proxy-userid
+--- navi2ch-util.el.orig Sun Oct 10 00:01:11 2004
++++ navi2ch-util.el Sun Aug 28 22:55:41 2005
+@@ -1269,5 +1269,13 @@
+ (setq bol (1+ (navi2ch-line-end-position))))))
+ (goto-char start))
+
++(defun navi2ch-float-time (&optional specified-time)
++ "Return the current time, as a float number of seconds since the epoch.
++If an argument is given, it specifies a time to convert to float
++instead of the current time."
++ (apply (lambda (high low &optional usec)
++ (+ (* high 65536.0) low (/ (or usec 0) 1000000.0)))
++ (or specified-time (current-time))))
++
+ (run-hooks 'navi2ch-util-load-hook)
+ ;;; navi2ch-util.el ends here
Index: files/patch-myanmar
===================================================================
RCS file: files/patch-myanmar
diff -N files/patch-myanmar
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-myanmar 28 Aug 2005 14:11:32 -0000
@@ -0,0 +1,110 @@
+--- 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 @@
+ (let ((func (or (navi2ch-fboundp
+ navi2ch-multibbs-send-message-retry-confirm-function)
+ #'yes-or-no-p))
+- spid)
++ cookies)
+ (unwind-protect
+ (let ((result (funcall func "Retry? ")))
+ (when result
+- (setq spid (navi2ch-board-load-spid board)))
++ (setq cookies (navi2ch-board-load-cookies board)))
+ result)
+- (navi2ch-board-save-spid board spid))))
++ (navi2ch-board-save-cookies board cookies))))
+
+ (defun navi2ch-multibbs-send-message
+ (from mail message subject board article)
+@@ -413,7 +413,7 @@
+ (from mail message subject bbs key time board article)
+ (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" "書き込む")
+ (cons "FROM" (or from ""))
+@@ -424,21 +424,30 @@
+ (if subject
+ (cons "subject" subject)
+ (cons "key" key)))))
+- (setq spid
+- (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))))
+ (let ((proc
+ (navi2ch-net-send-request
+ url "POST"
+ (list (cons "Content-Type" "application/x-www-form-urlencoded")
+- (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 "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))
+ 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 @@
+ ((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")
++ (let* ((str (cdr pair))
++ (date (when (string-match "expires=\\([^;]+\\);" str)
++ (navi2ch-http-date-decode (match-string 1 str)))))
++ (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)))))))
++
+ (defun navi2ch-net-download-logo (board)
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
--- navi2ch.diff ends here ---
>Release-Note:
>Audit-Trail:
>Unformatted:
More information about the freebsd-ports-bugs
mailing list