websteal
websteal
バグ
- 基本的に全然完全じゃないです。(ページの最初にバグの項を持ってくるくらい)
- href="...." とかの形式に乗っ取ってないとエラーで止まる。つまり実際のリンクじゃなく、コンテンツに埋め込まれた href=&... みたいなの。
- href="mailto:..." のやつもファイルと思って残してしまう。
- その他、ちゃんとしたパーズしてなくて部分的に(href/srcのみ)切り取っただけなので状況によっては変な動作すると思います。気を付けてください。。。
- 何やらコマンドラインから起動すると、エラー発生しちゃうことがある。(今は動いているので追求してません)
要はちゃんと文書全体をパーズしてなくて、 リンクとおぼしき部分にマッチするものを 決め打ちで引っ掛けてるので。
- とりあえず、上記の問題箇所は修正した。 デバッグで分かった隠れ虫も合わせて退治。 いちおう t-y-scheme も問題なく引っ張れるところまで確認。cut-sea:2004/07/26 04:55:49 PDT
メモ
web サイトからコンテンツをごっそり引っ張って来る。
ルートになるファイルを指定して実行するとリンクをたどって
次々に持って来るようにしている。
もちろん別のホストへのリンクは引っ張らない。(想像するだけで恐いから...)
以下のように SICP とか t-y-scheme みたいなサイトを自分の端末上に
ごっそり欲しかったのが書いてみた動機。
- 実はこの後見てみたら t-y-scheme(nobsun訳の方) は
アーカイブがリンクされているので、ページ探訪してそれをダウンロードすれば、
その方が楽チン。(あぁ、このページの存在意義が...)
- それをいうなら wget で終了... というのじゃもったいないから、a) 1 ページ持ってきたらしばらく待ってから次のページを持ってくる。(あくせく働かないで紳士的な行動をとる) b) 待ってる間にほかのサイトのページを持って来れたらうれしいかも。(ちょっと貧乏臭いが、これは効率よく働いているということにしておこう) c) ついでにキーワードインデックスなんかも作っちゃったりなんかして、 d) そのインデックスをひくための CGI かなんかも作っちゃえば。 e) サーチエンジンの出来上がり。
- 実は wget の存在は認識したのですが、私のシステムに入ってなくて、
使ったことがありませんでした。
で、よそ様のスクリプトで使ってるのを見ると引っ張りたいファイルの名前を
直接指定してたので、リンクをガンガン引きずり出すってのはないのかと。。。
関数一個二個お得になる程度なら、wget無いと動かないですよってのより、 つくっちゃおかな〜な感じで(この腰の軽さはGauche使い始めてからだなぁ)。
実を言うとa)についてはやっぱりそういうものかと反省してるので、 b)以下も考慮して取り組んでみます。cut-sea:2004/07/27 19:41:46 PDT
HTML 関係あんまり詳しく勉強してないので、 try&error で作ってます。 これから勉強する予定cut-sea:2004/07/25 06:10:31 PDT
- teranishi: "href="が使われた場合にリンク先がHTMLであると判定していますが、それだとスタイルシートをHTMLと勘違いしたり、フレームの中身をHTMLと認識できなかったりします。
HTTPヘッダの"Content-Type"が"text/html"で始まるかどうかで判定したほうがいいのではないでしょうか。- ご指摘ありがとうございます。
HTML関係まるで無知なんで勉強してやってみようと思います。
学生時代にTeXは使ってたので論理構造をマークアップするような文書自体には 抵抗ないのですが、仕様をきちんと学んだこと無いんで。
他にも色々気付いたトコ指摘していただければうれしいです。cut-sea:2004/07/27 19:41:46 PDT - teranishi: 今回の話はHTMLではなくHTTPの話なので、そちらを調べた方がよいでしょう(RFC2616とか)
要するに、http-getの2番目の戻り値を調べれば、ファイルの種類が分かるという事です。gosh> (assoc "content-type" (values-ref (http-get "mitpress.mit.edu" "/sicp/full-text/book/book.html") 1)) ("content-type" "text/html") gosh> (assoc "content-type" (values-ref (http-get "mitpress.mit.edu" "/sicp/full-text/book/book-Z-C.css") 1)) ("content-type" "text/css") gosh> (assoc "content-type" (values-ref (http-get "mitpress.mit.edu" "/sicp/full-text/book/cover.jpg") 1)) ("content-type" "image/jpeg")
- ご指摘ありがとうございます。
HTML関係まるで無知なんで勉強してやってみようと思います。
- ふむ。
- "href=" や "src=" は捕捉不要で child-list もすっきりさせる。
- get-web-page-from の返り値を Content-Type にする。
- websteal 本体がその返り値を見てパーズ+child-list生成するかどうか分岐。
って組めばよさそうですね。websteal 本体の仕事内容の順番見直し要だな。 でも"href="/"src="って気に入ってなかったから丁度いいわ。cut-sea:2004/07/28 16:53:01 PDT
- えーと、だいたい修正。待ち時間の持たせ方は暫定。 単なる sleep はいまいちだけど、とりあえず。cut-sea:2004/07/29 06:15:11 PDT
- teranishi: 今更ですが、本文に'href='というパターンがある場合など考えると、
HTMLの解析はHtmlPragとかにまかせた方が
無難じゃないかと。
(use htmlprag) (use sxml.sxpath) (define refs-from-shtml (node-or (sxpath '(// (or@ a area link) @ href *text*)) (sxpath '(// (or@ script input frame iframe img) @ src *text*)))) (define (collect-refs-from-file file) (call-with-input-file file (lambda (in) (refs-from-shtml (html->shtml in)))))
gosh> (load "./websteal.scm") #t gosh> (websteal "http://mitpress.mit.edu/sicp/full-text/book/book.html") getting file "sicp/full-text/book/book.html" from "mitpress.mit.edu" now ... done getting file "sicp/full-text/book/book-Z-C.css" from "mitpress.mit.edu" now ... done getting file "sicp/full-text/book/book-Z-H-1.html" from "mitpress.mit.edu" now ... done (snip) getting file "sicp/full-text/book/ch1-Z-G-4.gif" from "mitpress.mit.edu" now ... done getting file "sicp/full-text/book/ch1-Z-G-5.gif" from "mitpress.mit.edu" now ... done getting file "sicp/full-text/book/ch1-Z-G-6.gif" from "mitpress.mit.edu" now ... done getting file "sicp/full-text/book/cover.jpg" from "mitpress.mit.edu" now ... done #<undef> gosh>
ソース
":";exec gosh -b $0 "$@" ;; ;; Usage: ./websteal 'http://mitpress.mit.edu/sicp/full-text/book/book.html' ;; ;; $Id$ ;; ;;=================================================== ;; use library ;; (use rfc.http) (use rfc.uri) (use file.util) (use srfi-13) ;;=================================================== ;; global values ;; (define *no-wait* 0) (define *gentle-wait* 10) ;;=================================================== ;; miscellaneous functions ;; (define-syntax format/flush (syntax-rules () ((_ arg ...) (begin (format arg ...) (flush))))) ;;=================================================== ;; destruct/construct utility for URL and file name. ;; (define (root-cut path) (list->string (cdr (string->list path)))) (define (root-paste path) (string-append "/" path)) (define (from-root? path) (equal? #\/ (string-ref path 0))) (define (break-down-url url) (let ((url-head (values-ref (uri-scheme&specific url) 0)) (url-body (values-ref (uri-scheme&specific url) 1))) (let ((url-list (call-with-values (lambda _ (uri-decompose-hierarchical url-body)) list))) (let ((host (car url-list)) (dir (sys-dirname (cadr url-list))) (file (sys-basename (cadr url-list)))) (lambda (msg) (cond ((eq? msg 'url) url) ((eq? msg 'type) url-head) ((eq? msg 'body) url-body) ((eq? msg 'host) host) ((eq? msg 'file) file) ((eq? msg 'webdir) dir) ((eq? msg 'fsdir) (root-cut dir)) ((eq? msg 'web-full-path) (string-append dir (root-paste file))) ((eq? msg 'fs-full-path) (string-append (root-cut dir) (root-paste file))) (else (error "No such message permitted.")))))))) (define (get-type obj) (obj 'type)) (define (get-body obj) (obj 'body)) (define (get-url obj) (obj 'url)) (define (get-hostname obj) (obj 'host)) (define (get-filename obj) (obj 'file)) (define (get-webdir obj) (obj 'webdir)) (define (get-fsdir obj) (obj 'fsdir)) (define (get-web-full-path obj) (obj 'web-full-path)) (define (get-fs-full-path obj) (obj 'fs-full-path)) (define (construct-complete-url obj default-obj) (define (construct-url host dir file) (let ((tag "http://")) (string-append tag host dir (root-paste file)))) (call/cc (lambda (c) (let ((type (get-type obj)) (host% (get-hostname default-obj)) (dir% (get-webdir default-obj)) (host (get-hostname obj)) (dir (get-webdir obj))) (if (and (not (equal? "http" type)) (not (equal? #f type))) (c #f) (construct-url (if (eq? #f host) host% (if (equal? host% host) host (c #f))) (if (eq? #f host) (if (equal? "." dir) dir% (if (from-root? dir) dir (string-append dir% (root-paste dir)))) dir) (get-filename obj))))))) ;;=================================================== ;; utility to get web page. ;; return value is http-get multiple values as list. ;; (define (get-web-page-from url) (let ((url-obj (break-down-url url))) (let ((host (get-hostname url-obj)) (fsdir (get-fsdir url-obj)) (infile (get-web-full-path url-obj)) (outfile (get-fs-full-path url-obj))) (begin (make-directory* fsdir) (format/flush #t "steal ~s from ~s now ... " outfile host) (call-with-output-file outfile (lambda (out) (let ((response (call-with-values (lambda () (http-get host infile :sink out :flusher (lambda _ #t))) list))) (format/flush #t "done\n") response))))))) (define (content-type-of response) (if (null? response) "unknown-content-type" (cadr (assoc "content-type" (cadr response))))) ;;=================================================== ;; special utility for http text. ;; (define (refs-from-string str) (call/cc (lambda (c) (let loop ((buff str) (refs '())) (if (string-incomplete? buff) (c '()) (let ((match (#/(href=|src=)"(.*?)"/ buff))) (if match (let ((url (match 2))) (loop (match 'after) (cons url refs))) (reverse refs)))))))) (define (collect-refs-from-file file) (call-with-input-file file (lambda (in) (let loop ((buff (read-line in #t)) (refs '())) (if (eof-object? buff) (reverse refs) (loop (read-line in #t) (append (refs-from-string buff) refs))))))) (define (trans-refs refs default-url) (let ((*url* (break-down-url default-url))) (map (lambda (ref) (let ((url (break-down-url ref))) (construct-complete-url url *url*))) refs))) (define (remove-false-url refs) (let loop ((refs refs) (result '())) (if (null? refs) (reverse result) (let ((item (car refs)) (rest (cdr refs))) (if item (loop rest (cons item result)) (loop rest result)))))) (define (sort-refs refs) (sort refs string<)) (define (unique-refs refs) (let loop ((refs refs) (result '()) (prev #f)) (if (null? refs) (reverse result) (let ((item (car refs)) (rest (cdr refs))) (if (equal? prev item) (loop rest result item) (loop rest (cons item result) item)))))) ;;=================================================== ;; aliases for improvement of readability ;; (define (illegal-url? url) (member #f (map (lambda (msg) (msg url)) (list get-hostname get-webdir get-filename)))) (define (type-is-html? response) (equal? "text/html" (content-type-of response))) (define (child-of file parent-url) (unique-refs (sort-refs (remove-false-url (trans-refs (collect-refs-from-file file) parent-url))))) ;;=================================================== ;; main logic ;; (define (websteal url wait) (define %top-url% (break-down-url url)) (if (illegal-url? %top-url%) (error "illegal url format found.") (if (file-exists? (get-fs-full-path %top-url%)) 'done (begin (sys-sleep wait) (if (type-is-html? (get-web-page-from url)) (let ((url (get-url %top-url%)) (file (get-fs-full-path %top-url%))) (let ((child-list (child-of file url))) (for-each (lambda (url) (websteal url *gentle-wait*)) child-list))) 'not-html))))) (define (main args) (websteal (cadr args) *no-wait*))