-(defun req-recode-uri-sans-session-id (req)
- (setq cl-user::r req)
- (let ((ppath (puri:uri-parsed-path (request-uri req))))
- (when (is-raw-session-id (second ppath))
- (let ((new-path (list* (car ppath) (cddr ppath))))
- (setf (uri-parsed-path (request-uri req)) new-path)
- (setf (uri-parsed-path (request-raw-uri req)) new-path))
- (setf (request-decoded-uri-path req)
- (uridecode-string (uri-path (request-raw-uri req))))
- (raw-session-id->session-id (second ppath)))))
-
-(defun request-cookies (req)
- (aif (aserve-request req)
- (net.aserve:get-cookie-values it)
- (loop for h in (request-headers req)
+(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)