(defpackage i2pher (:use cl))

(defpackage i2pher (:use cl))
(in-package i2pher)

;;; #'serve uses spawned openbsd-nc process processes
;;; But the #'make-load-form method recursive serialization is good on its own
;;;These are geared at serving via a generic i2pd server tunnel config.
(defvar *local-port* 54321)
(defvar *local-address* "127.0.0.1")
(defvar *foreign-port* 54321)
(defvar *foreign-address* "localhost")

(defclass gopher ()
((item-type :initarg :item-type :reader item-type)
(item-description :initarg :item-description :reader item-description)
(item-specifier :initarg :item-specifier :reader item-specifier)
(in-memory :initarg :in-memory :reader in-memory)
(server :initarg :server :reader server)
(port :initarg :port :accessor port))
(:default-initargs :item-type 0 :port *foreign-port* :server *foreign-address*)
(:documentation "
(make-instance 'gopher :item-type :item-description :item-specifier
:in-memory :server :port )
Intends to make an in-memory gopher item whose content is the type 0
text (potentially other sequence) given by :in-memory.
Intended to be added to a gophermap via #'spawn
"))

(defmethod make-load-form ((obj gopher) &optional env) "
Admittedly locally tramples 'new-gopher
"
(declare (ignore env))
(multiple-value-bind (allocation slots)
(make-load-form-saving-slots obj)
(setf (second allocation) `(find-class ',(class-name (class-of obj))))
(mapc (lambda (x) (setf (second (second x)) 'new-gopher)) (cdr slots))
`(let ((new-gopher ,allocation))
,slots
(values new-gopher))))

(defclass gophermap (gopher)
((item-type :initform 1)
(litter :initarg :litter :type 'list :accessor litter)
(lock :initform (mp:make-lock) :reader lock)
(filename :initarg :filename :reader filename)
(in-memory :initform nil))
(:default-initargs :litter (list) :item-specifier '(:map))
(:documentation "
(make-instance 'gophermap :filename :item-description (:item-specifer '(:map)))
is the central class of i2pher.
Whence, gophers can spawn from it using #'spawn,
it can be persisted to disk using #'save (recursively (make-load-form)s)
Or can be #'serve -d
"))

(defmethod make-load-form ((obj gophermap) &optional env)
(declare (ignore env))
(let* ((gopher-load-form (call-next-method))
(setf-slots (cdaddr gopher-load-form)))
(dolist (s setf-slots)
(case (cadar (cddadr s))
('litter
(setf (third s)
(append '(list) `(,@(mapcar 'make-load-form (cadr (third s)))))))
('lock (setf (third s) '(mp:make-lock)))))
(values gopher-load-form)))

(defmethod in-memory ((obj gophermap))
(let ((properties (mapcar (lambda (x) (mapcar (lambda (y) (funcall y x))

'(item-type item-description item-specifier server port)))
(litter obj))))
(print properties)
(format nil "~{~{~d~a ~s ~a ~d~%~}~%~}" properties)))

(defmethod spawn ((obj gophermap) item-type item-description item-specifier in-memory) "
(spawn (obj gophermap) item-type item-description item-specifier in-memory)
Adds the pursuant gopher details to a gophermap.
in-memory should be the text of the (item type 0).
"
(push (make-instance 'gopher :item-type item-type :item-description item-description
:item-specifier item-specifier :in-memory in-memory)
(litter obj)))

;;;-------trying to make sure external processes end, in general.
(defvar *external-process-checkins* (list))
(defvar *ext-procs-lock* (mp:make-lock))

(defun make-checkin (external-process) "
(make-checkin external-process)
Erratically eventually signal processes to stop
(which should be due to client misbehaviour)
This is achieved by putting a closure somewhere the process in
*natural-killer* periodically bothers.
"
(mp:with-lock (*ext-procs-lock*)
(push
(let ((count 0))
(lambda () (mp:with-lock (*ext-procs-lock*)
(if (zerop count) (incf count)
(progn (si:killpid (ext:external-process-pid external-process)
ext:+SIGHUP+) (values))))))
*external-process-checkins*)))

(defvar *natural-killer*
(mp:process-run-function (gensym) (lambda ()
(loop (sleep (1+ (random 5)))
(setq *external-process-checkins*
(mapcan (lambda (x) (when (funcall x) (list x))) *external-process-checkins*))))))
;;;----------------------------------------------------------------------

(defmethod serve ((obj gophermap)) "
A multithreaded shell server using openbsd-netcat.
Should actually be called via (add-thread gophermap)
after which threads will be in *threads*.
Writes a sequence of items delimited as org mode sections by item descriptions
from
(responses
(remove-if-not (lambda (x) (subsetp item-specifier (item-specifier x) :test 'equalp))
(append (list obj) (litter obj))))
followed by