API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 14th, 2023
99
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.50 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..a2e8cad 100644
  3. --- a/navi2ch-list.el
  4. +++ b/navi2ch-list.el
  5. @@ -567,7 +567,7 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  6. (let ((board-id (cdr (assoc url navi2ch-list-board-id-alist))))
  7. (or board-id
  8. (save-match-data
  9. - (if (string-match "\\`http://.+/\\([^/]+\\)/\\'" url)
  10. + (if (string-match "\\`https?://.+/\\([^/]+\\)/\\'" url)
  11. (match-string 1 url))))))
  12.  
  13. (defun navi2ch-list-make-board-txt ()
  14. @@ -590,7 +590,7 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  15. (if (string-match "a" tag)
  16. (let (url board-id id u)
  17. (when (and (not ignore)
  18. - (string-match "href=\\(.+/\\([^/]+\\)/\\)" attr))
  19. + (string-match "href=\"?\\(.+/\\([^/]+\\)/\\)" attr))
  20. (setq url (match-string 1 attr))
  21. (setq url (or (cdr (assoc
  22. url
  23. @@ -624,7 +624,7 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  24.  
  25. (defun navi2ch-list-valid-board (uri)
  26. (save-match-data
  27. - (when (string-match "http://\\([^/]+\\)/\\([^/]+\\)/" uri)
  28. + (when (string-match "https?://\\([^/]+\\)/\\([^/]+\\)/" uri)
  29. (let ((host (match-string 1 uri)))
  30. (and (not (string-match navi2ch-list-invalid-host-regexp host))
  31. (string-match navi2ch-list-valid-host-regexp host))))))
  32. diff --git a/navi2ch-multibbs.el b/navi2ch-multibbs.el
  33. index 8e49f28..d1ef831 100644
  34. --- a/navi2ch-multibbs.el
  35. +++ b/navi2ch-multibbs.el
  36. @@ -345,7 +345,7 @@ START, END, NOFIRST で範囲を指定する"
  37.  
  38. ;;;-----------------------------------------------
  39.  
  40. -(defsubst navi2ch-2ch-subject-callback ()
  41. +(defsubst navi2ch-2ch-subject-callback (&optional args)
  42. (when navi2ch-board-use-subback-html
  43. (navi2ch-board-make-subject-txt)))
  44.  
  45. @@ -525,7 +525,7 @@ START, END, NOFIRST で範囲を指定する"
  46. 'equal)))
  47. (navi2ch-cache-get
  48. (cons uri file-name)
  49. - (cond ((string-match "http://\\(?:[^@/]+@\\)?\\(.+\\)" uri)
  50. + (cond ((string-match "https?://\\(?:[^@/]+@\\)?\\(.+\\)" uri)
  51. (navi2ch-expand-file-name
  52. (concat (match-string 1 uri)
  53. file-name)))
  54. diff --git a/navi2ch-net.el b/navi2ch-net.el
  55. index dc11ec5..972c97f 100644
  56. --- a/navi2ch-net.el
  57. +++ b/navi2ch-net.el
  58. @@ -228,7 +228,8 @@ nil なら常に再接続する。")
  59. host (cdr (assq 'host list))
  60. file (cdr (assq 'file list))
  61. port (cdr (assq 'port list))
  62. - host2ch (cdr (assq 'host2ch list))))
  63. + host2ch (cdr (assq 'host2ch list))
  64. + rest (cdr (assq 'rest list))))
  65. (when navi2ch-net-http-proxy
  66. (setq credentials (navi2ch-net-http-basic-credentials
  67. navi2ch-net-http-proxy-userid
  68. @@ -257,11 +258,8 @@ nil なら常に再接続する。")
  69. (setq proc nil)
  70. (unless (navi2ch-net-down-p host)
  71. (condition-case nil
  72. - (if (string-match "^https://" url)
  73. - (setq proc (funcall 'open-tls-stream
  74. - navi2ch-net-connection-name buf host "443"))
  75. - (setq proc (funcall navi2ch-open-network-stream-function
  76. - navi2ch-net-connection-name buf host port)))
  77. + (setq proc (apply navi2ch-open-network-stream-function
  78. + navi2ch-net-connection-name buf host port rest))
  79. (error (navi2ch-net-add-down-host host)))))
  80. (when proc
  81. (with-current-buffer buf
  82. @@ -304,6 +302,10 @@ nil なら常に再接続する。")
  83. (navi2ch-net-cleanup-vars)
  84. (setq navi2ch-net-process proc))))
  85.  
  86. +(defun navi2ch-net-split-url-scheme-to-rest (scheme)
  87. + (if (string-prefix-p "https:" scheme)
  88. + '(:type tls)))
  89. +
  90. (defun navi2ch-net-split-url (url &optional proxy)
  91. (let (host2ch authinfo user pass)
  92. (string-match "https?://\\([^@/]+@\\)?\\([^/]+\\)" url)
  93. @@ -324,16 +326,21 @@ nil なら常に再接続する。")
  94. (cons 'host (match-string 2 proxy))
  95. (cons 'file url)
  96. (cons 'port (string-to-number (match-string 3 proxy)))
  97. - (cons 'host2ch host2ch)))
  98. - (string-match "https?://\\(?:[^@/]+@\\)?\\([^/:]+\\)\\(?::\\([0-9]+\\)\\)?\\(.*\\)" url)
  99. + (cons 'host2ch host2ch)
  100. + (cons 'rest (navi2ch-net-split-url-scheme-to-rest (match-string 1 proxy)))))
  101. + (string-match "\\(https?://\\)\\(?:[^@/]+@\\)?\\([^/:]+\\)\\(?::\\([0-9]+\\)\\)?\\(.*\\)" url)
  102. (list
  103. (cons 'user user)
  104. (cons 'pass pass)
  105. - (cons 'host (match-string 1 url))
  106. - (cons 'port (string-to-number (or (match-string 2 url)
  107. - "80")))
  108. - (cons 'file (match-string 3 url))
  109. - (cons 'host2ch host2ch)))))
  110. + (cons 'host (match-string 2 url))
  111. + (cons 'port
  112. + (if (match-string 3 url)
  113. + (string-to-number (match-string 3 url))
  114. + (if (string-prefix-p "https:" (match-string 1 url))
  115. + 443 80)))
  116. + (cons 'file (match-string 4 url))
  117. + (cons 'host2ch host2ch)
  118. + (cons 'rest (navi2ch-net-split-url-scheme-to-rest (match-string 1 url)))))))
  119.  
  120. (defun navi2ch-net-http-basic-credentials (user pass)
  121. "USER と PASS から Basic 認証の証明書 (?) 部分を返す。"
  122. @@ -999,7 +1006,7 @@ This is taken from RFC 2396.")
  123. "BBS_\\(TITLE_PICTURE\\|FIGUREHEAD\\)=\\(.+\\)" content))
  124. (setq src (match-string 2 content))
  125. (let (url file)
  126. - (setq url (if (string-match "http://" src)
  127. + (setq url (if (string-match "https?://" src)
  128. src
  129. (navi2ch-board-get-url board src)))
  130. (string-match "/\\([^/]+\\)$" url)
  131.  
Tags: navi2ch
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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!