navi2ch-oyster.el

   1 ;;; navi2ch-oyster.el --- oyster module for Navi2ch. -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006 by Navi2ch Project
   4
   5 ;; Author: MIZUNUMA Yuto <mizmiz@users.sourceforge.net>
   6 ;; Keywords: network 2ch
   7
   8 ;; This file is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; This file is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; \e$B#2$A$c$s$M$k%S%e!<%"\e(B(\e$BDL>N!|\e(B)\e$B$r;H$C$F=q$-9~$_$7$?$j2a5n%m%0$r<hF@$G$-$k$h$&$K$J$j$^$9!#\e(B
  26 ;; oyster\e$B$H$$$&C18l$O!|$N=i4|$N3+H/%3!<%I%M!<%`$_$?$$$J$b$N$G$7$?!#\e(B
  27 ;; \e$B!|$N@5<0$J>&IJL>$O9uF&$H$$$&$i$7$$$G$9\e(B(\e$B%3%s%S%K7h:QNN<}=q$h$j\e(B)\e$B!#\e(B
  28 ;; \e$B;EMM\e(B http://kage.monazilla.org/system_DOLIB100.html
  29 ;;
  30 ;; \e$B%$%s%9%H!<%k!'\e(B
  31 ;; \e$B!|\e(BSESSION-ID\e$B<hF@$N$?$a$K!"\e(BSSL\e$B%"%/%;%9$G$-$k%i%$%V%i%j\e(B(gnu-tls\e$B$J$I\e(B)\e$B$,I,MW\e(B
  32 ;; Windows: cygwin\e$B$N\e(Bgnutls\e$B$r%$%s%9%H!<%k!#\e(Bgnutls-cli.exe\e$B$,%Q%9$KF~$C$F$$$k$3$H!#\e(B
  33 ;; Linux: gnutls\e$B$r\e(Bapt\e$B$J$I$G%$%s%9%H!<%k\e(B
  34 ;;
  35 ;; \e$B;HMQNc!'\e(B
  36 ;; M-x navi2ch-oyster-login \e$B$G%m%0%$%s!#\e(B
  37 ;; \e$B=q$-9~$_;~$K%"%/%;%96X;_$N%(%i!<$r<u$1$F!"\e(B'y'\e$B$G%m%0%$%s$b2D!#\e(B
  38 ;; \e$B!|%m%0%$%s>uBV$K$"$l$P!"2a5n%m%0<hF@$9$k\e(B(y-or-n\e$B$GJ9$+$l$k\e(B)
  39 ;; M-x navi2ch-oyster-logout \e$B$G%m%0%"%&%H\e(B
  40 ;;
  41 ;; \e$B!|$N\e(BSESSION-ID\e$B$N@8B84|4V$O1=$G$O\e(B24\e$B;~4V$H8@$o$l$F$$$^$9$,!"\e(B
  42 ;; \e$B;EMM$KL@5-$5$l$F$$$J$$$N$G\e(Bnavi2ch\e$BB&$G\e(Bexpire\e$B$O$;$:!"%(%i!<$G%j%H%i%$<hF@$7$^$9!#\e(B
  43
  44 ;;; Code:
  45
  46 (provide 'navi2ch-oyster)
  47
  48 (defconst navi2ch-oyster-ident
  49   "$Id$")
  50
  51 (eval-when-compile
  52   (require 'cl-lib)
  53   (require 'navi2ch-decls)
  54   (require 'navi2ch-inline))
  55 (require 'navi2ch-vars)
  56
  57 (autoload 'open-tls-stream "tls")
  58
  59 (defvar navi2ch-oyster-func-alist
  60   '((bbs-p              . navi2ch-oyster-p)
  61     (article-update     . navi2ch-oyster-article-update)
  62     (send-message       . navi2ch-oyster-send-message)
  63     (send-success-p     . navi2ch-oyster-send-message-success-p)
  64 ;    (extract-post      . navi2ch-2ch-extract-post)
  65     ))
  66 ;; navi2ch-net-user-agent \e$B$b\e(B multibbs \e$B2=$9$kI,MW$"$j\e(B?
  67
  68 (defvar navi2ch-oyster-variable-alist
  69   (list (cons 'coding-system navi2ch-coding-system)))
  70
  71 (navi2ch-multibbs-regist 'oyster
  72                          navi2ch-oyster-func-alist
  73                          navi2ch-oyster-variable-alist)
  74
  75 ;;-------------
  76
  77 (defvar navi2ch-oyster-use-oyster nil   ; \e$BJQ?tL>$OMW8!F$!#\e(B
  78   "*\e$B!|$r;H$&$+$I$&$+!#\e(B")
  79 (defvar navi2ch-oyster-id nil
  80   "*\e$B!|$N\e(BID(\e$B$*$=$i$/%a!<%k%"%I%l%9\e(B)")
  81 (defvar navi2ch-oyster-password nil
  82   "*\e$B!|$N%Q%9%o!<%I!#\e(B")
  83 (defvar navi2ch-oyster-server "2chv.tora3.net"
  84   "*\e$B!|\e(BID \e$B<hF@%5!<%P!#\e(B")
  85 (defvar navi2ch-oyster-cgi "/futen.cgi"
  86   "*\e$B!|\e(BID \e$B<hF@\e(B CGI\e$B!#\e(B")
  87
  88 (defvar navi2ch-oyster-session-id nil
  89   "\e$B!|%5!<%P$+$i<hF@$7$?%;%C%7%g%s\e(B ID\e$B!#\e(B")
  90
  91 (defun navi2ch-oyster-p (uri)
  92   "\e$B!|$KBP1~$9$k\e(B URI \e$B$J$i\e(B non-nil\e$B$rJV$9!#\e(B"
  93   (and navi2ch-oyster-use-oyster
  94        (or (string-match "http://.*\\.2ch\\.net/" uri)
  95            (string-match "http://.*\\.bbspink\\.com/" uri))))
  96
  97 (defun navi2ch-oyster-article-update (board article start)
  98   "BOARD, ARTICLE \e$B$KBP1~$9$k%U%!%$%k$r99?7$9$k!#\e(B
  99 START \e$B$,\e(B non-nil \e$B$J$i$P%l%9HV9f\e(B START \e$B$+$i$N:9J,$r<hF@$9$k!#\e(B
 100 START \e$B$+$i$8$c$J$$$+$b$7$l$J$$$1$I!&!&!&!#\e(B
 101 \e$BJV$jCM$O\e(B HEADER\e$B!#\e(B"
 102   (let ((file (navi2ch-article-get-file-name board article))
 103         (time (cdr (assq 'time article)))
 104         (url (navi2ch-article-get-url board article))
 105         header)
 106     (setq header (if start
 107                      (navi2ch-net-update-file-diff url file time)
 108                    (navi2ch-net-update-file url file time)))
 109     ;; \e$B%(%i!<$@$C$?$i2a5n%m%0$r<hF@\e(B
 110     (when (navi2ch-net-get-state 'error header)
 111       (setq url (navi2ch-article-get-kako-url board article))
 112       (setq header (navi2ch-net-update-file url file))
 113
 114       ;; \e$B$d$C$Q$j%@%a$@$C$?$i\e(B ID \e$B$r;H$C$F2a5n%m%0$r<hF@\e(B
 115       (if (not (navi2ch-net-get-state 'error header))
 116           (setq header (navi2ch-net-add-state 'kako header))
 117         (when (y-or-n-p "\e$B!|$r;H$C$F2a5n%m%0$r<hF@$7$^$9$+!)\e(B")
 118           (unless navi2ch-oyster-session-id
 119             (navi2ch-oyster-login))
 120           (setq url (navi2ch-oyster-get-offlaw-url
 121                      board article navi2ch-oyster-session-id file))
 122 ;         (message "offlaw url %s" url)
 123           (setq header
 124                 (if start
 125                     (progn
 126                       (message "article %s" article)
 127                       (navi2ch-oyster-update-file-with-offlaw url file time t))
 128                   (prog1
 129                       (navi2ch-oyster-update-file-with-offlaw url file time nil)
 130 ;                    (message "Getting from 0 offlaw.cgi")
 131                     )))
 132           (unless (navi2ch-net-get-state 'error header)
 133             (setq header (navi2ch-net-add-state 'kako header))))))
 134     header))
 135
 136 (defun navi2ch-oyster-send-message
 137   (from mail message subject bbs key time board article &optional post)
 138   (let ((post (navi2ch-put-alist "sid"
 139                                  ;;\e$B%;%C%7%g%s\e(BID\e$B<hF@:Q$_$G$"$l$P!|$G=q$-9~$_\e(B
 140                                  (or navi2ch-oyster-session-id "")
 141                                  post)))
 142     (navi2ch-2ch-send-message from mail message subject bbs key
 143                               time board article post)))
 144
 145 (defun navi2ch-oyster-send-message-success-p (proc)
 146   (when proc
 147     (let ((str (navi2ch-net-get-content proc)))
 148       (setq str (decode-coding-string str navi2ch-p2-coding-system))
 149       (cond ((or (string-match "\e$B=q$-$3$_$^$7$?!#\e(B" str)
 150                  (string-match "\e$B=q$-$3$_$,=*$o$j$^$7$?!#\e(B" str))
 151              t)
 152             ((or (string-match "<b>\e$B%/%C%-!<$,$J$$$+4|8B@Z$l$G$9!*\e(B</b>" str)
 153                  (string-match "<b>\e$B=q$-$3$_!u%/%C%-!<3NG'\e(B</b>" str))
 154              'retry)
 155             ((string-match "\e$B#E#R#R#O#R!'%"%/%;%95,@)Cf$G$9!*!*\e(B" str)
 156              (if (not (y-or-n-p "\e$B%"%/%;%95,@)Cf$G$9$,!|%m%0%$%s$7$^$9$+!)\e(B"))
 157                  nil
 158                (message "\e$B!|\e(Blogin..")
 159                (navi2ch-oyster-login)
 160                (if navi2ch-oyster-session-id
 161                    'retry
 162                  nil)))
 163             (t
 164              (message "\e$B!|\e(Berror::%s" str)
 165              nil)))))
 166
 167 (defun navi2ch-oyster-get-offlaw-url (board article session-id file)
 168   "BOARD, ARTICLE, SESSION-ID, FILE \e$B$+$i\e(B offlaw url \e$B$KJQ49!#\e(B"
 169   (let ((uri (navi2ch-board-get-uri board))
 170         (artid (cdr (assq 'artid article)))
 171         (size 0)
 172         encoded-s)
 173     (setq encoded-s (navi2ch-net-url-hexify-string session-id))
 174     (when (file-exists-p file)
 175       (setq size (max 0 (navi2ch-file-size file))))
 176     (string-match "\\(.*\\)\\/\\([^/]*\\)\\/" uri)
 177     (format "%s/test/offlaw.cgi/%s/%s/?raw=.%s&sid=%s"
 178             (match-string 1 uri) (match-string 2 uri) artid size encoded-s)))
 179
 180 (defun navi2ch-oyster-update-file-with-offlaw (url file &optional time diff)
 181   "FILE \e$B$r\e(B URL \e$B$+$i\e(B offlaw.cgi \e$B$r;H$C$F99?7$9$k!#\e(B
 182 TIME \e$B$,\e(B non-nil \e$B$J$i$P\e(B TIME \e$B$h$j?7$7$$;~$@$199?7$9$k!#\e(B
 183 DIFF \e$B$,\e(B non-nil \e$B$J$i$P:9J,$r<hF@$9$k!#\e(B
 184 \e$B99?7$G$-$l$P\e(B HEADER \e$B$rJV$9!#\e(B"
 185   (let ((dir (file-name-directory file))
 186         proc header status)
 187     (unless (file-exists-p dir)
 188       (make-directory dir t))
 189     (setq proc (navi2ch-net-download-file url time))
 190     (setq header (and proc
 191                       (navi2ch-net-get-header proc)))
 192     (setq status (and proc
 193                       (navi2ch-net-get-status proc)))
 194     (cond ((or (not proc)
 195                (not header)
 196                (not status))
 197            (setq header (navi2ch-net-add-state 'error header)))
 198           ((string= status "304")
 199            (setq header (navi2ch-net-add-state 'not-updated header)))
 200           ((string= status "200")
 201            (let ((coding-system-for-write 'binary)
 202                  (coding-system-for-read 'binary)
 203                  cont)
 204              (message "%s: getting file with offlaw.cgi..." (current-message))
 205              (setq cont (navi2ch-net-get-content proc))
 206              (if (or (string= cont "")
 207                      (not cont))
 208                  (progn (message "%sfailed" (current-message))
 209                         (signal 'navi2ch-update-failed nil))
 210                (message "%sdone" (current-message))
 211                (let (state data cont-size)
 212                  (when (string-match "^\\([^ ]+\\) \\(.+\\)\n" cont)
 213                    (setq state (match-string 1 cont))
 214                    (setq data (match-string 2 cont))
 215                    (setq cont (replace-match "" t nil cont)))
 216                  (when (and (string-match "\\(OK\\|INCR\\)" state)
 217                             (string-match "\\(.+\\)/\\(.+\\)K" data))
 218                    (setq cont-size (string-to-number (match-string 1 data))))
 219                  (cond
 220                   ((string= "+OK" state)
 221                    (with-temp-file file
 222                      (navi2ch-set-buffer-multibyte nil)
 223                      (when (and (file-exists-p file) diff)
 224                        (insert-file-contents file)
 225                        (goto-char (point-max)))
 226                      (insert (substring cont 0 cont-size))))
 227                   ((string= "-INCR" state) ;; \e$B$"$\!<$s\e(B
 228                    (with-temp-file file
 229                      (navi2ch-set-buffer-multibyte nil)
 230                      (insert (substring cont 0 cont-size)))
 231                    (setq header (navi2ch-net-add-state 'aborn header)))
 232                   (t
 233                    (when (string= "-ERR" state)
 234                      (let ((err-msg (decode-coding-string
 235                                      data navi2ch-coding-system)))
 236                        (message "Error! %s" err-msg)
 237                        (when (string-match "\e$B;XDj;~4V$,2a$.$^$7$?!#\e(B" err-msg)
 238                          (if (not (y-or-n-p "\e$B!|\e(BSESSION-ID\e$B$NM-8z4|8B$,@Z$l$^$7$?%m%0%$%s$7$^$9$+!)\e(B"))
 239                              (setq header (navi2ch-net-add-state 'error header))
 240                            (message "\e$B!|\e(Blogin..")
 241                            (navi2ch-oyster-login)
 242                              )))                   )))))))
 243           (t
 244            (setq header (navi2ch-net-add-state 'error header))))
 245     header))
 246
 247 (defun navi2ch-oyster-get-status-from-proc (proc)
 248   "PROC\e$B@\B3$N\e(BHTTP\e$B%9%F!<%?%9It$rJV$9!#\e(B"
 249   (with-current-buffer (process-buffer proc)
 250          (while (and (memq (process-status proc) '(open run))
 251                      (goto-char (point-min))
 252                      (not (looking-at "HTTP/1\\.[01] \\([0-9]+\\)")))
 253            (accept-process-output proc))
 254          (sleep-for 1)
 255          (goto-char (point-min))
 256          (let ((i 3))
 257            (catch 'loop
 258              (while (>= (setq i (1- i)) 0)
 259 ;               (sleep-for 1)     ; \e$B2?$@$+$&$^$/F0$+$J$$$N$G\e(Bwait\e$BF~$l$?\e(B
 260                (accept-process-output proc 1)
 261                (goto-char (point-min))
 262                ;; \e$B:G8e$^$G8+$D$+$i$J$$$^$^$@$H%(%i!<\e(B
 263                (when (search-forward "HTTP/1\." nil (> i 0))
 264                  (throw 'loop
 265                         (if (looking-at "[01] \\([0-9]+\\).+\n")
 266                             (match-string 1)))))))))
 267
 268 (defun navi2ch-oyster-get-session-id-from-proc (proc)
 269   "proc\e$B$+$i!|$N\e(BSESSIOIN-ID\e$B$r<hF@\e(B"
 270    (or (with-current-buffer (process-buffer proc)
 271          (while (and (eq (process-status proc) 'open)
 272                      (goto-char (point-min))
 273                      (not (search-forward "HTTP/1\\.[01] \\([0-9]+\\)")))
 274            (accept-process-output proc)
 275            (message "Retrying")
 276            (sleep-for 2))
 277          (let ((i 10))
 278            (catch 'loop
 279              (while (>= (setq i (1- i)) 0)
 280 ;               (sleep-for 1)     ; \e$B2?$@$+$&$^$/F0$+$J$$$N$G\e(Bwait\e$BF~$l$?\e(B
 281                (accept-process-output proc 1)
 282                (goto-char (point-min))
 283                ;; \e$B:G8e$^$G8+$D$+$i$J$$$^$^$@$H%(%i!<\e(B
 284                (when (search-forward "SESSION-ID=" nil (> i 0))
 285                  (throw 'loop
 286                         (if (looking-at "\\(.*\\)\n")
 287                             (match-string 1))))))))))
 288
 289 (defun navi2ch-oyster-login ()
 290   "\e$B!|$N%5!<%P$K%m%0%$%s$7$F\e(B session-id \e$B$r<hF@$9$k!#\e(B"
 291   (interactive)
 292   (let (buf proc strus)
 293     (message "\e$B!|$N%5!<%P$K%m%0%$%s$7$^$9\e(B")
 294     (setq buf (get-buffer-create (concat " *" "navi2ch oyster-ssl")))
 295     (with-current-buffer buf
 296       (erase-buffer)
 297       (setq proc (open-tls-stream "ssl" buf navi2ch-oyster-server 443))
 298       (let ((contents (concat "ID=" navi2ch-oyster-id
 299                               "&PW=" navi2ch-oyster-password)))
 300         (process-send-string proc
 301                              (concat
 302                               (concat "POST " navi2ch-oyster-cgi " HTTP/1.1\n")
 303                               (concat "Host: " navi2ch-oyster-server "\n")
 304                               "Accept: */*\n"
 305                               (concat "Referer: https://" navi2ch-oyster-server "/\n")
 306                               "User-Agent: DOLIB/1.00\n"
 307                               "X-2ch-UA: "
 308                               (format "Navigator for 2ch %s" navi2ch-version) "\n"
 309                               "Content-Length: "
 310                               (number-to-string (length contents)) "\n"
 311                               "Connection: close\n"
 312                               "\n"
 313                               contents "\n")))
 314       (setq status (navi2ch-oyster-get-status-from-proc proc))
 315       (cond
 316        ((string= status "200")
 317         (setq navi2ch-oyster-session-id (navi2ch-oyster-get-session-id-from-proc proc))
 318         (if (and navi2ch-oyster-session-id
 319                  (not (string-match "ERROR:.+" navi2ch-oyster-session-id)))
 320             (message "\e$B!|\e(BID\e$B<hF@\e(B ID=%s" navi2ch-oyster-session-id)
 321           (setq navi2ch-oyster-session-id nil)
 322           (error "\e$B!|\e(BID\e$B<hF@\e(BERROR \e$B$*$=$i$/4|8B@Z$l\e(B")))
 323        ((string= status "400")
 324         (message "\e$B!|\e(BID\e$B<hF@\e(BERROR \e$B%5!<%PITD4\e(B %s" status)))
 325       (kill-buffer buf))))
 326
 327 (defun navi2ch-oyster-logout ()
 328   "\e$B!|$N%m%0%"%&%H\e(B"
 329   (interactive)
 330   (setq navi2ch-oyster-session-id nil)
 331   (message "\e$B!|$N%5!<%P$+$i%m%0%"%&%H$7$^$7$?\e(B"))
 332
 333 ;;; navi2ch-oyster.el ends here