1;;; navi2ch-p2.el --- p2 frontend for navi2ch 2 3;; Copyright (C) 2008, 2009 by Navi2ch Project 4 5;; Authors: Naohiro Aota <naota@namazu.org> 6;; MIZUNUMA Yuto <mizmiz@users.sourceforge.net> 7;; Keywords: network 2ch 8 9;; This file is free software; you can redistribute it and/or modify 10;; it under the terms of the GNU General Public License as published by 11;; the Free Software Foundation; either version 2, or (at your option) 12;; any later version. 13 14;; This file is distributed in the hope that it will be useful, 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17;; GNU General Public License for more details. 18 19;; You should have received a copy of the GNU General Public License 20;; along with GNU Emacs; see the file COPYING. If not, write to 21;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22;; Boston, MA 02111-1307, USA. 23 24;;; Commentary: 25 26;; $B35MW(B 27;; navi2ch $B$r(B p2 $B$N%U%m%s%H%(%s%I$K$7$^$9!#(B 28;; $B$H$$$C$F$b:#$O$^$@(B bookmark $B$NF14|$@$1!#(B 29;; $B$^$@$^$@<B83CJ3,$J$N$GCm0U!#(B 30;; 31;; $B;H$$$+$?(B 32;; $B%Q%9$rDL$7$F!"(B 33;; (load "navi2ch-p2") 34;; 35;; M-x navi2ch-p2-sync-global-bookmark-to-p2 36;; 37;; $B;XDj$5$l$?(B global-bookmark $B$KEPO?$5$l$F$$$F!"(Bp2 $B$N$*5$$K$$$j$KEPO?$5(B 38;; $B$l$F$$$J$$%9%l$r(Bp2 $B$N$*5$$K$$$j$KEPO?$7!"(B $B;XDj$5$l$?(B 39;; global-bookmark $B$KEPO?$5$l$F$*$i$:!"(B p2 $B$N$*5$$K$$$j$KEPO?$5$l$F$$$k(B 40;; $B%9%l$r?R$M$F$+$i(B p2 $B$N$*5$$K$$$j$+$i:o=|$7$^$9!#(B 41;; 42;; M-x navi2ch-p2-sync-global-bookmark-from-p2 43;; 44;; p2 $B$N$*5$$K$$$j$K$KEPO?$5$l$F$$$F!";XDj$5$l$?(B global-bookmark $B$KEPO?(B 45;; $B$5$l$F$$$J$$%9%l$r;XDj$5$l$?(B global-bookmark $B$KEPO?$7!"(B p2 $B$N$*5$$K(B 46;; $B$$$j$KEPO?$5$l$F$*$i$:!"(B $B;XDj$5$l$?(B global-bookmark $B$KEPO?$5$l$F$$$k(B 47;; $B%9%l$r?R$M$F$+$i(B $B;XDj$5$l$?(B global-bookmark $B$+$i:o=|$7$^$9!#(B 48;; 49;; M-x navi2ch-p2-export 50;; 51;; navi2ch $B$N$*5$$K$$$j!"MzNr!"$"$\!<$s%o!<%I!"(Bdat$B!"%9%l>pJs$r;XDj$5$l(B 52;; $B$?%U%)%k%@$K(B rep2 $B7A<0$G(Bp export $B$7$^$9!#(B 53;; 54;; $B@_Dj(B 55;; navi2ch-p2-mail-address $B$K%a!<%k%"%I%l%9(B 56;; navi2ch-p2-password $B$K%Q%9%o!<%I$r@_Dj$7$F$*$/$HJXMx$G$7$g$&!#(B 57;; 58;; $B%(%/%9%]!<%H$r;H$&?M$O!"(B navi2ch-p2-export-bookmark $B$K%(%/%9%]!<%H$7(B 59;; $B$?$$(B global-bookmark $B$N(B id $B$r@_Dj$7$F$*$/$H$$$$$G$7$g$&!#(B 60;; 61;; dat $B$N%(%/%9%]!<%H$K;H$o$l$k4X?t$,(B navi2ch-p2-dat-copy-function $B$K@_(B 62;; $BDj$5$l$F$$$^$9!#(B $B%G%U%)%k%H$O(B add-name-to-file ($B%O!<%I%j%s%/(B)$B$K$J$C(B 63;; $B$F$$$^$9!#(B $B%j%s%/$,;HMQIT2DG=$J$i$P(B copy-file $B!"%j%s%/$,;HMQ2DG=$@$,(B 64;; $B%Q!<%F%#%7%g%s$,JL$G$"$k?M$O(B make-symbolic-link ($B%7%s%\%j%C%/%j%s%/(B)$B$K(B 65;; $B$9$k$H$$$$$G$7$g$&!#(B 66 67;; $B5!G=DI2C(B 68 69;; 2ch$B8x<0(BP2(http://p2.2ch.net)$B$r7PM3$7$F=q$-9~$_$,=PMh$k$h$&$K$9$k5!G=DI2C$G$9!#(B 70;; $B<g$JL\E*$O%W%m%P%$%@$N%"%/6X$K4,$-9~$^$l$?:]$N2sHr:v$G$9!#(B 71;; P2$B$d$i%b%j%?%]$K4X$7$F$ON.F0E*$J$N$G!"$=$NETEY!"3F!9D4$Y$F$/$@$5$$!#(B 72;; p2writer$B$d(Bp2proxy$B$"$?$j$H$d$C$F$k$3$H$OF1$8$J$N$G$=$NJU$N%9%l$G!#(B 73;; 1000$B%b%j%?%]>CHq$G=q$-9~$_5v2D$rF@$k$N$O%V%i%&%67PM3$G(B 74 75;; $B%9%lFI$_9~$_$O(Bp2$B7PM3$7$F$^$;$s!#=q$-9~$_$N$_$G$9!#(B 76 77;; $B4JC1$JFbIt;EMM$N@bL@$H$7$F$O(B 78;; http://p2.2ch.net/p2 $B$K%m%0%$%s$7$F(Bcookie(PS$B!"(Bcsid)$B<hF@(B 79;; $B!!"-(B 80;; $B$=$N(Bcookie$B$r;H$C$F(Bhttp://p2.2ch.net/p2/menu.php$B$r<hF@$9$k$H!"(B 81;; $B%I%-%e%a%s%H$KKd$a9~$^$l$F$k(Bcsrfid$BJQ?t$NCM$r<hF@2D(B(XSS$BBP:v(B?)$B!#(B 82;; $B!!"-(B 83;; $B%l%9=q$-9~$_$N%9%/%j%W%H$G$"$k!"(Bhttp://p2.2ch.net/p2/post.php 84;; $B$K(Bcookie$B$r(Bcookie$BEO$7!"(Bcsrfid$B$r(BPOST$B$N%Q%i%a!<%?!<EO$7$G%l%9$,2DG=$K$J$k!#(B 85 86;; tepo=don$B$H$$$&%Q%i%a!<%?!<$G=q$-9~$_8"8B$r%"%/%F%#%Y!<%7%g%s(B(?)$B$7$F$d$k$N$O!"(B2ch$BK\BN$HF1$8$C$]$$!#(B 87;; ($B$h$/$"$k!"3NG'2hLL$G(B2$BEY=q$-9~$`E[$G$9!K(B 88 89;; $B$"$/$^$G8D?ME*$KD4$Y$?HO0O$J$N$G!"4V0c$C$F$?$j!"5v2D$5$l$F$J$$%m%8%C%/$r;H$C$F$k2DG=@-$b$"$j$^$9!#(B 90;; cookie$B$d$i(Bcsrfid$B$N(B"$B@8B84|4V(B"$B$K4X$7$F$O2x$7$$ItJ,$b$"$k$N$G!"MW:F%m%0%$%s!":F<hF@$,$=$NETEYI,MW$+$b!#(B 91;; $B$3$NJU$N%j%H%i%$%k!<%W$O$+$J$j2x$7$$(B 92 93;; $B@_Dj$9$kJQ?t$O0J2<$N(B3$B$D$/$i$$(B 94;; (setq navi2ch-p2-use-p2 t) ;;p2$B$r;H$C$F=q$-9~$_$9$k$+$I$&$+!#(B 95;; (setq navi2ch-p2-mail-address "sample@hoge.hoge") ;; p2$B$N%a!<%k%"%I%l%9(B(ID) 96;; (setq navi2ch-p2-password "password") ;; p2$B$N%Q%9%o!<%I(B 97 98;;; Code: 99 100(provide 'navi2ch-p2) 101 102(require 'navi2ch-util) 103(require 'navi2ch-multibbs) 104 105(defvar navi2ch-p2-func-alist 106 '((bbs-p . navi2ch-p2-p) 107 (article-update . navi2ch-2ch-article-update) 108 (send-message . navi2ch-p2-send-message) 109 (send-success-p . navi2ch-p2-send-message-success-p) 110 (extract-post . navi2ch-2ch-extract-post))) 111 112(defvar navi2ch-p2-variable-alist 113 (list (cons 'coding-system navi2ch-coding-system))) 114 115(defconst navi2ch-p2-coding-system 'shift_jis) 116 117(navi2ch-multibbs-regist 'p2 118 navi2ch-p2-func-alist 119 navi2ch-p2-variable-alist) 120 121(defvar navi2ch-p2-madakana-url 122 "http://qb7.2ch.net/_403/madakana.cgi") 123 124;;------------- 125 126(defvar navi2ch-p2-use-p2 nil ; $BJQ?tL>$OMW8!F$!#(B 127 "*p2$B$r;H$C$F=q$-9~$_$9$k$+$I$&$+!#(B") 128(defvar navi2ch-p2-mail-address "" 129 "*p2$B$N%a!<%k%"%I%l%9(B(ID)$B!#(B") 130(defvar navi2ch-p2-password "" 131 "*p2$B$N%Q%9%o!<%I!#(B") 132 133(defvar navi2ch-p2-domain "p2.2ch.net") 134 135(defvar navi2ch-p2-login-url (concat "http://" navi2ch-p2-domain "/p2/") 136 "*p2$B$N%m%0%$%s(BURL$B!#(B") 137 138(defconst navi2ch-p2-cookie-names '("PS" "cid")) 139(defconst navi2ch-p2-cookie-domain navi2ch-p2-domain) 140(defconst navi2ch-p2-cookie-path '/p2) 141 142(defvar navi2ch-p2-login-flag nil) 143(defvar navi2ch-p2-csrfid nil) 144 145(defvar navi2ch-p2-board nil) 146(defvar navi2ch-p2-board-regexp nil) 147(defvar navi2ch-p2-all-board nil) 148 149(defun navi2ch-p2-p (uri) 150 "p2$B7PM3$G=q$-9~$`$J$i(Bnon-nil$B$rJV$9!#(B" 151 (when (and navi2ch-p2-use-p2 152 (string-match "http://\\([^/]+\\)/\\([^/]+\\)" uri)) 153 (let ((board (match-string 2 uri))) 154 (or navi2ch-p2-all-board 155 (member board navi2ch-p2-board) 156 (and navi2ch-p2-board-regexp 157 (if (string-match "^live.*" board) t)))))) 158 159(defun navi2ch-p2-board-p (board) 160; (message "p2-board-p %s" board) 161 (and navi2ch-p2-use-p2 162 (or navi2ch-p2-all-board 163 (member board navi2ch-p2-board) 164 (and navi2ch-p2-board-regexp 165 (if (string-match "^live.*" board) t))))) 166 167(defun navi2ch-p2-login-p () 168 (let ((cookies (navi2ch-net-match-cookies navi2ch-p2-login-url))) 169 (setq navi2ch-p2-login-flag 170 (null (memq nil 171 (mapcar (lambda (name) (assoc name cookies)) 172 navi2ch-p2-cookie-names)))))) 173 174(defun navi2ch-p2-send-message-success-p (proc) 175 (when proc 176 (let ((str (navi2ch-net-get-content proc))) 177 (setq str (decode-coding-string str navi2ch-p2-coding-system)) 178 (cond ((or (string-match "$B=q$-$3$_$^$7$?!#(B" str) 179 (string-match "$B=q$-$3$_$,=*$o$j$^$7$?!#(B" str)) 180 (message "P2$B$G=q$-9~$_$^$7$?(B") 181 t) 182 ;;$B$*$=$i$/(Bcsrfid$B$N4|8B@Z$J$I(B 183 ((or (string-match "Cookie$BG'>Z;~$K(BIP$B$NF10l@-$r%A%'%C%/$7$J$$(B" str) 184 (string-match "<b>$B=q$-$3$_!u%/%C%-!<3NG'(B</b>" str) 185 (string-match "p2 error: $B%Z!<%8A+0\$NBEEv@-$r3NG'$G$-$^$;$s$G$7$?!#(B" str) 186 ) 187 ;;$B:F<hF@(B 188 (message "reget-csrfid %s end" str) 189 (navi2ch-p2-get-csrfid) 190 'retry) 191 ((or (string-match "p2 error: $B0z?t$N;XDj$,JQ$G$9(B" str)) 192 (error str)) 193 (t 194 (message "p2 error::%s" str) 195 nil))))) 196 197(defun navi2ch-p2-make-deny-list () 198 "madakana.cgi$B$+$i%"%/%;%96X;_>uBV$r<hF@$9$k(B" 199 (let (content str navi2ch-net-accept-gzip-org) 200 (setq navi2ch-p2-all-board nil) 201 (setq navi2ch-p2-board nil) 202 (setq navi2ch-p2-board-regexp nil) 203 (setq navi2ch-net-accept-gzip-org navi2ch-net-accept-gzip) 204 (setq navi2ch-p2-all-board nil) 205 (if (equal system-type 'windows-nt) 206 (setq navi2ch-net-accept-gzip nil)) 207 (setq content (navi2ch-net-get-content (navi2ch-net-download-file navi2ch-p2-madakana-url))) 208 (setq navi2ch-net-accept-gzip navi2ch-net-accept-gzip-org) 209 (with-temp-buffer 210 (if (not content) 211 (message "$B%G!<%?<hF@$K<:GT$7$^$7$?(B") 212 (insert content) 213 (goto-char (point-min)) 214 (while (re-search-forward "<font color=red><b>\\(.*[^>]\\)$" nil t) 215 (setq str (match-string 1)) 216 (let (board host) 217 (cond 218 ((string-match "_BBS_\\(.*\\)_\\(.*\\)" str) 219 (progn 220 (setq board (match-string 1 str)) 221 (setq host (match-string 2 str)) 222 (unless (member board navi2ch-p2-board) 223 (setq navi2ch-p2-board (cons board navi2ch-p2-board))) 224 (message "deny board:%s host:%s" board host))) 225 ((string-match "_SRV_\\(.*\\)_\\(.*\\)" str) 226 (setq board (match-string 1 str)) 227 (setq host (match-string 2 str)) 228 (unless (member board navi2ch-p2-board-regexp) 229 (setq navi2ch-p2-board-regexp (cons board navi2ch-p2-board-regexp))) 230 (message "deny regexp board:%s host:%s" board host)) 231 (t 232 (setq navi2ch-p2-all-board t) 233 (message "all deny:%s" str))) 234 )))))) 235 236(defun navi2ch-p2-send-message 237 (from mail message subject bbs key time board article &optional post) 238 (unless navi2ch-p2-csrfid 239 (navi2ch-p2-get-csrfid)) 240 (when (navi2ch-message-samba24-check board) 241 (let* ((url (concat navi2ch-p2-login-url "post.php?guid=ON")) 242 (referer (concat navi2ch-p2-login-url "menu.php")) 243 (param-alist (list 244 (cons "submit" "$B=q$-9~$`(B") 245 (cons "FROM" (or from "")) 246 (cons "mail" (or mail "")) 247 (cons "bbs" bbs) 248 (cons "time" time) 249 (cons "host" (navi2ch-board-get-host board)) 250 (cons "popup" "1") 251 (cons "MESSAGE" message) 252 (cons "csrfid" navi2ch-p2-csrfid) 253 (cons "tepo" "don") 254 (cons "kuno" "ichi") 255 )) 256 (coding-system (navi2ch-board-get-coding-system board)) 257 (cookies (navi2ch-net-match-cookies url))) 258 (if (not subject) 259 (push (cons "key" key) param-alist) 260 (push (cons "newthread" "1") param-alist) 261 (push (cons "subject" subject) param-alist)) 262 263 (dolist (param post) 264 (unless (assoc (car param) param-alist) 265 (push param param-alist))) 266 (setq navi2ch-2ch-send-message-last-board board) 267 (let ((proc 268 (navi2ch-net-send-request 269 url "POST" 270 (list (cons "Content-Type" "application/x-www-form-urlencoded") 271 (cons "Cookie" 272 (navi2ch-net-cookie-string cookies coding-system)) 273 (cons "Referer" referer)) 274 (navi2ch-net-get-param-string param-alist 275 coding-system)))) 276 (navi2ch-net-update-cookies url proc coding-system) 277 (navi2ch-net-save-cookies) 278 proc)))) 279 280(defun navi2ch-p2-get-csrfid () 281 (message "navi2ch-p2-get-csrfid") 282 (dotimes (i 2) 283 (unless navi2ch-p2-login-flag 284 (navi2ch-p2-login)) 285 (let ((proc (navi2ch-net-send-request 286 (concat navi2ch-p2-login-url "menu.php") 287 "GET" 288 (list 289 (cons "Cookie" 290 (navi2ch-net-cookie-string 291 (navi2ch-net-match-cookies 292 navi2ch-p2-login-url) 293 navi2ch-p2-coding-system))) 294 ))) 295 (navi2ch-net-update-cookies navi2ch-p2-login-url 296 proc 297 navi2ch-p2-coding-system) 298 (navi2ch-net-save-cookies) 299 (with-temp-buffer 300 (insert (decode-coding-string 301 (navi2ch-net-get-content proc) 302 navi2ch-p2-coding-system)) 303 (goto-char (point-min)) 304 (if (re-search-forward "$B%f!<%6%m%0%$%s(B" nil t) 305 (if (and (zerop i) 306 (y-or-n-p "$BG'>Z<:GT!#%m%0%$%s$7$J$*$7$F$_$^$9$+(B? ")) 307 (setq navi2ch-p2-login-flag nil) 308 (error "$BG'>Z$K<:GT$7$^$7$?!#(B")) 309 (if (not (re-search-forward "csrfid=\\([a-f0-9]+\\)" nil t)) 310 (error "csrfid$B$N<hF@$K<:GT$7$^$7$?(B") 311 (setq navi2ch-p2-csrfid (match-string 1)) 312 (return proc))))))) 313 314(defun navi2ch-p2-login (&optional mail password) 315 (message "p2 login") 316 (unless mail 317 (setq mail (or navi2ch-p2-mail-address 318 (read-string "mail address: ")))) 319 (unless password 320 (setq password (or navi2ch-p2-password 321 (read-passwd "password: ")))) 322 (navi2ch-p2-logout) 323 (let ((proc (navi2ch-net-send-request 324 navi2ch-p2-login-url 325 "POST" 326 (list 327 (cons "Referer" navi2ch-p2-login-url) 328 (cons "User-Agent" navi2ch-net-user-agent) 329 (cons "Content-Type" "application/x-www-form-urlencoded")) 330 (navi2ch-net-get-param-string 331 (list 332 (cons "form_login_id" mail) 333 (cons "form_login_pass" password) 334 (cons "ctl_regist_cookie" "1") 335 (cons "regist_cookie" "1") 336 (cons "submit_member" "$B%f!<%6%m%0%$%s(B")) 337 navi2ch-p2-coding-system)))) 338 (navi2ch-net-update-cookies navi2ch-p2-login-url 339 proc 340 navi2ch-p2-coding-system) 341 (navi2ch-net-save-cookies) 342 (navi2ch-p2-login-p) 343 )) 344 345(defun navi2ch-p2-logout () 346 (dolist (name navi2ch-p2-cookie-names) 347 (navi2ch-net-store-cookie (list name "" 0 0) 348 navi2ch-p2-cookie-domain 349 navi2ch-p2-cookie-path)) 350 (navi2ch-net-save-cookies) 351 (setq navi2ch-p2-login-flag nil)) 352 353(defmacro navi2ch-p2-with-updated-file (spec &rest body) 354 `(dotimes (i 2) 355 (unless navi2ch-p2-login-flag 356 (navi2ch-p2-login)) 357 (navi2ch-net-update-file ,(car spec) 358 ,(cadr spec) 359 'file nil nil nil 360 (list 361 (cons "Cookie" 362 (navi2ch-net-cookie-string 363 (navi2ch-net-match-cookies 364 navi2ch-p2-bookmark-url) 365 navi2ch-p2-coding-system)))) 366 (if (and (file-exists-p ,(cadr spec)) 367 (file-readable-p ,(cadr spec))) 368 (let ((coding-system-for-read navi2ch-p2-coding-system)) 369 (with-temp-buffer 370 (insert-file-contents ,(cadr spec)) 371 (goto-char (point-min)) 372 (if (re-search-forward "$B%f!<%6%m%0%$%s(B" nil t) 373 (if (and (zerop i) 374 (y-or-n-p "$BG'>Z<:GT!#%m%0%$%s$7$J$*$7$F$_$^$9$+(B? ")) 375 (setq navi2ch-p2-login-flag nil) 376 (error "$BG'>Z$K<:GT$7$^$7$?!#(B")) 377 (return (funcall (lambda () ,@body)))))) 378 (error "$B%U%!%$%k<hF@$K<:GT$7$^$7$?!#(B")))) 379 380(put 'navi2ch-p2-with-updated-file 'lisp-indent-function 1) 381(put 'navi2ch-p2-with-updated-file 'edebug-form-spec '((symbolp form) def-body)) 382 383(defun navi2ch-p2-send-request (url method &optional other-header content) 384 (dotimes (i 2) 385 (unless navi2ch-p2-login-flag 386 (navi2ch-p2-login)) 387 (let ((proc (navi2ch-net-send-request 388 url 389 method 390 (append 391 (list 392 (cons "Cookie" 393 (navi2ch-net-cookie-string 394 (navi2ch-net-match-cookies 395 navi2ch-p2-bookmark-url) 396 navi2ch-p2-coding-system))) 397 other-header) 398 content))) 399 (navi2ch-net-update-cookies navi2ch-p2-login-url 400 proc 401 navi2ch-p2-coding-system) 402 (navi2ch-net-save-cookies) 403 (with-temp-buffer 404 (insert (decode-coding-string 405 (navi2ch-net-get-content proc) 406 navi2ch-p2-coding-system)) 407 (goto-char (point-min)) 408 (if (re-search-forward "$B%f!<%6%m%0%$%s(B" nil t) 409 (if (and (zerop i) 410 (y-or-n-p "$BG'>Z<:GT!#%m%0%$%s$7$J$*$7$F$_$^$9$+(B? ")) 411 (setq navi2ch-p2-login-flag nil) 412 (error "$BG'>Z$K<:GT$7$^$7$?!#(B")) 413 (return proc)))))) 414 415 416(defvar navi2ch-p2-bookmark-url "http://p2.2ch.net/p2/subject.php?spmode=fav&norefresh=true") 417(defvar navi2ch-p2-bookmark-file-name "p2/bookmark.html") 418(defun navi2ch-p2-get-bookmark () 419 (let ((file (navi2ch-expand-file-name navi2ch-p2-bookmark-file-name))) 420 (navi2ch-p2-with-updated-file (navi2ch-p2-bookmark-url file) 421 (let (result) 422 (goto-char (point-min)) 423 (while (re-search-forward 424 "href=\"read.php\\?host=\\([^&]*\\)&bbs=\\([^&]*\\)&key=\\([0-9]*\\)\\(?:&rc=\\([0-9]+\\)\\)?[^\"]*\" class=\"thre_title\" onClick=\"[^\"]*\">\\([^<]*\\)</a>" 425 nil t) 426 (let ((host (match-string 1)) 427 (bbs (match-string 2)) 428 (key (match-string 3)) 429 (rc (match-string 4)) 430 (subject (match-string 5))) 431 (setq result 432 (cons (list 433 (concat "http://" host "/" bbs "/" key) 434 (list 'board 435 (cons 'name 436 (navi2ch-message-samba24-board-conversion 437 'id 438 bbs 439 'name)) 440 (cons 'uri 441 (concat "http://" host "/" bbs "/")) 442 (cons 'id bbs)) 443 (list 'article 444 (cons 'subject subject) 445 (cons 'artid key))) 446 result)))) 447 result)))) 448 449(defun navi2ch-p2-add-bookmark (url name &optional delete) 450 (when (or (not delete) 451 (yes-or-no-p (format "%s$B$r:o=|$7$^$9$+(B? " 452 name))) 453 (string-match "http://\\([^/]*\\)/\\([^/]*\\)/\\([0-9]*\\)" url) 454 (let ((host (match-string 1 url)) 455 (bbs (match-string 2 url)) 456 (key (match-string 3 url)) 457 (add-or-del (if delete "$B:o=|(B" "$BDI2C(B"))) 458 (message "%s$B$r(B%s$BCf(B..." name add-or-del) 459 (let ((si:message (symbol-function 'message)) 460 (si:current-message (symbol-function 'current-message))) 461 (unwind-protect 462 (progn 463 (lexical-let ((name name) 464 (add-or-del add-or-del)) 465 (fset 'message 466 (byte-compile 467 `(lambda (fmt &rest args) 468 (funcall ,si:message 469 "%s$B$r(B%s$BCf(B...%s" 470 name add-or-del 471 (apply 'format fmt args))))) 472 (fset 'current-message 473 (byte-compile 474 `(lambda () 475 (substring 476 (funcall ,si:current-message) 477 (length (format "%s$B$r(B%s$BCf(B..." 478 name add-or-del))))))) 479 (navi2ch-p2-send-request 480 (format 481 (concat 482 "http://p2.2ch.net/p2/info.php?host=%s&" 483 "bbs=%s&key=%s&ttitle_en=%s&setfav=%d&") 484 host bbs key (navi2ch-p2-encode-string name) 485 (if delete 0 1)) 486 "GET")) 487 (fset 'message si:message) 488 (fset 'current-message si:current-message))) 489 (message "%s$B$r(B%s$BCf(B...done" name add-or-del)))) 490 491(defun navi2ch-p2-sync-global-bookmark-to-p2 (bookmark-id) 492 (interactive 493 (list (completing-read "Bookmark ID: " 494 navi2ch-bookmark-list 495 nil t navi2ch-bookmark-current-bookmark-id))) 496 (let ((bookmark (cddr (assoc bookmark-id navi2ch-bookmark-list)))) 497 (if bookmark 498 (let ((p2-bookmark (navi2ch-p2-get-bookmark))) 499 (dolist (url (mapcar #'car bookmark)) 500 (when (and (string-match 501 "^http://[^.]+\\.\\(?:2ch\\.net\\|machi\\.to\\|bbspink\\.com\\)/" 502 url) 503 (not (assoc url p2-bookmark))) 504 (navi2ch-p2-add-bookmark url 505 (cdr (assq 'subject 506 (assq 'article 507 (assoc url 508 bookmark))))))) 509 (dolist (url (mapcar #'car p2-bookmark)) 510 (unless (assoc url bookmark) 511 (navi2ch-p2-add-bookmark url 512 (cdr (assq 'subject 513 (assq 'article 514 (assoc url 515 p2-bookmark)))) 516 t)))) 517 (error "No such bookmark")))) 518 519(defun navi2ch-p2-sync-global-bookmark-from-p2 (bookmark-id) 520 (interactive 521 (list (navi2ch-bookmark-read-id "Bookmark ID: "))) 522 (unless (assoc bookmark-id navi2ch-bookmark-list) 523 (navi2ch-bookmark-create-bookmark bookmark-id)) 524 (let ((p2-bookmark (navi2ch-p2-get-bookmark)) 525 (bookmark (cddr (assoc bookmark-id navi2ch-bookmark-list))) 526 item article name) 527 (dolist (url (mapcar #'car p2-bookmark)) 528 (unless (assoc url bookmark) 529 (setq item (assoc url p2-bookmark) 530 article (cdr (assq 'article item)) 531 name (cdr (assq 'subject article))) 532 (message "%s$B$rDI2CCf(B..." name) 533 (navi2ch-bookmark-add-subr 534 bookmark-id 535 (cdr (assq 'board item)) 536 article) 537 (message "%s$B$rDI2CCf(B...done" name))) 538 (dolist (url (mapcar #'car bookmark)) 539 (when (and (not (assoc url p2-bookmark)) 540 (yes-or-no-p 541 (format "%s$B$r:o=|$7$^$9$+(B? " 542 (cdr (assq 'subject article))))) 543 (navi2ch-bookmark-delete-key bookmark-id 544 url))))) 545 546(defvar navi2ch-p2-dat-copy-function 'add-name-to-file) 547 548(defvar navi2ch-p2-recent-file-name "p2_recent.idx") 549(defvar navi2ch-p2-res-hist-file-name "p2_res_hist.idx") 550(defvar navi2ch-p2-favlist-file-name "p2_favlist.idx") 551(defconst navi2ch-p2-data-dir-2ch "2channel") 552(defconst navi2ch-p2-data-dir-machibbs "machibbs.com") 553(defconst navi2ch-p2-aborn-name-file-name "p2_aborn_name.txt") 554(defconst navi2ch-p2-aborn-mail-file-name "p2_aborn_mail.txt") 555(defconst navi2ch-p2-aborn-message-file-name "p2_aborn_msg.txt") 556(defconst navi2ch-p2-aborn-id-file-name "p2_aborn_id.txt") 557(defconst navi2ch-p2-ng-name-file-name "p2_ng_name.txt") 558(defconst navi2ch-p2-ng-mail-file-name "p2_ng_mail.txt") 559(defconst navi2ch-p2-ng-message-file-name "p2_ng_msg.txt") 560(defconst navi2ch-p2-ng-id-file-name "p2_ng_id.txt") 561 562(defun navi2ch-p2-get-dat-dir (board dir) 563 (let ((uri (cdr (assq 'uri board)))) 564 (cond 565 ((string-match "^http://[^.]+.\\(?:2ch\\.net\\|bbspink\\.com\\)/" uri) 566 (expand-file-name (cdr (assq 'id board)) 567 (expand-file-name navi2ch-p2-data-dir-2ch 568 dir))) 569 ((string-match "^http://[^.]+\\.\\(machi\\.to\\|machibbs\\.com\\)/" uri) 570 (expand-file-name (cdr (assq 'id board)) 571 (expand-file-name navi2ch-p2-data-dir-machibbs 572 dir))) 573 (t (let ((host (navi2ch-url-to-host uri))) 574 (while (string-match "\\(?:\\.\\|:/\\)/" host) 575 (setq host (replace-match "" nil nil host))) 576 (expand-file-name host 577 dir)))))) 578 579(defvar navi2ch-p2-export-bookmark nil) 580 581(defun navi2ch-p2-make-idx-data (board file) 582 (let* ((artid (navi2ch-article-file-name-to-artid file)) 583 (article (navi2ch-article-load-info 584 board 585 (list (cons 'artid artid)))) 586 (subject (if (and (file-exists-p file) 587 (file-readable-p file)) 588 (cdr (assq 'subject 589 (navi2ch-article-get-first-message-from-file 590 file board))) 591 "$BITL@(B")) 592 (response (or (cdr (assq 'response article)) 593 "0"))) 594 (format "%s<>%s<>%d<>%s<>%s<>%d<>%d<>%s<>%s<>%d<>%s<>%s<>0\n" 595 subject 596 artid 597 (if (file-exists-p file) 598 (nth 7 (file-attributes file)) 599 0) 600 response 601 (or (cdr (assq 'time article)) "") 602 (or (cdr (assq 'number article)) 603 0) 604 (if (and navi2ch-p2-export-bookmark 605 (assoc (navi2ch-bookmark-get-key board article) 606 (cddr (assoc navi2ch-p2-export-bookmark 607 navi2ch-bookmark-list)))) 608 1 609 0) 610 (or (cdr (assq 'name article)) "") 611 (or (cdr (assq 'mail article)) "") 612 (1+ (string-to-number 613 response)) 614 (navi2ch-url-to-host 615 (cdr (assq 'uri board))) 616 (cdr (assq 'id board))))) 617 618(defun navi2ch-p2-export (dir) 619 (interactive "G$B=PNO@h(B: ") 620 (if (file-exists-p dir) 621 (unless (file-directory-p dir) 622 (error "%s is not a directory." dir)) 623 (make-directory dir)) 624 (let* ((navi2ch-p2-export-bookmark 625 (or navi2ch-p2-export-bookmark 626 (completing-read "Bookmark ID: " 627 navi2ch-bookmark-list 628 nil t navi2ch-bookmark-current-bookmark-id)))) 629 (message "$B$*5$$K$$$j$r%(%/%9%]!<%HCf(B...") 630 (with-temp-file (expand-file-name navi2ch-p2-favlist-file-name 631 dir) 632 (apply 'insert 633 (mapcar 634 (lambda (item) 635 (let ((board (cdr (assq 'board item)))) 636 (navi2ch-p2-make-idx-data 637 board 638 (navi2ch-article-get-file-name 639 board 640 (cdr (assq 'article item)))))) 641 (cddr (assoc navi2ch-p2-export-bookmark 642 navi2ch-bookmark-list))))) 643 (message "$B$*5$$K$$$j$r%(%/%9%]!<%HCf(B...done") 644 (message "$BMzNr$r%(%/%9%]!<%HCf(B...") 645 (with-temp-file (expand-file-name navi2ch-p2-recent-file-name 646 dir) 647 (apply 'insert 648 (mapcar 649 (lambda (item) 650 (let ((board (nth 1 item))) 651 (navi2ch-p2-make-idx-data 652 board 653 (navi2ch-article-get-file-name 654 board 655 (nth 2 item))))) 656 navi2ch-history-alist))) 657 (message "$BMzNr$r%(%/%9%]!<%HCf(B...done") 658 ;; (message "$B=q$-$3$_MzNr$r%(%/%9%]!<%HCf(B...") 659 ;; (message "$B=q$-$3$_MzNr$r%(%/%9%]!<%HCf(B...done") 660 (message "$B$"$\!<$s%o!<%I$r%(%/%9%]!<%HCf(B...") 661 (dolist (part '("name" "mail" "message" "id")) 662 (with-temp-file (expand-file-name 663 (symbol-value 664 (intern (concat "navi2ch-p2-ng-" 665 part 666 "-file-name"))) 667 dir) 668 (apply 669 'insert 670 (mapcar 671 (lambda (item) 672 (if (eq (cdr item) 'hide) 673 (let* ((rule (car item)) 674 (maybe-matchstr (if (consp rule) 675 (car rule) 676 rule)) 677 (char (and (consp rule) 678 (stringp maybe-matchstr) 679 (string-to-char 680 (symbol-name (cadr rule))))) 681 (case-fold (and char 682 (eq char 683 (setq char (downcase char))))) 684 (invert (and char 685 (plist-get rule :invert))) 686 (bbs (plist-get rule :board-id)) 687 (artid (plist-get rule :artid)) 688 (file (and artid 689 (navi2ch-article-get-file-name 690 (dolist (x navi2ch-list-board-name-list) 691 (when (string= artid (cdr (assq 'id x))) 692 (return x))) 693 (list (cons 'artid artid))))) 694 (subject 695 (and artid file 696 (file-exists-p file) 697 (file-readable-p file) 698 (cdr (assq 699 'subject 700 (navi2ch-article-get-first-message-from-file 701 file))))) 702 (regexp 703 (cond 704 ((eq char ?r) 705 maybe-matchstr) 706 ((eq char ?s) 707 (regexp-quote maybe-matchstr)) 708 ((eq char ?e) 709 (concat "^" 710 (regexp-quote maybe-matchstr) 711 "$")) 712 ((eq char ?f) 713 (navi2ch-fuzzy-regexp maybe-matchstr 714 case-fold 715 "[$B!!(B \f\t\n\r\v]*")) 716 (t nil)))) 717 (concat 718 (if regexp 719 (if invert 720 "<regex:i>" 721 "<regex>") 722 (if invert 723 "<invert>" 724 "")) 725 (if bbs (concat "<bbs>" bbs "</bbs>") "") 726 (if subject 727 (concat "<title>" 728 (regexp-quote subject) 729 "</title>") 730 "") 731 (or regexp maybe-matchstr) 732 "\t\t0\n")) 733 "")) 734 (symbol-value 735 (intern (concat "navi2ch-article-message-filter-by-" 736 part 737 "-alist"))))))) 738 (message "$B$"$\!<$s%o!<%I$r%(%/%9%]!<%HCf(B...done") 739 (message "dat, idx $B$r%(%/%9%]!<%HCf(B...") 740 (lexical-let ((dir dir)) 741 (navi2ch-search-for-each-article 742 (lambda (board file) 743 (let* ((artid (navi2ch-article-file-name-to-artid file)) 744 (article (navi2ch-article-load-info 745 board 746 (list (cons 'artid artid)))) 747 (subject (assq 'subject 748 (navi2ch-article-get-first-message-from-file 749 file board))) 750 (response (or (cdr (assq 'response article)) 751 "0")) 752 (dat-dir (navi2ch-p2-get-dat-dir board dir))) 753 (when (and (file-exists-p file) 754 (file-readable-p file)) 755 (make-directory dat-dir t) 756 (funcall navi2ch-p2-dat-copy-function 757 file 758 (expand-file-name (file-name-nondirectory file) 759 dat-dir) 760 t)) 761 (with-temp-file (expand-file-name (concat artid ".idx") 762 dat-dir) 763 (insert (navi2ch-p2-make-idx-data board file))))) 764 (navi2ch-search-all-board-list))) 765 (message "dat, idx $B$r%(%/%9%]!<%HCf(B...done"))) 766 767(defun navi2ch-p2-encode-string (text) 768 (when (stringp text) 769 (setq text 770 (base64-encode-string 771 (encode-coding-string text navi2ch-p2-coding-system) 772 t)) 773 (while (string-match "[/+]" text) 774 (setq text (replace-match 775 (if (string= (match-string 0 text) "/") 776 "%2F" 777 "%2B") 778 nil nil text))) 779 text)) 780 781(defun navi2ch-p2-decode-string (text) 782 (when (stringp text) 783 (while (string-match "%2\\(B\\|F\\)" text) 784 (setq text (replace-match 785 (if (string= (match-string 1 text) "F") 786 "/" 787 "+") 788 nil nil text))) 789 (decode-coding-string 790 (base64-decode-string text) 791 navi2ch-p2-coding-system))) 792;;; navi2ch-p2.el ends here 793