Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;; Trivial SEXP server.
;; BIG FAT WARNING!!!!
;; safe-read is subject to DoS attacks whereby attackers force the server
;; to intern a lot of useless symbols until it runs out of memory.
;; THIS NOT FOR USE IN THE WILD! Only on safe (virtual) private networks.
;;
;; If you want a robust server, you'll have to supply your own robust parser.
;; And handle all kind of weird issues such as handling character encoding,
;; not to speak about avoiding extra consing for performance.
;; I recommend then trying UDF-A.
(in-package :philip-jose)
(defparameter *request-heads* (make-hash-table :test #'equal))
(def*fun register-request-head (x func)
(setf (gethash x *request-heads*) func))
(def*macro defun-request-handler (name formals &body body)
`(progn
(defun ,name ,formals ,@body)
(register-request-head ,(conc-keyword name) (function ,name))))
(def*fun call-request-handler (f &rest args)
(let ((fun (gethash f *request-heads*)))
(if fun
(apply fun args)
(error "Not a registered request type ~S" f))))
(defun handle-sexp-request (request)
(if (consp request)
(apply #'call-request-handler request)
(error "Bad request ~S" request)))
(defun sexp-request-handler ()
(handle-sexp-request (safe-read)))
(defun handle-sexp-request-from-stream (i &optional (o i))
(let* ((*standard-input* i)
(*standard-output* o))
(sexp-request-handler)))
(defun handle-sexp-request-from-socket (socket)
(handle-sexp-request-from-stream socket))
(def*fun reply (x)
(safe-write x)
(princ +crlf+)
(finish-output))
(def*fun reply* (&rest x)
(reply x))