1 ! Copyright (C) 2008 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
3 USING: calendar checksums checksums.md5 checksums.sha
4 combinators endian kernel literals math math.bitwise math.parser
10 : (timestamp) ( -- time )
11 ! 0x01b21dd213814000L is the number of 100-ns intervals
12 ! between the UUID epoch 1582-10-15 00:00:00 and the
13 ! Unix epoch 1970-01-01 00:00:00.
14 now timestamp>micros 10 * 0x01b21dd213814000 + ;
16 : (hardware) ( -- address )
17 ! Choose a random 48-bit number with eighth bit
18 ! set to 1 (as recommended in RFC 4122)
19 48 random-bits 0x010000000000 bitor ;
21 : (clock) ( -- clockseq )
22 ! Choose a random 14-bit number
25 : (version) ( n version -- n' )
27 0xc000 48 shift bitnot bitand
29 0xf000 64 shift bitnot bitand
30 ] dip 76 shift bitor ;
32 : (uuid) ( a version b variant c -- n )
36 [ 12 bits 64 shift + ]
41 : uuid>string ( n -- string )
42 >hex 32 CHAR: 0 pad-head
43 [ CHAR: - 20 ] dip insert-nth
44 [ CHAR: - 16 ] dip insert-nth
45 [ CHAR: - 12 ] dip insert-nth
46 [ CHAR: - 8 ] dip insert-nth ;
48 : string>uuid ( string -- n )
49 CHAR: - swap remove hex> ;
53 : uuid-parse ( string -- byte-array )
56 : uuid-unparse ( byte-array -- string )
61 [ 32 bits 16 shift ] [ -32 shift 16 bits + 1 ] [ -48 shift ] tri
62 0b01 (clock) 48 shift (hardware) +
65 : uuid3 ( namespace name -- string )
66 [ uuid-parse ] dip append
67 md5 checksum-bytes 16 index-or-length head be>
68 3 (version) uuid>string ;
72 4 (version) uuid>string ;
74 : uuid5 ( namespace name -- string )
75 [ uuid-parse ] dip append
76 sha1 checksum-bytes 16 index-or-length head be>
77 5 (version) uuid>string ;
80 (timestamp) [ -12 shift 6 ] [ 12 bits ] bi
81 0b10 (clock) 48 shift $[ 48 random-bits ] +
85 now timestamp>millis 7
87 62 random-bits (uuid) uuid>string ;
89 : uuid8 ( a b c -- string )
90 [ 8 ] 2dip [ 0b01 ] dip (uuid) uuid>string ;
92 : uuid-urn ( string -- url )
95 CONSTANT: NAMESPACE_DNS "6ba7b810-9dad-11d1-80b4-00c04fd430c8"
96 CONSTANT: NAMESPACE_URL "6ba7b811-9dad-11d1-80b4-00c04fd430c8"
97 CONSTANT: NAMESPACE_OID "6ba7b812-9dad-11d1-80b4-00c04fd430c8"
98 CONSTANT: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8"