pax_global_header00006660000000000000000000000064121753614150014517gustar00rootroot0000000000000052 comment=b5d563b0ed57e0f1d3be912e16ed0742e41f3020 uuid-20130813-git/000077500000000000000000000000001217536141500135115ustar00rootroot00000000000000uuid-20130813-git/.gitignore000066400000000000000000000000301217536141500154720ustar00rootroot00000000000000*~ *# *.fasl *.gz *.asc uuid-20130813-git/emacs.jpeg000066400000000000000000000023201217536141500154450ustar00rootroot00000000000000JFIFC     "" $(4,$&1'-=-157:::#+?D?8C49:7C 7%%77777777777777777777777777777777777777777777777777M"4 !1"AQTqa$2B#4b$!1aA ?5W 8i7hn[8Ii\fp^ e$ #2/{EDk1fg27Yr݋K'*_gP}|i\N?-Us(ӮZE?%Xq]ŒulTR)ZkE$uWvđ)SPVPԥ";)R q9stד 2I4Scp#Q q3}#Am']GZr̩.D IZ@!J:JAU'n.aH2P i 1BSiIH7Mu}#8̎ckhnhk5C4BU-i`2UCjlk-W7mcrssHurk -ak,B. F%!s B{k1J}%˲Fcq˭rwP(^4 r#/hjXFmsxi51aF"# Ss/ Zhg[%hHO{p7 j1u=)ƹB`$'sGiD)׋vRPHZ5 ;x3u_u_VYw~cEUgXwteSE<0M 1ieIu|w"u\-\/fT{jʙ Ned [I.-5K|ۢWM3+s+3LK+L%\Q/"*s>?`3̀Pv3c{|t]l67QLL oIUU /{&&&&*-[PfBBƍN=iĉpN"u̙3䩧r*߸q#DGG#FкukΟ?XH"##?˃W\w<ڷoψ#HNNn޼Y;qFٳHV^ ˗iժڵʕ+,[HZn;}/dZfߧsxzzbXhٲ%3f̠f4 ֭[EIpp抝Ǝ+{ibX$..Nl6*ڵ///QE6m*VUiHǎe2|;w<#b2l6/"""ڳCCCԩS}o.Z{L&Jvv̝;W>&&>CdӦM""bd(r-S-[&?t:D'@bccr@+)..FIPP/ȲezK{@RR("ӧOm }[0z!NG@x '0^zIQQQ_?b)//w 7|#H-$''Gk2n8iڴ$''Ez=Æ > %%3uTٶm|  EGGwީQl68t 6t+MRRjߜ9s ?fɒ%n^aذa4h@+Ww}SNѥKLxw}GAAxzz2tPV+9/^d˖-ѨQ#Μ9_ #!!???l\wѶm[ڶmKLL ͚5cۗ~کn@@WˋsW_ ̨(.](JJJPE;i̘14jԈ'P]9wYf|Fs|tؑٳgӤIBCC0aׯ_LG:{ӧd߾}(eee~YV횒ʒT'N'OTM%\zURSSҥK5ֵm2Y.9rDRSS%//ϩ\UUIKKZ6l /^HFFF̛T?rSKt\rEoRݩJ {3kt=Iz=nb[_eyeTQTuSH]̛T M0oy̛t̛`qo$*p^erkFUHUxr1|srHxR# 0n0QU(jْ1c2s5kg۶m[,ۼcJOG`ƫ<}:?8[V6l@jj* 6dС_ 6ԤI8{ < [UM{/RQ8)̀ڵ5}lݺU+{7IJJbtЁ|SR`+,@SLVUaE'*:VZa2PU'Or L&[iݺvʕ+HOOgĉ$&&ʴi4h \0 Jqq1Jq1+8u:R$}Y L-/g<<Gpp0z^*%%%lݺO>nݺ3#++;}Y~']v4m___EF]pǏW~Tl<vA YFT֭:t})ǎKbcc%33SV\ r<E.]'|"꯱Zw^"b͚52~xׯ̜9eM6rJINN={bN'q~Liժ w7kLdժUHKFFA5l(Νsr./4aYr<ұcGiӦtU(]tݻk} .^z՛Y .& Wu3@olL~ym4<Ț5k\{ٳ/_ŋرZh!C 66muӦML43UG#XS"#\Lbb"ͣy 6<:uĨQ*tY,Jn? ^FU#g͚5Kt_=b2DQbv%E}YAIIݻX\"qnnJ@@TM&>2;GtV#ʶo.111du~7 pǣM6r XyGu]t:("ڵݻwKIItUf̘rMvv@ lk*Pd2cl2-dzpL"+r ZhrEQڵ+VUS)++Ç~zXz5܌>`۶m0rHҘ>}:ƍ㥗^r ki(Xgln)T''=I$yJg ;|[1}tVXE.^HXXsmڴAnqii)"ªU7nnѰaC|||wXDܹ3%%%8q-[j_~t?99owlTcEE_/|-z끯fx̜9W^yŭ12@@vwv9wmaZ9p- 6e˖ie{Fdf1a221.Uj>`J:|=$ ȇ | l0cқ0FѡC:yWF 553fЦM'P[nqۘ3g2x`1m`0`Zk}Eq뭷B&Mx4fa0p'N?nD2 ٓ 10[oFmƬX0b€CgO:(43?{n4m܌ht:Νĉݻ>}mL>}رc}Ν]v?T\nڵ, J`Ǐ{ADtz-ZSTT|+*yp㒕qx_:vZZ"8g8OIk`>8z&fȪ#+J݁V)wᦪs(O9xQdN8JlIQvH~CP Qw8AUT f4f#S^"T;**n5G`q,jנgw*`F`zV׀`KhFa/E4^1N>ΉD~2NѸVl \ۀUv;K/ c35 r~mⷐŢ38QѴqlJY*֨gB{=gx?TĕzVFҌ@/}T3ɞz3FEï(nEֽ&uwXV0\Z)[u:\x XMkyZPShn[7[VڀUDAMTIbE(8 R5`D aC]eS2η&u >8]UJ`G`5W`Q*z :tFgV6`"䃾HH56`mqJ) u1c/,xQp-=[%5NY,'=[ X{R4 [*tG"5.ddTlSH1((XJ`kX'#Qg&n#[R L?cU%q}-ԱvlW\t5)"t0'ޘp yA]S=cIJ*ά(ՀuMT)W~RE)TOxXu ɩ[n5%4`nnU?-To2brCY2_XgU`ĄO,xbŒ딪=*8 (4`↣FK2j9Ayxu+"JFgrشn̓qdK\NRB)%q=zLX0 *_Rx[C9{UƣIg`+?U8TT3ߊ+ ňނQw"Z.Ԫ淴 l@ =LD EL1fsZ=z⁙ *&WATB%8U\Yb:.Vޭk"P(Zd)-|0(zr&enR6ʅ#CiNsdl݈6(-3aƌ&`ӯj&P3`6̙uԋӞzSQ"K.UZgPU2§tE0Wl ػ_7oSZ`b JYdp3dI\XIy ){jO + 53TG"U^TZƹ+4hvw+%. rNo|>h߱k4S~dDCdʮ_HdF4iX^L("0C1Tc w cˮG&09fr+%x.@D*n . ôo߾B\<~cccޫuKh2<֍͠SF9eQ0`¤6WDQ 8(Rbs̉TZj` lVzA|||"˗ \v5z^CX2pxi;MҬUa~NYbmbJr0`X ki:#Q{&HQ mAH ɓlqNԚ6m4d&%%b 2_Z5I9-xbs(5?OYt(a~+S5TQ5ӯJU'fERɖo˥X-aWBu̗Xv-IIIL4ɉ w2qjǎ7iJ(F chAx&*4 "I5)|$Mid`+Wu$R-W'CEG#/ V)H-p;6h^/3Ade^PaܹsٷoIII_dzm6ƌ4 0''i;I&q뭷r: IɦO)5RTPg8 4%q?;\W}V$aEٮH{vyq[mL1|G̙3~UVk.m}3g$oDGG( ͂2HJ Y2](m[c()r9~j-oS9qE ̪er\ܾJbzB^P.{m[B|x"((={pyf7o=z 00maǎg0CCCiժMtI5nsGڷo6md0E1Lb bcc 77K@Æ Yh!!! 6ӧOvZ4ܹsھgթ_~Ns}Μ9ç~ʝwIǎ~!?8f97{w(Bvv6+W$..XnJJJ z/wy8nVYv-ۛԾ"O QIDAT/^,w-]v^/{l6IKK^//&I#""AAAҧOټykSSSSNҩS'N}_n۟~ekݻw !QQQ&F`1cƈȾ}DQy7DD_@7o_FÆ eٲe~:t///0`SF̞=1{6m "L0+W^-:t;wСCܹ)ע/'N~zD?3>}_|)S8|0?=z@D2e saȑ.[(vҥKqa"## q5G.[ԅ{M2gҭ[7 :Bu!::˗3diTUO?cǎSS2yd'Sg0MRfժUN(4dlի0aФI|I&O>*7o[n'`޽ڹWGXXPPP4xРAn=Z5kHII!%%޽{3l0m, >gϞ~`ʔ) /e˖`ܹw\X,NG}os\ENڵk=zTyiҤW0Ҹqc0aڵDDΝ;'.T)~~~ҲeK9r[eM:oo4X7ntN:[VV&3foozF>|X^u!;v(u*Fzw}IE!**(,,ȑ#?~\Xz5"))NHQWaPUE%ݻ 68e;iӦM,^%ZjErr2ǎ#11իWѣGٵkK:l߾}L6N:t(YYY.GFFc\vtFNVXLZΝ;߱cG6nH\\nN:ո{u2L=Jv2d={ڹ#G7h[p`ǎsyxΝX,ߕm3qD&MTBEqIl6LV9n&g=Hՙݺus)h׮SNv ]qF2{|Â9qD|}}]O8kF||<nݚΝ֭[k4:u*Vr*7 86@\#F=zGzjEϏxƎK~꼊>|gdgg3駟M676 -[6m?5pU֭[W_}E||<~a :=#VWL0ӧלλђ:u믿رcZ{:YQU͛73hР !^_Yp!f%NBB @E^ZZvbΝl߾3gθ\sN.]ĉk-1aGtt4]tqYTϏnݺiVf?2fO?`{]6ސ̺z=}孷rL$iZINN&--M;ϔ)St}vN,--GZYZZ}o_| O0[lGvЁAթF;77xz)h9¢Exw]to80kwѣGLÇsIM( y7 Jff&W\qGիkn?-vWdԩtЁW^yj\*yyyz^z1wZiXjՅ3BN!L( 8~ĺuHJJܹs8uz, 7O><~5NG``3_β O>ɓO>y]`69p@׏~!"\t,^JYY& ???BCCqܹ?ļ&R i72gp+HNNH=_3Ԯbի nRM6?=Zs3IENDB`uuid-20130813-git/opensource-55x48.png000066400000000000000000000063051217536141500172000ustar00rootroot00000000000000PNG  IHDR70ME?tIME.eu yIDATxXiTSd fT EℶPpZ}%jyeAD*E'hQXZ4 2{LDA?s3}.1=kCfs30g0Nݧ1FZQtXi^c}<||РA|>QWWw1cL6 c㓘! RMlOJ!Ġ3zZ:}A>Έxc ZeY}v-]bCXދC~ٳluOM9wƚ OÅ cG="XK̾V}ܜ]+OTAhZ̟%t:)yAuЦ~~3_ ig+^&Y,1SACSZ&Ng)Vʕ~zm'ښGw9=Ϫ'yF=~x1cFsssBB@dd$,Z(00`gΜiii B" quuusss}}=X$aZZZ(d2YSSƸP"H$8'5$IRCƷ% b"S3Ä!{)W.r}馷xq?>x"ߨT; .߉;0FOL‡7VgYo5GQs9qΛSS `>ۂgI`RvkHG=:}:I P&tFػ ߑ!VَY 5qm',@gYϞ-Gˬۚ$`ݹ0HfK3fޫlTv?uoɝj*ѹI9QszgP{PR㓒d2/I;~8FFFRYZZz%yaIIɚ5k ""B%''oݺeϞ=3gLIIYjx|>ի5_I&asrrd2R{|%΃CБ^+v~E3SMҶe|?`P1S9Sjʂg]^U}9]HayQC45ҏ:b%Ǟ>E"^,I^h˖}nH%IR@A)Sc|l0c  Urn$UBvnUlw7חΤo& khm?B}TZN {XC S0xʰ|߸&f%o |M05` IvjσzG% gbmA%b h4: 6rMAFАe^㱨DS^S G7\>z0;FGk}W6 ~\gTm .`Ĥx,0S}?S[Y5A+ȷ-(#@ Z]aL}B;m-lFEI @bК*EONۖw ]ݾ6q_"7)h[Rծ2d$Eh$ؒmZKω=oz@} Z>i%4a3o_iN8+9& \ M5ퟑӶm$IΙ3ѣ_|񅅅ҥKS]]bffKQT@@AK,ٷo_eeePPqwwž<O$ř=x ""$ɸ8ȨݸqP(111EEEEɓ)))g\;&Bܹs|>?//lڴߟ㥥544Յ;880M6-Xfgeeڵ+--̬xȑ .wYXtd!djj|p{nP8n8m,;To޼‚ kFFFrUVI$t.9 t1(x+++ //PZpbbbv=dȐfd2j5 Universally Unique Indentifier

