diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/examples/src/forms.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/examples/src/forms.lisp
*** ucw-ajax-last/ucw_ajax/examples/src/forms.lisp	2023-09-08 19:48:52.714634049 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/examples/src/forms.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 63,72 ****
     (dojo-date-input :accessor dojo-date-input-of
                      :initform (make-instance 'dojo-dropdown-date-picker :value (now)
!                                              :validators (list (multiple-value-bind (usec sec min hour day month year day-of-week daylight-saving-time-p timezone)
!                                                                    (decode-local-time (now))
!                                                                  (declare (ignore usec sec min hour day-of-week daylight-saving-time-p))
                                                                   (make-instance 'time-range-validator
!                                                                                 :min-value (encode-local-time 0 0 0 0 (- day 10) month year :timezone timezone)
!                                                                                 :max-value (encode-local-time 0 59 59 23 (+ day 10) month year :timezone timezone))))))
     (dojo-time-input :accessor dojo-time-input-of
                      :initform (make-instance 'dojo-dropdown-time-picker :value (now)))
--- 63,72 ----
     (dojo-date-input :accessor dojo-date-input-of
                      :initform (make-instance 'dojo-dropdown-date-picker :value (now)
!                                              :validators (list (multiple-value-bind (usec sec min hour day month year day-of-week)
!                                                                    (decode-timestamp (now))
!                                                                  (declare (ignore usec sec min hour day-of-week))
                                                                   (make-instance 'time-range-validator
!                                                                                 :min-value (timestamp- (encode-timestamp 0 0 0 0 day month year) 10 :day)
!                                                                                 :max-value (timestamp+ (encode-timestamp 0 59 59 23 day month year) 10 :day))))))
     (dojo-time-input :accessor dojo-time-input-of
                      :initform (make-instance 'dojo-dropdown-time-picker :value (now)))
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/admin/admin.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/admin/admin.lisp
*** ucw-ajax-last/ucw_ajax/src/admin/admin.lisp	2023-09-08 19:48:52.714634049 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/admin/admin.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 5,9 ****
  (defvar *admin-application*
    (make-instance 'standard-application
!                  :url-prefix "/ucw/"
                   :tal-generator (make-instance 'yaclml:file-system-generator
                                                 :cachep t
--- 5,9 ----
  (defvar *admin-application*
    (make-instance 'standard-application
!                  :url-prefix "/admin/"
                   :tal-generator (make-instance 'yaclml:file-system-generator
                                                 :cachep t
***************
*** 19,23 ****
           :accessor admin-app.body
           :component admin-login))
!   (:default-initargs :title "UCW Administration" :stylesheet "/admin/ucw/ucw.css"))
  
  (defmethod render-html-body ((app admin-app))
--- 19,23 ----
           :accessor admin-app.body
           :component admin-login))
!   (:default-initargs :title "UCW Administration" :stylesheet '("/static/ucw/ucw.css")))
  
  (defmethod render-html-body ((app admin-app))
***************
*** 50,54 ****
                       (cons "Control Panel" control-panel)
                       (cons "Server REPL" server-repl)
!                      (cons "Applications" applications))
            :key-test #'string=
            :current-component-key "Control Panel")))
--- 50,54 ----
                       (cons "Control Panel" control-panel)
                       (cons "Server REPL" server-repl)
!                      );;(cons "Applications" applications))
            :key-test #'string=
            :current-component-key "Control Panel")))
***************
*** 72,77 ****
  
  (defmethod/cc toggle-inspectors ((self admin-control-panel))
!   (setf *inspect-components* (not *inspect-components*))
!   (call 'info-message :message (strcat "Inspectors "
                                         (if *inspect-components*
                                             ""
--- 72,77 ----
  
  (defmethod/cc toggle-inspectors ((self admin-control-panel))
!   ;;(setf *inspect-components* (not *inspect-components*))
!   (call 'info-message :message (strcat "(fake for security) Inspectors "
                                         (if *inspect-components*
                                             ""
***************
*** 105,109 ****
    (ucw.admin.info "Starting slime server.")
    (call 'info-message
!         :message (format nil "Swank server started on port ~D." (swank:create-server))))
  
  ;;;; The REPL
--- 105,111 ----
    (ucw.admin.info "Starting slime server.")
    (call 'info-message
!         :message (format nil "(fake for security) Swank server started on port ~D." 0
! 			 ;;(swank:create-server)
! 			 )))
  
  ;;;; The REPL
***************
*** 124,128 ****
                                                     :cols 60))
     (form-value :accessor admin-repl.form-value :initarg :form-value :initform nil))
!   (:default-initargs :template-name "ucw/admin/admin-repl.tal"))
  
  (defun admin-do-eval (repl)
--- 126,130 ----
                                                     :cols 60))
     (form-value :accessor admin-repl.form-value :initarg :form-value :initform nil))
!   (:default-initargs :template-name "../admin/admin-repl.tal"))
  
  (defun admin-do-eval (repl)
***************
*** 133,137 ****
      (let* ((*package* (value package-select))
             (form (read-from-string (value input))))
!       (setf form-value (eval form)))))
  
  (defmethod/cc submit ((self admin-repl))
--- 135,141 ----
      (let* ((*package* (value package-select))
             (form (read-from-string (value input))))
!       (setf form-value "fake for security"
! 	    ;;(eval form)
! 	    ))))
  
  (defmethod/cc submit ((self admin-repl))
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp
*** ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp	2023-09-08 19:48:52.714634049 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp	2023-09-06 20:00:24.927399237 +0100
***************
*** 97,101 ****
          (remote-address (remote-address request))
          (raw-uri (raw-uri request)))
!     (ucw.backend.info "Handling request from ~S for ~S" remote-address raw-uri)
      (or (block handle
            (dolist* ((can-match handler url-base) (handlers backend))
--- 97,101 ----
          (remote-address (remote-address request))
          (raw-uri (raw-uri request)))
!     (ucw.backend.info "Handling request from ~a for ~S" remote-address raw-uri)
      (or (block handle
            (dolist* ((can-match handler url-base) (handlers backend))
***************
*** 110,114 ****
                        internal-time-units-per-second)))
        (when (> seconds 0.05)
!         (ucw.backend.info "Handled request in ~,3f secs (request came from ~S for ~S)"
                            seconds remote-address raw-uri)))))
  
--- 110,114 ----
                        internal-time-units-per-second)))
        (when (> seconds 0.05)
!         (ucw.backend.info "Handled request in ~,3f secs (request came from ~a for ~S)"
                            seconds remote-address raw-uri)))))
  
***************
*** 156,168 ****
    (declare (optimize speed)
             (inline localhost-ip-address-p ip-address-from-private-network-p))
