;;; -*- 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))