UUID

UUID is a Common Lisp librabry for generation of universally unique identifiers as described by RFC 4122.

Description

UUID provides methods for the generation of uuids version 1 (time based), 3 (name based with MD5 hashing), 5 (name based with SHA1 hashing) and 4 (random uuids).

Platforms

UUID has been run on Clisp (Windows), CMUCL(19d), SBCL(1.0.5 - Linux) and Allegro (Linux). Plattform specific code is needed only for the generation of time based (version 1) uuids for getting the MAC address of an ethernet device. If run in an unsupported lisp implementation a random number will be used for the node id instead of the MAC address.

History

26 May 2009 - Added suport for Allegron on Linux (Contributed by Andrew Philpot). Added suport for formatting as URN (Thanks to Kim Minh Kaplan).

27 July 2008 - Resolve loading issue due to Ironclad shadowing cl:null. (Reported by Maciek Pasternacki)

20 January 2008 - Fixed uuid-to-byte-array and provided byte-array-to-uuid.

02 October 2007 - Don't print a newline as part of the uuid.

07 July 2007 - Reinitialize *random-state* when loading in SBCL to ensure randomnes of v4 uuids. (Reported by Brian Seitz)

30 May 2007 - Added support for SBCL.

17 April 2007 - Updated the package with the correct file. (Reported by Rafael Cavallaro)

