diff --git a/cl-webdav.asd b/cl-webdav.asd
index cdd9d02..d2c0290 100755
--- a/cl-webdav.asd
+++ b/cl-webdav.asd
@@ -36,7 +36,8 @@
                (:file "xml")
                (:file "resources")
                (:file "properties")
+               (:file "locks")
                (:file "handlers")
                (:file "file-resources")
                (:file "authorized-file-resources"))
-  :depends-on (:hunchentoot :cxml :cl-fad))
+  :depends-on (:hunchentoot :cxml :cxml-stp :cl-fad))
diff --git a/handlers.lisp b/handlers.lisp
index 6b8a2b7..49cb22a 100755
--- a/handlers.lisp
+++ b/handlers.lisp
@@ -47,6 +47,8 @@ exported and only used internally by CREATE-DAV-DISPATCHER."
                    (:move 'move-handler)
                    (:mkcol 'mkcol-handler)
                    (:delete 'delete-handler)
+                   (:lock 'lock-handler)
+                   (:unlock 'unlock-handler)
                    (otherwise 'not-implemented))))
     (lambda ()
       (let ((*resource-class* resource-class))
@@ -61,6 +63,8 @@ resource.  Sigh..."
   (case (request-method request)
     (:options 'options-handler)))
 
+;;; 2008065 CLH: The comment about ms-workaround-p being true doesn't
+;;; seem to be accurate.
 (defgeneric create-dav-dispatcher (resource-class &optional ms-workaround-p)
   (:documentation "Creates and returns a dispatcher for the class
 RESOURCE-CLASS which must be a subclass of RESOURCE.  If
@@ -99,7 +103,21 @@ properties."
                                (bad-request))))
          (initial-resource (get-resource)))
     (unless (resource-exists initial-resource)
-      (not-found))
+      ;; if initial-resource doesn't exist, we need to check to see if
+      ;; the resoruce instead corresponds to a lock empty resource
+      ;; (rfc:4918/9.10.4).
+      (if (gethash (resource-name initial-resource)
+                   *lock-resource-hash*)
+          (multiple-value-bind (properties propname)
+              (parse-propfind (raw-post-data :force-binary t))
+            (setf (content-type) "text/xml; charset=utf-8"
+                  (return-code) +http-multi-status+)
+            (serialize-xmls-node (dav-node "multistatus"
+                                           (collect-properties
+                                            initial-resource
+                                            properties
+                                            (not propname)))))
+          (not-found)))
     (multiple-value-bind (properties propname)
         (parse-propfind (raw-post-data :force-binary t))
       (setf (content-type) "text/xml; charset=utf-8"
@@ -163,7 +181,10 @@ correctly.  Also doubles as handler for HEAD requests if
 HEAD-REQUEST-P is true."
   (let ((resource (get-resource)))
     (unless (resource-exists resource)
-      (not-found))
+      (if (gethash (resource-name resource)
+                   *lock-resource-hash*)
+          (no-content)
+          (not-found)))
     (when (resource-collection-p resource)
       (forbidden))
     (let ((etag (resource-etag resource))
@@ -242,7 +263,11 @@ new resource from the contents sent by the client."
     (let ((parent (resource-parent resource)))
       (when (or (null parent) (not (resource-exists parent)))
         (conflict)))
-    (let* ((content-length-header (cdr (assoc :content-length (headers-in*))))
+    (let* ((content-length-header (or (header-in* :content-length)
+                                      (header-in* :x-expected-entity-length)))
+           ;; the MacOS WebDAV clients sends X-Expected-Entity-Length
+           ;; instead of content-length.  Perhaps we should ignore the
+           ;; length altogether and read until EOF.
            (content-length (and content-length-header
                                 (parse-integer content-length-header :junk-allowed t))))
       (unless content-length
@@ -327,4 +352,24 @@ internally."
         (setf (return-code) +http-internal-server-error+))
       (:no-error (&rest args)
         (declare (ignore args))
-        (resource-created resource)))))
\ No newline at end of file
+        (resource-created resource)))))
+
+(defun lock-handler ()
+  "The handler for LOCK requests."
+  (let* ((depth-header (header-in* :depth))
+         (depth-value (cond ((or (null depth-header)
+                                 (string-equal depth-header "infinity")) nil)
+                            ((and (string= depth-header "0")) 0)
+                            (t (warn "Depth header is ~S." depth-header)
+                               (bad-request))))
+         (timeout (header-in* :timeout))
+         (resource (get-resource)))
+    (if (header-in* :if)
+        (refresh-lock resource)
+        (create-lock resource))))
+
+(defun unlock-handler ()
+  "The handler for UNLOCK requests."
+  (let ((resource (get-resource)))
+    (remove-lock resource)))
+
diff --git a/locks.lisp b/locks.lisp
new file mode 100644
index 0000000..5e66d0d
--- /dev/null
+++ b/locks.lisp
@@ -0,0 +1,232 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-WEBDAV; Base: 10 -*-
+
+;;; This file is part of the cl-webdav package which is Copyright (c)
+;;; 2007, Dr. Edmund Weitz.  All rights reserved.
+;;;
+;;; This file itself is Copyright (c) 2008, Cyrus Harmon. All rights
+;;; reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-webdav)
+
+(defparameter *default-lock-timeout* 604800 "Default timeout value (in seconds).")
+
+(defclass lockable-resource (resource)
+  ((lock-state :initarg :lock-state :accessor resource-lock-state)
+   (locks :accessor resource-locks :initform nil)))
+
+(defclass lock (resource)
+  ((scope :initarg :scope :accessor lock-scope)
+   (type :initarg :type :accessor lock-type)
+   (owner :initarg :owner :accessor lock-owner)
+   (token :initarg :token :accessor lock-token)))
+
+(defvar *lock-resource-hash* (make-hash-table :test 'equal))
+(defvar *lock-resource-hash-lock* (bt:make-lock "uuid-time-collisiion"))
+
+(defgeneric create-lock (resource)
+  (:documentation "This function attempts to create a LOCK for resource."))
+
+(defgeneric remove-lock (resource)
+  (:documentation "This function attempts to remove a LOCK for resource."))
+
+(defmacro with-dav-namespace (&body body)
+  `(xpath:with-namespaces (("D" "DAV:"))
+     ,@body))
+
+(defun string-or-nil (string)
+  (unless (equal "" string)
+    string))
+
+(defun parse-lockscope (document)
+  (with-dav-namespace
+    (string-or-nil
+     (xpath:evaluate "local-name(/D:lockinfo/D:lockscope/*)" document))))
+
+(defun parse-locktype (document)
+  (with-dav-namespace
+    (string-or-nil
+     (xpath:evaluate "local-name(/D:lockinfo/D:locktype/*)" document))))
+
+(defun parse-owner (document)
+  (with-dav-namespace
+    (string-or-nil
+     (xpath:string-value (xpath:evaluate "/D:lockinfo/D:owner/D:href/text()" document)))))
+
+(defun parse-lockinfo (octets)
+  (unless (zerop (length octets))
+    (let ((document (cxml:parse octets (stp:make-builder))))
+      (when document
+        (let ((lockscope (parse-lockscope document))
+              (locktype (parse-locktype document))
+              (owner (parse-owner document)))
+          (values (when lockscope (make-keyword lockscope))
+                  (when locktype (make-keyword locktype))
+                  owner))))))
+
+(defun serialize-lock-prop (lock &key (depth "Infinity"))
+  (with-accessors ((scope lock-scope)
+                   (type lock-type)
+                   (token lock-token))
+      lock
+    (setf (header-out :lock-token) (format nil "<urn:uuid:~A>" token)
+          (content-type) "text/xml; charset=utf-8") 
+    (let ((prop (stp:make-element "D:prop" "DAV:")))
+      (let ((lockdiscovery (stp:make-element "D:lockdiscovery" "DAV:")))
+        (stp:append-child prop lockdiscovery)
+        (let ((activelock (stp:make-element "D:activelock" "DAV:")))
+          (stp:append-child lockdiscovery activelock)
+          (let ((locktype (stp:make-element "D:locktype" "DAV:")))
+            (stp:append-child activelock locktype)
+            (cond ((string-equal type "write")
+                   (stp:append-child locktype (stp:make-element "D:write" "DAV:")))
+                  ((string-equal type "read")
+                   (stp:append-child locktype (stp:make-element "D:read" "DAV:")))))
+          (let ((lockscope (stp:make-element "D:lockscope" "DAV:")))
+            (stp:append-child activelock lockscope)
+            (cond ((string-equal scope "exclusive")
+                   (stp:append-child lockscope (stp:make-element "D:exclusive" "DAV:")))
+                  ((string-equal scope "shared")
+                   (stp:append-child lockscope (stp:make-element "D:shared" "DAV:")))))
+          (when depth
+            (let ((depth-node (stp:make-element "D:depth" "DAV:")))
+              (stp:append-child activelock depth-node)
+              (cond ((string-equal depth "Infinity")
+                     (stp:append-child depth-node (stp:make-text "Infinity")))
+                    ((string-equal depth "0")
+                     (stp:append-child depth-node (stp:make-text "0"))))))
+          (let ((locktoken (stp:make-element "D:locktoken" "DAV:")))
+            (stp:append-child activelock locktoken)
+            (let ((href (stp:make-element "D:href" "DAV:")))
+              (stp:append-child locktoken href)
+              (stp:append-child href
+                                (stp:make-text
+                                 (format nil "urn:uuid:~A" token)))))))
+      (stp:serialize (stp:make-document prop)
+                     (cxml:make-string-sink)))))
+
+
+(defvar *last-uuid-universal-time* 0)
+(defvar *uuid-time-collision-count* 0)
+(defvar *uuid-time-collision-lock* (bt:make-lock "uuid-time-collisiion"))
+
+(defun get-uuid ()
+  (bt:with-lock-held (*uuid-time-collision-lock*)
+    (let ((time (get-universal-time)))
+      (if (eql time *last-uuid-universal-time*)
+          (incf *uuid-time-collision-count*)
+          (setf *last-uuid-universal-time* time))
+      (format nil "c2f41010-65b3-11d1-a29f-~2,'0X~10,'0X"
+              *uuid-time-collision-count*
+              time))))
+
+(defun parse-token (token-string)
+  (let ((token (nth-value 1 (ppcre:scan-to-strings "<urn:uuid:([\\w-]+)>" token-string))))
+    (when token
+      (elt token 0))))
+
+(defun refresh-lock (resource)
+  (let ((token (parse-token (header-in* :if))))
+    (bt:with-lock-held (*lock-resource-hash-lock*)
+      (let ((lock (find-lock (resource-script-name resource) token)))
+        (when lock
+          (serialize-lock-prop lock))))))
+
+(defmethod create-lock (resource)
+  (multiple-value-bind (scope type owner)
+      (parse-lockinfo (raw-post-data :force-binary t))
+    (flet ((make-dav-lock ()
+             (apply #'make-instance 'lock
+                    :scope scope
+                    :type type
+                    :token (get-uuid)
+                    (append
+                     (when owner `(:owner ,owner))))))
+      (unless (and (keywordp scope)
+                   (keywordp type))
+        (precondition-failed))
+      (let ((script-name (resource-script-name resource)))
+        (bt:with-lock-held (*lock-resource-hash-lock*)
+          (let ((lockable-resource (gethash script-name
+                                            *lock-resource-hash*))
+                lock)
+            (if (and lockable-resource
+                     (resource-locks lockable-resource))
+                (let ((current-lock-state (resource-lock-state lockable-resource)))
+                  ;; cases:
+                  ;;
+                  ;; 1. if we have a shared lock and we request another
+                  ;; shared lock, we should create a new shared lock and
+                  ;; add it to the list.
+                  (if (and (eql current-lock-state :shared)
+                           (eql scope :shared))
+                      (progn
+                        (setf lock (make-dav-lock)) 
+                        (push lock (resource-locks
+                                    lockable-resource)))
+                      ;; 2. if we have an exclusive lock and there's another
+                      ;; lock request, we need to fail.
+                      ;;
+                      ;; 3. if we have a shared lock and there's a request for
+                      ;; an exclusive lock we need to fail. 
+                      (locked)))
+                ;; 4. No existing lock. It's ok for us to make one here.
+                (progn
+                  (setf lockable-resource (make-instance 'lockable-resource
+                                                       :script-name script-name
+                                                       :lock-state scope))
+                  (setf lock (make-dav-lock)) 
+                  (push lock (resource-locks lockable-resource))
+                  (setf (gethash script-name *lock-resource-hash*) lockable-resource)) )
+            (when lock
+              (serialize-lock-prop lock))))))))
+
+(defun find-lock (resource-name token)
+  (let ((lockable-resource (gethash resource-name *lock-resource-hash*)))
+    (when lockable-resource
+      (find token (resource-locks lockable-resource)
+            :key 'lock-token
+            :test 'equal))))
+
+(defmethod remove-lock (resource)
+  (let ((token (parse-token (header-in* :lock-token))))
+    (print token *debug-io*)
+    (unless token
+      (bad-request))
+    (setf (content-type) "text/xml; charset=utf-8")
+    (let ((script-name (resource-script-name resource)))
+      (bt:with-recursive-lock-held (*lock-resource-hash-lock*)
+        (let ((lockable-resource (gethash script-name *lock-resource-hash*)))
+          (if (find-lock script-name token)
+              (progn
+                (setf (resource-locks lockable-resource)
+                      (remove-if (lambda (lock)
+                                   (equal (lock-token lock)
+                                          token))
+                                 (resource-locks lockable-resource)))
+                (no-content))
+              (conflict)))))))
+
diff --git a/resources.lisp b/resources.lisp
index 9030e90..3a7d72e 100755
--- a/resources.lisp
+++ b/resources.lisp
@@ -408,4 +408,5 @@ resource RESOURCE."
       (setf (header-out :etag) etag))
     (when content-language
       (setf (header-out :content-language) content-language)))
-  nil)
\ No newline at end of file
+  nil)
+
diff --git a/specials.lisp b/specials.lisp
index 9bbabae..ba4b4d6 100755
--- a/specials.lisp
+++ b/specials.lisp
@@ -56,14 +56,16 @@
   "An alist mapping the \(names of the) standard DAV properties
 to functions handling them.")
 
-(defvar *dav-compliance-classes* '(1)
+(tbnl::def-http-return-code +http-locked+ 423 "Locked")
+
+(defvar *dav-compliance-classes* '(1 2)
   "A /sorted/ list of DAV compliance classes reported in the
 `DAV' header when answering OPTIONS requests.  It doesn't make
 much sense to have more then class 1 in here as long as there's
 no lock support.")
 
 (defvar *allowed-methods*
-  '(:options :get :head :delete :propfind :proppatch :put :copy :move :mkcol)
+  '(:options :get :head :delete :propfind :proppatch :put :copy :move :mkcol :lock :unlock)
   "The list of methods \(as keywords) returned by the `Allow'
 header in case of OPTIONS requests \(and also utilized by the
 handler for MKCOL).  Can be adapted to allow for more methods,
diff --git a/util.lisp b/util.lisp
index 7b7abf2..90149d6 100755
--- a/util.lisp
+++ b/util.lisp
@@ -48,6 +48,8 @@ the HANDLER-DONE catch tag." return-code)
 (define-return-code-shortcut precondition-failed +http-precondition-failed+)
 (define-return-code-shortcut failed-dependency +http-failed-dependency+)
 (define-return-code-shortcut method-not-allowed +http-method-not-allowed+)
+(define-return-code-shortcut locked +http-locked+)
+(define-return-code-shortcut no-content +http-no-content+)
 
 (defun status-line (return-code)
   "Returns a full HTTP/1.1 status line corresponding to the
@@ -92,3 +94,6 @@ then uses LATIN-1 if that fails."
       (url-decode string +utf-8+)
     (flex:external-format-encoding-error ()
       (url-decode string +latin-1+))))
+
+(defun make-keyword (string)
+  (intern (string-upcase string) :keyword))
