clisp 实现http请求 (2) (未完成)

暂存代码。

1、未实现post,仅实现了 get

2、未实现 https 

 

运行环境： win7 clisp 2.49

(in-package :cl-user)
(use-package :socket)

;主机信息
(defstruct hostinfo host port)
(defstruct urlinfo hostinfo url https-p)

;tool: 生成 struct: hostinfo
(defmacro mk-hostinfo (host port)
    `(make-hostinfo :host ,host :port ,port))


;;tool: 解析出url中的主机名和端口号
;参数格式: host:port
(defun make-hostinfo-by-hostport (hostport &optional default-port)
    (let ((i (search ":" hostport)))
        (mk-hostinfo 
            (if i 
                (subseq hostport 0 i) 
                hostport)
           (if i
               (parse-integer (subseq hostport (1+ i)) :junk-allowed t)
               default-port))))
            
;tool: 解析出url中的主机名和端口号   
(defun make-urlinfo-by-url (url)
    (let ((s1 (search "://" url)))
        (if s1
            (setf s1 (+ s1 3))
            (error "invalid url:~a" url))

        (let ((urlinfo (make-urlinfo))
              (s2 (search "/" url :start2 s1)))
              
             (setf (urlinfo-https-p urlinfo) (if (search "https://" url :test #'string-equal) t nil)
                   (urlinfo-url urlinfo)  (if s2 (subseq url s2) "/")
                    (urlinfo-hostinfo urlinfo) (make-hostinfo-by-hostport
                                                        (subseq url s1  s2)
                                                        (if (urlinfo-https-p urlinfo) 443 80)))
             urlinfo)))

;;;;打开一个socket连接
(defmacro with-open-socket ((conn hostinfo) &body body)
    (with-gensyms (nil hi host port)
        `(let* ((,hi ,hostinfo)
                (,port (hostinfo-port ,hi))
                (,host (hostinfo-host ,hi))
                (,conn (socket-connect ,port ,host)))
                
                (setf (stream-element-type ,conn) '(unsigned-byte 8))
                (unwind-protect
                   (progn
                        ,@body)
                   (close ,conn)))))
;;;;send data
(defun send-cmd (out cmd &optional (newline-p t) (charset charset:utf-8))
    (when cmd 
            (write-sequence 
                (convert-string-to-bytes cmd charset)
                out))
        (when newline-p
            (write-sequence '(13 10) out)))
;;;;读取所有数据  
(defun read-all-data (io &optional (time-out 10))
    (symbol-macrolet ((conn-ok-p (eq (socket-status io) :IO)))
        (loop for i from 0 to time-out
              while (not conn-ok-p)
                do (sleep 1))
                    
        (unless conn-ok-p
            (error "read-all-data timeout."))

        (let ((vret (make-array 4096 :adjustable t :fill-pointer 0)))
            (do nil
                ((not conn-ok-p))
                (vector-push-extend (read-byte io) vret))
            vret)))

;;;;解析出http请求返回的数据
(defun http-data (vret charset)
    (let (header content)
        (let ((i (search #(13 10 13 10) vret)))
            (if i
                (setf header (convert-string-from-bytes (subseq vret 0 i) charset:utf-8)
                      content (convert-string-from-bytes (subseq vret (+ i 4)) charset))
                (setf header (convert-string-from-bytes vret charset:utf-8)))
            (list :header header
                  :content content))))
;实现get请求
(defun http-get (url &optional (charset charset:utf-8))
    (let* ((urlinfo (make-urlinfo-by-url url))
           (hostinfo (urlinfo-hostinfo urlinfo)))
        (with-open-socket (io hostinfo)
            (send-cmd io (format nil "GET ~a HTTP/1.1"(urlinfo-url urlinfo)))
            (send-cmd io (string-concat "Host: " (hostinfo-host hostinfo)))
            (send-cmd io "User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko")
    
            (send-cmd io nil)
            (http-data 
                (read-all-data io)
                charset))))
;head       
(defun http-head (url)
    (let* ((urlinfo (make-urlinfo-by-url url))
           (hostinfo (urlinfo-hostinfo urlinfo)))
        (with-open-socket (io hostinfo)
            (send-cmd io (format nil "HEAD ~a HTTP/1.1"(urlinfo-url urlinfo)))
            (send-cmd io (string-concat "Host: " (hostinfo-host hostinfo)))
            (send-cmd io "User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko")
    
            (send-cmd io nil)
            (http-data 
                (read-all-data io)
                charset:utf-8))))