!   (let ((physical-remote-address (call-next-method)))
!     (if (and physical-remote-address
!              (or (ip-address-from-private-network-p physical-remote-address)
!                  (localhost-ip-address-p physical-remote-address)))
          ;; check if we are in a proxy setup and extract the real remote address if provided.
          ;; but do so only if the physical remote address is coming from a machine from the local net.
          ;; please note that this is not a realiable source for ip addresses!
          (let ((ip-as-string (get-header message "X-Forwarded-For")))
!           (when ip-as-string
              (let* ((real-remote-address (first (cl-ppcre:split "," ip-as-string :sharedp t)))
                     (pieces (cl-ppcre:split "\\." real-remote-address :sharedp t)))
--- 156,169 ----
    (declare (optimize speed)
             (inline localhost-ip-address-p ip-address-from-private-network-p))
!   (let* ((physical-remote-address (call-next-method))
! 	 (address-vector (iolib.sockets:address-to-vector physical-remote-address)))
!     (if (and address-vector
!              (or (ip-address-from-private-network-p address-vector)
!                  (localhost-ip-address-p address-vector)))
          ;; check if we are in a proxy setup and extract the real remote address if provided.
          ;; but do so only if the physical remote address is coming from a machine from the local net.
          ;; please note that this is not a realiable source for ip addresses!
          (let ((ip-as-string (get-header message "X-Forwarded-For")))
!           (if ip-as-string
              (let* ((real-remote-address (first (cl-ppcre:split "," ip-as-string :sharedp t)))
                     (pieces (cl-ppcre:split "\\." real-remote-address :sharedp t)))
***************
*** 177,181 ****
                    (progn
                      (ucw.backend.info "Returning NIL instead of an invalid ip address: ~S" ip-as-string)
!                     nil)))))
          physical-remote-address)))
  
--- 178,183 ----
                    (progn
                      (ucw.backend.info "Returning NIL instead of an invalid ip address: ~S" ip-as-string)
!                     nil)))
! 	    physical-remote-address))
          physical-remote-address)))
  
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp~ ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp~
*** ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp~	1970-01-01 01:00:00.000000000 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp~	2022-06-20 18:57:47.000000000 +0100
***************
*** 0 ****
--- 1,414 ----
+ ;; -*- lisp -*-
+ 
+ (in-package :it.bese.ucw)
+ 
+ (defclass basic-backend (backend)
+   ((host :accessor host :initarg :host)
+    (port :accessor port :initarg :port)
+    (socket :initform nil :accessor socket)
+    (server :accessor server :initarg :server)
+    (handlers :accessor handlers :initform '())
+    (request-content-length-limit :initform *request-content-length-limit*
+                                  :accessor request-content-length-limit-of
+                                  :initarg :request-content-length-limit)))
+ 
+ (defprint-object (self basic-backend)
+   (write-string ":host ")
+   (princ (host self))
+   (write-string " :port ")
+   (princ (port self)))
+ 
+ (defclass basic-message (message)
+   ((headers :accessor headers :initform '())
+    (socket :accessor socket :initarg :socket)))
+ 
+ (defclass basic-request (basic-message request)
+   ((cookies :accessor cookies)
+    (parameters :accessor parameters :initform '())
+    (raw-uri :accessor raw-uri :initform nil)
+    (query-path :accessor query-path :initform nil)
+    (raw-body :accessor raw-body :initform nil)
+    (http-method :accessor http-method :initform nil)))
+ 
+ (defclass basic-response (basic-message response)
+   ((headers-are-sent :accessor headers-are-sent-p :initform nil :type boolean)
+    (cookies :accessor cookies :initform '())
+    (request :accessor request :initarg :request :initform nil)
+    (html-stream :accessor html-stream :initform (make-string-output-stream))
+    (status :accessor status :initform +http-ok+)
+    (external-format :accessor external-format :initform nil)
+    (content :accessor content :initform nil)))
+ 
+ (defclass lockable-backend-mixin ()
+   ((lock
+     :initform (make-recursive-lock "backend lock")
+     :accessor lock-of)))
+ 
+ (defmacro with-lock-held-on-backend (backend &body body)
+   `(with-recursive-lock-held ((lock-of ,backend))
+     ,@body))
+ 
+ 
+ ;;;; Cookies
+ 
+ (defmethod cookies ((request basic-request))
+   (if (slot-boundp request 'cookies)
+       (slot-value request 'cookies)
+       (setf (slot-value request 'cookies)
+             ;; TODO consider calling safe-parse-cookies, see rfc2109 comments
+             (rfc2109:parse-cookies (get-header request "Cookie")))))
+ 
+ (defmethod find-cookie ((request basic-request) cookie)
+   (find-cookie-using-request (context.request *context*) cookie))
+ 
+ (defmethod find-cookie-using-request ((request basic-request) cookie)
+   (let ((cookie-name (cond ((stringp cookie) cookie)
+                            ((rfc2109:cookie-p cookie) (rfc2109:cookie-name cookie))
+                            (t (error "FIND-COOKIE only supports string and rfc2109:cookie struct as cookie name specifier")))))
+     (find cookie-name (cookies request) :test #'string= :key #'rfc2109:cookie-name)))
+ 
+ (defun cookie-value (cookie &optional default)
+   (cookie-value-using-request (context.request *context*) cookie default))
+ 
+ (defmethod cookie-value-using-request ((request basic-request) cookie &optional default)
+   (aif (find-cookie request cookie)
+        (unescape-as-uri (rfc2109:cookie-value it))
+        default))
+ 
+ (defun add-cookie (cookie)
+   "Add cookie to the current response."
+   (add-cookie-using-response (context.response *context*) cookie))
+ 
+ (defmethod add-cookie-using-response ((response basic-response) cookie)
+   (assert (rfc2109:cookie-p cookie))
+   (push cookie (cookies response)))
+ 
+ 
+ ;;;; Backend methods
+ (defmethod initialize-backend ((backend basic-backend) &key server &allow-other-keys)
+   (when (and (null *mime-types*)
+              (probe-file *default-mime-types-file*))
+     (read-mime-types *default-mime-types-file*))
+   (setf (server backend) server)
+   backend)
+ 
+ (defmethod handle-request ((backend basic-backend) (request basic-request) (response basic-response))
+   (let ((start-time (get-internal-real-time))
+         (remote-address (remote-address request))
+         (raw-uri (raw-uri request)))
+     (ucw.backend.info "Handling request from ~a for ~S" remote-address raw-uri)
+     (or (block handle
+           (dolist* ((can-match handler url-base) (handlers backend))
+             (declare (ignore url-base))
+             (when (funcall can-match (query-path request))
+               (funcall handler request response)
+               (return-from handle t)))
+           nil)
+         (handle-request (server backend) request response)
+         (error 'no-handler-for-request :raw-uri raw-uri :request request))
+     (let ((seconds (/ (- (get-internal-real-time) start-time)
+                       internal-time-units-per-second)))
+       (when (> seconds 0.05)
+         (ucw.backend.info "Handled request in ~,3f secs (request came from ~a for ~S)"
+                           seconds remote-address raw-uri)))))
+ 
+ (defmethod publish-directory ((backend basic-backend) directory-pathname url-base)
+   (push (list (lambda (request-url)
+                 (ucw.backend.dribble "Trying to match '~S' under url-base '~S' to serve it as a file from '~S'"
+                                      request-url url-base directory-pathname)
+                 (starts-with request-url url-base))
+               (lambda (request response)
+                 (aif (map-query-path-to-file (query-path request)
+                                              url-base
+                                              directory-pathname)
+                      (progn
+                        (ucw.backend.debug "Serving [~S] as a file under url-base [~S]" it url-base)
+                        (serve-file it :request request :response response))
+                      (progn
+                        (ucw.backend.debug "Failed to serve [~S] as a file under url-base [~S]" (query-path request) url-base)
+                        (error 'no-handler-for-request :raw-uri (raw-uri request) :request request))))
+               url-base)
+         (handlers backend)))
+ 
+ ;;;; Message headers methods
+ 
+ (defmethod get-header ((message basic-message) header-name)
+   (cdr (assoc header-name (headers message) :test #'string-equal)))
+ 
+ (defmethod (setf get-header) (value (message basic-message) header-name)
+   (aif (assoc header-name (headers message) :test #'string-equal)
+        (setf (cdr it) value)
+        (push (cons header-name value) (headers message)))
+   value)
+ 
+ (defmethod add-header ((message basic-message) header-name value)
+   (push (cons header-name value) (headers message))
+   value)
+ 
+ (defmethod delete-header ((message basic-message) header-name)
+   (setf (headers message)
+         (delete-if #'(lambda (item)
+                        (string-equal (car item)
+                                       header-name))
+                    (headers message))))
+ 
+ (defmethod remote-address :around ((message basic-message))
+   (declare (optimize speed)
+            (inline localhost-ip-address-p ip-address-from-private-network-p))
+   (let ((physical-remote-address (call-next-method)))
+     (if (and physical-remote-address
+              (or (ip-address-from-private-network-p physical-remote-address)
+                  (localhost-ip-address-p physical-remote-address)))
+         ;; check if we are in a proxy setup and extract the real remote address if provided.
+         ;; but do so only if the physical remote address is coming from a machine from the local net.
+         ;; please note that this is not a realiable source for ip addresses!
+         (let ((ip-as-string (get-header message "X-Forwarded-For")))
+           (if ip-as-string
+             (let* ((real-remote-address (first (cl-ppcre:split "," ip-as-string :sharedp t)))
+                    (pieces (cl-ppcre:split "\\." real-remote-address :sharedp t)))
+               (declare (type list pieces))
+               (if (= (length pieces) 4)
+                   (iter (with result = (make-array 4 :element-type '(unsigned-byte 8)))
+                         (for idx :from 0 :below 4)
+                         (for ip-address-part = (parse-integer (pop pieces)))
+                         (assert (<= 0 ip-address-part 255))
+                         (setf (aref result idx) ip-address-part)
+                         (finally (return result)))
+                   (progn
+                     (ucw.backend.info "Returning NIL instead of an invalid ip address: ~S" ip-as-string)
+                     nil)))
+ 	    physical-remote-address))
+         physical-remote-address)))
+ 
+ ;;;; Request handling
+ 
+ (defun read-line-from-network (stream &optional (eof-error-p t))
+   "A simple state machine which reads chars from STREAM until it
+   gets a CR-LF sequence or the end of the stream."
+   (declare (optimize (speed 3)))
+   (let ((buffer (make-array 50
+                             :element-type '(unsigned-byte 8)
+                             :adjustable t
+                             :fill-pointer 0)))
+     (labels ((read-next-char ()
+                (let ((byte (read-byte stream eof-error-p stream)))
+                  (if (eq stream byte)
+                      (return-from read-line-from-network buffer)
+                      (return-from read-next-char byte))))
+              (cr ()
+                (let ((next-byte (read-next-char)))
+                  (case next-byte
+                    (#.+linefeed+ ;; LF
+                       (return-from read-line-from-network buffer))
+                    (t ;; add both the cr and this char to the buffer
+                     (vector-push-extend #.+carriage-return+ buffer)
+                     (vector-push-extend next-byte buffer)
+                     (next)))))
+              (next ()
+                (let ((next-byte (read-next-char)))
+                  (case next-byte
+                    (#.+carriage-return+ ;; CR
+                       (cr))
+                    (#.+linefeed+ ;; LF
+                       (return-from read-line-from-network buffer))
+                    (t
+                     (vector-push-extend next-byte buffer)
+                     (next))))))
+       (next))))
+ 
+ (defun accumulate-parameters (assoc-list)
+   "Accumulates same parameters into lists. Otherwise
+   multiple-selection lists won't have a list value and
+   <ucw:select would fail."
+   (let ((result '()))
+     (dolist* ((name . value) assoc-list)
+       (unless (string= name "")
+         (aif (assoc name result :test #'string=)
+              (if (and (cdr it) (listp (cdr it)))
+                  (setf (cdr it) (cons value (cdr it)))
+                  (setf (cdr it) (list value (cdr it))))
+              (push (cons name value) result))))
+ ;;; reverse the (cdr it) so that writer lambda's see the values
+ ;;; in correct order. 
+     (dolist (it result)
+       (when (and (cdr it) (listp (cdr it)))
+         (setf (cdr it) (nreverse (cdr it)))))
+ ;;; rever the result so that map-parameters see the request
+ ;;; parameters in correct order.
+     (nreverse result)))
+ 
+ (defgeneric read-request (backend socket)
+   (:method :around (backend socket)
+     (with-thread-name " / READ-REQUEST"
+       (call-next-method)))
+   (:method :around ((backend basic-backend) socket)
+     (let ((*request-content-length-limit* (request-content-length-limit-of backend)))
+       (call-next-method))))
+ 
+ (defun read-basic-request ()
+   (let* ((request *request*)
+          (stream (network-stream request))
+          (line (read-line-from-network stream))
+          (pieces (split-on-space line)))
+     (ucw.backend.dribble "In read-basic-request, first line in :us-ascii is ~S, pieces are ~S"
+                          (ignore-errors
+                            (octets-to-string line :us-ascii)) pieces)
+     (destructuring-bind (http-method uri &optional protocol) pieces
+       (declare (ignore protocol))
+       ;; uri's must be foo%12%34bar encoded utf-8 strings in us-ascii. processing anything else here would be ad-hoc...
+       (setf (raw-uri request) (coerce (octets-to-string uri :us-ascii) 'simple-string)
+             (http-method request) (coerce (octets-to-string http-method :us-ascii) 'simple-string)
+             (headers request) (read-request-headers stream))
+       (ucw.backend.dribble "Request headers are ~S" (headers request))
+       (aif (position #\? (raw-uri request))
+            (setf (query-path request) (make-displaced-array (raw-uri request) 0 it)
+                  (parameters request) (parse-query-parameters
+                                        (make-displaced-array (raw-uri request)
+                                                              (1+ it))))
+            (setf (query-path request) (raw-uri request)
+                  (parameters request) '()))
+       (setf (query-path request) (unescape-as-uri (query-path request)))
+       (setf (parameters request) (append (parameters request)
+                                          (accumulate-parameters
+                                           (parse-request-body stream
+                                                               (get-header request "Content-Length")
+                                                               (get-header request "Content-Type"))))))
+     request))
+ 
+ (defmethod get-parameter ((request basic-request) name)
+   (loop
+      with result = '()
+      for (k . v) in (parameters request)
+      when (string= k name)
+        do (if result
+               (if (consp result)
+                   (push v result)
+                   (setf result (list v result)))
+               (setf result v))
+      finally (return result)))
+ 
+ (defmethod map-parameters ((request basic-request) lambda)
+   (dolist* ((name . value) (parameters request))
+     (unless (string= name "")
+       (funcall lambda name (if (stringp value)
+                                (copy-seq value)
+                                value)))))
+ 
+ (defun read-request-headers (stream)
+   (iterate
+     (for header-line = (read-line-from-network stream))
+     (until (= 0 (length header-line)))
+     (for (name . value) = (split-header-line header-line))
+     (collect (cons (octets-to-string name :us-ascii)
+                    (octets-to-string value :iso-8859-1)))))
+ 
+ (defmethod close-request ((request basic-request))
+   request)
+ 
+ ;;;; Response objects
+ 
+ (defmethod clear-response ((response basic-response))
+   (setf (html-stream response) (make-string-output-stream)
+         (headers response) '()))
+ 
+ ;;;; basic-response objects special case the "Status" header.
+ 
+ (defmethod get-header ((response basic-response) header-name)
+   (if (string= "Status" header-name)
+       (status response)
+       (call-next-method)))
+ 
+ (defmethod (setf get-header) (value (response basic-response) header-name)
+   (if (string= "Status" header-name)
+       (setf (status response) value)
+       (call-next-method)))
+ 
+ (defun write-crlf (stream)
+   (write-byte 13 stream)
+   (write-byte 10 stream))
+ 
+ (defun write-header-line (name value stream)
+   (write-sequence (string-to-octets name :us-ascii) stream)
+   ;; ": "
+   (write-byte 58 stream)
+   (write-byte 32 stream)
+   (write-sequence (string-to-octets value :iso-8859-1) stream)
+   (write-crlf stream))
+ 
+ (defmethod encoding ((response basic-response))
+   (or (external-format response)
+       (call-next-method)))
+ 
+ (defmethod send-headers :before ((response basic-response))
+   (assert (not (headers-are-sent-p response)))
+   (setf (headers-are-sent-p response) t))
+ 
+ (defmethod send-headers ((response basic-response))
+   (ucw.backend.dribble "Sending headers for ~S (Status: ~S)." response (status response))
+   (let ((stream (network-stream response)))
+     (write-sequence #.(string-to-octets "HTTP/1.1 " :us-ascii) stream)
+     (write-sequence (string-to-octets (status response) :us-ascii) stream)
+     (write-byte #.(char-code #\Space) stream)
+     (write-crlf stream)
+     (dolist* ((name . value) (headers response))
+       (unless (null value)
+         (ucw.backend.dribble "Sending header ~S: ~S" name value)
+         (write-header-line name value stream)))
+     (dolist (cookie (cookies response))
+       (ucw.backend.dribble "Writing cookie header line for ~S" cookie)
+       (write-header-line "Set-Cookie"
+                          (if (rfc2109:cookie-p cookie)
+                              (rfc2109:cookie-string-from-cookie-struct cookie)
+                              cookie)
+                          stream))
+     (write-crlf stream)
+     response))
+ 
+ (defmethod send-response ((response basic-response))
+   (assert (response-managed-p response))
+   (awhen (html-stream response)
+     (ucw.backend.dribble "Converting html stream of ~A" response)
+     (setf (content response)
+           (string-to-octets (get-output-stream-string it) (encoding response)))
+     (unless (get-header response "Content-Length")
+       (ucw.backend.dribble "Setting Content-Length header of ~A" response)
+       (setf (get-header response "Content-Length")
+             (princ-to-string (length (content response))))))
+ 
+   (send-headers response)
+ 
+   (when (and (content response)
+              (not (string= "HEAD" (http-method (request response)))))
+     (ucw.backend.dribble "Sending ~S (~D bytes) as body"
+                          (content response) (length (content response)))
+     (write-sequence (content response) (network-stream response))))
+ 
+ ;; Copyright (c) 2005-2006 Edward Marco Baringer
+ ;; All rights reserved. 
+ ;; 
+ ;; Redistribution and use in source and binary forms, with or without
+ ;; modification, are permitted provided that the following conditions are
+ ;; met:
+ ;; 
+ ;;  - Redistributions of source code must retain the above copyright
+ ;;    notice, this list of conditions and the following disclaimer.
+ ;; 
+ ;;  - Redistributions in binary form must reproduce the above copyright
+ ;;    notice, this list of conditions and the following disclaimer in the
+ ;;    documentation and/or other materials provided with the distribution.
+ ;; 
+ ;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
+ ;;    of its contributors may be used to endorse or promote products
+ ;;    derived from this software without specific prior written permission.
+ ;; 
+ ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ ;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
+ ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ipv6 ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ipv6
*** ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ipv6	1970-01-01 01:00:00.000000000 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ipv6	2022-06-20 18:57:47.000000000 +0100
***************
*** 0 ****
--- 1,414 ----
+ ;; -*- lisp -*-
+ 
+ (in-package :it.bese.ucw)
+ 
+ (defclass basic-backend (backend)
+   ((host :accessor host :initarg :host)
+    (port :accessor port :initarg :port)
+    (socket :initform nil :accessor socket)
+    (server :accessor server :initarg :server)
+    (handlers :accessor handlers :initform '())
+    (request-content-length-limit :initform *request-content-length-limit*
+                                  :accessor request-content-length-limit-of
+                                  :initarg :request-content-length-limit)))
+ 
+ (defprint-object (self basic-backend)
+   (write-string ":host ")
+   (princ (host self))
+   (write-string " :port ")
+   (princ (port self)))
+ 
+ (defclass basic-message (message)
+   ((headers :accessor headers :initform '())
+    (socket :accessor socket :initarg :socket)))
+ 
+ (defclass basic-request (basic-message request)
+   ((cookies :accessor cookies)
+    (parameters :accessor parameters :initform '())
+    (raw-uri :accessor raw-uri :initform nil)
+    (query-path :accessor query-path :initform nil)
+    (raw-body :accessor raw-body :initform nil)
+    (http-method :accessor http-method :initform nil)))
+ 
+ (defclass basic-response (basic-message response)
+   ((headers-are-sent :accessor headers-are-sent-p :initform nil :type boolean)
+    (cookies :accessor cookies :initform '())
+    (request :accessor request :initarg :request :initform nil)
+    (html-stream :accessor html-stream :initform (make-string-output-stream))
+    (status :accessor status :initform +http-ok+)
+    (external-format :accessor external-format :initform nil)
+    (content :accessor content :initform nil)))
+ 
+ (defclass lockable-backend-mixin ()
+   ((lock
+     :initform (make-recursive-lock "backend lock")
+     :accessor lock-of)))
+ 
+ (defmacro with-lock-held-on-backend (backend &body body)
+   `(with-recursive-lock-held ((lock-of ,backend))
+     ,@body))
+ 
+ 
+ ;;;; Cookies
+ 
+ (defmethod cookies ((request basic-request))
+   (if (slot-boundp request 'cookies)
+       (slot-value request 'cookies)
+       (setf (slot-value request 'cookies)
+             ;; TODO consider calling safe-parse-cookies, see rfc2109 comments
+             (rfc2109:parse-cookies (get-header request "Cookie")))))
+ 
+ (defmethod find-cookie ((request basic-request) cookie)
+   (find-cookie-using-request (context.request *context*) cookie))
+ 
+ (defmethod find-cookie-using-request ((request basic-request) cookie)
+   (let ((cookie-name (cond ((stringp cookie) cookie)
+                            ((rfc2109:cookie-p cookie) (rfc2109:cookie-name cookie))
+                            (t (error "FIND-COOKIE only supports string and rfc2109:cookie struct as cookie name specifier")))))
+     (find cookie-name (cookies request) :test #'string= :key #'rfc2109:cookie-name)))
+ 
+ (defun cookie-value (cookie &optional default)
+   (cookie-value-using-request (context.request *context*) cookie default))
+ 
+ (defmethod cookie-value-using-request ((request basic-request) cookie &optional default)
+   (aif (find-cookie request cookie)
+        (unescape-as-uri (rfc2109:cookie-value it))
+        default))
+ 
+ (defun add-cookie (cookie)
+   "Add cookie to the current response."
+   (add-cookie-using-response (context.response *context*) cookie))
+ 
+ (defmethod add-cookie-using-response ((response basic-response) cookie)
+   (assert (rfc2109:cookie-p cookie))
+   (push cookie (cookies response)))
+ 
+ 
+ ;;;; Backend methods
+ (defmethod initialize-backend ((backend basic-backend) &key server &allow-other-keys)
+   (when (and (null *mime-types*)
+              (probe-file *default-mime-types-file*))
+     (read-mime-types *default-mime-types-file*))
+   (setf (server backend) server)
+   backend)
+ 
+ (defmethod handle-request ((backend basic-backend) (request basic-request) (response basic-response))
+   (let ((start-time (get-internal-real-time))
+         (remote-address (remote-address request))
+         (raw-uri (raw-uri request)))
+     (ucw.backend.info "Handling request from ~a for ~S" remote-address raw-uri)
+     (or (block handle
+           (dolist* ((can-match handler url-base) (handlers backend))
+             (declare (ignore url-base))
+             (when (funcall can-match (query-path request))
+               (funcall handler request response)
+               (return-from handle t)))
+           nil)
+         (handle-request (server backend) request response)
+         (error 'no-handler-for-request :raw-uri raw-uri :request request))
+     (let ((seconds (/ (- (get-internal-real-time) start-time)
+                       internal-time-units-per-second)))
+       (when (> seconds 0.05)
+         (ucw.backend.info "Handled request in ~,3f secs (request came from ~a for ~S)"
+                           seconds remote-address raw-uri)))))
+ 
+ (defmethod publish-directory ((backend basic-backend) directory-pathname url-base)
+   (push (list (lambda (request-url)
+                 (ucw.backend.dribble "Trying to match '~S' under url-base '~S' to serve it as a file from '~S'"
+                                      request-url url-base directory-pathname)
+                 (starts-with request-url url-base))
+               (lambda (request response)
+                 (aif (map-query-path-to-file (query-path request)
+                                              url-base
+                                              directory-pathname)
+                      (progn
+                        (ucw.backend.debug "Serving [~S] as a file under url-base [~S]" it url-base)
+                        (serve-file it :request request :response response))
+                      (progn
+                        (ucw.backend.debug "Failed to serve [~S] as a file under url-base [~S]" (query-path request) url-base)
+                        (error 'no-handler-for-request :raw-uri (raw-uri request) :request request))))
+               url-base)
+         (handlers backend)))
+ 
+ ;;;; Message headers methods
+ 
+ (defmethod get-header ((message basic-message) header-name)
+   (cdr (assoc header-name (headers message) :test #'string-equal)))
+ 
+ (defmethod (setf get-header) (value (message basic-message) header-name)
+   (aif (assoc header-name (headers message) :test #'string-equal)
+        (setf (cdr it) value)
+        (push (cons header-name value) (headers message)))
+   value)
+ 
+ (defmethod add-header ((message basic-message) header-name value)
+   (push (cons header-name value) (headers message))
+   value)
+ 
+ (defmethod delete-header ((message basic-message) header-name)
+   (setf (headers message)
+         (delete-if #'(lambda (item)
+                        (string-equal (car item)
+                                       header-name))
+                    (headers message))))
+ 
+ (defmethod remote-address :around ((message basic-message))
+   (declare (optimize speed)
+            (inline localhost-ip-address-p ip-address-from-private-network-p))
+   (let ((physical-remote-address (call-next-method)))
+     (if (and physical-remote-address
+              (or (ip-address-from-private-network-p physical-remote-address)
+                  (localhost-ip-address-p physical-remote-address)))
+         ;; check if we are in a proxy setup and extract the real remote address if provided.
+         ;; but do so only if the physical remote address is coming from a machine from the local net.
+         ;; please note that this is not a realiable source for ip addresses!
+         (let ((ip-as-string (get-header message "X-Forwarded-For")))
+           (if ip-as-string
+             (let* ((real-remote-address (first (cl-ppcre:split "," ip-as-string :sharedp t)))
+                    (pieces (cl-ppcre:split "\\." real-remote-address :sharedp t)))
+               (declare (type list pieces))
+               (if (= (length pieces) 4)
+                   (iter (with result = (make-array 4 :element-type '(unsigned-byte 8)))
+                         (for idx :from 0 :below 4)
+                         (for ip-address-part = (parse-integer (pop pieces)))
+                         (assert (<= 0 ip-address-part 255))
+                         (setf (aref result idx) ip-address-part)
+                         (finally (return result)))
+                   (progn
+                     (ucw.backend.info "Returning NIL instead of an invalid ip address: ~S" ip-as-string)
+                     nil)))
+ 	    physical-remote-address))
+         physical-remote-address)))
+ 
+ ;;;; Request handling
+ 
+ (defun read-line-from-network (stream &optional (eof-error-p t))
+   "A simple state machine which reads chars from STREAM until it
+   gets a CR-LF sequence or the end of the stream."
+   (declare (optimize (speed 3)))
+   (let ((buffer (make-array 50
+                             :element-type '(unsigned-byte 8)
+                             :adjustable t
+                             :fill-pointer 0)))
+     (labels ((read-next-char ()
+                (let ((byte (read-byte stream eof-error-p stream)))
+                  (if (eq stream byte)
+                      (return-from read-line-from-network buffer)
+                      (return-from read-next-char byte))))
+              (cr ()
+                (let ((next-byte (read-next-char)))
+                  (case next-byte
+                    (#.+linefeed+ ;; LF
+                       (return-from read-line-from-network buffer))
+                    (t ;; add both the cr and this char to the buffer
+                     (vector-push-extend #.+carriage-return+ buffer)
+                     (vector-push-extend next-byte buffer)
+                     (next)))))
+              (next ()
+                (let ((next-byte (read-next-char)))
+                  (case next-byte
+                    (#.+carriage-return+ ;; CR
+                       (cr))
+                    (#.+linefeed+ ;; LF
+                       (return-from read-line-from-network buffer))
+                    (t
+                     (vector-push-extend next-byte buffer)
+                     (next))))))
+       (next))))
+ 
+ (defun accumulate-parameters (assoc-list)
+   "Accumulates same parameters into lists. Otherwise
+   multiple-selection lists won't have a list value and
+   <ucw:select would fail."
+   (let ((result '()))
+     (dolist* ((name . value) assoc-list)
+       (unless (string= name "")
+         (aif (assoc name result :test #'string=)
+              (if (and (cdr it) (listp (cdr it)))
+                  (setf (cdr it) (cons value (cdr it)))
+                  (setf (cdr it) (list value (cdr it))))
+              (push (cons name value) result))))
+ ;;; reverse the (cdr it) so that writer lambda's see the values
+ ;;; in correct order. 
+     (dolist (it result)
+       (when (and (cdr it) (listp (cdr it)))
+         (setf (cdr it) (nreverse (cdr it)))))
+ ;;; rever the result so that map-parameters see the request
+ ;;; parameters in correct order.
+     (nreverse result)))
+ 
+ (defgeneric read-request (backend socket)
+   (:method :around (backend socket)
+     (with-thread-name " / READ-REQUEST"
+       (call-next-method)))
+   (:method :around ((backend basic-backend) socket)
+     (let ((*request-content-length-limit* (request-content-length-limit-of backend)))
+       (call-next-method))))
+ 
+ (defun read-basic-request ()
+   (let* ((request *request*)
+          (stream (network-stream request))
+          (line (read-line-from-network stream))
+          (pieces (split-on-space line)))
+     (ucw.backend.dribble "In read-basic-request, first line in :us-ascii is ~S, pieces are ~S"
+                          (ignore-errors
+                            (octets-to-string line :us-ascii)) pieces)
+     (destructuring-bind (http-method uri &optional protocol) pieces
+       (declare (ignore protocol))
+       ;; uri's must be foo%12%34bar encoded utf-8 strings in us-ascii. processing anything else here would be ad-hoc...
+       (setf (raw-uri request) (coerce (octets-to-string uri :us-ascii) 'simple-string)
+             (http-method request) (coerce (octets-to-string http-method :us-ascii) 'simple-string)
+             (headers request) (read-request-headers stream))
+       (ucw.backend.dribble "Request headers are ~S" (headers request))
+       (aif (position #\? (raw-uri request))
+            (setf (query-path request) (make-displaced-array (raw-uri request) 0 it)
+                  (parameters request) (parse-query-parameters
+                                        (make-displaced-array (raw-uri request)
+                                                              (1+ it))))
+            (setf (query-path request) (raw-uri request)
+                  (parameters request) '()))
+       (setf (query-path request) (unescape-as-uri (query-path request)))
+       (setf (parameters request) (append (parameters request)
+                                          (accumulate-parameters
+                                           (parse-request-body stream
+                                                               (get-header request "Content-Length")
+                                                               (get-header request "Content-Type"))))))
+     request))
+ 
+ (defmethod get-parameter ((request basic-request) name)
+   (loop
+      with result = '()
+      for (k . v) in (parameters request)
+      when (string= k name)
+        do (if result
+               (if (consp result)
+                   (push v result)
+                   (setf result (list v result)))
+               (setf result v))
+      finally (return result)))
+ 
+ (defmethod map-parameters ((request basic-request) lambda)
+   (dolist* ((name . value) (parameters request))
+     (unless (string= name "")
+       (funcall lambda name (if (stringp value)
+                                (copy-seq value)
+                                value)))))
+ 
+ (defun read-request-headers (stream)
+   (iterate
+     (for header-line = (read-line-from-network stream))
+     (until (= 0 (length header-line)))
+     (for (name . value) = (split-header-line header-line))
+     (collect (cons (octets-to-string name :us-ascii)
+                    (octets-to-string value :iso-8859-1)))))
+ 
+ (defmethod close-request ((request basic-request))
+   request)
+ 
+ ;;;; Response objects
+ 
+ (defmethod clear-response ((response basic-response))
+   (setf (html-stream response) (make-string-output-stream)
+         (headers response) '()))
+ 
+ ;;;; basic-response objects special case the "Status" header.
+ 
+ (defmethod get-header ((response basic-response) header-name)
+   (if (string= "Status" header-name)
+       (status response)
+       (call-next-method)))
+ 
+ (defmethod (setf get-header) (value (response basic-response) header-name)
+   (if (string= "Status" header-name)
+       (setf (status response) value)
+       (call-next-method)))
+ 
+ (defun write-crlf (stream)
+   (write-byte 13 stream)
+   (write-byte 10 stream))
+ 
+ (defun write-header-line (name value stream)
+   (write-sequence (string-to-octets name :us-ascii) stream)
+   ;; ": "
+   (write-byte 58 stream)
+   (write-byte 32 stream)
+   (write-sequence (string-to-octets value :iso-8859-1) stream)
+   (write-crlf stream))
+ 
+ (defmethod encoding ((response basic-response))
+   (or (external-format response)
+       (call-next-method)))
+ 
+ (defmethod send-headers :before ((response basic-response))
+   (assert (not (headers-are-sent-p response)))
+   (setf (headers-are-sent-p response) t))
+ 
+ (defmethod send-headers ((response basic-response))
+   (ucw.backend.dribble "Sending headers for ~S (Status: ~S)." response (status response))
+   (let ((stream (network-stream response)))
+     (write-sequence #.(string-to-octets "HTTP/1.1 " :us-ascii) stream)
+     (write-sequence (string-to-octets (status response) :us-ascii) stream)
+     (write-byte #.(char-code #\Space) stream)
+     (write-crlf stream)
+     (dolist* ((name . value) (headers response))
+       (unless (null value)
+         (ucw.backend.dribble "Sending header ~S: ~S" name value)
+         (write-header-line name value stream)))
+     (dolist (cookie (cookies response))
+       (ucw.backend.dribble "Writing cookie header line for ~S" cookie)
+       (write-header-line "Set-Cookie"
+                          (if (rfc2109:cookie-p cookie)
+                              (rfc2109:cookie-string-from-cookie-struct cookie)
+                              cookie)
+                          stream))
+     (write-crlf stream)
+     response))
+ 
+ (defmethod send-response ((response basic-response))
+   (assert (response-managed-p response))
+   (awhen (html-stream response)
+     (ucw.backend.dribble "Converting html stream of ~A" response)
+     (setf (content response)
+           (string-to-octets (get-output-stream-string it) (encoding response)))
+     (unless (get-header response "Content-Length")
+       (ucw.backend.dribble "Setting Content-Length header of ~A" response)
+       (setf (get-header response "Content-Length")
+             (princ-to-string (length (content response))))))
+ 
+   (send-headers response)
+ 
+   (when (and (content response)
+              (not (string= "HEAD" (http-method (request response)))))
+     (ucw.backend.dribble "Sending ~S (~D bytes) as body"
+                          (content response) (length (content response)))
+     (write-sequence (content response) (network-stream response))))
+ 
+ ;; Copyright (c) 2005-2006 Edward Marco Baringer
+ ;; All rights reserved. 
+ ;; 
+ ;; Redistribution and use in source and binary forms, with or without
+ ;; modification, are permitted provided that the following conditions are
+ ;; met:
+ ;; 
+ ;;  - Redistributions of source code must retain the above copyright
+ ;;    notice, this list of conditions and the following disclaimer.
+ ;; 
+ ;;  - Redistributions in binary form must reproduce the above copyright
+ ;;    notice, this list of conditions and the following disclaimer in the
+ ;;    documentation and/or other materials provided with the distribution.
+ ;; 
+ ;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
+ ;;    of its contributors may be used to endorse or promote products
+ ;;    derived from this software without specific prior written permission.
+ ;; 
+ ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ ;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
+ ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ORI ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ORI
*** ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ORI	1970-01-01 01:00:00.000000000 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/basic-backend.lisp-ORI	2011-04-03 16:11:12.000000000 +0100
***************
*** 0 ****
--- 1,413 ----
+ ;; -*- lisp -*-
+ 
+ (in-package :it.bese.ucw)
+ 
+ (defclass basic-backend (backend)
+   ((host :accessor host :initarg :host)
+    (port :accessor port :initarg :port)
+    (socket :initform nil :accessor socket)
+    (server :accessor server :initarg :server)
+    (handlers :accessor handlers :initform '())
+    (request-content-length-limit :initform *request-content-length-limit*
+                                  :accessor request-content-length-limit-of
+                                  :initarg :request-content-length-limit)))
+ 
+ (defprint-object (self basic-backend)
+   (write-string ":host ")
+   (princ (host self))
+   (write-string " :port ")
+   (princ (port self)))
+ 
+ (defclass basic-message (message)
+   ((headers :accessor headers :initform '())
+    (socket :accessor socket :initarg :socket)))
+ 
+ (defclass basic-request (basic-message request)
+   ((cookies :accessor cookies)
+    (parameters :accessor parameters :initform '())
+    (raw-uri :accessor raw-uri :initform nil)
+    (query-path :accessor query-path :initform nil)
+    (raw-body :accessor raw-body :initform nil)
+    (http-method :accessor http-method :initform nil)))
+ 
+ (defclass basic-response (basic-message response)
+   ((headers-are-sent :accessor headers-are-sent-p :initform nil :type boolean)
+    (cookies :accessor cookies :initform '())
+    (request :accessor request :initarg :request :initform nil)
+    (html-stream :accessor html-stream :initform (make-string-output-stream))
+    (status :accessor status :initform +http-ok+)
+    (external-format :accessor external-format :initform nil)
+    (content :accessor content :initform nil)))
+ 
+ (defclass lockable-backend-mixin ()
+   ((lock
+     :initform (make-recursive-lock "backend lock")
+     :accessor lock-of)))
+ 
+ (defmacro with-lock-held-on-backend (backend &body body)
+   `(with-recursive-lock-held ((lock-of ,backend))
+     ,@body))
+ 
+ 
+ ;;;; Cookies
+ 
+ (defmethod cookies ((request basic-request))
+   (if (slot-boundp request 'cookies)
+       (slot-value request 'cookies)
+       (setf (slot-value request 'cookies)
+             ;; TODO consider calling safe-parse-cookies, see rfc2109 comments
+             (rfc2109:parse-cookies (get-header request "Cookie")))))
+ 
+ (defmethod find-cookie ((request basic-request) cookie)
+   (find-cookie-using-request (context.request *context*) cookie))
+ 
+ (defmethod find-cookie-using-request ((request basic-request) cookie)
+   (let ((cookie-name (cond ((stringp cookie) cookie)
+                            ((rfc2109:cookie-p cookie) (rfc2109:cookie-name cookie))
+                            (t (error "FIND-COOKIE only supports string and rfc2109:cookie struct as cookie name specifier")))))
+     (find cookie-name (cookies request) :test #'string= :key #'rfc2109:cookie-name)))
+ 
+ (defun cookie-value (cookie &optional default)
+   (cookie-value-using-request (context.request *context*) cookie default))
+ 
+ (defmethod cookie-value-using-request ((request basic-request) cookie &optional default)
+   (aif (find-cookie request cookie)
+        (unescape-as-uri (rfc2109:cookie-value it))
+        default))
+ 
+ (defun add-cookie (cookie)
+   "Add cookie to the current response."
+   (add-cookie-using-response (context.response *context*) cookie))
+ 
+ (defmethod add-cookie-using-response ((response basic-response) cookie)
+   (assert (rfc2109:cookie-p cookie))
+   (push cookie (cookies response)))
+ 
+ 
+ ;;;; Backend methods
+ (defmethod initialize-backend ((backend basic-backend) &key server &allow-other-keys)
+   (when (and (null *mime-types*)
+              (probe-file *default-mime-types-file*))
+     (read-mime-types *default-mime-types-file*))
+   (setf (server backend) server)
+   backend)
+ 
+ (defmethod handle-request ((backend basic-backend) (request basic-request) (response basic-response))
+   (let ((start-time (get-internal-real-time))
+         (remote-address (remote-address request))
+         (raw-uri (raw-uri request)))
+     (ucw.backend.info "Handling request from ~S for ~S" remote-address raw-uri)
+     (or (block handle
+           (dolist* ((can-match handler url-base) (handlers backend))
+             (declare (ignore url-base))
+             (when (funcall can-match (query-path request))
+               (funcall handler request response)
+               (return-from handle t)))
+           nil)
+         (handle-request (server backend) request response)
+         (error 'no-handler-for-request :raw-uri raw-uri :request request))
+     (let ((seconds (/ (- (get-internal-real-time) start-time)
+                       internal-time-units-per-second)))
+       (when (> seconds 0.05)
+         (ucw.backend.info "Handled request in ~,3f secs (request came from ~S for ~S)"
+                           seconds remote-address raw-uri)))))
+ 
+ (defmethod publish-directory ((backend basic-backend) directory-pathname url-base)
+   (push (list (lambda (request-url)
+                 (ucw.backend.dribble "Trying to match '~S' under url-base '~S' to serve it as a file from '~S'"
+                                      request-url url-base directory-pathname)
+                 (starts-with request-url url-base))
+               (lambda (request response)
+                 (aif (map-query-path-to-file (query-path request)
+                                              url-base
+                                              directory-pathname)
+                      (progn
+                        (ucw.backend.debug "Serving [~S] as a file under url-base [~S]" it url-base)
+                        (serve-file it :request request :response response))
+                      (progn
+                        (ucw.backend.debug "Failed to serve [~S] as a file under url-base [~S]" (query-path request) url-base)
+                        (error 'no-handler-for-request :raw-uri (raw-uri request) :request request))))
+               url-base)
+         (handlers backend)))
+ 
+ ;;;; Message headers methods
+ 
+ (defmethod get-header ((message basic-message) header-name)
+   (cdr (assoc header-name (headers message) :test #'string-equal)))
+ 
+ (defmethod (setf get-header) (value (message basic-message) header-name)
+   (aif (assoc header-name (headers message) :test #'string-equal)
+        (setf (cdr it) value)
+        (push (cons header-name value) (headers message)))
+   value)
+ 
+ (defmethod add-header ((message basic-message) header-name value)
+   (push (cons header-name value) (headers message))
+   value)
+ 
+ (defmethod delete-header ((message basic-message) header-name)
+   (setf (headers message)
+         (delete-if #'(lambda (item)
+                        (string-equal (car item)
+                                       header-name))
+                    (headers message))))
+ 
+ (defmethod remote-address :around ((message basic-message))
+   (declare (optimize speed)
+            (inline localhost-ip-address-p ip-address-from-private-network-p))
+   (let ((physical-remote-address (call-next-method)))
+     (if (and physical-remote-address
+              (or (ip-address-from-private-network-p physical-remote-address)
+                  (localhost-ip-address-p physical-remote-address)))
+         ;; check if we are in a proxy setup and extract the real remote address if provided.
+         ;; but do so only if the physical remote address is coming from a machine from the local net.
+         ;; please note that this is not a realiable source for ip addresses!
+         (let ((ip-as-string (get-header message "X-Forwarded-For")))
+           (when ip-as-string
+             (let* ((real-remote-address (first (cl-ppcre:split "," ip-as-string :sharedp t)))
+                    (pieces (cl-ppcre:split "\\." real-remote-address :sharedp t)))
+               (declare (type list pieces))
+               (if (= (length pieces) 4)
+                   (iter (with result = (make-array 4 :element-type '(unsigned-byte 8)))
+                         (for idx :from 0 :below 4)
+                         (for ip-address-part = (parse-integer (pop pieces)))
+                         (assert (<= 0 ip-address-part 255))
+                         (setf (aref result idx) ip-address-part)
+                         (finally (return result)))
+                   (progn
+                     (ucw.backend.info "Returning NIL instead of an invalid ip address: ~S" ip-as-string)
+                     nil)))))
+         physical-remote-address)))
+ 
+ ;;;; Request handling
+ 
+ (defun read-line-from-network (stream &optional (eof-error-p t))
+   "A simple state machine which reads chars from STREAM until it
+   gets a CR-LF sequence or the end of the stream."
+   (declare (optimize (speed 3)))
+   (let ((buffer (make-array 50
+                             :element-type '(unsigned-byte 8)
+                             :adjustable t
+                             :fill-pointer 0)))
+     (labels ((read-next-char ()
+                (let ((byte (read-byte stream eof-error-p stream)))
+                  (if (eq stream byte)
+                      (return-from read-line-from-network buffer)
+                      (return-from read-next-char byte))))
+              (cr ()
+                (let ((next-byte (read-next-char)))
+                  (case next-byte
+                    (#.+linefeed+ ;; LF
+                       (return-from read-line-from-network buffer))
+                    (t ;; add both the cr and this char to the buffer
+                     (vector-push-extend #.+carriage-return+ buffer)
+                     (vector-push-extend next-byte buffer)
+                     (next)))))
+              (next ()
+                (let ((next-byte (read-next-char)))
+                  (case next-byte
+                    (#.+carriage-return+ ;; CR
+                       (cr))
+                    (#.+linefeed+ ;; LF
+                       (return-from read-line-from-network buffer))
+                    (t
+                     (vector-push-extend next-byte buffer)
+                     (next))))))
+       (next))))
+ 
+ (defun accumulate-parameters (assoc-list)
+   "Accumulates same parameters into lists. Otherwise
+   multiple-selection lists won't have a list value and
+   <ucw:select would fail."
+   (let ((result '()))
+     (dolist* ((name . value) assoc-list)
+       (unless (string= name "")
+         (aif (assoc name result :test #'string=)
+              (if (and (cdr it) (listp (cdr it)))
+                  (setf (cdr it) (cons value (cdr it)))
+                  (setf (cdr it) (list value (cdr it))))
+              (push (cons name value) result))))
+ ;;; reverse the (cdr it) so that writer lambda's see the values
+ ;;; in correct order. 
+     (dolist (it result)
+       (when (and (cdr it) (listp (cdr it)))
+         (setf (cdr it) (nreverse (cdr it)))))
+ ;;; rever the result so that map-parameters see the request
+ ;;; parameters in correct order.
+     (nreverse result)))
+ 
+ (defgeneric read-request (backend socket)
+   (:method :around (backend socket)
+     (with-thread-name " / READ-REQUEST"
+       (call-next-method)))
+   (:method :around ((backend basic-backend) socket)
+     (let ((*request-content-length-limit* (request-content-length-limit-of backend)))
+       (call-next-method))))
+ 
+ (defun read-basic-request ()
+   (let* ((request *request*)
+          (stream (network-stream request))
+          (line (read-line-from-network stream))
+          (pieces (split-on-space line)))
+     (ucw.backend.dribble "In read-basic-request, first line in :us-ascii is ~S, pieces are ~S"
+                          (ignore-errors
+                            (octets-to-string line :us-ascii)) pieces)
+     (destructuring-bind (http-method uri &optional protocol) pieces
+       (declare (ignore protocol))
+       ;; uri's must be foo%12%34bar encoded utf-8 strings in us-ascii. processing anything else here would be ad-hoc...
+       (setf (raw-uri request) (coerce (octets-to-string uri :us-ascii) 'simple-string)
+             (http-method request) (coerce (octets-to-string http-method :us-ascii) 'simple-string)
+             (headers request) (read-request-headers stream))
+       (ucw.backend.dribble "Request headers are ~S" (headers request))
+       (aif (position #\? (raw-uri request))
+            (setf (query-path request) (make-displaced-array (raw-uri request) 0 it)
+                  (parameters request) (parse-query-parameters
+                                        (make-displaced-array (raw-uri request)
+                                                              (1+ it))))
+            (setf (query-path request) (raw-uri request)
+                  (parameters request) '()))
+       (setf (query-path request) (unescape-as-uri (query-path request)))
+       (setf (parameters request) (append (parameters request)
+                                          (accumulate-parameters
+                                           (parse-request-body stream
+                                                               (get-header request "Content-Length")
+                                                               (get-header request "Content-Type"))))))
+     request))
+ 
+ (defmethod get-parameter ((request basic-request) name)
+   (loop
+      with result = '()
+      for (k . v) in (parameters request)
+      when (string= k name)
+        do (if result
+               (if (consp result)
+                   (push v result)
+                   (setf result (list v result)))
+               (setf result v))
+      finally (return result)))
+ 
+ (defmethod map-parameters ((request basic-request) lambda)
+   (dolist* ((name . value) (parameters request))
+     (unless (string= name "")
+       (funcall lambda name (if (stringp value)
+                                (copy-seq value)
+                                value)))))
+ 
+ (defun read-request-headers (stream)
+   (iterate
+     (for header-line = (read-line-from-network stream))
+     (until (= 0 (length header-line)))
+     (for (name . value) = (split-header-line header-line))
+     (collect (cons (octets-to-string name :us-ascii)
+                    (octets-to-string value :iso-8859-1)))))
+ 
+ (defmethod close-request ((request basic-request))
+   request)
+ 
+ ;;;; Response objects
+ 
+ (defmethod clear-response ((response basic-response))
+   (setf (html-stream response) (make-string-output-stream)
+         (headers response) '()))
+ 
+ ;;;; basic-response objects special case the "Status" header.
+ 
+ (defmethod get-header ((response basic-response) header-name)
+   (if (string= "Status" header-name)
+       (status response)
+       (call-next-method)))
+ 
+ (defmethod (setf get-header) (value (response basic-response) header-name)
+   (if (string= "Status" header-name)
+       (setf (status response) value)
+       (call-next-method)))
+ 
+ (defun write-crlf (stream)
+   (write-byte 13 stream)
+   (write-byte 10 stream))
+ 
+ (defun write-header-line (name value stream)
+   (write-sequence (string-to-octets name :us-ascii) stream)
+   ;; ": "
+   (write-byte 58 stream)
+   (write-byte 32 stream)
+   (write-sequence (string-to-octets value :iso-8859-1) stream)
+   (write-crlf stream))
+ 
+ (defmethod encoding ((response basic-response))
+   (or (external-format response)
+       (call-next-method)))
+ 
+ (defmethod send-headers :before ((response basic-response))
+   (assert (not (headers-are-sent-p response)))
+   (setf (headers-are-sent-p response) t))
+ 
+ (defmethod send-headers ((response basic-response))
+   (ucw.backend.dribble "Sending headers for ~S (Status: ~S)." response (status response))
+   (let ((stream (network-stream response)))
+     (write-sequence #.(string-to-octets "HTTP/1.1 " :us-ascii) stream)
+     (write-sequence (string-to-octets (status response) :us-ascii) stream)
+     (write-byte #.(char-code #\Space) stream)
+     (write-crlf stream)
+     (dolist* ((name . value) (headers response))
+       (unless (null value)
+         (ucw.backend.dribble "Sending header ~S: ~S" name value)
+         (write-header-line name value stream)))
+     (dolist (cookie (cookies response))
+       (ucw.backend.dribble "Writing cookie header line for ~S" cookie)
+       (write-header-line "Set-Cookie"
+                          (if (rfc2109:cookie-p cookie)
+                              (rfc2109:cookie-string-from-cookie-struct cookie)
+                              cookie)
+                          stream))
+     (write-crlf stream)
+     response))
+ 
+ (defmethod send-response ((response basic-response))
+   (assert (response-managed-p response))
+   (awhen (html-stream response)
+     (ucw.backend.dribble "Converting html stream of ~A" response)
+     (setf (content response)
+           (string-to-octets (get-output-stream-string it) (encoding response)))
+     (unless (get-header response "Content-Length")
+       (ucw.backend.dribble "Setting Content-Length header of ~A" response)
+       (setf (get-header response "Content-Length")
+             (princ-to-string (length (content response))))))
+ 
+   (send-headers response)
+ 
+   (when (and (content response)
+              (not (string= "HEAD" (http-method (request response)))))
+     (ucw.backend.dribble "Sending ~S (~D bytes) as body"
+                          (content response) (length (content response)))
+     (write-sequence (content response) (network-stream response))))
+ 
+ ;; Copyright (c) 2005-2006 Edward Marco Baringer
+ ;; All rights reserved. 
+ ;; 
+ ;; Redistribution and use in source and binary forms, with or without
+ ;; modification, are permitted provided that the following conditions are
+ ;; met:
+ ;; 
+ ;;  - Redistributions of source code must retain the above copyright
+ ;;    notice, this list of conditions and the following disclaimer.
+ ;; 
+ ;;  - Redistributions in binary form must reproduce the above copyright
+ ;;    notice, this list of conditions and the following disclaimer in the
+ ;;    documentation and/or other materials provided with the distribution.
+ ;; 
+ ;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
+ ;;    of its contributors may be used to endorse or promote products
+ ;;    derived from this software without specific prior written permission.
+ ;; 
+ ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ ;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
+ ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/backend/httpd.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/httpd.lisp
*** ucw-ajax-last/ucw_ajax/src/backend/httpd.lisp	2023-09-08 19:48:52.714634049 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/httpd.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 61,65 ****
  
  ;; so we may get called with :host nil :port nil still meaning the default
! (def constructor httpd-backend
    (unless (host self)
      (setf (host self) "0.0.0.0"))
--- 61,65 ----
  
  ;; so we may get called with :host nil :port nil still meaning the default
! (defmethod initialize-instance :after ((self httpd-backend) &key)
    (unless (host self)
      (setf (host self) "0.0.0.0"))
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/backend/message-queue.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/message-queue.lisp
*** ucw-ajax-last/ucw_ajax/src/backend/message-queue.lisp	2023-09-08 19:48:52.714634049 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/backend/message-queue.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 23,27 ****
      :accessor message-received-condition-of)))
  
! (def constructor message-queue
    (setf (lock-of self) (make-lock (format nil "Lock for ~S" (name-of self)))))
  
--- 23,27 ----
      :accessor message-received-condition-of)))
  
! (defmethod initialize-instance :after ((self message-queue) &key &allow-other-keys)
    (setf (lock-of self) (make-lock (format nil "Lock for ~S" (name-of self)))))
  
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/components/ajax.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/ajax.lisp
*** ucw-ajax-last/ucw_ajax/src/components/ajax.lisp	2023-09-08 19:48:52.718634011 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/ajax.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 63,67 ****
  (defun call-in-restored-rendering-environment (component trunk)
    (let ((parents))
!     (iter (for parent :first (parent component) :then (parent parent))
            (while parent)
            (push parent parents))
--- 63,67 ----
  (defun call-in-restored-rendering-environment (component trunk)
    (let ((parents))
!     (iter (for parent :first component :then (parent parent))
            (while parent)
            (push parent parents))
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/components/container.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/container.lisp
*** ucw-ajax-last/ucw_ajax/src/components/container.lisp	2023-09-08 19:48:52.718634011 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/container.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 290,302 ****
            (container.contents container)))
  
- ;; TODO this is bullshit, what about dojo-tab-container inheriting from it?
- (defmethod css-style ((self switching-container))
-   (let ((rest (call-next-method)))
-     (if (client-side-p self)
-         (if rest
-             (concatenate 'string "display: none; " rest)
-             "display: none;")
-         rest)))
- 
  (defmethod render ((container switching-container))
    (if (client-side-p container)
--- 290,293 ----
***************
*** 324,330 ****
                  (<ucw:script (if selectedp
                                   `(dojo.html.show ,(dom-id component))
!                                  `(dojo.html.hide ,(dom-id component)))))
!           ;; only show the main div when all the non-visible clients were hidden
!           (<ucw:script `(dojo.html.show ,(dom-id container))))
          (when (remember-selected-child-p container)
            (<ucw:script `(let ((container ($ ,(dom-id container))))
--- 315,319 ----
                  (<ucw:script (if selectedp
                                   `(dojo.html.show ,(dom-id component))
!                                  `(dojo.html.hide ,(dom-id component))))))
          (when (remember-selected-child-p container)
            (<ucw:script `(let ((container ($ ,(dom-id container))))
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/components/dojo-widgets.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/dojo-widgets.lisp
*** ucw-ajax-last/ucw_ajax/src/components/dojo-widgets.lisp	2023-09-08 19:48:52.718634011 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/dojo-widgets.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 279,288 ****
  
  (defun format-local-time-for-dojo (local-time &rest args)
!   (apply #'format-rfc3339-timestring local-time :use-zulu-p nil args))
  
! (defmethod (setf value) ((local-time local-time) (self dojo-dropdown-date-picker))
    (setf (client-value self) (format-local-time-for-dojo local-time)))
  
! (defmethod (setf value) ((local-time local-time) (self dojo-dropdown-time-picker))
    (setf (client-value self) (format-local-time-for-dojo local-time)))
  
--- 279,288 ----
  
  (defun format-local-time-for-dojo (local-time &rest args)
!   (apply #'format-rfc3339-timestring nil local-time :use-zulu nil args))
  
! (defmethod (setf value) ((local-time timestamp) (self dojo-dropdown-date-picker))
    (setf (client-value self) (format-local-time-for-dojo local-time)))
  
! (defmethod (setf value) ((local-time timestamp) (self dojo-dropdown-time-picker))
    (setf (client-value self) (format-local-time-for-dojo local-time)))
  
***************
*** 291,295 ****
      (when (and client-value
                 (not (zerop (length client-value))))
!       (minimize-time-part (parse-timestring client-value :allow-missing-time-part-p t)))))
  
  (defmethod value ((self dojo-dropdown-time-picker))
--- 291,296 ----
      (when (and client-value
                 (not (zerop (length client-value))))
!       (timestamp-minimize-part (parse-timestring client-value :allow-missing-time-part t)
! 			       :hour))))
  
  (defmethod value ((self dojo-dropdown-time-picker))
***************
*** 298,302 ****
                 (not (zerop (length client-value))))
        ;; HINT: the server's *default-timezone* shoud be +utc-zone+ to minimize headaches
!       (parse-timestring client-value :allow-missing-date-part-p t))))
  
  (defmethod render-widget-wrapper :around ((self local-time-based-dojo-dropdown-widget) next-render-method)
--- 299,303 ----
                 (not (zerop (length client-value))))
        ;; HINT: the server's *default-timezone* shoud be +utc-zone+ to minimize headaches
!       (parse-timestring client-value :allow-missing-date-part t))))
  
  (defmethod render-widget-wrapper :around ((self local-time-based-dojo-dropdown-widget) next-render-method)
***************
*** 338,345 ****
          ,(when min-value
                 `(setf date-picker.start-date (dojo.date.from-rfc3339
!                                               ,(format-local-time-for-dojo min-value :omit-timezone-part-p t))))
          ,(when max-value
                 `(setf date-picker.end-date (dojo.date.from-rfc3339
!                                             ,(format-local-time-for-dojo max-value :omit-timezone-part-p t))))
          ,(when (or min-value max-value)
                 `(date-picker._init-u-i 42))))))
--- 339,346 ----
          ,(when min-value
                 `(setf date-picker.start-date (dojo.date.from-rfc3339
!                                               ,(format-local-time-for-dojo min-value :omit-timezone-part t))))
          ,(when max-value
                 `(setf date-picker.end-date (dojo.date.from-rfc3339
!                                             ,(format-local-time-for-dojo max-value :omit-timezone-part t))))
          ,(when (or min-value max-value)
                 `(date-picker._init-u-i 42))))))
***************
*** 364,372 ****
        ;; TODO does the timezone stuff correctly come up to the server?
        (if date
!           (multiple-value-bind (usec sec min hour day month year day-of-week daylight-saving-time-p timezone)
!               (decode-local-time date)
!             (declare (ignore day-of-week daylight-saving-time-p))
              (if time
!                 (multiple-value-setq (usec sec min hour) (decode-local-time time))
                  (setf usec 0
                        sec 0
--- 365,373 ----
        ;; TODO does the timezone stuff correctly come up to the server?
        (if date
!           (multiple-value-bind (usec sec min hour day month year day-of-week)
!               (decode-timestamp date)
!             (declare (ignore day-of-week))
              (if time
!                 (multiple-value-setq (usec sec min hour) (decode-timestamp time))
                  (setf usec 0
                        sec 0
***************
*** 374,382 ****
                        hour 0))
              (setf (slot-value self 'value)
!                   (encode-local-time usec sec min hour day month year :timezone timezone)))
            (setf (slot-value self 'value) nil))))
    (slot-value self 'value))
  
! (defmethod (setf value) ((local-time local-time) (self dojo-timestamp-picker))
    (setf (value (date-picker-of self)) local-time)
    (setf (value (time-picker-of self)) local-time))
--- 375,383 ----
                        hour 0))
              (setf (slot-value self 'value)
!                   (encode-timestamp usec sec min hour day month year)))
            (setf (slot-value self 'value) nil))))
    (slot-value self 'value))
  
! (defmethod (setf value) ((local-time timestamp) (self dojo-timestamp-picker))
    (setf (value (date-picker-of self)) local-time)
    (setf (value (time-picker-of self)) local-time))
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/components/form.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/form.lisp
*** ucw-ajax-last/ucw_ajax/src/components/form.lisp	2023-09-08 19:48:52.718634011 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/form.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 498,502 ****
                   `(and (<= ,min-value value) (<= value ,max-value)))
                  (min-value `(<= ,min-value value))
!                 (max-value `(<= value ,max-value))
                  (t t))
          (fail)))))
--- 498,502 ----
                   `(and (<= ,min-value value) (<= value ,max-value)))
                  (min-value `(<= ,min-value value))
!                 (max-value `(<= ,max-value value))
                  (t t))
          (fail)))))
***************
*** 566,570 ****
  
  (defmethod (setf value) ((utime integer) (self local-time-based-date-field))
!   (setf (value self) (local-time :universal utime)))
  
  (defclass date-field (universal-time-based-date-field form-field html-element)
--- 566,570 ----
  
  (defmethod (setf value) ((utime integer) (self local-time-based-date-field))
!   (setf (value self) (universal-to-timestamp utime)))
  
  (defclass date-field (universal-time-based-date-field form-field html-element)
***************
*** 653,657 ****
  
  (defmethod validate ((field local-time-based-date-field) (validator is-a-date-validator))
!   (typep (value field) 'local-time))
  
  (defclass is-a-date-time-validator (is-a-date-validator)
--- 653,657 ----
  
  (defmethod validate ((field local-time-based-date-field) (validator is-a-date-validator))
!   (typep (value field) 'timestamp))
  
  (defclass is-a-date-time-validator (is-a-date-validator)
***************
*** 674,679 ****
          (value (value field)))
      (and (call-next-method)
!          (or (not min-value) (local-time<= min-value value))
!          (or (not max-value) (local-time<= value max-value)))))
  
  ;;;; *** Select input fields
--- 674,679 ----
          (value (value field)))
      (and (call-next-method)
!          (or (not min-value) (timestamp<= min-value value))
!          (or (not max-value) (timestamp<= value max-value)))))
  
  ;;;; *** Select input fields
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp
*** ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp	2023-09-08 19:48:52.718634011 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp	2022-06-19 14:58:58.000000000 +0100
***************
*** 24,31 ****
  
  (defmethod render ((insp ucw-inspector))
!   (multiple-value-bind (title content)
!       (swank::inspect-for-emacs (slot-value insp 'datum)
!                                 (swank::make-default-inspector))
!     (<:h2 (<:as-html title))
      (dolist (part content)
        (etypecase part
--- 24,30 ----
  
  (defmethod render ((insp ucw-inspector))
!   (multiple-value-bind (content)
!       (swank::emacs-inspect (slot-value insp 'datum))
!     (<:h2 (prin1-to-string (slot-value insp 'datum)))
      (dolist (part content)
        (etypecase part
***************
*** 34,38 ****
                      (<:as-html part)
                      (<:pre (<:as-html part))))
!         (cons (swank::destructure-case part
                  ((:newline) (<:br))
                  ((:value obj &optional (str (prin1-to-string obj)))
--- 33,37 ----
                      (<:as-html part)
                      (<:pre (<:as-html part))))
!         (cons (swank::dcase part
                  ((:newline) (<:br))
                  ((:value obj &optional (str (prin1-to-string obj)))
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp~ ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp~
*** ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp~	1970-01-01 01:00:00.000000000 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/components/ucw-inspector.lisp~	2011-04-03 17:01:01.000000000 +0100
***************
*** 0 ****
--- 1,75 ----
+ ;; -*- lisp -*-
+ 
+ (in-package :it.bese.ucw)
+ 
+ ;;;; ** UCW Inspector
+ 
+ (defclass ucw-inspector ()
+   ((datum :accessor datum :initarg :datum :initform nil))
+   (:documentation "Component for inspecting random lisp values.
+ 
+ Based on SLIME's inspector.")
+   (:metaclass standard-component-class))
+ 
+ (defmethod/cc call-inspector ((self component) datum)
+   "Call an inspector for DATUM on the component COMPONENT."
+   (call 'ucw-inspector :datum datum))
+ 
+ (defun inspect-anchor (from datum &optional (string (write-to-string datum :circle t :pretty nil)))
+   (<ucw:a :action-body (call-inspector from datum) (<:as-html string)))
+ 
+ (defun inspect-anchor-string (from datum)
+   (with-output-to-string (*yaclml-stream*)
+     (inspect-anchor from datum)))
+ 
+ (defmethod render ((insp ucw-inspector))
+   (multiple-value-bind (content)
+       (swank::emacs-inspect (slot-value insp 'datum))
+     (<:h2 (prin1-to-string (slot-value insp 'datum)))
+     (dolist (part content)
+       (etypecase part
+         (null nil)
+         (string (if (< (length part) 100)
+                     (<:as-html part)
+                     (<:pre (<:as-html part))))
+         (cons (swank::destructure-case part
+                 ((:newline) (<:br))
+                 ((:value obj &optional (str (prin1-to-string obj)))
+                  (<ucw:a :action-body (call-inspector insp obj)
+                          (<:as-html str)))
+                 ((:action text lambda)
+                  (<ucw:a :action-body (funcall lambda)
+                          (<:as-html text)))))))
+     (when (and (slot-boundp insp 'calling-component)
+                (slot-value insp 'calling-component))
+       (<:p (<ucw:a :action-body (ok insp) "Ok.")))))
+ 
+ ;; Copyright (c) 2003-2005 Edward Marco Baringer
+ ;; All rights reserved. 
+ ;; 
+ ;; Redistribution and use in source and binary forms, with or without
+ ;; modification, are permitted provided that the following conditions are
+ ;; met:
+ ;; 
+ ;;  - Redistributions of source code must retain the above copyright
+ ;;    notice, this list of conditions and the following disclaimer.
+ ;; 
+ ;;  - Redistributions in binary form must reproduce the above copyright
+ ;;    notice, this list of conditions and the following disclaimer in the
+ ;;    documentation and/or other materials provided with the distribution.
+ ;; 
+ ;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
+ ;;    of its contributors may be used to endorse or promote products
+ ;;    derived from this software without specific prior written permission.
+ ;; 
+ ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ ;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
+ ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/rerl/request-loop-error.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/rerl/request-loop-error.lisp
*** ucw-ajax-last/ucw_ajax/src/rerl/request-loop-error.lisp	2023-09-08 19:48:52.718634011 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/rerl/request-loop-error.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 27,31 ****
                                          (ignore-errors
                                            (if (numberp index)
!                                               (swank-backend:frame-source-location-for-emacs index)
                                                index))
                                          (swank-backend:frame-locals index))))))))
--- 27,31 ----
                                          (ignore-errors
                                            (if (numberp index)
!                                               index ;(swank-backend:frame-source-location-for-emacs index)
                                                index))
                                          (swank-backend:frame-locals index))))))))
***************
*** 127,133 ****
      ;; TODO render some token that can be used to search the logs?
      (<:html
!      (<:head
!       (<:meta :content "text/html; charset=UTF-8" :http-equiv "Content-Type")
!       (<:title (<:as-html title)))
       (<:body (<:h1 (<:as-html title))
               (<:p (<:as-html message))))))
--- 127,131 ----
      ;; TODO render some token that can be used to search the logs?
      (<:html
!      (<:head (<:title (<:as-html title)))
       (<:body (<:h1 (<:as-html title))
               (<:p (<:as-html message))))))
***************
*** 152,156 ****
  (def function log-error-with-backtrace (error)
    (ucw.rerl.error "~%*** At: ~A~%*** In thread: ~A~%*** Error:~%~A~%*** Backtrace is:~%~A"
!                   (format-rfc3339-timestring (now))
                    (thread-name (current-thread))
                    error
--- 150,154 ----
  (def function log-error-with-backtrace (error)
    (ucw.rerl.error "~%*** At: ~A~%*** In thread: ~A~%*** Error:~%~A~%*** Backtrace is:~%~A"
!                   (format-rfc3339-timestring nil (now))
                    (thread-name (current-thread))
                    error
diff -rN -C 2 '--exclude=.git' '--exclude=_darcs' ucw-ajax-last/ucw_ajax/src/rerl/rerl-utils.lisp ../UCW-old/ucw-ajax-last/ucw_ajax/src/rerl/rerl-utils.lisp
*** ucw-ajax-last/ucw_ajax/src/rerl/rerl-utils.lisp	2023-09-08 19:48:52.718634011 +0100
--- ../UCW-old/ucw-ajax-last/ucw_ajax/src/rerl/rerl-utils.lisp	2011-04-03 17:01:01.000000000 +0100
***************
*** 34,38 ****
    ;; TODO KLUDGE this is a concurrent access itself and should be wrapped in a (debug-only* ...)
    (iter (for (nil session) :in-hashtable (application.session-table application))
!         (assert (not (session-lock-held-p session)) ()
                  "You are trying to lock the application ~A while one of its session ~A is locked by you"
                  application session))
--- 34,38 ----
    ;; TODO KLUDGE this is a concurrent access itself and should be wrapped in a (debug-only* ...)
    (iter (for (nil session) :in-hashtable (application.session-table application))
!         #+nil (assert (not (session-lock-held-p session)) ()
                  "You are trying to lock the application ~A while one of its session ~A is locked by you"
                  application session))