uuidgen.el (12877B)
1 ;;; uuidgen.el --- Provides various UUID generating functions 2 3 ;; Copyright (C) 2010, 2011, 2014, 2020 Kan-Ru Chen 4 5 ;; Author: Kan-Ru Chen <kanru@kanru.info> 6 ;; Created: 08 Nov 2010 7 ;; Version: 1.0 8 ;; Package-Version: 1.0 9 ;; Package-Commit: f096f35a6e1f27d2bc9e9093cd61dd97bc33f502 10 ;; Keywords: extensions, lisp, tools 11 12 ;; This file is NOT part of GNU Emacs. 13 14 ;; This program is free software: you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation, either version 3 of the License, or 17 ;; (at your option) any later version. 18 19 ;; This program is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; You should have received a copy of the GNU General Public License 25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 ;; 29 ;; This is a naive implementation of RFC4122 Universally Unique 30 ;; IDentifier generation in elisp. Currently implemented are UUID v1 31 ;; v3, v4 and v5 generation. The resolution of the time based UUID is 32 ;; microseconds, which is 10 times of the suggested 100-nanosecond 33 ;; resolution, but should be enough for general usage. 34 ;; 35 ;; Get development version from git: 36 ;; 37 ;; git clone git://github.com/kanru/uuidgen-el.git 38 39 ;;; TODO: 40 ;; 41 ;; * Simplify implementation and interfaces. 42 ;; * Unpack time-based UUID. 43 44 ;;; Code: 45 46 (require 'calc-ext) 47 (require 'sha1) 48 49 (defgroup uuidgen nil 50 "UUID generation." 51 :group 'extensions 52 :group 'tools) 53 54 (defcustom uuidgen-suppress-network-info-warnings nil 55 "Non-nil means suppress warning messages for missing\ 56 `network-interface-list' or `network-interface-info' support." 57 :type 'boolean 58 :group 'uuidgen) 59 60 (defcustom uuidgen-cid-format-string 61 "{ 0x%02x%02x%02x%02x, 0x%02x%02x, 0x%02x%02x, { 0x%02x, 0x%02x, 0x%02x, 0x%02x, 0x%02x, 0x%02x, 0x%02x, 0x%02x } }" 62 "Format string used to output CID string." 63 :type 'string 64 :group 'uuidgen) 65 66 (defvar uuidgen-unix-epoch-delta (math-read-radix "1b21dd213814000" 16) 67 "The interval between the UUID epoch and the Unix epoch. 68 That is the number of 100-nanoseconds between 69 1582-10-15 00:00:00 and 1970-01-01 00:00:00.") 70 71 (defcustom uuidgen-interface "eth0" 72 "The default interface for time based UUID generation." 73 :type 'string 74 :group 'uuidgen) 75 76 ;; Predefined namespace IDs 77 ;; Ref: RFC4122 Appendix C 78 79 (defvar uuidgen-ns-dns "6ba7b810-9dad-11d1-80b4-00c04fd430c8" 80 "For UUID name string which is a fully-qualified domain name.") 81 82 (defvar uuidgen-ns-url "6ba7b811-9dad-11d1-80b4-00c04fd430c8" 83 "For UUID name string which is a URL.") 84 85 (defvar uuidgen-ns-oid "6ba7b812-9dad-11d1-80b4-00c04fd430c8" 86 "For UUID name string which is an ISO OID.") 87 88 (defvar uuidgen-ns-x500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8" 89 "For UUID name string which is an X.500 DN (in DER or a text output format).") 90 91 (defun uuidgen--string-to-octets (string &optional start) 92 "Convert UUID string to a list of integers. 93 STRING should contain a UUID string, the 8-4-4-4-12 format is 94 preferred. If START is not nil, start search form START 95 position." 96 (if (string-match "[0-9a-f]\\{2\\}" string start) 97 (cons (string-to-number (match-string 0 string) 16) 98 (uuidgen--string-to-octets string (match-end 0))))) 99 100 (defun uuidgen--decode (id) 101 "Convert UUID string to binary representation. 102 ID should contain a UUID string, the 8-4-4-4-12 format is 103 preferred." 104 (apply (if (fboundp 'unibyte-string) 105 'unibyte-string 106 'string) 107 (uuidgen--string-to-octets id))) 108 109 (defun uuidgen--fixnum (bignum) 110 "Compatibility layer to convert a bignum to fixnum. 111 Emacs supports native bignum starting from version 27. For older 112 version will use calc for bignum calculation." 113 (if (integerp bignum) 114 bignum 115 (if (fboundp 'math-fixnum) 116 (math-fixnum bignum) 117 (error "%s is not a supported number format" bignum)))) 118 119 (defun uuidgen--current-unix-clock () 120 "Get the current Unix time as a 100-nanosecond intervals." 121 (if (fboundp 'time-convert) 122 (car (time-convert (current-time) 10000000)) 123 (let* ((unix-time (current-time)) 124 (high (nth 0 unix-time)) 125 (low (nth 1 unix-time)) 126 (micro (nth 2 unix-time))) 127 (math-add 128 (math-mul 10000000 (math-add (math-mul high #x10000) low)) 129 (* 10 micro))))) 130 131 (defun uuidgen--system-clock () 132 "Get the 100-nanosecond intervals after UUID epoch." 133 (math-add (uuidgen--current-unix-clock) uuidgen-unix-epoch-delta)) 134 135 (defun uuidgen--random-clock () 136 "Get a random generated 60 bit clock." 137 (calcFunc-random (math-power-of-2 60))) 138 139 (defun uuidgen--format-time-low (clock) 140 "Format the time_low part of the UUID. 141 CLOCK should be a integer less than 60 bits." 142 (let ((time-low (uuidgen--fixnum (math-clip clock 32)))) 143 (format "%08x" time-low))) 144 145 (defun uuidgen--format-time-mid (clock) 146 "Format the time_mid part of the UUID. 147 CLOCK should be a integer less than 60 bits." 148 (let ((time-mid (uuidgen--fixnum 149 (math-clip 150 (car (math-idivmod clock (math-power-of-2 32))) 16)))) 151 (format "%04x" time-mid))) 152 153 (defun uuidgen--format-time-hi-version (clock &optional ver) 154 "Format the time_hi_and_version part of the UUID. 155 CLOCK should be a integer less than 60 bits. 156 VER is the UUID variant number. Valid VER are 1, 3, 4, 5." 157 (let ((version (or ver 1)) 158 (time-hi (uuidgen--fixnum 159 (math-clip 160 (car (math-idivmod clock (math-power-of-2 48))) 12)))) 161 (format "%01x%03x" ver time-hi))) 162 163 (defun uuidgen--format-clock-seq-low (clock) 164 "Format the clock_seq_low part of the UUID. 165 CLOCK should be a integer less than 60 bits." 166 (format "%02x" (logand #xFF clock))) 167 168 (defun uuidgen--format-clock-seq-hi-reserved (clock) 169 "Format the clock_seq_hi_and_reserved part of the UUID. 170 CLOCK should be a integer less than 60 bits." 171 (format "%02x" (logior #x80 (logand #x3F (lsh clock -8))))) 172 173 (defun uuidgen--random-address () 174 "Return a address formed by list of random numbers." 175 (mapcar (lambda (n) (random 256)) (make-list 6 0))) 176 177 (defun uuidgen--random-multicast-address () 178 "Return a random multicast address." 179 (let ((addr (uuidgen--random-address))) 180 ;; Set multicast bit. RFC4122#4.1.6 181 (cons (logior #x10 (car addr)) 182 (cdr addr)))) 183 184 (defun uuidgen--get-interface (interfaces &optional default) 185 "Return the interface for UUID node information. 186 The INTERFACES is the same format of `network-interface-list' output. 187 If DEFAULT is not nil, check whether interface DEFAULT exists first." 188 (if (and default (network-interface-info default)) 189 default 190 (let ((ifname (caar interfaces))) 191 (if (string= ifname "lo") 192 (uuidgen--get-interface (cdr interfaces)) 193 ifname)))) 194 195 (defun uuidgen--get-ieee-address () 196 "Return the IEEE address from `network-interface-info'. 197 The return value is a array consist of the address number. 198 If there is no interface available then return a random 199 multicast address list." 200 ;; Some platform doesn't have network-interface-* so we have to 201 ;; check this. 202 (if (and (fboundp 'network-interface-list) 203 (fboundp 'network-interface-info)) 204 (let ((info (network-interface-info 205 (uuidgen--get-interface 206 (network-interface-list) uuidgen-interface)))) 207 (if (and info 208 (nth 3 info)) 209 (cdr (nth 3 info)) 210 (progn 211 (or uuidgen-suppress-network-info-warnings 212 (display-warning 213 '(uuid network-interface-info) 214 "`network-interface-info' returned nil address. 215 216 This means either your NIC has no MAC address or the 217 `network-interface-info' implementation on your platform is buggy. 218 219 Will use random multicast address instead. Although this is suggested 220 by RFC4122, the result might not be desired. 221 222 You can customize `uuidgen-suppress-network-info-warnings' to 223 disable this warning or by adding the entry (uuid network-interface-info) 224 to the user option `warning-suppress-types', which is defined in the 225 `warnings' library.\n")) 226 (uuidgen--random-multicast-address)))) 227 (progn 228 (or uuidgen-suppress-network-info-warnings 229 (display-warning 230 'uuid 231 "Missing `network-interface-info' or `network-interface-list' support. 232 233 Use random multicast address instead. Although this is suggested 234 by RFC4122, the result might not be desired. 235 236 You can customize `uuidgen-suppress-network-info-warnings' to 237 disable this warning or by adding the entry (uuid network-interface-info) 238 to the user option `warning-suppress-types', which is defined in the 239 `warnings' library.\n")) 240 (uuidgen--random-multicast-address)))) 241 242 (defun uuidgen--format-ieee-address () 243 "Format the IEEE address based node name of UUID." 244 (let ((address (uuidgen--get-ieee-address))) 245 (mapconcat (lambda (var) (format "%02x" var)) 246 address ""))) 247 248 (defun uuidgen--format-random-address () 249 "Format the IEEE address based node name of UUID." 250 (let ((address (uuidgen--random-address))) 251 (mapconcat (lambda (var) (format "%02x" var)) 252 address ""))) 253 254 (defun uuidgen--from-time (clock seq ver addr-function) 255 "Generate UUID based on various value. 256 CLOCK should be a integer less than 60 bits. SEQ should be a 257 integer less than 14 bits. VER is the UUID variant number. 258 Valid VER are 1, 3, 4, 5. ADDR-FUNCTION is a function generating 259 the node information. Pre-defined ADDR-FUNCTION are 260 `uuidgen--format-ieee-address' and `uuidgen--format-random-address'." 261 (mapconcat 'identity 262 (list 263 (uuidgen--format-time-low clock) 264 (uuidgen--format-time-mid clock) 265 (uuidgen--format-time-hi-version clock ver) 266 (concat (uuidgen--format-clock-seq-hi-reserved seq) 267 (uuidgen--format-clock-seq-low seq)) 268 (funcall addr-function)) 269 "-")) 270 271 (defun uuidgen-1 () 272 "Generate time based UUID, aka UUIDv1." 273 (let ((clock (uuidgen--system-clock)) 274 (seq (random))) 275 (uuidgen--from-time clock seq 1 'uuidgen--format-ieee-address))) 276 277 (defun uuidgen-4 () 278 "Generate UUID form random numbers, aka UUIDv4." 279 (let ((clock (uuidgen--random-clock)) 280 (seq (random))) 281 (uuidgen--from-time clock seq 4 'uuidgen--format-random-address))) 282 283 (defun uuidgen-from-hash (hash ver) 284 "Generate name based UUID form hash HASH and version VER." 285 (mapconcat 'identity 286 (list 287 (substring hash 0 8) 288 (substring hash 8 12) 289 (concat (number-to-string ver) 290 (substring hash 13 16)) 291 (format "%04x" 292 (logior #x8000 (logand #x3FFF 293 (string-to-number (substring hash 16 20) 16)))) 294 (substring hash 20 32)) 295 "-")) 296 297 (defun uuidgen-3 (ns name) 298 "Generate name based UUID using MD5 hash algorithm, aka UUIDv3. 299 NS should be a generated UUID or predefined namespaces, 300 `uuidgen-ns-dns', `uuidgen-ns-url', `uuidgen-ns-oid', `uuidgen-ns-x500'. 301 NAME is the node name string." 302 (let ((hash (md5 (concat (uuidgen--decode ns) (string-as-unibyte name))))) 303 (uuidgen-from-hash hash 3))) 304 305 (defun uuidgen-5 (ns name) 306 "Generate name based UUID using SHA-1 hash algorithm, aka UUIDv5. 307 NS should be a generated UUID or predefined namespaces, 308 `uuidgen-ns-dns', `uuidgen-ns-url', `uuidgen-ns-oid', `uuidgen-ns-x500'. 309 NAME is the node name string." 310 (let ((hash (sha1 (concat (uuidgen--decode ns) (string-as-unibyte name))))) 311 (uuidgen-from-hash hash 5))) 312 313 (defun uuidgen-urn (uuid) 314 "Return the string representation of a UUID as a URN." 315 (concat "urn:uuid:" uuid)) 316 317 (defun uuidgen-cid (&optional uuid) 318 "Return UUID string in CID format that is suitable for COM definition. 319 If UUID is nil will generate UUIDGEN-4 automatically. 320 You customize `uuidgen-cid-format-string' to change the default format." 321 (let ((raw (uuidgen--string-to-octets (or uuid 322 (uuidgen-4))))) 323 (apply 'format uuidgen-cid-format-string raw))) 324 325 ;;;###autoload 326 (defun insert-uuid-cid (uuid) 327 "Insert UUID string in CID format that is suitable for COM definition. 328 If UUID is nil will generate UUIDGEN-4 automatically. 329 You customize `uuidgen-cid-format-string' to change the default format." 330 (interactive (list (read-string "UUID: " (uuidgen-4)))) 331 (insert (uuidgen-cid uuid))) 332 333 ;;;###autoload 334 (defun uuidgen (time-based) 335 "Insert UUIDv4 at point. If TIME-BASED is non-nil, insert UUIDv1 instead." 336 (interactive "P") 337 (if time-based 338 (insert (uuidgen-1)) 339 (insert (uuidgen-4)))) 340 341 (provide 'uuidgen) 342 ;;; uuidgen.el ends here