[patch] org-id: New org-id-method 'uuid' w/ elisp function that creates random uuid

[David Maus <dmaus@ictsoc.de>]

[-- Attachment #1.1.1: Type: text/plain, Size: 730 bytes --]

Attached patch for org-id adds a new function `org-id-uuid' that
returns a random (version 4) uuid following the format and suggestions
in RFC 4122:

  - it collects some random, system ans user specific data

  - creates a md5 hash for this data to obtain the require 32 octets

  - flips the correct bits to indicate a random uuid

Using the elisp method to create a random uuid can be customized by
setting `org-id-method' to 'uuid.

In addition `org-id-new' throws an error when the call to
`org-id-uuid-program' returns something that does not look like a
uuid.[1]

HTH
 -- David


[1] Sorry, this should have been a patch on its own.

--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #1.1.2: org-id-uuid-elisp.diff --]
[-- Type: application/octet-stream, Size: 3156 bytes --]

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 88d477e..171c222 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2010-05-07  David Maus  <dmaus@ictsoc.de>
+
+	* org-id.el (org-id-uuid-regexp): New constant.  Regexp that
+	matches a uuid.
+	(org-id-method): New customization value.
+	(org-id-new): Use lisp function to create uuid.
+	(org-id-uuid): New function.  Return random (version 4) uuid.
+
 2010-05-07  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-table.el (org-table-recalculate-buffer-tables)
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 168a0c9..0442ee2 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -72,6 +72,10 @@
 
 (declare-function message-make-fqdn "message" ())
 
+(defconst org-id-uuid-regexp
+  "^[0-9a-fA-F]\\{8\\}\\(-[0-9a-fA-F]\\{4\\}\\)\\{3\\}-[0-9a-fA-F]\\{12\\}"
+  "Regular expression matching a uuid.")
+
 ;;; Customization
 
 (defgroup org-id nil
@@ -86,7 +90,7 @@
 
 (defcustom org-id-method
   (condition-case nil
-      (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'"
+      (if (string-match org-id-uuid-regexp
 			(org-trim (shell-command-to-string
 				   org-id-uuid-program)))
 	  'uuidgen
@@ -105,10 +109,13 @@ org        Org's own internal method, using an encoding of the current time to
            microsecond accuracy, and optionally the current domain of the
            computer.  See the variable `org-id-include-domain'.
 
+uuid       Random \(version 4\) uuids.
+
 uuidgen    Call the external command uuidgen."
   :group 'org-id
   :type '(choice
 	  (const :tag "Org's internal method" org)
+	  (const :tag "random uuid" uuid)
 	  (const :tag "external: uuidgen" uuidgen)))
 
 (defcustom org-id-prefix nil
@@ -307,7 +314,11 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
     (if (equal prefix ":") (setq prefix ""))
     (cond
      ((eq org-id-method 'uuidgen)
-      (setq unique (org-trim (shell-command-to-string org-id-uuid-program))))
+      (setq unique (org-trim (shell-command-to-string org-id-uuid-program)))
+      (unless (string-match-p org-id-uuid-regexp unique)
+	(error "Invalid uuid: %s" unique)))
+     ((eq org-id-method 'uuid)
+      (setq unique (org-id-uuid)))
      ((eq org-id-method 'org)
       (let* ((etime (org-id-reverse-string (org-id-time-to-b36)))
 	     (postfix (if org-id-include-domain
@@ -318,6 +329,30 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
      (t (error "Invalid `org-id-method'")))
     (concat prefix unique)))
 
+(defun org-id-uuid ()
+  "Return string with random uuid."
+  (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
+			  (random t)
+			  (current-time)
+			  (user-uid)
+			  (emacs-pid)
+			  (user-full-name)
+			  user-mail-address
+			  (recent-keys)))))
+    (format "%s-%s-4%s-%s%s-%s"
+	    (substring rnd 0 8)
+	    (substring rnd 8 12)
+	    (substring rnd 13 16)
+	    (format "%x"
+		    (logior
+		     #B10000000
+		     (logand
+		      #B10111111
+		      (string-to-number
+		       (substring rnd 16 18) 16))))
+	    (substring rnd 18 20)
+	    (substring rnd 20 32))))
+
 (defun org-id-reverse-string (s)
   (mapconcat 'char-to-string (nreverse (string-to-list s)) ""))
 

[-- Attachment #1.2: Type: application/pgp-signature, Size: 230 bytes --]

[-- Attachment #2: Type: text/plain, Size: 201 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode