+(defun path->session-id (path ent)
+ "Returns session-id,remainder-path"
+ (let ((prefix (project-prefix (entity-project ent))))
+ (when (and (> (length path) (length prefix))
+ (string= prefix (subseq path 0 (length prefix))))
+ (let ((sans-prefix (subseq path (length prefix))))
+ (when (char= #\~ (schar sans-prefix 0))
+ (let* ((len (length sans-prefix))
+ (next-tilde (position-char #\~ sans-prefix 1 len))
+ (next-slash (position-char #\/ sans-prefix 1 len)))
+ (when (and next-tilde next-slash
+ (< next-tilde next-slash))
+ (values
+ (subseq sans-prefix 0 (1+ next-tilde))
+ (subseq sans-prefix (1+ next-tilde))))))))))
+
+
+(defun req-recode-uri-sans-session-id (req ent)
+ (multiple-value-bind (raw-session-id remainder)
+ (path->session-id (request-decoded-uri-path req) ent)
+ (when raw-session-id
+ (let ((new-path (concatenate 'string (project-prefix
+ (entity-project ent))
+ (subseq remainder 1))))
+ (setf (uri-path (request-uri req)) new-path)
+ (setf (uri-path (request-raw-uri req)) new-path)
+ (setf (request-decoded-uri-path req) new-path))
+ (raw-session-id->session-id raw-session-id))))
+
+ (defun request-cookies (req)
+ (aif (aserve-request req)
+ (net.aserve:get-cookie-values it)
+ (loop for h in (request-headers req)
+ when (eq :cookie (car h))
+ collect (cdr h))))
+
+(defun header-lines-matching (key headers)
+ (loop for hdr in headers
+ when (eq key (car hdr))
+ collect (cdr hdr)))
+
+(defun set-cookies-in-headers (headers)
+ (header-lines-matching :set-cookie headers))
+
+(defun cookies-in-headers (headers)
+ (header-lines-matching :cookie headers))
+
+(defun cookie-session-key (ent cookies)
+ "Return the session key from the alist of cookies"
+ (let ((name (project-name (entity-project ent))))
+ (cdr (assoc name cookies :test #'string-equal))))
+
+(defun entity-project-prefix-string (ent)
+ (let ((prefix (project-prefix (entity-project ent))))
+ (if (= 1 (length prefix))
+ ""
+ (subseq prefix 1 (1- (length prefix))))))
+
+(defun compute-uris (req ent)
+ "Compute URI's of a request"
+ (let* ((url-session-id (req-recode-uri-sans-session-id req ent))
+ (uri (request-raw-uri req))
+ (ppath (puri:uri-parsed-path uri))
+ (prefix-string (entity-project-prefix-string ent)))
+
+ (assert (eq (first ppath) :absolute))
+
+ (cond
+ ((zerop (length prefix-string))
+ ;; strip :absolute
+ (setq ppath (cdr ppath)))
+ ((string-equal (second ppath) (entity-project-prefix-string ent))
+ (setq ppath (cddr ppath)))
+ (t
+ (warn "Non-prefix path ~S" ppath)
+ (return-from compute-uris nil)))
+
+ (compute-session req ent url-session-id)
+ (multiple-value-bind (page plists) (decode-url ppath)
+ (when page
+ (setf (request-page req) (base-page-name page)))
+ (when plists
+ (setf (request-url-plist req) (car plists))
+ (setf (request-url-next-plists req) (cdr plists))
+ (when (null page)
+ (awhen (getf (request-url-plist req) :page)
+ (setf (request-page req) it))))
+ (setf (request-uri-query req) (puri:uri-query uri)))))
+