public
Created

[newLISP]短縮URLを展開する

  • Download Gist
get-headers.lsp
Common Lisp
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
#!/usr/bin/env newlisp
# 短縮URLを展開する
 
;; Usage:
;; $ newlisp get-headers.lsp http://google.com/
;; -> http://www.google.com/
 
;; NOTE:
;; (get-url $url "header") でもURLのヘッダー部分を取得することができるが
;; ステータスコードが30Xの場合、ロケーションを内部で判定してその先のヘッダを
;; 自動的に取得してしまうのでここでは利用できない。
 
;; 1. 自前でHTTPリクエストを組み立てる方法
(define (get-headers url)
(local (host path conn buffer)
(or (regex "http://([^/]+)/?(.*)" url)
(throw-error "HTTP bad formed URL"))
(map set '(host path) (list $1 $2))
(setq conn (or (net-connect host 80)
(throw-error (net-error))))
(net-send conn (string
"HEAD /" path " HTTP/1.1\r\n"
"Host: " host "\r\n"
"User-Agent: newLISP v" (sys-info -2) "\r\n"
"Connection: close\r\n"
"\r\n"))
;; 通信を待つ
(while (net-select conn "read" 1000)
(if (net-error) (print (net-error))))
;; ヘッダ部分を読み込む
(net-receive conn buffer 0x1000 "\r\n\r\n")
(net-close conn)
(map (fn (h)
(parse h ": "))
(parse buffer "\r\n"))
))
 
;; 2. 外部コマンド(cURL)を利用した方法
(define (get-headers url)
(let (header (join (exec (format "curl -sI %s" url)) "\n"))
(map (lambda (h)
(parse h ": "))
(parse header "\n"))))
 
(setq $url (main-args 2))
(setq $h (get-headers $url))
(println (lookup "Location" $h))
 
(exit)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.