トップ > Gauche > Gaucheでクローラを書くことと、そのためのライブラリ

Gaucheでクローラを書くことと、そのためのライブラリ

Gauche プログラミング

リンクをたどっていくつか巡回するだけの簡単なクローラを作ってみたら、戸惑うところが多かったので、まずはそのメモ。

戸惑ったところ

  • http-get
    • オプションで「:no-redirect #t」を指定しないと、自動でリダイレクトする → リダイレクトされると、持ってきたページのURIが想定していたURIと違う場合がある。→ 「http://」から始まらないパス(相対URI)を長いURI(絶対URI)に戻せない。
    • オプション「:sink out」を指定すると、HTTPの応答のメッセージボディは出力ポートoutに書き出されていく。「:sink out」を指定している状態でリダイレクトが発生すると、リダイレクト前にoutに書き出されたものとリダイレクト後の結果の両方が書き込まれた状態になる。flusherオプションで適切に処理させる?
  • 文字コード関連
    • http-getは文字コードの指定オプションがないので、gauche.charconvのces-convertで戻り値を変換するか、:sinkオプションで別の場所に出力してからエンコーディングを指定して読み込む。
    • 文字化けファイルをコード変換したり読み込もうとするとエラーが出る。「 : invalid character sequence ……」。
      対処: nkfに通してからあらためて読み込む。
    • 入力ポートのエンコーディングオプションに自動判別("*JP")や正しくないをコード指定してhtml->shtmlに読み込ませると、正しくパーズできない場合がある。エラーが発生するのではなく、内容の大部分がSXMLツリーに含まれずに捨てられてしまう。けっこう気づかない(文字コードに関係なく素行の悪いHTMLはちゃんと読み込めていないのかもしれない)。
  • リクエストヘッダ
    • Referer : リファラを送らないと取得できないページがある。でもクローラはリファラを送らないほうがいいのか?
    • Cookie : クッキーについては知識がないので、とりあえず放置。
  • SSL/TLSへの対応。SSL/TLSで通信するだけなら、以前に書いたことを流用すればたぶん何とかなる(「OpenSSLライブラリを使ってプログラミング(1)」 「(2)」 「(3)」)。でも色々と面倒そう。それともwgetを利用すればよいのか。
  • リンクをたどっていくと色々エラーに遭遇する。http-getを使っていて生じたエラー。
    • : couldn't find host: ……
    • : http reply contains no data
    • : bad reply from server
    • : connect failed to #: Connection timed out
    • : connect failed to #: Connection refused
    • ……

簡単なライブラリ

とりあえず基本部品になりそうな関数をいくつか書いて、面倒になった。

http-get-to-shtml
normal;font-style:italic;">uri &keyword ……: uriに基づいて通信して得たメッセージボディをSXML形式の形で返す。ただし戻り値はSXMLデータだけではなく、4つの値からなる多値: status、headers、shtml、uri。statusとheadersは、通信結果の応答コードおよびヘッダの内容をリストにしたもの(http-getの戻り値の最初の2つと同じ)。shtmlはメッセージボディをSXML形式にしたもの。uriは実際に結果を得たときのURIで、通常は引数のuriと同じだけど、リダイレクトがあった場合は引数と違う値になる。キーワード引数は、そのままhttp-getに渡されるのでサーバへのヘッダの指定に使う。例えばリファラを指定するなら次のように書くことになる。
(receive (status headers shtml uri) (http-get-to-shtml uri :Referer ref-uri)
  ……)

http-get-to-file
normal;font-style:italic;">uri file &keyword ……: uriで通信して得たメッセージボディをファイルfileに書き込む。SXMLへの変換はしない。たんに受け取った結果を保存したいときに使う。戻り値はstatus、headers、uriの3つからなる多値。戻り値それぞれの意味はhttp-get-to-shtmlのと同じ。キーワード引数に関してもhttp-get-to-shtmlと同じ。
html-file->shtml
normal;font-style:italic;">file &optional encoding: HTMLファイルを読み込んでSXML形式にして返す。戻り値はそれだけ。オプション引数でencodingが指定された場合は、そのエンコーディングで読もうとする。無い場合は調べたり推測したりして読む。基本的には指定しない方がいいはず。それから文字化けなどの理由で読めなかった場合は、ファイルをnkfコマンドに通したあと再び読み込む。(http-get-to-shtmlは、内部的にはhttp-get-to-fileをエンコーディング指定無しで呼んでいる)
http-uri-expand
normal;font-style:italic;">uri base-uri: base-uriをベースURIとして、uriを絶対URIに変換する。uriが元から「http://……」の形なら、uriはそのまま。base-uriで指定されたHTMLファイル中に「href="../foo/bar.html"」などとあった場合に「http://……」の形に直すのに使う。例えば次のようになる。
(http-uri-expand "../foo/bar.html" "http://aaa.bbb.ccc/ddd/eee/fff.html")
→ "http://aaa.bbb.ccc/ddd/foo/bar.html"
sxpath-rx
sxml.sxpathモジュールのsxpath関数の拡張で、クエリに正規表現を埋め込めるようにしたもの(「sxpathのクエリに正規表現を書けるようにする」)。