16 April 2007 - Released

Dependencies

Ironclad - needed for the generation of version 3 and version 5 uuids.

License

Lisp Lesser GNU Public License (LLGPL)

Author

Boian Tzonev <boiantz@gmail.com>

Download

http://www.dardoria.net/software/uuid.tar.gz

Installation

UUID can be loaded with asdf. After unpacking the archive UUID can be loaded with:

CL-USER> (asdf:oos 'asdf:load-op 'uuid)

Usage

CL-USER> (in-package :uuid)

Generation of version 1 (time based) uuid:

UUID> (make-v1-uuid)
D79FC180-ED1C-11DB-90E2-345C6EAC45A5

Generation of version 3 (name based MD5) uuid in the DNS namespace:

UUID> (make-v3-uuid +namespace-dns+ "www.widgets.com")
3D813CBB-47FB-32BA-91DF-831E1593AC29

Generation of version 4 (random) uuid:

UUID> (make-v4-uuid)
5EB052B1-BEF9-40E5-9EC5-D735A12DBF48

Generation of version 5 (name based SHA1) uuid in the DNS namespace:

UUID> (make-v5-uuid +namespace-dns+ "www.widgets.com")
21F7F8DE-8051-5B89-8680-0195EF798B6A

Documentation

*ticks-per-count* variable

