! Copyright (C) 2008 John Benediktsson ! See http://factorcode.org/license.txt for BSD license USING: alien.syntax alien.c-types byte-arrays checksums checksums.md5 checksums.sha1 kernel math math.parser math.ranges random unicode.case sequences strings system ; IN: uuid ( address clockseq time_high time_mid time_low -- n ) 96 shift [ 80 shift ] dip bitor [ 64 shift ] dip bitor [ 48 shift ] dip bitor bitor ; : (version) ( n version -- n' ) [ HEX: c000 48 shift bitnot bitand HEX: 8000 48 shift bitor HEX: f000 64 shift bitnot bitand ] dip 76 shift bitor ; : uuid>string ( n -- string ) >hex 32 CHAR: 0 pad-left CHAR: - 20 rot insert-nth CHAR: - 16 rot insert-nth CHAR: - 12 rot insert-nth CHAR: - 8 rot insert-nth ; : string>uuid ( string -- n ) [ CHAR: - = not ] filter 16 base> ; : uuid>byte-array ( n -- byte-array ) 16 swap 0 15 1 [ dup 8 * neg [ swap dup ] dip shift HEX: ff bitand rot roll [ set-nth ] keep swap ] each drop reverse ; : byte-array>uuid ( byte-array -- n ) [ >hex 2 CHAR: 0 pad-left ] { } map-as "" join 16 base> ; PRIVATE> : uuid-parse ( string -- byte-array ) string>uuid uuid>byte-array ; : uuid-unparse ( byte-array -- string ) byte-array>uuid uuid>string ; : uuid1 ( -- string ) (hardware) (clock) (timestamp) 1 (version) uuid>string ; : uuid3 ( namespace name -- string ) [ uuid-parse ] dip >byte-array append md5 checksum-bytes 16 short head byte-array>uuid 3 (version) uuid>string ; : uuid4 ( -- string ) 128 random-bits 4 (version) uuid>string ; : uuid5 ( namespace name -- string ) [ uuid-parse ] dip >byte-array append sha1 checksum-bytes 16 short head byte-array>uuid 5 (version) uuid>string ; : NAMESPACE_DNS "6ba7b810-9dad-11d1-80b4-00c04fd430c8" ; inline : NAMESPACE_URL "6ba7b811-9dad-11d1-80b4-00c04fd430c8" ; inline : NAMESPACE_OID "6ba7b812-9dad-11d1-80b4-00c04fd430c8" ; inline : NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8" ; inline