"Returns session-id,remainder-path"
(let ((prefix (project-prefix (entity-project ent))))
(when (and (> (length path) (length prefix))
"Returns session-id,remainder-path"
(let ((prefix (project-prefix (entity-project ent))))
(when (and (> (length 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))))))))))
+ (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))))))))))
(path->session-id (request-decoded-uri-path req) ent)
(when raw-session-id
(let ((new-path (concatenate 'string (project-prefix
(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))))
+ (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))))
- (net.aserve:get-cookie-values it)
- (loop for h in (request-headers req)
- when (eq :cookie (car h))
- collect (cdr h))))
+ (net.aserve:get-cookie-values it)
+ (loop for h in (request-headers req)
+ when (eq :cookie (car h))
+ collect (cdr h))))
(defun entity-project-prefix-string (ent)
(let ((prefix (project-prefix (entity-project ent))))
(if (= 1 (length prefix))
(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))
(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)))
-
+ (uri (request-raw-uri req))
+ (ppath (puri:uri-parsed-path uri))
+ (prefix-string (entity-project-prefix-string ent)))
+
- (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-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))))
- (push (url-string-to-plist (subseq elem +plist-header-length+))
- plists)
- (warn "Non plist header found in url ~S" elem)))
+ (push (url-string-to-plist (subseq elem +plist-header-length+))
+ plists)
+ (warn "Non plist header found in url ~S" elem)))
(values page-name (nreverse plists))))
(defun make-wol-url (page req ent &optional plist)
(let ((session (websession-from-req req))
(values page-name (nreverse plists))))
(defun make-wol-url (page req ent &optional plist)
(let ((session (websession-from-req req))
- (websession-key session)
- (not (eq :cookies (websession-method session))))
- (format nil "~~~A~~/" (websession-key session))
- "")
+ (websession-key session)
+ (not (eq :cookies (websession-method session))))
+ (format nil "~~~A~~/" (websession-key session))
+ "")
- (concatenate 'string page ".html")
- (concatenate 'string
- (concatenate 'string +plist-header+
- (plist-to-url-string url-plist)))))))
+ (concatenate 'string page ".html")
+ (concatenate 'string
+ (concatenate 'string +plist-header+
+ (plist-to-url-string url-plist)))))))
(otherwise elem)))
(defun compressed-string-to-plist (encoded-str)
(let ((encoded (ignore-errors (read-from-string encoded-str)))
(otherwise elem)))
(defun compressed-string-to-plist (encoded-str)
(let ((encoded (ignore-errors (read-from-string encoded-str)))