From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Sat, 19 Jul 2003 20:32:48 +0000 (+0000)
Subject: r5339: *** empty log message ***
X-Git-Url: http://git.kpe.io/?p=wol.git;a=commitdiff_plain;h=b02132b356f13c6e1d04fde727eb86ac1ee0b3ce

r5339: *** empty log message ***
---

diff --git a/package.lisp b/package.lisp
index 7b96f97..557c445 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  April 2001
 ;;;;
-;;;; $Id: package.lisp,v 1.2 2003/07/18 21:34:18 kevin Exp $
+;;;; $Id: package.lisp,v 1.3 2003/07/19 20:32:48 kevin Exp $
 ;;;;
 ;;;; This file and wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -17,7 +17,7 @@
 
 (defpackage #:wol
   (:use #:kmrcl #:hyperobject #:common-lisp
-	#:lml2 #:base64 #:modlisp)
+	#:lml2 #:base64 #:modlisp #:puri)
   (:export
 
    ;; classes.lisp
diff --git a/project.lisp b/project.lisp
index 0280a27..a0d4061 100644
--- a/project.lisp
+++ b/project.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
-;;;; $Id: project.lisp,v 1.3 2003/07/18 21:34:18 kevin Exp $
+;;;; $Id: project.lisp,v 1.4 2003/07/19 20:32:48 kevin Exp $
 ;;;;
 ;;;; This file and Wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -87,12 +87,12 @@
   (make-instance 'http-request
 		 :method (net.aserve:request-method as-req)
 		 ;;:host (net.aserve:request-host as-req)
-		 :raw-uri (net.uri:render-uri
-			   (net.aserve:request-raw-uri as-req)
-			   nil)
-		 :uri (net.uri:render-uri
-		       (net.aserve:request-uri as-req)
-		       nil)
+		 :raw-uri (puri:intern-uri
+			   (net.uri:render-uri
+			    (net.aserve:request-raw-uri as-req) nil))
+		 :uri (puri:intern-uri
+		       (net.uri:render-uri
+			(net.aserve:request-uri as-req) nil))
 		 :protocol (net.aserve:request-protocol as-req)
 		 :protocol-string
 		 (net.aserve:request-protocol-string as-req)
@@ -112,13 +112,10 @@
   (let ((req
 	 (make-instance 'http-request
 	   :host (header-value command :host)
-	   :raw-uri (header-value command :url)
-	   :uri (create-uri (header-value command :host)
-			    (awhen (header-value
-				  command :server-ip-port)
-				 (parse-integer it))
-			    (header-value command :url))
-	   :protocol (ensure-keyword (header-value command :server-protocol))
+	   :raw-uri (puri:intern-uri (header-value command :url))
+	   :uri (puri:intern-uri (command->uri command))
+	   :protocol (ensure-keyword
+		      (header-value command :server-protocol))
 	   :protocol-string (header-value command :server-protocol)
 	   :method (ensure-keyword (header-value command :method))
 	   :posted-content (header-value command :posted-content)
@@ -130,11 +127,16 @@
 (defun header-slot-value (req slot)
   (header-value (request-headers req) slot))
 
-(defun create-uri (host port page)
-  (format nil "http://~A:~D~A" host port page))
+(defun command->uri (command)
+  (format nil "http://~A:~D~A"
+	  (header-value command :host)
+	  (awhen (header-value
+		  command :server-ip-port)
+		 (parse-integer it))
+	  (header-value command :url)))
 
 (defun is-index-request (req ent)
-  (string= (request-raw-uri req) 
+  (string= (puri:uri-path (request-raw-uri req)) 
 	   (project-prefix (entity-project ent))))
 
 (defun redirect-entity (page ent)
@@ -166,7 +168,7 @@
 
 (defun request-matches-prefix (req prefix)
   "Returns project if request matches project"
-  (string-starts-with prefix (request-raw-uri req)))
+  (string-starts-with prefix (puri:uri-path (request-raw-uri req))))
 
 
 (defun dispatch-to-handler (req ent)
diff --git a/uri.lisp b/uri.lisp
index afbeb75..16764b7 100644
--- a/uri.lisp
+++ b/uri.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
-;;;; $Id: uri.lisp,v 1.2 2003/07/18 21:34:18 kevin Exp $
+;;;; $Id: uri.lisp,v 1.3 2003/07/19 20:32:48 kevin Exp $
 ;;;;
 ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -18,7 +18,7 @@
 (defun request-decompile-uri (req ent)
   "returns (VALUE PAGE PLIST QUERY-ALIST)"
   (multiple-value-bind (page plists query) 
-      (decode-url (request-raw-uri req))
+      (decode-url (puri:uri-path (request-raw-uri req)))
     (when page
       (setf (request-page req) (base-page-name page ent)))
     (when plists
diff --git a/wol.asd b/wol.asd
index 7adb3ef..849582a 100644
--- a/wol.asd
+++ b/wol.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
-;;;; $Id: wol.asd,v 1.3 2003/07/18 21:34:18 kevin Exp $
+;;;; $Id: wol.asd,v 1.4 2003/07/19 20:32:48 kevin Exp $
 ;;;;
 ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -26,7 +26,7 @@
 (in-package #:wol-system)
 
 (defsystem wol
-    :depends-on (:kmrcl :modlisp :lml2 :hyperobject :base64
+    :depends-on (:kmrcl :modlisp :lml2 :hyperobject :base64 :puri
 			#-allegro :acl-compat)
     :components
     ((:file "package")