Date: Sun, 28 Aug 2005 23:21:43 +0900 (JST) From: NIIMI Satoshi <sa2c@sa2c.net> To: FreeBSD-gnats-submit@FreeBSD.org Subject: ports/85400: japanese/navi2ch-emacs20: patch to insert wait between HTTP connections and to add support HTTP cookies Message-ID: <20050828142143.B873511453@berkeley.l.sa2c.net> Resent-Message-ID: <200508281430.j7SEUNJn062181@freefall.freebsd.org>
next in thread | raw e-mail | index | archive | help
>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@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:
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20050828142143.B873511453>