navi2ch-localfile.el

   1 ;;; navi2ch-localfile.el --- View localfile for Navi2ch. -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008 by Navi2ch Project
   4
   5 ;; Author: Nanashi San <nanashi@users.sourceforge.net>
   6 ;; Part6 \e$B%9%l$N\e(B 427 \e$B$NL>L5$7$5$s\e(B
   7 ;; <http://pc.2ch.net/test/read.cgi/unix/1023884490/427>
   8
   9 ;; Keywords: 2ch, network
  10
  11 ;; This file is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This file is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; \e$B$^$:!"\e(BBBS \e$B$rMQ0U$7$?$$%G%#%l%/%H%j$r:n$k!#\e(B
  29 ;;  % mkdir /tmp/localfile
  30 ;; \e$B<!$K!"%G%#%l%/%H%j$N%Q!<%_%C%7%g%s$rE,@Z$K@_Dj$9$k!#\e(B
  31 ;;  % chgrp navi2ch /tmp/localfile
  32 ;;  % chmod g+w /tmp/localfile
  33 ;;  % chmod g+s /tmp/localfile (OS \e$B$K$h$C$F$OI,MW\e(B)
  34 ;; \e$B:G8e$K!"FI$_=q$-$7$?$$E[$i$N\e(B etc.txt \e$B$K\e(B
  35 ;; ====
  36 ;; \e$B%m!<%+%k%U%!%$%k%F%9%H\e(B
  37 ;; x-localbbs:///tmp/localfile
  38 ;; localfile
  39 ;; ====
  40 ;; \e$B$N$h$&$K@_Dj$7$F$d$k$H!"%G%#%l%/%H%j\e(B /tmp/localfile \e$B$K=q$-9~$_$^$9!#\e(B
  41
  42 ;;; Code:
  43 (provide 'navi2ch-localfile)
  44
  45 (defconst navi2ch-localfile-ident
  46   "$Id$")
  47
  48 (eval-when-compile
  49   (require 'cl-lib)
  50   (require 'navi2ch-decls)
  51   (require 'navi2ch-inline))
  52 (require 'navi2ch-vars)
  53
  54 (defcustom navi2ch-localfile-cache-name "localfile"
  55   "*\e$B%m!<%+%k\e(B BBS \e$B$N>pJs$rJ]B8$9$k%G%#%l%/%H%j$NL>A0!#\e(B
  56 `navi2ch-directory' \e$B$+$i$NAjBP%Q%9$r;XDj$9$k!#\e(B"
  57   :type 'string
  58   :group 'navi2ch-localfile)
  59
  60 (defcustom navi2ch-localfile-default-file-modes (+ (* 64 7) (* 8 7) 5)
  61   "*\e$B%m!<%+%k\e(B BBS \e$B$K%U%!%$%k$r=q$-9~$`:]$K;HMQ$9$k\e(B `default-file-modes'\e$B!#\e(B
  62 \e$B0UL#$,$"$k$N$O\e(B8\e$B?J?t$J$N$G@8$GA`:n$9$k;~$OCm0U!#\e(B"
  63   :type '(choice (const :tag "\e$BFCDj%0%k!<%W$NE[$i$N$_$,=q$-$3$a$k\e(B" (+ (* 64 7) (* 8 7) 5))
  64                  (const :tag "\e$B<+J,$N$_$,=q$-$3$a$k\e(B" (+ (* 64 7) (* 8 5) 5))
  65                  (const :tag "\e$BFCDj%0%k!<%W$NE[$i$N$_$,FI$_=q$-$G$-$k\e(B" (+ (* 64 7) (* 8 5)))
  66                  (const :tag "\e$B<+J,$N$_$,FI$_=q$-$G$-$k\e(B" (* 64 7)))
  67   :group 'navi2ch-localfile)
  68
  69 (defcustom navi2ch-localfile-default-user-name "\e$BL>L5$7$5$s\e(B"
  70   "*\e$B%m!<%+%k\e(B BBS \e$B$K=q$-9~$`:]$NL>L5$7$NL>A0!#\e(B"
  71   :type 'string
  72   :group 'navi2ch-localfile)
  73
  74 (defvar navi2ch-localfile-regexp "\\`x-localbbs://")
  75 (defvar navi2ch-localfile-use-lock t)
  76 (defvar navi2ch-localfile-lock-name "lockdir_localfile")
  77
  78 (defvar navi2ch-localfile-func-alist
  79   '((bbs-p              . navi2ch-localfile-p)
  80     (article-update     . navi2ch-localfile-article-update)
  81     (article-to-url     . navi2ch-localfile-article-to-url)
  82     (url-to-board       . navi2ch-localfile-url-to-board)
  83     (url-to-article     . navi2ch-localfile-url-to-article)
  84     (send-message       . navi2ch-localfile-send-message)
  85     (send-success-p     . navi2ch-localfile-send-message-success-p)
  86     (error-string       . navi2ch-localfile-error-string)
  87     (board-update       . navi2ch-localfile-board-update)
  88     (board-get-file-name . navi2ch-localfile-board-get-file-name)))
  89
  90 (defvar navi2ch-localfile-variable-alist
  91   (list (cons 'coding-system navi2ch-coding-system)))
  92
  93 (navi2ch-multibbs-regist 'localfile
  94                          navi2ch-localfile-func-alist
  95                          navi2ch-localfile-variable-alist)
  96
  97 ;;-------------
  98
  99 ;; internal functions like bbs.cgi
 100 (defconst navi2ch-localfile-coding-system
 101   (intern (format "%s-unix" navi2ch-coding-system)))
 102
 103 (defvar navi2ch-localfile-encode-html-tag-alist
 104   '((">" . "&gt;")
 105     ("<" . "&lt;")
 106     ("\n" . "<br>")))
 107
 108 (defvar navi2ch-localfile-subject-file-name "subject.txt")
 109
 110 (defun navi2ch-localfile-lock (dir)
 111   "`navi2ch-directory' \e$B$r%m%C%/$9$k!#\e(B"
 112   (when navi2ch-localfile-use-lock
 113     (let ((redo t)
 114           error-message)
 115       (while redo
 116         (setq redo nil)
 117         (unless (navi2ch-lock-directory dir navi2ch-localfile-lock-name)
 118           (setq error-message "\e$B%G%#%l%/%H%j$N%m%C%/$K<:GT$7$^$7$?!#\e(B")
 119           (cond ((y-or-n-p (format "%s\e$B$b$&0lEY;n$7$^$9$+\e(B? "
 120                                    error-message))
 121                  (setq redo t))
 122                 ((yes-or-no-p (format "%s\e$B4m81$r>5CN$GB3$1$^$9$+\e(B? "
 123                                       error-message))
 124                  nil)
 125                 (t
 126                  (error "Lock failed"))))))))
 127
 128 (defun navi2ch-localfile-unlock (dir)
 129   "DIR \e$B$N%m%C%/$r2r=|$9$k!#\e(B"
 130   (when navi2ch-localfile-use-lock
 131     (navi2ch-unlock-directory dir navi2ch-localfile-lock-name)))
 132
 133 (defmacro navi2ch-localfile-with-lock (directory &rest body)
 134   "DIRECTORY \e$B$r%m%C%/$7!"\e(BBODY \e$B$r<B9T$9$k!#\e(B
 135 BODY \e$B$N<B9T8e$O\e(B DIRECTORY \e$B$N%m%C%/$r2r=|$9$k!#\e(B"
 136   `(unwind-protect
 137        (progn
 138          (navi2ch-localfile-lock ,directory)
 139          ,@body)
 140      (navi2ch-localfile-unlock ,directory)))
 141
 142 (put 'navi2ch-localfile-with-lock 'lisp-indent-function 1)
 143
 144 (defun navi2ch-localfile-encode-string (string)
 145   (let* ((alist navi2ch-localfile-encode-html-tag-alist)
 146          (regexp (regexp-opt (mapcar 'car alist))))
 147     (navi2ch-replace-string regexp (lambda (key)
 148                                      (cdr (assoc key alist)))
 149                             string t)))
 150
 151 (defun navi2ch-localfile-encode-message (from mail time message
 152                                               &optional subject)
 153   (format "%s<>%s<>%s<>%s<>%s\n"
 154           (navi2ch-localfile-encode-string from)
 155           (navi2ch-localfile-encode-string mail)
 156           (format-time-string "%y/%m/%d %R" time)
 157           (navi2ch-localfile-encode-string message)
 158           (navi2ch-localfile-encode-string (or subject ""))))
 159
 160 (defun navi2ch-localfile-update-subject-file (directory
 161                                               &optional article-id sage-flag)
 162   "DIRECTORY \e$B0J2<$N\e(B `navi2ch-localfile-subject-file-name' \e$B$r99?7$9$k!#\e(B
 163 ARTICLE-ID \e$B$,;XDj$5$l$F$$$l$P$=$N%"!<%F%#%/%k$N$_$r99?7$9$k!#\e(B
 164 `navi2ch-localfile-subject-file-name' \e$B$K;XDj$5$l$?%"!<%F%#%/%k$,L5$$>l\e(B
 165 \e$B9g$O\e(B SUBJECT \e$B$r;HMQ$9$k!#\e(BDIRECTORY \e$B$O8F$S=P$785$G%m%C%/$7$F$*$/$3$H!#\e(B"
 166   (if (not article-id)
 167       (dolist (file (directory-files (expand-file-name "dat" directory)
 168                                      nil "\\`[0-9]+\\.dat\\'"))
 169         (navi2ch-localfile-update-subject-file
 170          directory (file-name-sans-extension file)))
 171     (let* ((coding-system-for-read navi2ch-localfile-coding-system)
 172            (coding-system-for-write navi2ch-localfile-coding-system)
 173            (dat-directory (expand-file-name "dat" directory))
 174            (article-file (expand-file-name (concat article-id ".dat")
 175                                            dat-directory))
 176            (subject-file (expand-file-name navi2ch-localfile-subject-file-name
 177                                            directory))
 178            (temp-file (navi2ch-make-temp-file subject-file))
 179            subject lines new-line)
 180       (unwind-protect
 181           (progn
 182             (with-temp-buffer
 183               (insert-file-contents article-file)
 184               (setq lines (count-lines (point-min) (point-max)))
 185               (goto-char (point-min))
 186               (let ((list (split-string (buffer-substring (point-min)
 187                                                           (progn
 188                                                             (end-of-line)
 189                                                             (point)))
 190                                         "<>")))
 191                 (setq subject (or (nth 4 list) ""))))
 192             (setq new-line
 193                   (format "%s.dat<>%s (%d)\n" article-id subject lines))
 194             (with-temp-file temp-file
 195               (if (file-exists-p subject-file)
 196                   (insert-file-contents subject-file))
 197               (goto-char (point-min))
 198               (if (re-search-forward (format "^%s\\.dat<>[^\n]+\n"
 199                                              article-id) nil t)
 200                   (replace-match "")
 201                 (goto-char (point-max))
 202                 (if (and (char-before)
 203                          (not (= (char-before) ?\n))) ; \e$BG0$N$?$a\e(B
 204                     (insert "\n")))
 205               (unless sage-flag
 206                 (goto-char (point-min)))
 207               (insert new-line))
 208             (rename-file temp-file subject-file t))
 209         (if (file-exists-p temp-file)
 210             (delete-file temp-file))))))
 211
 212 ;; \e$B"-$H$j$"$($:%9%?%V!#>-MhE*$K$O\e(B SETTING.TXT \e$B$rFI$`$h$&$K$7$?$$!#\e(B
 213 (defun navi2ch-localfile-default-user-name (directory)
 214   "DIRECTORY \e$B$G$N%G%U%)%k%H$NL>L5$7$5$s$rJV$9!#\e(B"
 215   navi2ch-localfile-default-user-name)
 216
 217 (defun navi2ch-localfile-create-thread (directory from mail message subject)
 218   "DIRECTORY \e$B0J2<$K%9%l$r:n$k!#\e(B"
 219   (if (string= from "")
 220       (setq from (navi2ch-localfile-default-user-name directory)))
 221   (navi2ch-with-default-file-modes navi2ch-localfile-default-file-modes
 222     (navi2ch-localfile-with-lock directory
 223       (let ((coding-system-for-read navi2ch-localfile-coding-system)
 224             (coding-system-for-write navi2ch-localfile-coding-system)
 225             (dat-directory (expand-file-name "dat" directory))
 226             now article-id file)
 227         (unless (file-exists-p dat-directory)
 228           (make-directory dat-directory t))
 229         (while (progn
 230                  (setq now (current-time)
 231                        article-id (format-time-string "%s" now)
 232                        file (expand-file-name (concat article-id ".dat")
 233                                               dat-directory))
 234                  ;; \e$B$3$3$G%U%!%$%k$r%"%H%_%C%/$K:n$j$?$$$H$3$@$1$I!"\e(B
 235                  ;; write-region \e$B$K\e(B mustbenew \e$B0z?t$NL5$$\e(B XEmacs \e$B$G$I$&\e(B
 236                  ;; \e$B$d$l$P$$$$$s$@$m$&!#!#!#\e(B
 237                  (file-exists-p file))
 238           (sleep-for 1))                ; \e$B$A$g$C$HBT$C$F$_$k!#\e(B
 239         (with-temp-file file
 240           (insert (navi2ch-localfile-encode-message
 241                    from mail now message subject)))
 242         (navi2ch-localfile-update-subject-file directory article-id
 243                                                (string-match "sage" mail))))))
 244
 245 (defun navi2ch-localfile-append-message (directory article-id
 246                                                    from mail message)
 247   "DIRECTORY \e$B$N\e(B ARTICLE-ID \e$B%9%l$K%l%9$rIU$1$k!#\e(B"
 248   (if (string= from "")
 249       (setq from (navi2ch-localfile-default-user-name directory)))
 250   (navi2ch-with-default-file-modes navi2ch-localfile-default-file-modes
 251     (navi2ch-localfile-with-lock directory
 252       (let* ((coding-system-for-read navi2ch-localfile-coding-system)
 253              (coding-system-for-write navi2ch-localfile-coding-system)
 254              (dat-directory (expand-file-name "dat" directory))
 255              (file (expand-file-name (concat article-id ".dat")
 256                                      dat-directory))
 257              (temp-file (navi2ch-make-temp-file file)))
 258         (unwind-protect
 259             (when (file-readable-p file)
 260               (with-temp-file temp-file
 261                 (insert-file-contents file)
 262                 (goto-char (point-max))
 263                 (if (not (= (char-before) ?\n)) ; \e$BG0$N$?$a\e(B
 264                     (insert "\n"))
 265                 (insert (navi2ch-localfile-encode-message
 266                          from mail (current-time) message)))
 267               (rename-file temp-file file t))
 268           (if (file-exists-p temp-file)
 269               (delete-file temp-file)))
 270         (navi2ch-localfile-update-subject-file directory article-id
 271                                                (string-match "sage" mail))))))
 272
 273 ;; interface functions for multibbs
 274 (defun navi2ch-localfile-p (uri)
 275   "URI \e$B$,\e(B localfile \e$B$J$i\e(B non-nil\e$B$rJV$9!#\e(B"
 276   (string-match navi2ch-localfile-regexp uri))
 277
 278 (defun navi2ch-localfile-article-update (board article start)
 279   "BOARD ARTICLE \e$B$N5-;v$r99?7$9$k!#\e(B"
 280   (let* ((url (navi2ch-article-get-url board article))
 281          (file (navi2ch-article-get-file-name board article))
 282          (time (or (cdr (assq 'time article))
 283                    (and (file-exists-p file)
 284                         (navi2ch-http-date-encode (navi2ch-file-mtime file))))))
 285     (navi2ch-localfile-update-file url file time)))
 286
 287 (defun navi2ch-localfile-article-to-url
 288   (board article &optional start end nofirst)
 289   (let* ((uri (cdr (assq 'uri board)))
 290          (artid (cdr (assq 'artid article)))
 291          url)
 292     (unless (string= (substring uri -1) "/")
 293       (setq uri (concat uri "/")))
 294     (if (null artid)
 295         uri
 296       (setq url (concat uri "dat/" artid ".dat/"))
 297       (when (numberp start)
 298         (setq start (number-to-string start)))
 299       (when (numberp end)
 300         (setq end (number-to-string end)))
 301       (if (equal start end)
 302           (concat url start)
 303         (concat url
 304                 start (and (or start end) "-") end
 305                 (and nofirst "n"))))))
 306
 307 (defun navi2ch-localfile-url-to-board (url)
 308   (let (list uri id)
 309     (cond
 310      ((string-match
 311        "\\`\\(x-localbbs://.*/\\([^/]+\\)\\)/dat/[0-9]+\\.dat" url)
 312       (setq uri (match-string 1 url)
 313             id  (match-string 2 url)))
 314      ((string-match
 315        "\\`\\(x-localbbs://.*/\\([^/]+\\)\\)/?$" url)
 316       (setq uri (match-string 1 url)
 317             id  (match-string 2 url))))
 318     (when uri
 319       (setq uri (concat uri "/"))
 320       (setq list (cons (cons 'uri uri) list)))
 321     (when id
 322       (setq list (cons (cons 'id id) list)))
 323     list))
 324
 325 (defun navi2ch-localfile-url-to-article (url)
 326   (let (list)
 327     (when (string-match
 328            "\\`x-localbbs://.*/\\([0-9]+\\)\\.dat/?\\([0-9]+\\)?" url)
 329       (setq list (cons (cons 'artid (match-string 1 url))
 330                        list))
 331       (when (match-string 2 url)
 332         (setq list (cons (cons 'number
 333                                (string-to-number (match-string 2 url)))
 334                          list))))
 335     list))
 336
 337 (defvar navi2ch-localfile-last-error nil)
 338
 339 (defun navi2ch-localfile-send-message
 340   (from mail message subject bbs key time board article &optional post)
 341   (setq navi2ch-localfile-last-error
 342         (catch 'error
 343           (when (= (length message) 0)
 344             (throw 'error "\e$BK\J8$,=q$+$l$F$$$^$;$s!#\e(B"))
 345           (when (and subject
 346                      (= (length subject) 0))
 347             (throw 'error "Subject \e$B$,=q$+$l$F$$$^$;$s!#\e(B"))
 348           (save-match-data
 349             (let* ((url (navi2ch-board-get-url board))
 350                    directory)
 351               (if (string-match (concat navi2ch-localfile-regexp "\\(.+\\)")
 352                                 url)
 353                   (setq directory (file-name-directory (match-string 1 url)))
 354                 (throw 'error "\e$B2?$+JQ$G$9!#\e(B"))
 355               (if subject
 356                   ;; \e$B%9%lN)$F\e(B
 357                   (navi2ch-localfile-create-thread directory
 358                                                    from mail message subject)
 359                 ;; \e$B%l%9=q$-\e(B
 360                 (navi2ch-localfile-append-message directory key
 361                                                   from mail message))))
 362           nil)))
 363
 364 (defun navi2ch-localfile-send-message-success-p (proc)
 365   (null navi2ch-localfile-last-error))
 366
 367 (defun navi2ch-localfile-error-string (proc)
 368   navi2ch-localfile-last-error)
 369
 370 (defun navi2ch-localfile-board-update (board)
 371   (let* ((url (navi2ch-board-get-url board))
 372          (file (navi2ch-board-get-file-name board))
 373          (time (or (cdr (assq 'time board))
 374                    (and (file-exists-p file)
 375                         (navi2ch-http-date-encode (navi2ch-file-mtime file))))))
 376     (navi2ch-localfile-update-file url file time)))
 377
 378 (defun navi2ch-localfile-board-get-file-name (board &optional file-name)
 379   (let ((uri (navi2ch-board-get-uri board))
 380         (cache-dir (navi2ch-expand-file-name navi2ch-localfile-cache-name)))
 381     (when (and uri
 382                (string-match
 383                 (concat navi2ch-localfile-regexp "/*\\(.:/\\)?\\(.+\\)") uri))
 384       (expand-file-name (or file-name
 385                             navi2ch-board-subject-file-name)
 386                         (expand-file-name (match-string 2 uri) cache-dir)))))
 387
 388 (defun navi2ch-localfile-update-file (url file &optional time &rest args)
 389   (let ((directory (file-name-directory file)))
 390     (unless (file-exists-p directory)
 391       (make-directory directory t)))
 392   (let (source-file)
 393     (save-match-data
 394       (when (string-match (concat navi2ch-localfile-regexp "\\(.+\\)") url)
 395         (setq source-file (match-string 1 url))))
 396     (when (and source-file (file-readable-p source-file))
 397       (message "Checking file...")
 398       (let* ((mtime (navi2ch-file-mtime source-file))
 399              (mtime-string (navi2ch-http-date-encode mtime))
 400              header)
 401         (when time (setq time (navi2ch-http-date-decode time)))
 402         (setq header (list (cons 'date mtime-string)
 403                            (cons 'server "localfile")))
 404         (if (or navi2ch-net-force-update
 405                 (navi2ch-compare-times mtime time)
 406                 (not (file-exists-p file)))
 407             (progn
 408               (copy-file source-file file t)
 409               (setq header (cons (cons 'last-modified mtime-string) header))
 410               (message "%supdated" (current-message)))
 411           (setq header (navi2ch-net-add-state 'not-updated header))
 412           (message "%snot updated" (current-message)))
 413         header))))
 414
 415 ;;; navi2ch-localfile.el ends here