Holds the amount of ticks per count. The ticks per count determine the number of possible version 1 uuids created for one time interval. Common Lisp provides INTERNAL-TIME-UINITS-PER-SECOND which gives the ticks per count for the current system so *ticks-per-count* can be set to INTERNAL-TIME-UINITS-PER-SECOND

+namespace-dns+ constant

The DNS Namespace. Can be used for the generation of uuids version 3 and 5.

+namespace-url+ constant

The URL Namespace. Can be used for the generation of uuids version 3 and 5.

+namespace-oid+ constant

The OID Namespace. Can be used for the generation of uuids version 3 and 5.

+namespace-x500+ constant

The x500+ Namespace. Can be used for the generation of uuids version 3 and 5.

uuid class

Represents an uuid

(make-uuid-from-string uuid-string) function

Creates an uuid from the string represenation of an uuid. (example input string 6ba7b810-9dad-11d1-80b4-00c04fd430c8)

(make-null-uuid) function

Returns a NULL uuid (i.e 00000000-0000-0000-0000-000000000000)

(make-v1-uuid) function

Returns a version 1 (time-based) uuid.

(make-v3-uuid namespace name) function

Returns a version 3 (named based MD5) uuid.

(make-v4-uuid) function

Returns a version 4 (random) uuid.

(make-v5-uuid namespace name) function

