API tools faq
paste
Guest User

Untitled

a guest
Jul 16th, 2023
107
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 9.90 KB | Source Code | 0 0
raw download clone embed print report
  1. diff --git a/navi2ch-list.el b/navi2ch-list.el
  2. index 4188735..509df1d 100644
  3. --- a/navi2ch-list.el
  4. +++ b/navi2ch-list.el
  5. @@ -94,7 +94,7 @@
  6. (nil " " navi2ch-list-board-name-face))))
  7.  
  8. (defconst navi2ch-list-bbstable-default-url
  9. - "http://menu.2ch.net/bbsmenu.html")
  10. + "https://menu.5ch.net/bbsmenu.json")
  11.  
  12. ;; add hook
  13. (add-hook 'navi2ch-save-status-hook 'navi2ch-list-save-info)
  14. @@ -567,10 +567,56 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  15. (let ((board-id (cdr (assoc url navi2ch-list-board-id-alist))))
  16. (or board-id
  17. (save-match-data
  18. - (if (string-match "\\`http://.+/\\([^/]+\\)/\\'" url)
  19. + (if (string-match "\\`https?://.+/\\([^/]+\\)/\\'" url)
  20. (match-string 1 url))))))
  21.  
  22. +
  23. (defun navi2ch-list-make-board-txt ()
  24. + (if (and navi2ch-list-media-type
  25. + (string-equal (cdr navi2ch-list-media-type) "application/json"))
  26. + (navi2ch-list-make-board-txt-from-json)
  27. + (navi2ch-list-make-board-txt-from-html)))
  28. +
  29. +(defun navi2ch-list-make-board-txt-from-json ()
  30. + "bbstable.json から (navi2ch 用の) board.txt を作る。
  31. +`navi2ch-net-update-file' のハンドラ。"
  32. + (let ((coding-system-for-read 'binary)
  33. + (coding-system-for-write 'binary)
  34. + (case-fold-search t)
  35. + (beg (point))
  36. + (id-to-url-table (make-hash-table :test 'eq))
  37. + (bbstable (json-parse-string (decode-coding-string (buffer-string) 'utf-8))))
  38. + (erase-buffer)
  39. + (seq-doseq (category (gethash "menu_list" bbstable))
  40. + (let ((category-name (gethash "category_name" category)))
  41. + (unless
  42. + ;; ignore category?
  43. + (member category-name navi2ch-list-ignore-category-list)
  44. + (insert (encode-coding-string category-name navi2ch-coding-system) "\n\n\n")
  45. + (seq-doseq (board (gethash "category_content" category))
  46. + (let ((url (gethash "url" board))
  47. + (board-name (gethash "board_name" board))
  48. + board-id id u)
  49. + (setq url (or (cdr (assoc url navi2ch-list-moved-board-alist))
  50. + url))
  51. + (when (and (navi2ch-list-valid-board url)
  52. + (setq board-id (navi2ch-list-board-id-from-url url)))
  53. + (setq id (intern board-id))
  54. + (when (and (setq u (gethash id id-to-url-table))
  55. + (not (string= u url)))
  56. + ;; 同じ ID で URL が違う板がある場合
  57. + (let ((i 2)
  58. + newid)
  59. + (while (and (setq newid (intern (format "%s:%d" id i)))
  60. + (setq u (gethash newid id-to-url-table))
  61. + (not (string= u url)))
  62. + (setq i (1+ i)))
  63. + (setq id newid)))
  64. + (insert (encode-coding-string board-name navi2ch-coding-system) "\n"
  65. + url "\n" (symbol-name id) "\n")))))))))
  66. +
  67. +
  68. +(defun navi2ch-list-make-board-txt-from-html ()
  69. "bbstable.html から (navi2ch 用の) board.txt を作る。
  70. `navi2ch-net-update-file' のハンドラ。"
  71. (let ((coding-system-for-read 'binary)
  72. @@ -590,7 +636,7 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  73. (if (string-match "a" tag)
  74. (let (url board-id id u)
  75. (when (and (not ignore)
  76. - (string-match "href=\\(.+/\\([^/]+\\)/\\)" attr))
  77. + (string-match "href=\"?\\(.+/\\([^/]+\\)/\\)" attr))
  78. (setq url (match-string 1 attr))
  79. (setq url (or (cdr (assoc
  80. url
  81. @@ -624,7 +670,7 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  82.  
  83. (defun navi2ch-list-valid-board (uri)
  84. (save-match-data
  85. - (when (string-match "http://\\([^/]+\\)/\\([^/]+\\)/" uri)
  86. + (when (string-match "https?://\\([^/]+\\)/\\([^/]+\\)/" uri)
  87. (let ((host (match-string 1 uri)))
  88. (and (not (string-match navi2ch-list-invalid-host-regexp host))
  89. (string-match navi2ch-list-valid-host-regexp host))))))
  90. diff --git a/navi2ch-multibbs.el b/navi2ch-multibbs.el
  91. index 8e49f28..d1ef831 100644
  92. --- a/navi2ch-multibbs.el
  93. +++ b/navi2ch-multibbs.el
  94. @@ -345,7 +345,7 @@ START, END, NOFIRST で範囲を指定する"
  95.  
  96. ;;;-----------------------------------------------
  97.  
  98. -(defsubst navi2ch-2ch-subject-callback ()
  99. +(defsubst navi2ch-2ch-subject-callback (&optional args)
  100. (when navi2ch-board-use-subback-html
  101. (navi2ch-board-make-subject-txt)))
  102.  
  103. @@ -525,7 +525,7 @@ START, END, NOFIRST で範囲を指定する"
  104. 'equal)))
  105. (navi2ch-cache-get
  106. (cons uri file-name)
  107. - (cond ((string-match "http://\\(?:[^@/]+@\\)?\\(.+\\)" uri)
  108. + (cond ((string-match "https?://\\(?:[^@/]+@\\)?\\(.+\\)" uri)
  109. (navi2ch-expand-file-name
  110. (concat (match-string 1 uri)
  111. file-name)))
  112. diff --git a/navi2ch-net.el b/navi2ch-net.el
  113. index dc11ec5..687c810 100644
  114. --- a/navi2ch-net.el
  115. +++ b/navi2ch-net.el
  116. @@ -220,7 +220,7 @@ nil なら常に再接続する。")
  117. (process-connection-type nil)
  118. (inherit-process-coding-system
  119. navi2ch-net-inherit-process-coding-system)
  120. - user pass host file port host2ch credentials auth)
  121. + user pass host file port host2ch credentials auth rest)
  122. (let ((list (navi2ch-net-split-url url navi2ch-net-http-proxy)))
  123. (setq list (navi2ch-net-connect-check list))
  124. (setq user (cdr (assq 'user list))
  125. @@ -228,7 +228,8 @@ nil なら常に再接続する。")
  126. host (cdr (assq 'host list))
  127. file (cdr (assq 'file list))
  128. port (cdr (assq 'port list))
  129. - host2ch (cdr (assq 'host2ch list))))
  130. + host2ch (cdr (assq 'host2ch list))
  131. + rest (cdr (assq 'rest list))))
  132. (when navi2ch-net-http-proxy
  133. (setq credentials (navi2ch-net-http-basic-credentials
  134. navi2ch-net-http-proxy-userid
  135. @@ -257,11 +258,8 @@ nil なら常に再接続する。")
  136. (setq proc nil)
  137. (unless (navi2ch-net-down-p host)
  138. (condition-case nil
  139. - (if (string-match "^https://" url)
  140. - (setq proc (funcall 'open-tls-stream
  141. - navi2ch-net-connection-name buf host "443"))
  142. - (setq proc (funcall navi2ch-open-network-stream-function
  143. - navi2ch-net-connection-name buf host port)))
  144. + (setq proc (apply navi2ch-open-network-stream-function
  145. + navi2ch-net-connection-name buf host port rest))
  146. (error (navi2ch-net-add-down-host host)))))
  147. (when proc
  148. (with-current-buffer buf
  149. @@ -304,6 +302,10 @@ nil なら常に再接続する。")
  150. (navi2ch-net-cleanup-vars)
  151. (setq navi2ch-net-process proc))))
  152.  
  153. +(defun navi2ch-net-split-url-scheme-to-rest (scheme)
  154. + (if (string-prefix-p "https:" scheme)
  155. + '(:type tls)))
  156. +
  157. (defun navi2ch-net-split-url (url &optional proxy)
  158. (let (host2ch authinfo user pass)
  159. (string-match "https?://\\([^@/]+@\\)?\\([^/]+\\)" url)
  160. @@ -324,16 +326,21 @@ nil なら常に再接続する。")
  161. (cons 'host (match-string 2 proxy))
  162. (cons 'file url)
  163. (cons 'port (string-to-number (match-string 3 proxy)))
  164. - (cons 'host2ch host2ch)))
  165. - (string-match "https?://\\(?:[^@/]+@\\)?\\([^/:]+\\)\\(?::\\([0-9]+\\)\\)?\\(.*\\)" url)
  166. + (cons 'host2ch host2ch)
  167. + (cons 'rest (navi2ch-net-split-url-scheme-to-rest (match-string 1 proxy)))))
  168. + (string-match "\\(https?://\\)\\(?:[^@/]+@\\)?\\([^/:]+\\)\\(?::\\([0-9]+\\)\\)?\\(.*\\)" url)
  169. (list
  170. (cons 'user user)
  171. (cons 'pass pass)
  172. - (cons 'host (match-string 1 url))
  173. - (cons 'port (string-to-number (or (match-string 2 url)
  174. - "80")))
  175. - (cons 'file (match-string 3 url))
  176. - (cons 'host2ch host2ch)))))
  177. + (cons 'host (match-string 2 url))
  178. + (cons 'port
  179. + (if (match-string 3 url)
  180. + (string-to-number (match-string 3 url))
  181. + (if (string-prefix-p "https:" (match-string 1 url))
  182. + 443 80)))
  183. + (cons 'file (match-string 4 url))
  184. + (cons 'host2ch host2ch)
  185. + (cons 'rest (navi2ch-net-split-url-scheme-to-rest (match-string 1 url)))))))
  186.  
  187. (defun navi2ch-net-http-basic-credentials (user pass)
  188. "USER と PASS から Basic 認証の証明書 (?) 部分を返す。"
  189. @@ -642,6 +649,9 @@ OTHER-HEADER は `navi2ch-net-download-file' に渡される。
  190. (navi2ch-set-buffer-multibyte nil)
  191. (insert cont)
  192. (goto-char (point-min))
  193. + (set (make-local-variable 'navi2ch-list-media-type)
  194. + (if (assq 'content-type header)
  195. + (assq 'content-type header)))
  196. (funcall func)
  197. (buffer-string))))
  198. (when (navi2ch-net-is-tanpan-thread-p cont)
  199. @@ -999,7 +1009,7 @@ This is taken from RFC 2396.")
  200. "BBS_\\(TITLE_PICTURE\\|FIGUREHEAD\\)=\\(.+\\)" content))
  201. (setq src (match-string 2 content))
  202. (let (url file)
  203. - (setq url (if (string-match "http://" src)
  204. + (setq url (if (string-match "https?://" src)
  205. src
  206. (navi2ch-board-get-url board src)))
  207. (string-match "/\\([^/]+\\)$" url)
  208. diff --git a/navi2ch-vars.el b/navi2ch-vars.el
  209. index 7bb307c..dbc5dda 100644
  210. --- a/navi2ch-vars.el
  211. +++ b/navi2ch-vars.el
  212. @@ -255,7 +255,7 @@ nil ならば手動で更新しないかぎり取りにいかない。"
  213.  
  214. (defcustom navi2ch-list-valid-host-regexp
  215. (concat "\\("
  216. - (regexp-opt '(".2ch.net" ".bbspink.com" ".machibbs.com" ".machi.to"))
  217. + (regexp-opt '(".5ch.net" ".2ch.net" ".bbspink.com" ".machibbs.com" ".machi.to"))
  218. "\\)\\'")
  219. "*２ちゃんねるの板とみなすホストの正規表現。"
  220. :type 'regexp
  221. @@ -263,7 +263,7 @@ nil ならば手動で更新しないかぎり取りにいかない。"
  222.  
  223. (defcustom navi2ch-list-invalid-host-regexp
  224. (concat "\\`\\("
  225. - (regexp-opt '("find.2ch.net" "info.2ch.net"))
  226. + (regexp-opt '("find.5ch.net" "find.2ch.net" "info.5ch.net" "info.2ch.net" ))
  227. "\\)\\'")
  228. "*２ちゃんねるの板とみなさないホストの正規表現。
  229. `navi2ch-list-valid-host-regexp' より優先される。"
  230. @@ -2424,5 +2424,8 @@ to force the image format."
  231. (define-key map "\C-x\C-s" 'navi2ch-save-status)
  232. (setq navi2ch-global-view-map map)))
  233.  
  234. +;;;
  235. +(defvar navi2ch-list-media-type nil)
  236. +
  237. (run-hooks 'navi2ch-vars-load-hook)
  238. ;;; navi2ch-vars.el ends here
  239.  
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!