www-mode で Google Scholar

Google の機能の一つに Google Scholar というものがあります。
一言で言うと「論文を検索」してくれるわけなんですが、
ほかにもその論文を引用できるように BibTeX とか Endnote 形式で
保存できたり、その手の人には何かと便利です。


で、それを xyzzy の www-mode から使おうとしたのですが、
Google Scholar での設定が反映されずハマりました。
いろいろ調べてみると、どうやら Google Scholar が送ってくる
クッキーが www-mode にリジェクトされている様子。
Emacs で w3m を使ってる人たちも同様の問題に遭遇していたようで、
それを参考に www-mode に変更を加えてみました。
具体的には以下を .www に書き加えました。

;;; Google Scholar が送ってくるクッキーに対応
(defun cookie-domain-match (domain host)
  (or (string-equal domain host)
      ;; ↓Google Scholar などサブドメインでないのに頭にドットをつけてくるところへの対処
      (string-equal domain (concat "." host))
      (string-matchp (concat "^[-_0-9a-zA-Z]+" (regexp-quote domain) "$") host)))

;; 一部書き換え
(defun cookie-parse (cookie host file)
  (let (name
        value
        expires
        domain
        path
        parts)
    (unless (stringp cookie)
      (return-from cookie-parse))
    (setq parts (split-string cookie ";" nil " \t\r\n"))
    (setq value (pop parts))
    (unless value
      (msgbox "No value: ~S" value)
      (return-from cookie-parse))
    (when (< *www-cookie-max-len* (length value))
      (msgbox "Cookie is too long.: < ~D ~D"
              *www-cookie-max-len*
              (length value))
      (return-from cookie-parse))
    (unless (string-match "\\([^ \t\r\n;,=]+\\)=\\([^ \t\r\n;,]+\\)" value)
      (msgbox "Not cookie name & value: ~S" value)
      (return-from cookie-parse))
    (setq name (match-string 1))
    (setq value (match-string 2))
    (dolist (part parts)
      (if (string-matchp "\\(expires\\|path\\|domain\\|secure\\)\\(=\\(.+\\)\\)?" part)
          (let ((k (match-string 1))
                v)
            (when (match-beginning 2)
              (setq v (string-trim " \t\r\n" (match-string 3))))
            ;(msgbox "~S~%~S" k v)
            (cond ((equalp k "expires")
                   (when v
                     (setq expires (cookie-parse-date v)))
                   )
                  ((equalp k "path")
                   (when v
                     (setq path v))
                   )
                  ((equalp k "domain")
                   (when v
;;;                      (unless (string-match "\\.[-_0-9a-zA-Z]+\\.[-_0-9a-zA-Z]+$" v) ; -
                     (unless (string-match "\\.[-_0-9a-zA-Z]+\\.[-_0-9a-zA-Z]+$" v)     ; +
                       (msgbox "Illegal domain in cookie. Ignored. ~S" v)
                       (return-from cookie-parse))
;;;                  (if (string-matchp (concat v "$") host)                 ; -
;;;                      (setq domain v)                                     ; -
;;;                    (if *www-cookie-ignore-host-mismatch*                 ; -
;;;                        (return-from cookie-parse)                        ; -
;;;                      (if *www-cookie-alert-host-mismatch*                ; -
;;;                          (if (cookie-alert-host-mismatch-ok cookie host) ; -
;;;                              (setq domain v)                             ; -
;;;                            (return-from cookie-parse))                   ; -
                     ;; RFC 2965                                             ; +
                     (unless (string-match "^." v)                           ; +
                       (setf v (concat "." v)))                              ; +
                     (cond ((cookie-domain-match v host)                     ; +
                            (setq domain v))                                 ; +
                           (*www-cookie-ignore-host-mismatch*                ; +
                            (return-from cookie-parse))                      ; +
                           ((or (not *www-cookie-alert-host-mismatch*)       ; +
                                (cookie-alert-host-mismatch-ok cookie host)) ; +
                            (setq domain v))                                 ; +
                           (t                                                ; +
                            (return-from cookie-parse))))                    ; +
                   )
                  ((equalp k "secure")
                   ;; https をサポートしていないのでsecure cookieは受付できない
                   (when *www-http-debug*
                     (msgbox "Ignore Secure Cookie"))
                   (return-from cookie-parse)
                   )))
        (msgbox "Not cookie options: ~S" part)))
    (unless domain
      (setq domain host))
    (unless path
      (setq path file))
    (list domain path name value expires)
    ))

;; 書き換え
(defun cookie-get (host file)
  (let ((cookies
         (remove-if (complement
                     #'(lambda (cookie)
                         (and (cookie-domain-match (cookie-domain cookie) host)
                              (string-match (concat "^" (cookie-path cookie)) file))))
                    *www-cookie-data*)))
    (when cookies
      (format nil "~{~A~^;~}"
              (mapcar #'(lambda (c)
                          (format nil "~A=~A" (cookie-name c) (cookie-value c)))
                      cookies)))))

(mapc #'compile '(cookie-add cookie-domain-match cookie-parse cookie-get))

ついでに cookie-add にバグらしきものを発見。
クッキーが一つだけしか保存されてなかったので修正してみました。

;; バグ?
(defun cookie-add (cookie)
  (let (new
        (done nil))
    (dolist (d *www-cookie-data*)
      (if (cookie-equal-p d cookie)
          (progn
            (push cookie new)
            (setq done t))
;;;     (push cookie d))) ; -
        (push d new)))    ; +
    (unless done
      (push cookie new))
    (let ((cnt (length new)))
      (when (< *www-cookie-max-cnt* cnt)
        (setq new (butlast new (- cnt *www-cookie-max-cnt*)))))
    (setq *www-cookie-data* (reverse new))
    (cookie-save)))

以上の変更を加えた結果、無事 Scholar 設定が保存されるようになりました。


ここから余談。
Google Scholarhttp://scholar.google.com/) が送ってくるクッキーは
Domain=.scholar.google.com となっているわけですが、
RFC2965 を読んで自分が理解した限りだと
これはリジェクトされてしかるべきに思えます。
一方、Internet ExplorerFirefox でアクセスすると何も問題がおきず、
普通にクッキーは保存されます。
この辺どういう仕組みになっているのかはよくわかりませんでした。