Returns a version 5 (name based SHA1) uuid.

(uuid-to-byte-array uuid) function

Converts an uuid to byte-array.

(byte-array-to-uuid byte-array) function

Converts a byte-array generated with uuid-to-byte-array to an uuid.

(print-bytes stream uuid) function

Prints the raw bytes in hex form. (example output 6ba7b8109dad11d180b400c04fd430c8).

(format-as-urn stream uuid) function

Formats the UUID as URN (example output urn:uuid:ea0e0cb8-7ed8-4b10-8214-1a175e982cc6).


Last modified: Tue May 26 23:05:54 EEST 2009    

uuid-20130813-git/uuid.lisp000066400000000000000000000260031217536141500153510ustar00rootroot00000000000000;;;; Author Boian Tzonev ;;;; 2007-2011, All Rights Reserved ;;;; ;;;; This software may be distributed and used according to the terms of the Lisp Lesser GNU Public License (LLGPL) ;;;; (http://opensource.franz.com/preamble.html). (cl:defpackage :uuid (:use :common-lisp) (:export :uuid :*ticks-per-count* :format-as-urn :make-null-uuid :make-uuid-from-string :make-v1-uuid :make-v3-uuid :make-v4-uuid :make-v5-uuid :uuid= :+namespace-dns+ :+namespace-url+ :+namespace-oid+ :+namespace-x500+ :print-bytes :uuid-to-byte-array :byte-array-to-uuid)) (cl:in-package :uuid) (defvar *clock-seq* 0 "Holds the clock sequence. It is set when a version 1 uuid is generated for the first time and remains unchanged during a whole session.") (defvar *node* nil "Holds the IEEE 802 MAC address or a random number when such is not available") (defvar *ticks-per-count* 1024 "Holds the amount of ticks per count. The ticks per count determine the number of possible version 1 uuids created for one time interval. Common Lisp provides INTERNAL-TIME-UNITS-PER-SECOND which gives the ticks per count for the current system so *ticks-per-count* can be set to INTERNAL-TIME-UNITS-PER-SECOND") (defparameter *uuid-random-state* nil "Holds the random state used for generation of random numbers") (defclass uuid () ((time-low :initarg :time-low :type (unsigned-byte 32) :accessor time-low :initform 0) (time-mid :initarg :time-mid :type (unsigned-byte 16) :accessor time-mid :initform 0) (time-high-and-version :initarg :time-high :type (unsigned-byte 16) :accessor time-high :initform 0) (clock-seq-and-reserved :initarg :clock-seq-var :type (unsigned-byte 8) :accessor clock-seq-var :initform 0) (clock-seq-low :initarg :clock-seq-low :type (unsigned-byte 8) :accessor clock-seq-low :initform 0) (node :initarg :node :type (unsigned-byte 48) :accessor node :initform 0)) (:documentation "Represents an uuid")) (defun make-uuid-from-string (string) "Creates an uuid from the string represenation of an uuid. (example input string 6ba7b810-9dad-11d1-80b4-00c04fd430c8)" (unless (= (length string) 36) (error "~@" string (length string))) (unless (and (eq (aref string 8) #\-) (eq (aref string 13) #\-) (eq (aref string 18) #\-) (eq (aref string 23) #\-)) (error "~@" string #\- (char-name #\-))) (labels ((parse-block (string start end) (parse-integer string :start start :end end :radix 16))) (make-instance 'uuid :time-low (parse-block string 0 8) :time-mid (parse-block string 9 13) :time-high (parse-block string 14 18) :clock-seq-var (parse-block string 19 21) :clock-seq-low (parse-block string 21 23) :node (parse-block string 24 36)))) (defparameter +namespace-dns+ (make-uuid-from-string "6ba7b810-9dad-11d1-80b4-00c04fd430c8") "The DNS Namespace. Can be used for the generation of uuids version 3 and 5") (defparameter +namespace-url+ (make-uuid-from-string "6ba7b811-9dad-11d1-80b4-00c04fd430c8") "The URL Namespace. Can be used for the generation of uuids version 3 and 5") (defparameter +namespace-oid+ (make-uuid-from-string "6ba7b812-9dad-11d1-80b4-00c04fd430c8") "The OID Namespace. Can be used for the generation of uuids version 3 and 5") (defparameter +namespace-x500+ (make-uuid-from-string "6ba7b814-9dad-11d1-80b4-00c04fd430c8") "The x500+ Namespace. Can be used for the generation of uuids version 3 and 5") (defun get-node-id () "Get MAC address of first ethernet device" (let ((node #+linux (let ((interface (first (remove "lo" (mapcan (lambda (x) (last (pathname-directory x))) (directory "/sys/class/net/*/")) :test #'equal)))) (when (not (null interface)) (with-open-file (address (make-pathname :directory (concatenate 'string "/sys/class/net/" interface) :name "address")) (parse-integer (remove #\: (read-line address)) :radix 16)))) #+(and :windows :clisp) (let ((output (ext:run-program "ipconfig" :arguments (list "/all") :input nil :output :stream :wait t))) (loop for line = (read-line output nil) while line when (search "Physical" line :test #'string-equal) return (parse-integer (remove #\- (subseq line 37)) :radix 16))) #+(and :macosx :lispworks) (with-open-stream (stream (sys:run-shell-command "/sbin/ifconfig en0 ether" :output :stream :if-error-output-exists t :wait nil)) (loop for line = (read-line stream nil) while line when (search "ether" line :test #'string-equal) return (parse-integer (remove #\: (subseq line 7)) :radix 16))))) (unless node (unless *uuid-random-state* (setf *uuid-random-state* (make-random-state t))) (setf node (dpb #b01 (byte 8 0) (random #xffffffffffff *uuid-random-state*)))) node)) (let ((uuids-this-tick 0) (last-time 0)) (defun get-timestamp () "Get timestamp, compensate nanoseconds intervals" (tagbody restart (let ((time-now (+ (* (get-universal-time) 10000000) 100103040000000000))) ;10010304000 is time between 1582-10-15 and 1900-01-01 in seconds (cond ((not (= last-time time-now)) (setf uuids-this-tick 0 last-time time-now) (return-from get-timestamp time-now)) (T (cond ((< uuids-this-tick *ticks-per-count*) (incf uuids-this-tick) (return-from get-timestamp (+ time-now uuids-this-tick))) (T (sleep 0.0001) (go restart))))))))) (defun format-v3or5-uuid (hash ver) "Helper function to format a version 3 or 5 uuid. Formatting means setting the appropriate version bytes." (check-type ver (or (eql 3) (eql 5)) "either 3 or 5.") (let ((result (byte-array-to-uuid (subseq hash 0 16)))) (setf (time-high result) (dpb (ecase ver (3 #b0011) (5 #b0101)) (byte 4 12) (logior (ash (aref hash 6) 8) (aref hash 7))) (clock-seq-var result) (dpb #b10 (byte 2 6) (aref hash 8))) result)) (defmethod print-object ((id uuid) stream) "Prints an uuid in the string represenation of an uuid. (example string 6ba7b810-9dad-11d1-80b4-00c04fd430c8)" (format stream "~8,'0X-~4,'0X-~4,'0X-~2,'0X~2,'0X-~12,'0X" (time-low id) (time-mid id) (time-high id) (clock-seq-var id) (clock-seq-low id) (node id))) (defun print-bytes (stream uuid) "Prints the raw bytes in hex form. (example output 6ba7b8109dad11d180b400c04fd430c8)" (format stream "~8,'0X~4,'0X~4,'0X~2,'0X~2,'0X~12,'0X" (time-low uuid) (time-mid uuid) (time-high uuid) (clock-seq-var uuid) (clock-seq-low uuid) (node uuid))) (defun format-as-urn (stream uuid) "Prints the uuid as a urn" (format stream "urn:uuid:~(~A~)" uuid)) (defun make-null-uuid () "Generates a NULL uuid (i.e 00000000-0000-0000-0000-000000000000)" (make-instance 'uuid)) (defun make-v1-uuid () "Generates a version 1 (time-based) uuid." (unless *uuid-random-state* (setf *uuid-random-state* (make-random-state t))) (let ((timestamp (get-timestamp))) (when (zerop *clock-seq*) (setf *clock-seq* (random 10000 *uuid-random-state*))) (unless *node* (setf *node* (get-node-id))) (make-instance 'uuid :time-low (ldb (byte 32 0) timestamp) :time-mid (ldb (byte 16 32) timestamp) :time-high (dpb #b0001 (byte 4 12) (ldb (byte 12 48) timestamp)) :clock-seq-var (dpb #b10 (byte 2 6) (ldb (byte 6 8) *clock-seq*)) :clock-seq-low (ldb (byte 8 0) *clock-seq*) :node *node*))) (defun make-v3-uuid (namespace name) "Generates a version 3 (named based MD5) uuid." (format-v3or5-uuid (digest-uuid :md5 (uuid-to-byte-array namespace) name) 3)) (defun make-v4-uuid () "Generates a version 4 (random) uuid" (unless *uuid-random-state* (setf *uuid-random-state* (make-random-state t))) (make-instance 'uuid :time-low (random #xffffffff *uuid-random-state*) :time-mid (random #xffff *uuid-random-state*) :time-high (dpb #b0100 (byte 4 12) (ldb (byte 12 0) (random #xffff *uuid-random-state*))) :clock-seq-var (dpb #b10 (byte 2 6) (ldb (byte 8 0) (random #xff *uuid-random-state*))) :clock-seq-low (random #xff *uuid-random-state*) :node (random #xffffffffffff *uuid-random-state*))) (defun make-v5-uuid (namespace name) "Generates a version 5 (name based SHA1) uuid." (format-v3or5-uuid (digest-uuid :sha1 (uuid-to-byte-array namespace) name) 5)) (defun uuid= (uuid1 uuid2) (or (eq uuid1 uuid2) (and (= (time-low uuid1) (time-low uuid2)) (= (time-mid uuid1) (time-mid uuid2)) (= (time-high uuid1) (time-high uuid2)) (= (clock-seq-var uuid1) (clock-seq-var uuid2)) (= (clock-seq-low uuid1) (clock-seq-low uuid2)) (= (node uuid1)(node uuid2))))) (defun uuid-to-byte-array (uuid) "Converts an uuid to byte-array" (let ((array (make-array 16 :element-type '(unsigned-byte 8)))) (with-slots (time-low time-mid time-high-and-version clock-seq-and-reserved clock-seq-low node) uuid (loop for i from 3 downto 0 do (setf (aref array (- 3 i)) (ldb (byte 8 (* 8 i)) time-low))) (loop for i from 5 downto 4 do (setf (aref array i) (ldb (byte 8 (* 8 (- 5 i))) time-mid))) (loop for i from 7 downto 6 do (setf (aref array i) (ldb (byte 8 (* 8 (- 7 i))) time-high-and-version))) (setf (aref array 8) (ldb (byte 8 0) clock-seq-and-reserved)) (setf (aref array 9) (ldb (byte 8 0) clock-seq-low)) (loop for i from 15 downto 10 do (setf (aref array i) (ldb (byte 8 (* 8 (- 15 i))) node))) array))) (defmacro arr-to-bytes (from to array) "Helper macro used in byte-array-to-uuid." `(loop for i from ,from to ,to with res = 0 do (setf (ldb (byte 8 (* 8 (- ,to i))) res) (aref ,array i)) finally (return res))) (defun byte-array-to-uuid (array) "Converts a byte-array generated with uuid-to-byte-array to an uuid." (check-type array (array (unsigned-byte 8) (16)) "Provided value is not an one-dimensional array with 16 elements of type (unsigned-byte 8)") (make-instance 'uuid :time-low (arr-to-bytes 0 3 array) :time-mid (arr-to-bytes 4 5 array) :time-high (arr-to-bytes 6 7 array) :clock-seq-var (aref array 8) :clock-seq-low (aref array 9) :node (arr-to-bytes 10 15 array))) (defun digest-uuid (digest uuid name) "Helper function that produces a digest from a namespace (a byte array) and a string. Used for the generation of version 3 and 5 uuids." (let ((digester (ironclad:make-digest digest))) (ironclad:update-digest digester uuid) (ironclad:update-digest digester (trivial-utf-8:string-to-utf-8-bytes name)) (ironclad:produce-digest digester)))