r5339: *** empty log message ***

diff --git a/package.lisp b/package.lisp
index 7b96f97bb1321f6b80c8778c5a149a3bb08e35d7..557c4459ce58957d707f70250a5ea320556b126a 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  April 2001
 ;;;;
 ;;;; 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
 ;;;; *************************************************************************
 ;;;;
 ;;;; This file and wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************


@@ -17,7 +17,7 @@
 
 (defpackage #:wol
   (:use #:kmrcl #:hyperobject #:common-lisp
 
 (defpackage #:wol
   (:use #:kmrcl #:hyperobject #:common-lisp

-       #:lml2 #:base64 #:modlisp)
+       #:lml2 #:base64 #:modlisp #:puri)

   (:export
 
    ;; classes.lisp
   (:export
 
    ;; classes.lisp

diff --git a/project.lisp b/project.lisp
index 0280a27e9ff88252f33f497ac02059dca0ea49ab..a0d40610b561d6468cbab955cccd534747701b3f 100644 (file)
--- a/project.lisp
+++ b/project.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
 ;;;; 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
 ;;;; *************************************************************************
 ;;;;
 ;;;; 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)
   (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)
                 :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)
   (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)
           :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 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)
 
 (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)
           (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"
 
 (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)
 
 
 (defun dispatch-to-handler (req ent)

diff --git a/uri.lisp b/uri.lisp
index afbeb75e26109991780e17fe491b8e38913543d0..16764b7772fbe2e6016da5bd18dc5f37663c64ff 100644 (file)
--- a/uri.lisp
+++ b/uri.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
 ;;;; 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
 ;;;; *************************************************************************
 ;;;;
 ;;;; 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) 
 (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
     (when page
       (setf (request-page req) (base-page-name page ent)))
     (when plists

diff --git a/wol.asd b/wol.asd
index 7adb3ef9ec3d60bac560e56c1cc7d40538383d1a..849582a2b9a2cb36ef2ee3561fa8a7782582476a 100644 (file)
--- a/wol.asd
+++ b/wol.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  July 2003
 ;;;;
 ;;;; 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
 ;;;; *************************************************************************
 ;;;;
 ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************


@@ -26,7 +26,7 @@
 (in-package #:wol-system)
 
 (defsystem wol
 (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")
                        #-allegro :acl-compat)
     :components
     ((:file "package")