リモートからコマンドを実行する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 ""))