-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: July 2003
;;;;
-;;;; $Id: uri.lisp,v 1.5 2003/08/08 09:03:45 kevin Exp $
+;;;; $Id: uri.lisp,v 1.6 2003/08/08 23:40:13 kevin Exp $
;;;;
;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
;;;; *************************************************************************
(in-package #:wol)
-
-(defun request-decompile-uri (req ent)
- "returns (VALUE PAGE PLIST QUERY-ALIST)"
+(defun uri->recode-uri-sans-session-id (uri)
+ (let ((parsed-path (puri:uri-parsed-path uri)))
+ (cond
+ ((and (eq :absolute (first parsed-path))
+ (is-raw-session-id (second parsed-path)))
+ (values (copy-uri uri :place t
+ :parsed-path
+ (list* :absolute (cddr parsed-path)))
+ (raw-session-id->session-id (second parsed-path))))
+ (t
+ (values uri nil)))))
+
+(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 cookie-session-key (ent cookies)
+ (let ((name (project-name (entity-project ent))))
+ (cdr (assoc name cookies :test #'string-equal))))
+
+(defun url-session-key (url)
+ "Return a session key encoded in a URL"
+ nil)
+
+(defun compute-uris (req ent)
+ "Compute URI's of a request"
+ (compute-session req ent)
(multiple-value-bind (page plists query)
(decode-url (puri:uri-path (request-raw-uri req)))
(when page
(when (null page)
(awhen (getf (request-plist req) :page)
(setf (request-page req) it))))
- (setf (request-uri-query req) query))
- req)
+ (setf (request-uri-query req) query)))
;;; URI Functions
-#+ignore
-(defun make-html-url (page ent &optional query-args)
- (make-url (concatenate 'string page ".html")
- :base-dir (project-prefix
- (entity-project ent))
- :vars query-args :format :xhtml))
-
-
-(defun make-wol-url (page ent &optional plist)
- (let ((url-plist (append (list :page page) plist))
+(defun make-wol-url (page req ent &optional plist)
+ (let ((session (websession-from-req req))
+ (url-plist (append (list :page page) plist))
(prefix (project-prefix (entity-project ent))))
- (if (null plist)
- (concatenate 'string prefix page ".lsp")
- (concatenate 'string
- prefix
- +asp-header+
- (concatenate 'string +plist-header+
- (plist-to-url-string url-plist))))))
+ (concatenate 'string
+ (if (and session
+ (websession-key session)
+ (eq :url (websession-method session)))
+ (format nil "/~~~A~~/" (websession-key session))
+ "")
+ prefix
+ (if (null plist)
+ (concatenate 'string page ".html")
+ (concatenate 'string
+ +asp-header+
+ (concatenate 'string +plist-header+
+ (plist-to-url-string url-plist)))))))
;; Property lists