1 ! Copyright (C) 2008 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
3 USING: calendar checksums checksums.md5 checksums.sha endian
4 kernel math math.parser random sequences ;
9 : (timestamp) ( -- time_high time_mid time_low )
10 ! 0x01b21dd213814000L is the number of 100-ns intervals
11 ! between the UUID epoch 1582-10-15 00:00:00 and the
12 ! Unix epoch 1970-01-01 00:00:00.
13 now timestamp>micros 10 * 0x01b21dd213814000 +
14 [ -48 shift 0x0fff bitand ]
15 [ -32 shift 0xffff bitand ]
19 : (hardware) ( -- address )
20 ! Choose a random 48-bit number with eighth bit
21 ! set to 1 (as recommended in RFC 4122)
22 48 random-bits 0x010000000000 bitor ;
24 : (clock) ( -- clockseq )
25 ! Choose a random 14-bit number
28 : <uuid> ( address clockseq time_high time_mid time_low -- n )
30 [ 80 shift ] dip bitor
31 [ 64 shift ] dip bitor
32 [ 48 shift ] dip bitor
35 : (version) ( n version -- n' )
37 0xc000 48 shift bitnot bitand
39 0xf000 64 shift bitnot bitand
40 ] dip 76 shift bitor ;
42 : uuid>string ( n -- string )
43 >hex 32 CHAR: 0 pad-head
44 [ CHAR: - 20 ] dip insert-nth
45 [ CHAR: - 16 ] dip insert-nth
46 [ CHAR: - 12 ] dip insert-nth
47 [ CHAR: - 8 ] dip insert-nth ;
49 : string>uuid ( string -- n )
50 CHAR: - swap remove hex> ;
54 : uuid-parse ( string -- byte-array )
57 : uuid-unparse ( byte-array -- string )
61 (hardware) (clock) (timestamp) <uuid>
62 1 (version) uuid>string ;
64 : uuid3 ( namespace name -- string )
65 [ uuid-parse ] dip append
66 md5 checksum-bytes 16 short head be>
67 3 (version) uuid>string ;
71 4 (version) uuid>string ;
73 : uuid5 ( namespace name -- string )
74 [ uuid-parse ] dip append
75 sha1 checksum-bytes 16 short head be>
76 5 (version) uuid>string ;
78 CONSTANT: NAMESPACE_DNS "6ba7b810-9dad-11d1-80b4-00c04fd430c8"
79 CONSTANT: NAMESPACE_URL "6ba7b811-9dad-11d1-80b4-00c04fd430c8"
80 CONSTANT: NAMESPACE_OID "6ba7b812-9dad-11d1-80b4-00c04fd430c8"
81 CONSTANT: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8"