CLISP 之 創建HTTP GET、POST、HEAD請求

;;;; WHJ.20180504

;;;; 創建HTTP GET、POST、HEAD測試 及 cookie 攜帶,自定義 Header 

; 注：首行要注意大寫

(in-package :cl-user)

(defun reload nil
(load "h:/lisptool/httpcli.lisp"))

(defconstant +host-ip+ "localhost")
(defconstant +host-port+ 37212)
(defconstant +newline+ (coerce (list #\return #\newline ) 'string))

;當前與服務器的sockt連接
(defparameter *conn* nil)
;文檔內容編碼格式
(defvar *html-charset* charset:utf-8)


;創建 socket連接
(defun cli-init ()
(unless (and *conn* (ignore-errors (socket-status *conn*)))
(when *conn* (close *conn*))
(setf *conn* (socket-connect +host-port+  +host-ip+ )))

(http-stream-mode t))

(defun http-stream-mode (byte-flag)
(setf (stream-element-type *conn*) (if byte-flag '(unsigned-byte 8) 'character)))

(defun string2bytes (string)
(convert-string-to-bytes string charset:gbk))

(defun http-write-bytes (vec)
(loop for i from 0 to (1- (length vec)) do (write-byte (aref vec i) *conn*)))

(defun http-read-byte ()
(read-byte *conn* nil))

(defun http-read-line ()
(read-line *conn* nil))

(defun urlencode (string)
(reduce 
(lambda (x y) (format nil "~a%~(~x~)" x y)) 
(convert-string-to-bytes string charset:utf-8)
:initial-value ""))

;解析k=v,分別對k，v 調用urlencode得到 k1,v1 ,然後再合成k1=v1
(defun encode-keyvalue-string (kv-string)
(let ((index= (search "=" kv-string)))
(format nil "~a=~a" (urlencode (subseq kv-string 0 index=)) (urlencode (subseq kv-string (1+ index=))))))

(defun http-write (string &optional (newline t))
(http-write-bytes (string2bytes string))
(when newline (http-write-bytes (string2bytes +newline+))))

(defun get-content-length (html-header-list)
(let* ((flag "Content-Length:")
   (content-length-header (find-if (lambda (x) (search flag x)) html-header-list)))
(if content-length-header
(parse-integer (subseq content-length-header (+ (search flag content-length-header) (length flag))) :junk-allowed t)
0)))

(defun decode-bytes (byte-sequence charset)
(convert-string-from-bytes 
(if (listp byte-sequence)
(coerce byte-sequence 'vector)
byte-sequence)
charset))


(defun http-get (url)


(let ((host nil)(rel-url nil))
(let* ((s (+ 3 (search "://" url)))
   (e (search "/" url :start2 s)))

(setf host (subseq url s e)

rel-url (subseq url e)))

       (cli-init)
(http-write (format nil "GET ~a HTTP/1.1" rel-url))
(http-write (format nil "Host: ~a" host))
(http-write (format nil "mydata: ~a" "it is a test"))
(http-write (format nil "mydata2: ~a" "這是一箇中文的頭部")) ;ok

;帶cookie
(http-write "Cookie: myk1=test ;myk2=it is a cookie test;ASP.NET_SessionId=jon1wjqpiaikcvahvo3yv0xw")



(http-write +newline+ nil)


(when *conn*
(http-stream-mode nil)
(let* ((tmp-list (loop for x = (http-read-line)
while (and x (plusp (length x)))
collect x))
   (content-length (get-content-length tmp-list)))

(http-stream-mode t)
;讀取返回內容
(decode-bytes 
(loop for i from 0 to (1- content-length) for x = (http-read-byte) while x collect x)
*html-charset*)))))

(defun http-post (url data)


;轉義 data 特殊字符
(setf data 
(reduce 
(lambda (x y) (format nil "~a&~a" x y))
(mapcar #'encode-keyvalue-string (split #\& data))))

(let ((host nil)(rel-url nil))
(let* ((s (+ 3 (search "://" url)))
   (e (search "/" url :start2 s)))


(setf host (subseq url s e)
rel-url (subseq url e)))


(cli-init)


(http-write (format nil "POST ~a HTTP/1.1" rel-url))
(http-write (format nil "Host: ~a" host))
(http-write "Content-Type: application/x-www-form-urlencoded")
(http-write (format nil "Content-Length: ~d" (length data)))
(http-write +newline+ nil)

(http-write data nil)


(when *conn*
(http-stream-mode nil)
(let* ((tmp-list (loop for x = (http-read-line) 
while (and x (plusp (length x)))
collect x))
   (content-length (get-content-length tmp-list)))

(http-stream-mode t)

;讀取返回內容
(decode-bytes 
(loop for i from 0 to (1- content-length) for x = (http-read-byte) while x collect x)
*html-charset*)))))

(defun http-head (url)


(let ((host nil)(rel-url nil))
(let* ((s (+ 3 (search "://" url)))
   (e (search "/" url :start2 s)))


(setf host (subseq url s e)
rel-url (subseq url e)))


(cli-init)
(http-write (format nil "HEAD ~a HTTP/1.1" rel-url))
(http-write (format nil "HOST: ~a" host))
(http-write +newline+ nil)


(when *conn*
(http-stream-mode nil)
(let* ((tmp-list (loop for x = (http-read-line)
while (and x (plusp (length x)))
collect x))
   (content-length (get-content-length tmp-list)))
   
(format nil "~%~{~a~^~%~}~%" tmp-list)))))