quicklisp 좋네

http://www.quicklisp.org/

유사한놈들이 몇가지 있지만 윈도우에서 쓰긴 어려워서 수작업으로 다운받는 식으로 쓰곤 했는데 저놈은 윈도에서도 그럴듯하게 돌아간다. 잘 기억해두자.

clozure common lisp 세팅

그냥 몇가지 적어둔다.

1. 뜰때 읽는 파일이 ccl-init.lisp 인데 내가 환경변수 HOME 을 잡아둔 곳에서 읽지 않고 내문서 그쪽에서 읽는다. $HOME 읽는 프로그램들 중(*nix 쪽에서 나온 놈들)에 이렇게 돌아가는건 처음보네. 아.. 허긴 이놈은 mac 출신이구나. 어쨌건 ccl 띄운후 (user-homedir-pathname) 를 확인해보면 알수있다.
2. 위 경로에 ccl-init.lisp 을 만들고 아래 코드로 c:/opt/lisp 아래의 asdf 패키지들을 찾도록 했다. 아래 코드는 http://paste.lisp.org/display/83926 에서 가져온것
   

   (require 'asdf)
   (defun setup-registry (directory-path)
     (format t "; adding components under ~A to asdf registry~%" directory-path)
     (mapc (lambda (asd-pathname)
             (pushnew (make-pathname :name nil
                                     :type nil
                                     :version nil 
                                     :defaults asd-pathname)
                      asdf:*central-registry*
                     :test #'equal))
           (directory (merge-pathnames #p"**/*.asd" directory-path))))
   (setup-registry #p"c:/opt/lisp/")

3. asdf-install 이 지원되는 모양인데.. 난 수작업을 하는편.
   
4. http://read-eval-print.blogspot.com/2009/06/clozure-cl-windows.html 를 보면 인코딩 세팅하는 코드도 나와있다. 지금은 그냥 돌려본거라 이건 테스트 안해봤는데 한글윈도에서 코딩하려면 반드시 필요하겠지. 파일인코딩은 euc-kr, 그외는 utf-8 식으로..
   

   (setf ccl:*default-external-format*
         (ccl:make-external-format :character-encoding :utf-8
                                   :line-termination :dos)
         ccl:*default-file-character-encoding* :utf-8
         ccl:*default-socket-character-encoding* :utf-8)

패키지 몰아서 받는건 아래 링크 통해서 하고있다. libcl 자체가 패키지관리기능을 가지고 있지만 난 그냥 저거 압축만 풀어서 쓰고있는 상태.
http://libcl.com/

성능좋은 common lisp 정규식 라이브러리 cl-irregsexp

이거 뭐 내가 이걸 쓸리는 업고 그냥 웹에서 놀다 보이길래 적어둔다.
전에 어디선가 cl-ppcre 가 런타임에 컴파일을 하기 때문에 속도가 조낸 빠르다는 소릴 들었는데 여기에 나온 벤치에 의하면 그렇지 못하네... 음 벤치가 너무 단순해서 그런가.

이 벤치는 다양한 패턴이 적용되지는 않은것 같지만 그냥 흥미있길래 적어둔다.

http://common-lisp.net/project/cl-irregsexp/


음 적는김에 링크 몇개 더 적어본다. 언젠가 읽어볼날이 오겠지. 오려나?

• Regular Expression Matching Can Be Simple And Fast(but is slow in Java, Perl, PHP, Python, Ruby, ...)
• reddit
• A silly CL-PPCRE performance test
  

emacs 기반 개발환경을 제공하는 common lisp 로그라이크 엔진

RLX: a cross-platform graphical roguelike engine

emacs 를 저렇게도 활용하네.
스샷에 보이는 cell 모드가 이 http://www.emacswiki.org/emacs/CellMode 셀모드인가 아님 따로 만든건가.. 어쨌건 셀모드 사이트는 링크가 지금 죽은 상태.

그외 걸린 링크들도 그럴싸해보이길래 적어둔다.

소스는 아직 안받아보고 스샷만 구경한 상태..
그런데 플레이어 입장으로 보면 별로 재미있어 보이는 스샷은 아니네. 낄낄

UPNP 로 공유기 찾고 포트매핑 추가하기. lisp(SBCL 전용) 예제

아 시바 정말 귀찮네.
이넘들이 망할 soap 을 쓰는 바람에 C 로 짜긴 귀찮은 존재구나.
libupnp 까지 붙이고 싶지는 않고.. 내가 지금 하려는거에 굳이 soap 결과를 파싱까지 하고 싶지는 않고.. 그래서 간단히 upnp 기능만 돌려보는 테스트 스크립트를 만들어봤다. slime 상에서 여러가지 경우로 테스트 해보기 위해서 lisp 으로 만들었고 lisp 으로 udp 쏘는건 처음이라 소스를 적어둔다.

아래 소스 로딩하고 (discover-gateway) 부르면 같은 망 내의 공유기를 찾아서(하나라고 가정) control url 을 *control-url* 에 담기게 되고, 그상태에서 (test/blahblah) 함수들을 적절히 불러가면서 공유기가 무슨짓을 하는지 보면 된다.

그런데 포트매핑을 추가한상태에서 또 추가한다거나, 다른 어플리케이션이 이미 포트 뚫어논 상태에서 내가 같은 포트로 뚫으려고 한다거나.. 내 어플이 뒤지고 다시 깨서 이미 뚫린걸 다시 뚫으려고 한다거나.. 내가 뚫어논걸 다른 색히가 가로챈다거나.. 음.. 테스트할 경우의수가 좀 많구나... 아무래도 문서를 읽어봐야 할거 같군. 걍 미리 만들어둔 xml 뿅 쏘고 넘길려고 했는데 그리 쉽게는 안되겠네?? 지금 아래 구현체는 upnp 하나도 모르고 그냥 빗토런트의 upnp 구현체를 보고 따라친거 뿐인데 이정도 테스트 만으로 넘어가긴 좀 그렇구나.

문서좀 읽고 libupnp 를 검토해봐야겠구나.. 후랄.

아 그리고 당연한 말이지만 아래 코드는 테스트용으로 만든거라 여러 가정을 깔고 있고 환경이 바뀌면 안돌아갈수 있다.. 나중에 기억못할테니 적어두자면.. 로컬 IP 가 *local-ip-address* 에 상수로 박혀있고 udp 쏘고 소켓 읽는 부분이 블러킹으로 리딩하기 때문에 만약 같은 망 내에 공유기가 없으면 마냥 블러킹 되고.. find-location-blahblah 함수내의 정규식 패턴에 ^M 이 \r 제어문자 라는거.. 이맥스에서는 C-Q C-M 으로 입력이 가능한데 다른 에디터는 모르겠다. 나중에 다시 필요하면 여기서 긁어붙일텐데 이때 ^M 주의하자.

소스보기..

;;; UPNP 를 이용해서 같은망 내의 공유기를 찾아서 포트매핑을 요청하는
;;; 예제.
;;;
;;; C 로 코딩하기전에 테스트정도로 짠거라 에러에 대한 처리는
;;; 전무. 예를들어 디스커버리 멀티캐스팅 후 응답이 없으면 마냥
;;; 블러킹되고, soap 날렸을때 에러나는경우 처리를 못하고 등등.
;;;
;;; 몇가지 더 적어두자면
;;; 1. udp socket 을 sb-bsd-sockets 의 함수들을 썼다. 따라서 sbcl
;;;    전용.
;;; 2. 뉴라인 찾는걸.. 정규식으로 처리를 잘 못해서 ^M 을 이맥스에서
;;;    코드상으로 박아버렸다. 애초에 별거아닌 문자열 검색에
;;;    정규식쓴것도 좀 그렇군.
;;; 3. drakma 를 써서 SOAP call 을 해결했다.
;;; 4. prog1 이 절라 편하군.. 하지만 쓰고나서 읽기는 버겁더라.
;;;
;;;
;;; 테스트하려면
;;; 1. 먼저 (discover-gateway) 를 불러서 *control-url* 를 채우고
;;; 2. (test/blahblah) 류 함수들을 불러가면서 공유기 제어를 해보자.
;;;

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require 'drakma)
  (require 'cl-ppcre)
  (require 'puri))

(defpackage #:upnp
  (:use #:cl #:cl-ppcre))
(in-package #:upnp)


;;; drakma 디버깅출력을 보는게 좀더 편하겠군
(setf drakma:*header-stream* *standard-output*)

(defvar *control-url* nil "soap 을 때릴 주소. discover-gateway 함수를
부르면 채워준다.")

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun join-lines (&rest lines)
  "인자로 들어오는 문자열들을 묶어 하나의 문자열로 만드는데 이때 문자열
끝마다 crlf 를 넣어준다. 좀더 간지나게 짤수도 있을것 같은데 당장 loop
부터 떠오르더라.."
  (loop
     with r
     for x in lines
     do (setf r (concatenate 'string r x #(#\Return #\Linefeed)))
     finally (return r))))

(defvar *discovery*
  (join-lines
   "M-SEARCH * HTTP/1.1"
   "Host:239.255.255.250:1900"
   "ST:urn:schemas-upnp-org:device:InternetGatewayDevice:1"
   "Man:\"ssdp:discover\""
   "MX:3"
   ""))

(defvar *local-ip-address* "192.168.0.2" "헐 시바. 자기 ip 얻는방법을
모르겠네 소켓 만들어서 따와야 하나 고민할거 없이 걍 상수로 박았다. 이게
필요한 이유는 매핑할때 인자로 넘겨줘야 하기 때문.")


(defun multicast-discovery ()
  "우왕 복잡하고 드러운 코드네. with- 매크로를 만들기 싫어서 그냥
막짰더니 다시 못읽는 코드가 나와버렸네. prog1 도 쓸때는 졸라 편한데
읽을땐 더러워지는 구나.

어쨌건 이함수를 부르면 upnp discovery 패킷을 쏘고 응답이 있으면 그걸 받아 출력해준다.
응답이 없는 경우...는 테스트 안해봤다. 뭐 블럭되겠지..."
  (let ((sock (make-instance 'sb-bsd-sockets:inet-socket :type :datagram :protocol :udp)))
    (sb-bsd-sockets:socket-send sock *discovery* nil :address '(#(239 255 255 250) 1900))
    (multiple-value-bind (buf readed from)
        (sb-bsd-sockets:socket-receive sock nil 8192 :element-type 'character)
      (prog1 (values (make-array readed :displaced-to buf :element-type 'character)
                     readed
                     from)
        (sb-bsd-sockets:socket-close sock)))))

(defun find-location-from-discovery-response (discovery-response)
  "헐. #Return 을 없애는걸.. strip 이나 등등을 쓰지 못하고 정규식내에
^M 을 집어넣어서 해결했다. 뭐 테스트 용도이니 빨리 짜는게 장땡이지."
  (multiple-value-bind (string results)
      (cl-ppcre:scan-to-strings "LOCATION: \(.*\)^M" discovery-response)
    (declare (ignore string))
    (aref results 0)))


(defun httpcall (url)
  (drakma:http-request url))

(defun soapcall (url action body)
  (drakma:http-request url
                       :content-type "text/xml; charset=\"utf-8\""
                       :method :post
                       :content body
                       :additional-headers `(("SOAPAction" . ,action))))


(defun between (string begin end &optional &key (start 0))
  "string 안에서 begin 과 end 사이의 문자열을 찾아 리턴 에러처리 따로
안했으니 못찾으면 아마 search 함수가 에러내겠지."
  (let* ((b (search begin string :start2 start))
         (e (search end   string :start2 b)))
    (subseq string (+ b (length begin)) e)))


(defun search-before (string before target)
  "헐 영어가 후달리니 이름을 못짓겠네. 주어진 string 에서 먼저 target
을 찾고 그 앞쪽에서부터 before 를 찾아서 첫번째 나오는 위치(string 내의
인덱스)를 리턴해준다."
  (search before
          string
          :end2 (search target string)
          :from-end t))


(defun wanip-connection-service (description)
  "서비스타입이 urn:schemas-upnp-org:service:WANIPConnection: 인
서비스를 찾아 그부분만 리턴."
  (let* ((b (search-before description "<service>" "<serviceType>urn:schemas-upnp-org:service:WANIPConnection:"))
         (service (between description "<service>" "</service>" :start b)))
    service))

(defun discover-gateway ()
  "여자저차 해서 *control-url* 에 값을 채운다.

 1. 먼저 디스커버리 멀티캐스팅을 쏘고
 2. 응답중에 location 부분을 따와서
 3. http get 때려서 디스크립션을 얻고
 4. 디스크립션중 urn:schemas-upnp-org:service:WANIPConnection: 타입의 서비스 부분을 찾아서
 5. 그 서비스의 controlURL 을 얻어서
 6. *control-url* 에 담는다."
  (let* ((discovery-response (multicast-discovery))
         (gateway-location   (find-location-from-discovery-response discovery-response))
         (description        (httpcall gateway-location))
         (service            (wanip-connection-service description))
         (control-url        (between service "<controlURL>" "</controlURL>"))
         (abs-control-url    (puri:merge-uris control-url gateway-location)))
    (setf *control-url* abs-control-url)
    *control-url*))


(defun xml-get-port-mapping (index)
  (format nil "<?xml version=\"1.0\"?>
<s:Envelope xmlns:s=\"http://schemas.xmlsoap.org/soap/envelope/\" s:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\">
  <s:Body>
    <u:GetGenericPortMappingEntry xmlns:u=\"urn:schemas-upnp-org:service:WANIPConnection:1\">
      <NewPortMappingIndex>~D</NewPortMappingIndex>
    </u:GetGenericPortMappingEntry>
  </s:Body>
</s:Envelope>"
          index))


(defun xml-add-port-mapping (&key internal-port external-port protocol (host *local-ip-address*) service-name)
  (format nil "<?xml version=\"1.0\"?>
<s:Envelope xmlns:s=\"http://schemas.xmlsoap.org/soap/envelope/\" s:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\">
  <s:Body>
    <u:AddPortMapping xmlns:u=\"urn:schemas-upnp-org:service:WANIPConnection:1\">
      <NewEnabled>1</NewEnabled>
      <NewRemoteHost></NewRemoteHost>
      <NewLeaseDuration>0</NewLeaseDuration>
      <NewInternalPort>~D</NewInternalPort>
      <NewExternalPort>~D</NewExternalPort>
      <NewProtocol>~A</NewProtocol>
      <NewInternalClient>~A</NewInternalClient>
      <NewPortMappingDescription>~A</NewPortMappingDescription>
    </u:AddPortMapping>
  </s:Body>
</s:Envelope>"
          internal-port
          external-port
          protocol
          host
          service-name))

(defun xml-del-port-mapping (&key external-port protocol)
  (format nil "<?xml version=\"1.0\"?>
<s:Envelope xmlns:s=\"http://schemas.xmlsoap.org/soap/envelope/\" s:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\">
  <s:Body>
    <u:DeletePortMapping xmlns:u=\"urn:schemas-upnp-org:service:WANIPConnection:1\">
      <NewRemoteHost></NewRemoteHost>
      <NewExternalPort>~D</NewExternalPort>
      <NewProtocol>~A</NewProtocol>
    </u:DeletePortMapping>
  </s:Body>
</s:Envelope>"
          external-port
          protocol))


(defun test/get-external-ip ()
  "soap 이 잘되는지 테스트 하려고 만들어본놈. 그외 의미는 없다."
  (soapcall *control-url*
            "urn:schemas-upnp-org:service:WANIPConnection:1#GetExternalIPAddress"
            "<?xml version=\"1.0\"?>
<s:Envelope xmlns:s=\"http://schemas.xmlsoap.org/soap/envelope/\" s:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\">
  <s:Body>
    <u:GetExternalIPAddress xmlns:u=\"urn:schemas-upnp-org:service:WANIPConnection:1\">
    </u:GetExternalIPAddress>
  </s:Body>
</s:Envelope>
"))

(defun test/get-port-mapping (&optional &key (index 0))
  "인덱스를 줘야 한다는게 좀 드럽군. 전체 리스팅하는걸 찾아봐야 할까?"
  (soapcall *control-url*
            "urn:schemas-upnp-org:service:WANIPConnection:1#GetGenericPortMappingEntry"
            (xml-get-port-mapping index)))

(defun test/add-port-mapping (&optional &key (internal-port 9413) (external-port 9999) (protocol "TCP") (service-name "hehehe upnp test"))
  (soapcall *control-url*
            "urn:schemas-upnp-org:service:WANIPConnection:1#AddPortMapping"
            (xml-add-port-mapping :internal-port internal-port
                                  :external-port external-port
                                  :protocol      protocol
                                  :service-name  service-name)))

(defun test/del-port-mapping (&optional &key (external-port 9999) (protocol "TCP"))
  "지울때는 external-port 와 protocol 로 지우는구나.. 결국 이게 key
값이란 소린데 그럼 포트매핑이 쫑나면 어떻게 처리하지?"
  (soapcall *control-url*
            "urn:schemas-upnp-org:service:WANIPConnection:1#DeletePortMapping"
            (xml-del-port-mapping :external-port external-port
                                  :protocol      protocol)))



;;; 테스트는 요런식으로.. test/blahblah 류 함수들을 이용하자.
;; (test/add-port-mapping)
;; (test/get-port-mapping :index 0)
;; (test/del-port-mapping :external-port 9999 :protocol "TCP"

common lisp 에서 \r\n, crlf 의 표현 방법 ( usocket 을 이용한 간단한 http call 예제 )

;;; \r\n 이 자주 쓰이는 표현인데 common lisp 에서는 \r\n 식으로
;;; 표현하면 그냥 이스케이프 되서 못알아먹고 #\Return #\Newline 등으로
;;; 나타내야 되는데 lisp 을 자주 쓰는것도 아니고 어쩌다 한번 쓸려고
;;; 하면 매번 까먹길래 적어둔다.
;;;
;;; 참고로 sbcl 에선 아래결과가 나오는데
;;; (char-code #\Return)    -> 13
;;; (char-code #\Linefeed)  -> 10
;;; (char-code #\Newline)   -> 10
;;; 이게 표준인지는 잘 모르겠다 특히 라인피드와 뉴라인 캐릭터가 같이
;;; 있는건 좀 애매하군. 설마 플래폼마다 Newline 값이 달라지는건가?
;;; 
;;; 아래 예제는 usocket 을 이용해서 간단히 http request 를 날려보는
;;; 예제. \r\n 을 스트림으로 쏘는 함수를 만들어서 이용을 했는데 굳이
;;; 이렇게 안하고 format 에서 ~C~C 로 하고 #\Return #\Linefeed 을 대줘도
;;; 된다.
;;;

(require 'usocket)
(use-package :usocket)

(declaim (inline crlf))
(defun crlf (s)
  (check-type s stream)
  (write-char #\Return s)
  (write-char #\Linefeed s))

;;; crlf 함수를 통해서
(with-client-socket (sock stream "www.live.com" 80)
  (format stream "GET / HTTP/1.0")
  (crlf stream)
  (crlf stream)
  (force-output stream)
  (loop
     for buf = (read-line stream nil)
     while buf
     do (print buf)))


;;; format 에서 바로 써봤다. \r\n 처럼 format 안쪽에서 바로 표현하는
;;; 방법은 모르겠네
(with-client-socket (sock stream "www.live.com" 80)
  (format stream "GET / HTTP/1.0~C~C~C~C" #\Return #\Linefeed #\Return #\Linefeed)
  (force-output stream)
  (loop
     for buf = (read-line stream nil)
     while buf
     do (print buf)))

hunchentoot 한글(유니코드) 출력하기

전에도 고민했던 문제였는데 다시 만나게 되서 삽질을 또 해봤는데

이번에 한 삽질 보기

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require 'hunchentoot)
  (require 'cl-who)
  (require 'html-template))

(defpackage :simple-web
  (:use :common-lisp :hunchentoot :html-template)
  (:export :start :stop))
(in-package :simple-web)

(defvar *server* nil "웹서버 인스턴스")

(defun start (&key (port 8080))
  "웹서버 시작"
  (when *server* (error "already started"))
  (setf *server* (start-server :port port)
        *default-content-type* "text/html; charset=utf-8"
        *dispatch-table* (list (create-prefix-dispatcher "/foo" 'foo)
                               (create-prefix-dispatcher "/bar" 'bar)
                               (create-prefix-dispatcher "/baz" 'baz)
                               'default-dispatcher))
  *server*)

(defun stop ()
  "웹서버 종료"
  (stop-server *server*)
  (setf *server* nil))


(push (create-prefix-dispatcher "/test" 'foo) *dispatch-table*)

(defun foo ()
  "한글(유니코드)출력을 하려면 어래이 형태로 리턴해주면 된다"
  (sb-ext:string-to-octets
   "한글"))

(defun bar ()
  "html-template 를 써봤다. 이놈으로 한글을 리턴해주려면
  이스케이프되는것을 막아야 하는데 *string-modifier* 를 적당히 다른걸로
  바꿔치면 된다. 어떤걸로 써야 할지는 아직 잘 모르겠는데.. 문서
  참고하세... 흠 html-template 가 스트림에 바로 쓰는 함수는 있는데
  스트링으로 리턴해주는 함수가 없네. 못찾은건가.. 그래서
  with-output-to-string 으로 스트링으로 받아내고 이중에 유니코드가
  껴있으니 다시 string-to-octets 으로 어래이 형태로 변환을 했다."
  (sb-ext:string-to-octets
   (with-output-to-string (s)
     (let ((*string-modifier* #'escape-string-minimal-plus-quotes))
       (fill-and-print-template (create-template-printer "안녕 <!-- TMPL_VAR world -->")
                                '(:world "세상")
                                :stream s)))))

(defun baz ()
  "이건 fill-and-print-template 에 바로 스트림을 넘기기 위해서
send-headers 로 스트림을 가져온것."
  (let ((s (send-headers)))
    (fill-and-print-template (create-template-printer "안녕 <!-- TMPL_VAR world -->")
                             '(:world "세상")
                             :stream s)))

헐 시바 그런데 존내 간단한 해결방법이 있었네
http://osdir.com/ml/lisp.html-template.general/2007-05/msg00004.html
예전엔 왜 못봤지?


그래서 위 코드를 적용하고 나니 위의 foo 와 baz 가 이렇게 간단히 변했다.

(setf hunchentoot:*hunchentoot-default-external-format* :UTF-8)

(defun foo ()
  "한글")
(defun baz ()
  (let ((s (send-headers)))
    (fill-and-print-template (create-template-printer "안녕 <!-- TMPL_VAR world -->")
                             '(:world "세상")
                             :stream s)))


아 쉬바...