リモートからコマンドを実行するHTTPサーバ

今日作成したデーモンサーバ作成モジュールを使って、HTTP通信を通して送信されたコマンドを実行するデーモンサーバを実装する。
この記事のものとは少し異なるが、そもそもデーモン用のモジュールを作成したのは、コマンド実行サーバを作りたかったから。


とはいっても、コード量自体は短く、またそのほとんどはHTTPヘッダのパースに当てられている。


まずは、ユーティリティ関数。

(defmacro nlet (fn-name letargs &body body)
  `(labels ((,fn-name ,(mapcar #'car letargs)
              ,@body))
     (,fn-name ,@(mapcar #'cadr letargs))))

;; ※ 他の記事で良く使われているnlet-accとは若干異なり、listではなくvectorを返す
;;    このように、list以外を返して欲しいケースはまれにあるので、typeを指定できるようにnlet-accを拡張しても良いかもしれない
(defmacro nlet-acc (fn-name letargs  &body body)
  (let ((acc (gensym)))
    `(let ((,acc (make-array 64 :element-type '(unsigned-byte 8)
                                :fill-pointer 0 :adjustable 0)))
       (flet ((accumulate (x) (vector-push-extend x ,acc)))
         (setf (fill-pointer ,acc) 0)
         (nlet ,fn-name ,letargs
           ,@body))
       ,acc)))


リクエストパース

(defun urldecode(url &aux (len (length url)))
  (octets-to-string
   (nlet-acc self ((i 0))
     (when (< i len)
       (case #1=(schar url i)
         (#\% (accumulate (parse-integer url :start (1+ i) :end (+ i 3) :radix 16)) (self (+ i 3)))
	 (#\+ (accumulate (char-code #\Space))   (self (1+ i)))
	 (otherwise (accumulate (char-code #1#)) (self (1+ i))))))))

;; HTTPリクエストの内、一行目だけを利用
;; 一行目のパス指定の部分を実行するコマンドとして解釈する(パスの先頭の'/'は外す)
(defun read-command ()
  (let* ((line (read-line))
	 (beg (1+ (position #\/ line)))
	 (end (position #\Space line :start beg))
	 (cmd (subseq line beg end)))
    (urldecode cmd)))


その他

;; HTTPレスポンス
(defconstant CRLF (coerce '(#\Return #\Newline) 'string))
(defun write-http-response (content)
  (format t "HTTP/1.0 200 ok~A~
             CONNECTION: close~:*~A~
             CONTENT-TYPE: text/html~:*~A~
             CONTENT-LENGTH: ~D~2:*~A~:*~A~*~A" 
	  CRLF (length (string-to-octets content)) content))

;; コマンド実行: コマンドの標準出力を文字列にして返す
(defun system(cmd)
  (with-output-to-string (out)
    (run-program "sh" `("-c" ,cmd) :search t :output out)))


サーバ実行。

(require :deamon)

;; 127.0.0.1:3000でサーバ起動(デーモン)
(deamon:do-accept (#(127 0 0 1) 3000 :bivalent t :anaph t 
                                     :pid "/tmp/3000.pid" 
                                     :log "/tmp/3000.log")
  (deamon:log "==============")
  (deamon:log "Accept : ~A" (sb-bsd-sockets:socket-peername client))

  (let ((cmd (read-command)))
    (deamon:log "Execute: ~A" cmd)
    (write-http-response (system cmd)))

  (deamon:log ""))

これで、ブラウザなどで'http://127.0.0.1:3000/ls'とURLを指定すると、lsコマンドの実行結果が表示されるようになる。

shebang script

以下の内容のファイルを作成して、実行権限を付与すれば、'./script-name'みたいな感じでサーバを起動できる。

#! /usr/local/bin/sbcl --script

(let ((*standard-output* (make-broadcast-stream)))
  (require :asdf)
  (require :deamon))

(defmacro nlet (fn-name letargs &body body)
  `(labels ((,fn-name ,(mapcar #'car letargs)
              ,@body))
     (,fn-name ,@(mapcar #'cadr letargs))))

(defmacro nlet-acc (fn-name letargs  &body body)
  (let ((acc (gensym)))
    `(let ((,acc (make-array 64 :element-type '(unsigned-byte 8)
                                :fill-pointer 0 :adjustable 0)))
       (flet ((accumulate (x) (vector-push-extend x ,acc)))
         (setf (fill-pointer ,acc) 0)
         (nlet ,fn-name ,letargs
           ,@body))
       ,acc)))

(defconstant CRLF (coerce '(#\Return #\Newline) 'string))
(defun write-http-response (content)
  (format t "HTTP/1.0 200 ok~A~
             CONNECTION: close~:*~A~
             CONTENT-TYPE: text/html~:*~A~
             CONTENT-LENGTH: ~D~2:*~A~:*~A~*~A" 
          CRLF (length (string-to-octets content)) content))

(defun urldecode(url &aux (len (length url)))
  (octets-to-string
   (nlet-acc self ((i 0))
     (when (< i len)
       (case #1=(schar url i)
         (#\% (accumulate (parse-integer url :start (1+ i) :end (+ i 3) :radix 16)) (self (+ i 3)))
         (#\+ (accumulate (char-code #\Space))   (self (1+ i)))
         (otherwise (accumulate (char-code #1#)) (self (1+ i))))))))

(defun read-command ()
  (let* ((line (read-line))
         (beg (1+ (position #\/ line)))
         (end (position #\Space line :start beg))
         (cmd (subseq line beg end)))
    (urldecode cmd)))

(defun system(cmd)
  (with-output-to-string (out)
    (run-program "sh" `("-c" ,cmd) :search t :output out)))

(deamon:do-accept (#(127 0 0 1) 3000 :bivalent t :anaph t 
                                     :pid "/tmp/3000.pid" 
                                     :log "/tmp/3000.log")
  (deamon:log "==============")
  (deamon:log "Accept : ~A" (sb-bsd-sockets:socket-peername client))

  (let ((cmd (read-command)))
    (deamon:log "Execute: ~A" cmd)
    (write-http-response (system cmd)))

  (deamon:log ""))