Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
#!/usr/bin/env newlisp
# 短縮URLを展開する
;; Usage:
;; $ newlisp get-headers.lsp
;; ->
;; 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"
;; 通信を待つ
(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))