まだ基本部品になりそうなのはこれだけしかないけど、例えば

(let ((uri "http://ja.wikipedia.org/wiki/Scheme"))
    (receive (s h shtml uri) (http-get-to-shtml uri)
      (let ((texts ((sxpath-rx '(// (not@ @) * #/scheme/i)) shtml)))
        (for-each print texts))))

で、ページ内に出てくる「scheme」という単語を抽出できる。前後が取り出せていないので出力を見ても何だかよくわからないけど

(let ((uri "http://ja.wikipedia.org/wiki/Scheme"))
    (receive (s h shtml uri) (http-get-to-shtml uri)
      (let ((texts ((sxpath-rx '(// (not@ @) (* (#/scheme/i)))) shtml)))
        (for-each print texts))))

と書けば、もう少し詳しい状況がわかる。
あと次のプログラムは、指定したURIページからリンクされているJPG画像を保存するスクリプト。これくらいならあまり難しくない。ただしこのプログラムだと

<a href="http://……/……?x=…….jpg">

のように末尾がjpgになっているけどjpgファイルでないものも含んでしまう。

#!/usr/bin/env gosh
(use file.util)
(use srfi-1)
(use srfi-19)

(add-load-path ".") ; 必要なら
(use www-helper)

(define (main args)
  (let* ((uri (cadr args))
         (save-dir (build-path "Image"
                       (date->string (current-date) "~Y_~m_~d_T~H~M"))))
    (receive (_ __ shtml uri) (http-get-to-shtml uri :Referer uri)
      (get-images shtml uri save-dir))))

(define (get-images shtml base-uri save-dir)
  (define (write-to-dir uris save-dir)
    (unless (null? uris)
      (make-directory* save-dir))
    (dolist (uri (delete-duplicates uris))
      (receive (base path ext) (decompose-path uri)
        (print uri)
        (http-get-to-file uri (build-path save-dir #`",|path|.,|ext|")
                          :Referer base-uri))))

  (let* ((paths ((sxpath-rx '(// a @ href #/\.jpg$/)) shtml))
         (uris (map (cut http-uri-expand <> base-uri) paths)))
    (write-to-dir uris save-dir))
  (let* ((paths ((sxpath-rx '(// (not@ a) img @ src #/\.jpg$/)) shtml))
         (uris (map (cut http-uri-expand <> base-uri) paths)))
    (write-to-dir uris (build-path save-dir "other"))))

ライブラリのソース

ライブラリを動かすにはhttp://www.neilvandyke.org/htmlprag/のhtmlprag-0-16.scmを読める場所に置いておく必要がある。
www-helper.scm

(define-module www-helper
  (use rfc.uri)
  (use rfc.http)
  (use sxml.sxpath)
  (use srfi-1)
  (use file.util)
  (use gauche.charconv)
  (export
    http-uri-server&request http-uri-expand
    http-get-to-file http-get-to-shtml html-file->shtml
    sxpath-rx))

(select-module www-helper)

(load "htmlprag-0-16.scm")

;; HTTPのURIの分解作成支援
;; rfc.uriのお手軽版

;; HTTP URIメモ
;; <uri> :== <scheme> ":" <specific>
:; <specific> :== "//" <authority> <path> "?" <query> "#" <fragment>
;; <path> :== <base> "/" <file> "." <ext>
(define (http-uri-server&request uri)
  (receive (_ specific) (uri-scheme&specific uri)
    (receive (auth path query fragment) (uri-decompose-hierarchical specific)
      (let ((request
              (call-with-output-string
                (lambda (oport)
                  (display (if path path "/") oport)
                  (when query (format oport "?~a" query))))))
        (values auth request)))))

;; 「http://……」の形のURIを作る
(define (http-uri-expand target-uri base-uri)
  (define (uri-has-scheme? uri)
    (receive (scheme _) (uri-scheme&specific uri)
      scheme))

  (define (uri-scheme&authority&path uri)
    (receive (scheme specific) (uri-scheme&specific uri)
      (receive (authority path _ __) (uri-decompose-hierarchical specific)
        (values scheme authority path))))

  (receive (base-scheme base-auth base-path) (uri-scheme&authority&path
                                               base-uri)
    (cond
      ((string=? target-uri "") base-uri)
      ((uri-has-scheme? target-uri) target-uri)
      ((#/^#/ target-uri) #`",|base-uri|,|target-uri|")
      ((#/^\/\// target-uri) #`",|base-scheme|:,|target-uri|")
      ((#/^\// target-uri) #`",|base-scheme|://,|base-auth|,|target-uri|")
      (else
        (let* ((path
                 (cond
                   ((or (not base-path) (string=? base-path "/"))
                    #`"/,|target-uri|")
                   (else
                     (receive (base-pathbase _ __) (decompose-path base-path)
                       #`",|base-pathbase|/,|target-uri|")))))
          #`",|base-scheme|://,|base-auth|,(simplify-path path)")))))


(define (html-file->shtml file . encoding-opt)
  (let ((encoding (get-optional encoding-opt #f)))
    (if encoding
      (call-with-input-file
        file
        (lambda (iport)
          (html->shtml iport))
        :encoding encoding)
      ;; encoding指定がない場合の処理
      ;; sxmlへの変換を2度やっているので非効率。
      (let* ((shtml (html-file->shtml file "*JP"))
             (meta-contents ((sxpath '(// meta @ content *text*)) shtml)))
        (let loop ((meta-contents meta-contents))
          (cond
            ((null? meta-contents) shtml)
            ((#/charset=(.*)/ (car meta-contents))
             => (lambda (rx)
                  (let ((encoding (cond
                                    ((#/euc.*j/i (rx 1)) 'euc-jp)
                                    ((#/s.*jis/i (rx 1)) 'shift_jis)
                                    ((#/utf.*8/i (rx 1)) 'utf-8)
                                    ((#/iso2022jp/i (rx 1)) 'iso2022jp)
                                    (else #f))))
                    (if encoding
                      (html-file->shtml file encoding)
                      shtml))))
            (else (loop (cdr meta-contents)))))))))

;; 文字化けファイルに対する処理。nkfを通してもう一度読む
(define (html-file->shtml-using-nkf file)
  (filter-nkf-w file)
  (html-file->shtml file 'utf-8))

(define (filter-nkf-w file)
  (receive (oport tmp-file) (sys-mkstemp "nkf-w")
    (sys-system #`"nkf -w ,|file| > ,|tmp-file|")
    (move-file tmp-file file :if-exists :supersede)))


(define (http-get-to-file uri file . opts)
  (http-method-to-file 'GET uri file #f opts))

(define (http-method-to-file method uri file body opts)
  (define (redirect-status? status)
    (#/3../ status))
  (define (write-to-file uri)
    (receive (server request) (http-uri-server&request uri)
      (call-with-output-file
        file
        (lambda (oport)
          (let ((opts (append
                        (list :no-redirect #t
                              :sink oport
                              :flusher (lambda _ #t))
                        opts)))
            (case method
              ((GET)
               (apply http-get  server request opts))
              ((POST)
               (apply http-post server request body opts))))))))

  (let loop ((uri uri)
             (history '()))
    (receive (scheme _) (uri-scheme&specific uri)
      (unless (string=? scheme "http")
        (errorf <http-error> "URI scheme ~a is not supported: ~a" scheme uri)))
    (when (or (member uri history) (> (length history) 20))
      (errorf <http-error> "looping? via ~a" uri))
    (receive (status headers _) (write-to-file uri)
      (if (redirect-status? status)
        (begin
          (remove-files (list file))
          (let ((location-uri (cadr (assoc "location" headers))))
            (loop (http-uri-expand location-uri uri) (cons uri history)
                  )))
        (values status headers uri)))))


(define (http-get-to-shtml uri . opts)
  (http-method-to-shtml 'GET uri #f opts))

(define (http-method-to-shtml method uri body opts)
  (receive (oport tmp-file) (sys-mkstemp "http_tmp_")
    (unwind-protect
      (receive (status headers uri) (http-method-to-file
                                      method uri tmp-file body opts)
        (let ((shtml (guard (e ((#/invalid character/ (ref e 'message))
                                (html-file->shtml-using-nkf tmp-file))
                               (else (raise e)))
                       (html-file->shtml tmp-file))))
          (values status headers shtml uri)))
      (remove-files (list tmp-file)))))

;; sxpathを拡張してクエリに正規表現を使えるようにしたもの
(define (sxpath-rx query)
  (define (select-kids-rx rx)
    (lambda (nodeset . args)
      ((select-kids
         (lambda (node)
           (and
             ((ntype?? '*text*) node)
             (rx node))))
       nodeset)))
  (define (subst-rx query)
    (cond
      ((null? query) '())
      ((regexp? (car query)) (cons (select-kids-rx (car query))
                                   (subst-rx (cdr query))))
      ((pair? (car query))
       (cons (subst-rx (car query)) (subst-rx (cdr query))))
      (else (cons (car query) (subst-rx (cdr query))))))

  (sxpath (subst-rx query)))

(provide "www-helper")