1.1--- a/lisp/lib/net/pkg.lisp	Wed Jul 17 21:56:18 2024 -0400
     1.2+++ b/lisp/lib/net/pkg.lisp	Thu Jul 18 22:09:56 2024 -0400
     1.3@@ -325,7 +325,9 @@
     1.4 
     1.5 (defpackage :net/srv
     1.6   (:nicknames :srv)
     1.7-  (:use :cl :std :obj/uri :net/core :net/proto/http :net/cookie :dat/base64 :sb-gray)
     1.8+  (:use :cl :std :obj/uri
     1.9+   :net/core :net/proto/http :net/cookie :dat/base64
    1.10+   :sb-gray :dat/mime :sb-bsd-sockets)
    1.11   (:export
    1.12    #:default-web-directory
    1.13    #:start-service
    1.14@@ -336,12 +338,13 @@
    1.15    #:service
    1.16    #:define-service
    1.17    #:*router*
    1.18-   #:*acceptor*
    1.19+   #:*service*
    1.20    #:*handlers*))
    1.21 
    1.22 (in-package :std-user)
    1.23 
    1.24 (defpkg :net
    1.25+  (:use :cl :std)
    1.26   (:use-reexport 
    1.27    :net/core 
    1.28    :net/tcp 

     2.1--- a/lisp/lib/net/srv.lisp	Wed Jul 17 21:56:18 2024 -0400
     2.2+++ b/lisp/lib/net/srv.lisp	Thu Jul 18 22:09:56 2024 -0400
     2.3@@ -23,14 +23,27 @@
     2.4   (srv:start ws)))
     2.5 |#
     2.6 
     2.7+;; not considering SSL currently - not a core object type but perhaps subclass
     2.8+
     2.9+;; mostly following the implementation of hunchentoot with attempts at
    2.10+;; simplification.
    2.11+
    2.12 ;;; Code:
    2.13 (in-package :net/srv)
    2.14 
    2.15 ;;; Vars
    2.16 (defvar *router*)
    2.17-(defvar *acceptor*)
    2.18+(defvar *service*)
    2.19 (defvar *handlers*)
    2.20-
    2.21+(defvar-unbound *request*)
    2.22+(defvar-unbound *response*)
    2.23+(defvar *global-session-db* nil)
    2.24+(defvar *global-session-db-lock* (make-mutex :name "global-session-db"))
    2.25+(defvar *default-connection-timeout* 20)
    2.26+(defvar *default-service-port* 8000)
    2.27+#+ssl (defvar *default-ssl-service-port* 8000)
    2.28+(defvar *default-session-timeout* #.(* 30 60)) ;; 30m
    2.29+(defvar *default-content-type* "text/html")
    2.30 ;;; Conditions
    2.31 ;; from hunchentoot
    2.32 (define-condition srv-condition (condition) ())
    2.33@@ -69,27 +82,103 @@
    2.34 
    2.35 (defgeneric add-route (self uri handler &key &allow-other-keys))
    2.36 (defgeneric delete-route (self uri &key &allow-other-keys))
    2.37+(defgeneric handle-request (self request))
    2.38+(defgeneric service-name (self)
    2.39+  (:method ((self t))
    2.40+    (obj/id:id self)))
    2.41+
    2.42+;;; Response
    2.43+(defclass service-response () ())
    2.44+(defclass http-service-response (service-response) ((response :type http-response)))
    2.45+
    2.46+;;; Request
    2.47+(defclass service-request ()
    2.48+  ((origin :initarg :origin
    2.49+           :reader request-origin)
    2.50+   (session :initform nil
    2.51+            :accessor session)))
    2.52+
    2.53+(defclass http-service-request (service-request)
    2.54+  ((request :type http-request)))
    2.55+
    2.56+;;; Session
    2.57+
    2.58+;; HACK 2024-07-18: currently not storing the SESSION-STRING directly in this
    2.59+;; class as a slot. may need to change but I would rather have the string
    2.60+;; cached/displaced to some other location.. depends how often we need that
    2.61+;; string.
    2.62+(defclass session (obj/id:id)
    2.63+  ((id :type integer)
    2.64+   (user-agent)
    2.65+   (remote-addr)
    2.66+   (session-start)
    2.67+   (last-click)
    2.68+   (data)
    2.69+   (max-time :type fixnum))
    2.70+  (:default-initargs
    2.71+   :session-start (get-universal-time)
    2.72+   :last-click (get-universal-time)
    2.73+   :max-time *default-session-timeout*))
    2.74+
    2.75+;;; Headers
    2.76 
    2.77 ;;; Router
    2.78+(defclass router () ())
    2.79 
    2.80+;;; Task Pool
    2.81+;; Automatic Multithreading support for service objects
    2.82+
    2.83+(define-task-kernel service-task-kernel () ()
    2.84+  "Default task kernel for service-based tasks.")
    2.85+
    2.86+;; supervisor, worker, task, kernel
    2.87 ;;; Service
    2.88 (defclass service (obj/id:id)
    2.89-  ((address)
    2.90-   (request-class)
    2.91-   (response-class)
    2.92-   (task-pool)
    2.93-   (read-timeout)
    2.94-   (write-timeout)
    2.95-   (home)
    2.96-   (connection-max)
    2.97-   (chunk-output-p)
    2.98-   (chunk-input-p)
    2.99-   (socket)
   2.100-   (request-count :initform 0)
   2.101-   (shutdown-lock :initform (sb-thread:make-mutex :name "shutdown-lock"))
   2.102-   (shutdown-queue :initform (sb-thread:make-waitqueue :name "shutdown-queue")))
   2.103+  ((port)
   2.104+   (address)
   2.105+   ;; HACK 2024-07-18: will this only accept class names? are structures classes? (http-request, http-response)
   2.106+   (request-class :type symbol)
   2.107+   (response-class :type symbol)
   2.108+   (task-pool :type task-pool)
   2.109+   (read-timeout :type fixnum)
   2.110+   (write-timeout :type fixnum)
   2.111+   (connection-max :type fixnum)
   2.112+   ;; RESEARCH 2024-07-18: 
   2.113+   ;; may need to start dealing with this
   2.114+   ;; https://datatracker.ietf.org/doc/html/rfc2616#section-3.6.1
   2.115+   (chunk-output-p :type boolean)
   2.116+   (chunk-input-p :type boolean)
   2.117+   (socket :type socket)
   2.118+   (request-count :type integer)
   2.119+   (shutdown-lock :type mutex)
   2.120+   (shutdown-queue :type waitqueue))
   2.121   (:default-initargs
   2.122-   :id (gensym "SRV")))
   2.123+   :id (symbol-name (gensym "srv"))
   2.124+   :port *default-service-port*
   2.125+   :address nil
   2.126+   :request-class 'service-request
   2.127+   :response-class 'service-response
   2.128+   :chunk-output-p t
   2.129+   :chunk-input-p t
   2.130+   :read-timeout *default-connection-timeout*
   2.131+   :write-timeout *default-connection-timeout*
   2.132+   :request-count 0
   2.133+   :shutdown-lock (sb-thread:make-mutex :name "shutdown-lock")
   2.134+   :shutdown-queue (sb-thread:make-waitqueue :name "shutdown-queue"))
   2.135+  (:documentation "The service class is designed primarily for webservers and functionally
   2.136+similar to HUNCHENTOOT:ACCEPTOR."))
   2.137+
   2.138+#+ssl
   2.139+(defclass ssl-service (service)
   2.140+  ((certificate-file :initarg :certificate-file
   2.141+                     :reader service-certificate-file)
   2.142+   (privatekey-file :initarg :privatekey-file
   2.143+                    :reader service-privatekey-file)
   2.144+   (privatekey-password :initarg :privatekey-password
   2.145+                        :reader service-privatekey-password))
   2.146+  (:default-initargs
   2.147+   :password nil
   2.148+   :port 443))
   2.149 
   2.150 ;;; Macros
   2.151 (defmacro define-service (name &rest initargs)

     3.1--- a/lisp/lib/obj/obj.asd	Wed Jul 17 21:56:18 2024 -0400
     3.2+++ b/lisp/lib/obj/obj.asd	Thu Jul 18 22:09:56 2024 -0400
     3.3@@ -48,7 +48,8 @@
     3.4                (:module "music"
     3.5                 :components ((:file "music")))
     3.6                (:module "time"
     3.7-                :components ((:file "local")))
     3.8+                :components ((:file "local")
     3.9+                             (:file "util")))
    3.10                (:file "uuid")
    3.11                (:file "temperature")
    3.12                (:file "direction")

     4.1--- a/lisp/lib/obj/pkg.lisp	Wed Jul 17 21:56:18 2024 -0400
     4.2+++ b/lisp/lib/obj/pkg.lisp	Thu Jul 18 22:09:56 2024 -0400
     4.3@@ -169,6 +169,8 @@
     4.4   (:nicknames :time)
     4.5   (:use :cl :std)
     4.6   (:export
     4.7+   :iso-time
     4.8+   :rfc-1123-date
     4.9    :timestamp
    4.10    :date
    4.11    :time-of-day

     5.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2+++ b/lisp/lib/obj/time/util.lisp	Thu Jul 18 22:09:56 2024 -0400
     5.3@@ -0,0 +1,31 @@
     5.4+;;; util.lisp --- Time Utils
     5.5+
     5.6+;; 
     5.7+
     5.8+;;; Code:
     5.9+(in-package :obj/time)
    5.10+
    5.11+;; from hunchentoot/util.lisp - these variants are more portable than the
    5.12+;; local.lisp alternatives.
    5.13+(defun rfc-1123-date (&optional (time (get-universal-time)))
    5.14+  "Generates a time string according to RFC 1123. Default is current time.
    5.15+This can be used to send a 'Last-Modified' header - see
    5.16+HUNCHENTOOT::HANDLE-IF-MODIFIED-SINCE."
    5.17+  (multiple-value-bind
    5.18+        (second minute hour date month year day-of-week)
    5.19+      (decode-universal-time time 0)
    5.20+    (format nil "~A, ~2,'0d ~A ~4d ~2,'0d:~2,'0d:~2,'0d GMT"
    5.21+            (svref +day-names+ day-of-week)
    5.22+            date
    5.23+            (svref +month-names+ (1- month))
    5.24+            year
    5.25+            hour
    5.26+            minute
    5.27+            second)))
    5.28+
    5.29+(defun iso-time (&optional (time (get-universal-time)))
    5.30+  "Returns the universal time TIME as a string in full ISO format."
    5.31+  (multiple-value-bind (second minute hour date month year)
    5.32+      (decode-universal-time time)
    5.33+    (format nil "~4,'0d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d"
    5.34+            year month date hour minute second)))