[newLISP]短縮URLを展開する

get-headers.lsp

#!/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)

元ネタは以下

• Schwarze SQ: 短縮URLを展開するRubyスクリプトを作ってみた
• 404 Blog Not Found:perl - 短縮URLを一行で展開する
• php - 短縮URLを一行で展開する